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 13229 for NEMO – NEMO

Changeset 13229 for NEMO


Ignore:
Timestamp:
2020-07-02T17:33:41+02:00 (4 years ago)
Author:
francesca
Message:

dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13218, see #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
Files:
55 edited
3 copied

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r13015 r13229  
    9595   !                    !  bulk algorithm : 
    9696   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    97    ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    98    ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    99    ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
    100       ! 
    101       rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
    102       rn_zu       = 10.       !  Wind vector reference height (m) 
    103       ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
    104       ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
    105       rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    106       rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    107       rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
    108       !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
    109       ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
    110       ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
    111       ! 
    112       ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
    113       ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
    114       ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    11597   ! 
    11698   cn_dir = './'  !  root directory for the bulk data location 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

    r13015 r13229  
    9292   !                    !  bulk algorithm : 
    9393   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    94    ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    95    ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    96    ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
    97       ! 
    98       rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
    99       rn_zu       = 10.       !  Wind vector reference height (m) 
    100       ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
    101       ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
    102       rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    103       rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    104       rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
    105       !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
    106       ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
    107       ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
    108       ! 
    109       ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
    110       ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
    111       ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    11294   ! 
    11395   cn_dir      = './'      !  root directory for the bulk data location 
     
    176158!----------------------------------------------------------------------- 
    177159   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    178    rn_sponge_tra = 1440.   !  coefficient for tracer   sponge layer [m2/s] 
    179    rn_sponge_dyn = 1440.   !  coefficient for dynamics sponge layer [m2/s] 
    180160   ln_chk_bathy  = .true.  !  =T  check the parent bathymetry 
    181161/ 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

    r13015 r13229  
    158158!----------------------------------------------------------------------- 
    159159   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    160    rn_sponge_tra =  480.   !  coefficient for tracer   sponge layer [m2/s] 
    161    rn_sponge_dyn =  480.   !  coefficient for dynamics sponge layer [m2/s] 
    162160   ln_chk_bathy  = .true.  !  =T  check the parent bathymetry 
    163161/ 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r13065 r13229  
    9595!----------------------------------------------------------------------- 
    9696   !                    !  bulk algorithm : 
     97<<<<<<< .locale 
    9798   ln_NCAR    = .true.     ! "NCAR"      algorithm   (Large and Yeager 2008) 
    9899 
     100======= 
     101   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
     102   ! 
     103>>>>>>> .merge-dx.r13218 
    99104   cn_dir = './'  !  root directory for the bulk data location 
    100105   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_ABL/EXPREF/file_def_nemo-oce.xml

    r12063 r13229  
    5656     <field field_ref="t_abl" /> 
    5757     <field field_ref="q_abl" /> 
     58     <field field_ref="uvz1_abl" /> 
     59     <field field_ref="tz1_abl" /> 
     60     <field field_ref="qz1_abl" /> 
     61     <field field_ref="uvz1_dta" /> 
     62     <field field_ref="tz1_dta" /> 
     63     <field field_ref="qz1_dta" /> 
    5864     <field field_ref="pblh" /> 
    5965   </file> 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg

    r13015 r13229  
    110110   !                    !  bulk algorithm : 
    111111   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    112    ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    113    ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    114    ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
    115       rn_zqt      = 10.     !  Air temperature & humidity reference height (m) 
    116       rn_zu       = 10.     !  Wind vector reference height (m) 
    117       ! 
    118       ! Skin is ONLY available in ECMWF and COARE algorithms: 
    119       ln_skin_cs = .false.  !  use the cool-skin parameterization => set nn_fsbc=1 and ln_dm2dc=.true.! 
    120       ln_skin_wl = .false.  !  use the warm-layer        "        => set nn_fsbc=1 and ln_dm2dc=.true.! 
    121       ! 
    122       ln_humi_sph = .true.  !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
    123       ln_humi_dpt = .false. !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
    124       ln_humi_rlh = .false. !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    125112   ! 
    126113   cn_dir = './'  !  root directory for the bulk data location 
     
    132119   sn_tair     = 'tair_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d',  24., 'tair'    , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bilinear' , ''    , '' 
    133120   sn_humi     = 'humi_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d',  24., 'humi'    , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bilinear' , ''    , '' 
    134    sn_hpgi     = 'uhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d',  24., 'uhpg'    , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic'  , 'UG'  , '' 
    135    sn_hpgj     = 'vhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d',  24., 'vhpg'    , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic'  , 'VG'  , '' 
    136  
    137121   sn_qsr      = 'ncar_rad.15JUNE2009_fill'                    , 24., 'SWDN_MOD', .false. , .true.  ,  'yearly' , 'weights_core_orca2_bilinear_noc.nc'      , ''    , '' 
    138122   sn_qlw      = 'ncar_rad.15JUNE2009_fill'                    , 24., 'LWDN_MOD', .false. , .true.  ,  'yearly' , 'weights_core_orca2_bilinear_noc.nc'      , ''    , '' 
     
    140124   sn_snow     = 'ncar_precip.15JUNE2009_fill'                 , -1., 'SNOW'    , .false. , .true.  ,  'yearly' , 'weights_core_orca2_bilinear_noc.nc'      , ''    , '' 
    141125   sn_slp      = 'slp.15JUNE2009_fill'                         ,  6., 'SLP'     , .false. , .true.  ,  'yearly' , 'weights_core_orca2_bilinear_noc.nc'      , ''    , '' 
     126   sn_hpgi     = 'uhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d',  24., 'uhpg'    , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic'  , 'UG'  , '' 
     127   sn_hpgj     = 'vhpg_drwnlnd_ERAI_L25Z10_GLOBAL_F128R_ana1d',  24., 'vhpg'    , .false. , .false. , 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic'  , 'VG'  , '' 
    142128/ 
    143129 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r13015 r13229  
    121121/ 
    122122!----------------------------------------------------------------------- 
     123&namsbc_abl    !   Atmospheric Boundary Layer formulation           (ln_abl = T) 
     124!----------------------------------------------------------------------- 
     125/ 
     126!----------------------------------------------------------------------- 
    123127&namtra_qsr    !   penetrative solar radiation                          (ln_traqsr =T) 
    124128!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

    r13015 r13229  
    6868   !                    !  bulk algorithm : 
    6969   ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    70    ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    71    ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    72    ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 31) 
    73       ! 
    74       rn_zqt      = 10.       !  Air temperature & humidity reference height (m) 
    75       rn_zu       = 10.       !  Wind vector reference height (m) 
    76       ln_Cd_L12   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2012) 
    77       ln_Cd_L15   = .false.   !  air-ice drags = F(ice concentration) (Lupkes et al. 2015) 
    78       rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow) 
    79       rn_efac     = 1.        !  multiplicative factor for evaporation (0. or 1.) 
    80       rn_vfac     = 0.        !  multiplicative factor for ocean & ice velocity used to 
    81       !                       !  calculate the wind stress (0.=absolute or 1.=relative winds) 
    82       ln_skin_cs = .false.  !  use the cool-skin parameterization (only available in ECMWF and COARE algorithms) !LB 
    83       ln_skin_wl = .false.  !  use the warm-layer        "               "                    " 
    84       ! 
    85       ln_humi_sph = .true.     !  humidity specified below in "sn_humi" is specific humidity     [kg/kg] if .true. 
    86       ln_humi_dpt = .false.    !  humidity specified below in "sn_humi" is dew-point temperature   [K]   if .true. 
    87       ln_humi_rlh = .false.    !  humidity specified below in "sn_humi" is relative humidity       [%]   if .true. 
    8870   ! 
    8971   cn_dir      = './'      !  root directory for the bulk data location 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/SHARED/field_def_nemo-oce.xml

    r13186 r13229  
    455455          <field id="t_dta"      long_name="DTA potential temperature"     standard_name="dta_theta"      unit="K"        /> 
    456456          <field id="q_dta"      long_name="DTA specific humidity"         standard_name="dta_qspe"       unit="kg/kg"    /> 
    457           <field id="coeft"      long_name="ABL nudging coefficient"       standard_name="coeft"          unit=""         /> 
     457          <field id="u_geo"      long_name="GEO i-horizontal velocity"     standard_name="geo_x_velocity" unit="m/s"      /> 
     458          <field id="v_geo"      long_name="GEO j-horizontal velocity"     standard_name="geo_y_velocity" unit="m/s"      /> 
    458459          <field id="tke_abl"    long_name="ABL turbulent kinetic energy"  standard_name="abl_tke"        unit="m2/s2"    /> 
    459460          <field id="avm_abl"    long_name="ABL turbulent viscosity"       standard_name="abl_avm"        unit="m2/s"     /> 
    460461          <field id="avt_abl"    long_name="ABL turbulent diffusivity"     standard_name="abl_avt"        unit="m2/s"     /> 
    461           <field id="mxl_abl"    long_name="ABL mixing length"             standard_name="abl_mxl"        unit="m"        /> 
     462          <field id="mxlm_abl"   long_name="ABL master mixing length"      standard_name="abl_mxlm"       unit="m"        /> 
     463          <field id="mxld_abl"   long_name="ABL dissipative mixing length" standard_name="abl_mxld"       unit="m"        /> 
    462464   </field_group> 
    463465 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/SHARED/namelist_ref

    r13176 r13229  
    268268      ln_Cd_L12  = .false.  !  air-ice drags = F(ice conc.) (Lupkes et al. 2012) 
    269269      ln_Cd_L15  = .false.  !  air-ice drags = F(ice conc.) (Lupkes et al. 2015) 
    270       !                     !  - module of the mean stress" data 
     270      ln_crt_fbk = .false.     !  Add surface current feedback to the wind stress (Renault et al. 2020, doi: 10.1029/2019MS001715) 
     271         rn_stau_a = -2.9e-3   !     Alpha from eq. 10: Stau = Alpha * Wnd + Beta 
     272         rn_stau_b =  8.0e-3   !     Beta  
    271273      rn_pfac    = 1.       !  multipl. factor for precipitation (total & snow) 
    272274      rn_efac    = 1.       !  multipl. factor for evaporation (0. or 1.) 
    273       rn_vfac    = 0.       !  multipl. factor for ocean & ice velocity 
    274       !                     !  used to calculate the wind stress 
    275       !                     ! (0. => absolute or 1. => relative winds) 
    276275      ln_skin_cs = .false.  !  use the cool-skin parameterization 
    277276      ln_skin_wl = .false.  !  use the warm-layer parameterization 
     
    280279      ln_humi_dpt = .false. !  humidity "sn_humi" is dew-point temperature [K] 
    281280      ln_humi_rlh = .false. !  humidity "sn_humi" is relative humidity     [%] 
     281      ln_tpot     = .true.  !!GS: compute potential temperature or not 
    282282   ! 
    283283   cn_dir      = './'      !  root directory for the bulk data location 
     
    291291   sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    292292   sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    293    sn_hpgi     = 'NOT USED'                   ,   24.        , 'uhpg'    ,   .false.   , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG'     , '' 
    294    sn_hpgj     = 'NOT USED'                   ,   24.        , 'vhpg'    ,   .false.   , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG'     , '' 
    295293   sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    296294   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    297295   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     296   sn_uoatm    = 'NOT USED'                   ,    6.        , 'UOATM'   ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , 'Uoceatm', '' 
     297   sn_voatm    = 'NOT USED'                   ,    6.        , 'VOATM'   ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , 'Voceatm', '' 
     298   sn_hpgi     = 'NOT USED'                   ,   24.        , 'uhpg'    ,   .false.   , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'UG'     , '' 
     299   sn_hpgj     = 'NOT USED'                   ,   24.        , 'vhpg'    ,   .false.   , .false., 'monthly' , 'weights_ERAI3D_F128_2_ORCA2_bicubic', 'VG'     , '' 
    298300/ 
    299301!----------------------------------------------------------------------- 
     
    308310   cn_ablrst_outdir = "."             !  directory to write output abl restarts 
    309311 
     312   ln_rstart_abl  = .false. 
    310313   ln_hpgls_frc   = .false. 
    311314   ln_geos_winds  = .false. 
    312    nn_dyn_restore = 2         ! restoring option for dynamical ABL variables: = 0 no restoring 
     315   ln_smth_pblh   = .false. 
     316   nn_dyn_restore = 0         ! restoring option for dynamical ABL variables: = 0 no restoring 
    313317                              !                                               = 1 equatorial restoring 
    314318                              !                                               = 2 global restoring 
    315    rn_ldyn_min   =  4.5       !  magnitude of the nudging on ABL dynamics at the bottom of the ABL   [hour] 
    316    rn_ldyn_max   =  1.5       !  magnitude of the nudging on ABL dynamics at the top of the ABL   [hour] 
    317    rn_ltra_min   =  4.5       !  magnitude of the nudging on ABL tracers  at the bottom of the ABL   [hour] 
    318    rn_ltra_max   =  1.5       !  magnitude of the nudging on ABL tracers  at the top of the ABL   [hour] 
     319   rn_ldyn_min   =  4.5       ! dynamics nudging magnitude inside the ABL [hour] (~3 rn_Dt) 
     320   rn_ldyn_max   =  1.5       ! dynamics nudging magnitude above  the ABL [hour] (~1 rn_Dt) 
     321   rn_ltra_min   =  4.5       ! tracers  nudging magnitude inside the ABL [hour] (~3 rn_Dt) 
     322   rn_ltra_max   =  1.5       ! tracers  nudging magnitude above  the ABL [hour] (~1 rn_Dt) 
    319323   nn_amxl       =  0         ! mixing length: = 0 Deardorff 80 length-scale 
    320324                              !                = 1 length-scale based on the distance to the PBL height 
    321325                              !                = 2 Bougeault & Lacarrere 89 length-scale 
    322    rn_Cm         = 0.0667     ! 0.126 in MesoNH 
    323    rn_Ct         = 0.1667     ! 0.143 in MesoNH 
    324    rn_Ce         = 0.4        ! 0.4   in MesoNH 
    325    rn_Ceps       = 0.7        ! 0.85  in MesoNH 
    326    rn_Rod        = 0.15       ! c0 in RMCA17 mixing length formulation (not yet implemented) 
    327    rn_Ric        = 0.139      !  Critical Richardson number (to compute PBL height and diffusivities) 
     326                              ! CBR00  ! CCH02  ! MesoNH ! 
     327   rn_Cm          = 0.0667    ! 0.0667 ! 0.1260 ! 0.1260 ! 
     328   rn_Ct          = 0.1667    ! 0.1667 ! 0.1430 ! 0.1430 ! 
     329   rn_Ce          = 0.40      ! 0.40   ! 0.34   ! 0.40   ! 
     330   rn_Ceps        = 0.700     ! 0.700  ! 0.845  ! 0.850  ! 
     331   rn_Ric         = 0.139     ! 0.139  ! 0.143  !   ?    ! Critical Richardson number (to compute PBL height and diffusivities) 
     332   rn_Rod         = 0.15      ! c0 in RMCA17 mixing length formulation (not yet implemented) 
    328333/ 
    329334!----------------------------------------------------------------------- 
     
    638643&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    639644!----------------------------------------------------------------------- 
    640    ln_agrif_2way = .true.  !  activate two way nesting 
    641    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    642    rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s] 
    643    rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s] 
    644    rn_trelax_tra = 0.01    !  inverse of relaxation time (in steps) for tracers [] 
    645    rn_trelax_dyn = 0.01    !  inverse of relaxation time (in steps) for dynamics [] 
    646    ln_chk_bathy  = .false. !  =T  check the parent bathymetry 
     645   ln_agrif_2way   = .true.  !  activate two way nesting 
     646   ln_init_chfrpar = .false. !  initialize child grids from parent 
     647   ln_spc_dyn      = .true.  !  use 0 as special value for dynamics 
     648   rn_sponge_tra   = 0.002   !  coefficient for tracer   sponge layer [] 
     649   rn_sponge_dyn   = 0.002   !  coefficient for dynamics sponge layer [] 
     650   rn_trelax_tra   = 0.01    !  inverse of relaxation time (in steps) for tracers [] 
     651   rn_trelax_dyn   = 0.01    !  inverse of relaxation time (in steps) for dynamics [] 
     652   ln_chk_bathy    = .false. !  =T  check the parent bathymetry 
    647653/ 
    648654!----------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/WED025/EXPREF/namelist_cfg

    r13015 r13229  
    138138!----------------------------------------------------------------------- 
    139139   !                    !  bulk algorithm : 
    140    ln_NCAR     = .true.   ! "NCAR"      algorithm   (Large and Yeager 2008) 
     140   ln_NCAR     = .true.     ! "NCAR"      algorithm   (Large and Yeager 2008) 
    141141   ln_COARE_3p0 = .false.   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    142142   ln_COARE_3p6 = .false.   ! "COARE 3.6" algorithm   (Edson et al. 2013) 
    143143   ln_ECMWF     = .false.   ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    144  
     144   ! 
    145145   cn_dir      = './'      !  root directory for the bulk data location 
    146146   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/doc/latex/NEMO/subfiles/chap_SBC.tex

    r12377 r13229  
    832832    Solid precipitation                  & snow           & $Kg.m^{-2}.s^{-1}$ & T     \\ 
    833833    \hline 
    834     Mean sea-level pressure              & slp            & $hPa$              & T     \\ 
     834    Mean sea-level pressure              & slp            & $Pa$              & T     \\ 
    835835    \hline 
    836836    \end{tabular} 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/abl.F90

    r12489 r13229  
    2929   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   avm_abl      !: turbulent viscosity   [m2/s] 
    3030   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   avt_abl      !: turbulent diffusivity [m2/s] 
    31    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   mxl_abl      !: mixing length         [m] 
     31   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   mxld_abl     !: dissipative mixing length    [m] 
     32   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)     ::   mxlm_abl     !: master mixing length         [m] 
    3233   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:)   ::   tke_abl      !: turbulent kinetic energy [m2/s2] 
    3334   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)       ::   fft_abl      !: Coriolis parameter    [1/s] 
     
    5556      !!---------------------------------------------------------------------- 
    5657      ! 
    57       ALLOCATE( u_abl  (1:jpi,1:jpj,1:jpka,jptime), & 
    58          &      v_abl  (1:jpi,1:jpj,1:jpka,jptime), & 
    59          &      tq_abl (1:jpi,1:jpj,1:jpka,jptime,jptq), & 
    60          &      avm_abl(1:jpi,1:jpj,1:jpka), & 
    61          &      avt_abl(1:jpi,1:jpj,1:jpka), & 
    62          &      mxl_abl(1:jpi,1:jpj,1:jpka), &          
    63          &      tke_abl(1:jpi,1:jpj,1:jpka,jptime), & 
    64          &      fft_abl(1:jpi,1:jpj), & 
    65          &      pblh   (1:jpi,1:jpj), &          
    66          &      msk_abl(1:jpi,1:jpj), & 
    67          &      rest_eq(1:jpi,1:jpj), &          
    68          &      e3t_abl(1:jpka), e3w_abl(1:jpka), ght_abl(1:jpka), ghw_abl(1:jpka),                 STAT=ierr ) 
     58      ALLOCATE( u_abl   (1:jpi,1:jpj,1:jpka,jptime     ), & 
     59         &      v_abl   (1:jpi,1:jpj,1:jpka,jptime     ), & 
     60         &      tq_abl  (1:jpi,1:jpj,1:jpka,jptime,jptq), & 
     61         &      tke_abl (1:jpi,1:jpj,1:jpka,jptime     ), & 
     62         &      avm_abl (1:jpi,1:jpj,1:jpka            ), & 
     63         &      avt_abl (1:jpi,1:jpj,1:jpka            ), & 
     64         &      mxld_abl(1:jpi,1:jpj,1:jpka            ), & 
     65         &      mxlm_abl(1:jpi,1:jpj,1:jpka            ), & 
     66         &      fft_abl (1:jpi,1:jpj                   ), & 
     67         &      pblh    (1:jpi,1:jpj                   ), & 
     68         &      msk_abl (1:jpi,1:jpj                   ), & 
     69         &      rest_eq (1:jpi,1:jpj                   ), & 
     70         &      e3t_abl (1:jpka), e3w_abl(1:jpka)       , & 
     71         &      ght_abl (1:jpka), ghw_abl(1:jpka)       , STAT=ierr ) 
    6972         ! 
    7073      abl_alloc = ierr 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/ablmod.F90

    r13176 r13229  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  ablmod  *** 
    4    !! Surface module :  ABL computation to provide atmospheric data  
     4   !! Surface module :  ABL computation to provide atmospheric data 
    55   !!                   for surface fluxes computation 
    66   !!====================================================================== 
    77   !! History :  3.6  ! 2019-03  (F. Lemarié & G. Samson)  Original code 
    88   !!---------------------------------------------------------------------- 
    9     
     9 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   abl_stp       : ABL single column model 
     
    1616 
    1717   USE phycst         ! physical constants 
    18    USE dom_oce, ONLY  : tmask   
     18   USE dom_oce, ONLY  : tmask 
    1919   USE sbc_oce, ONLY  : ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1, rhoa 
    20    USE sbcblk         ! use rn_?fac 
     20   USE sbcblk         ! use rn_efac, cdn_oce 
    2121   USE sbcblk_phy     ! use some physical constants for flux computation 
    2222   ! 
     
    3030 
    3131   PUBLIC   abl_stp   ! called by sbcabl.F90 
    32    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ustar2 
     32   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ustar2, zrough 
    3333   !! * Substitutions 
    3434#  include "do_loop_substitute.h90" 
     
    3838 
    3939!=================================================================================================== 
    40    SUBROUTINE abl_stp( kt, psst, pssu, pssv, pssq, &                            ! in 
    41               &            pu_dta, pv_dta, pt_dta, pq_dta,    &  
     40   SUBROUTINE abl_stp( kt, psst, pssu, pssv, pssq,            &     ! in 
     41              &            pu_dta, pv_dta, pt_dta, pq_dta,    & 
    4242              &            pslp_dta, pgu_dta, pgv_dta,        & 
    43               &            pcd_du, psen, pevp,                &                            ! in/out 
    44               &            pwndm, ptaui, ptauj, ptaum         &  
    45 #if defined key_si3           
    46               &          , ptm_su,pssu_ice,pssv_ice,pssq_ice,pcd_du_ice  &  
    47               &          , psen_ice, pevp_ice, pwndm_ice, pfrac_oce      &  
    48               &          , ptaui_ice, ptauj_ice                          & 
    49 #endif            
    50            &   ) 
     43              &            pcd_du, psen, pevp,                &     ! in/out 
     44              &            pwndm, ptaui, ptauj, ptaum         & 
     45#if defined key_si3 
     46              &          , ptm_su, pssu_ice, pssv_ice         & 
     47              &          , pssq_ice, pcd_du_ice, psen_ice     & 
     48              &          , pevp_ice, pwndm_ice, pfrac_oce     & 
     49              &          , ptaui_ice, ptauj_ice               & 
     50#endif 
     51              &      ) 
    5152!--------------------------------------------------------------------------------------------------- 
    5253 
     
    5455      !!                    ***  ROUTINE abl_stp *** 
    5556      !! 
    56       !! ** Purpose :   Time-integration of the ABL model  
     57      !! ** Purpose :   Time-integration of the ABL model 
    5758      !! 
    58       !! ** Method  :   Compute atmospheric variables : vertical turbulence  
     59      !! ** Method  :   Compute atmospheric variables : vertical turbulence 
    5960      !!                             + Coriolis term + newtonian relaxation 
    60       !!                 
     61      !! 
    6162      !! ** Action  : - Advance TKE to time n+1 and compute Avm_abl, Avt_abl, PBLh 
    6263      !!              - Advance tracers to time n+1 (Euler backward scheme) 
     
    7071      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   psst       ! sea-surface temperature [Celsius] 
    7172      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssu       ! sea-surface u (U-point) 
    72       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssv       ! sea-surface v (V-point)  
     73      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssv       ! sea-surface v (V-point) 
    7374      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssq       ! sea-surface humidity 
    7475      REAL(wp) , INTENT(in   ), DIMENSION(:,:,:) ::   pu_dta     ! large-scale windi 
     
    8283      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   psen       ! Ch x Du 
    8384      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pevp       ! Ce x Du 
    84       REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pwndm      ! ||uwnd||       
     85      REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pwndm      ! ||uwnd|| 
    8586      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaui      ! taux 
    8687      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj      ! tauy 
    87       REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaum      ! ||tau||  
    88       ! 
    89 #if defined key_si3     
     88      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaum      ! ||tau|| 
     89      ! 
     90#if defined key_si3 
    9091      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   ptm_su       ! ice-surface temperature [K] 
    9192      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssu_ice     ! ice-surface u (U-point) 
    92       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssv_ice     ! ice-surface v (V-point)       
    93       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssq_ice     ! ice-surface humidity  
     93      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssv_ice     ! ice-surface v (V-point) 
     94      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pssq_ice     ! ice-surface humidity 
    9495      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pcd_du_ice   ! Cd x Du over ice (T-point) 
    9596      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   psen_ice     ! Ch x Du over ice (T-point) 
    9697      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pevp_ice     ! Ce x Du over ice (T-point) 
    97       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndm_ice    ! ||uwnd - uice||   
    98       !REAL(wp) , INTENT(inout), DIMENSION(:,:  ) ::   pfrac_oce     !!GS: out useless ? 
    99       REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pfrac_oce      ! 
     98      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pwndm_ice    ! ||uwnd - uice|| 
     99      REAL(wp) , INTENT(in   ), DIMENSION(:,:  ) ::   pfrac_oce    ! ocean fraction 
    100100      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptaui_ice    ! ice-surface taux stress (U-point) 
    101       REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj_ice    ! ice-surface tauy stress (V-point)      
    102 #endif      
    103       ! 
    104       REAL(wp), DIMENSION(1:jpi,1:jpj   )        ::   zwnd_i, zwnd_j 
    105       REAL(wp), DIMENSION(1:jpi,2:jpka  )        ::   zCF     
    106       REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka)    ::   z_cft      !--FL--to be removed after the test phase    
    107       ! 
    108       REAL(wp), DIMENSION(1:jpi,1:jpka  )        ::   z_elem_a 
    109       REAL(wp), DIMENSION(1:jpi,1:jpka  )        ::   z_elem_b 
    110       REAL(wp), DIMENSION(1:jpi,1:jpka  )        ::   z_elem_c 
     101      REAL(wp) , INTENT(  out), DIMENSION(:,:  ) ::   ptauj_ice    ! ice-surface tauy stress (V-point) 
     102#endif 
     103      ! 
     104      REAL(wp), DIMENSION(1:jpi,1:jpj       )    ::   zwnd_i, zwnd_j 
     105      REAL(wp), DIMENSION(1:jpi      ,2:jpka)    ::   zCF 
     106      ! 
     107      REAL(wp), DIMENSION(1:jpi      ,1:jpka)    ::   z_elem_a 
     108      REAL(wp), DIMENSION(1:jpi      ,1:jpka)    ::   z_elem_b 
     109      REAL(wp), DIMENSION(1:jpi      ,1:jpka)    ::   z_elem_c 
    111110      ! 
    112111      INTEGER             ::   ji, jj, jk, jtra, jbak               ! dummy loop indices 
    113112      REAL(wp)            ::   zztmp, zcff, ztemp, zhumi, zcff1, zztmp1, zztmp2 
    114113      REAL(wp)            ::   zcff2, zfcor, zmsk, zsig, zcffu, zcffv, zzice,zzoce 
    115       ! 
    116       !!---------------------------------------------------------------------       
     114      LOGICAL             ::   SemiImp_Cor = .TRUE. 
     115      ! 
     116      !!--------------------------------------------------------------------- 
    117117      ! 
    118118      IF(lwp .AND. kt == nit000) THEN                  ! control print 
     
    120120         WRITE(numout,*) 'abl_stp : ABL time stepping' 
    121121         WRITE(numout,*) '~~~~~~' 
    122       ENDIF  
     122      ENDIF 
    123123      ! 
    124124      IF( kt == nit000 ) ALLOCATE ( ustar2( 1:jpi, 1:jpj ) ) 
    125       !! Compute ustar squared as Cd || Uatm-Uoce ||^2  
    126       !! needed for surface boundary condition of TKE  
     125      IF( kt == nit000 ) ALLOCATE ( zrough( 1:jpi, 1:jpj ) ) 
     126      !! Compute ustar squared as Cd || Uatm-Uoce ||^2 
     127      !! needed for surface boundary condition of TKE 
    127128      !! pwndm contains | U10m - U_oce | (see blk_oce_1 in sbcblk) 
    128129      DO_2D_11_11 
    129130         zzoce         = pCd_du    (ji,jj) * pwndm    (ji,jj) 
    130131#if defined key_si3 
    131          zzice         = pCd_du_ice(ji,jj) * pwndm_ice(ji,jj)  
    132          ustar2(ji,jj) = zzoce * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * zzice  
     132         zzice         = pCd_du_ice(ji,jj) * pwndm_ice(ji,jj) 
     133         ustar2(ji,jj) = zzoce * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * zzice 
    133134#else 
    134          ustar2(ji,jj) = zzoce    
     135         ustar2(ji,jj) = zzoce 
    135136#endif 
     137         zrough(ji,jj) = ght_abl(2) * EXP( - vkarmn / SQRT( MAX( Cdn_oce(ji,jj), 1.e-4 ) ) ) !<-- recover the value of z0 from Cdn_oce 
    136138      END_2D 
    137139      ! 
     
    140142      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    141143 
    142       CALL abl_zdf_tke( )                       !--> Avm_abl, Avt_abl, pblh defined on (1,jpi) x (1,jpj)  
    143           
     144      CALL abl_zdf_tke( )                       !--> Avm_abl, Avt_abl, pblh defined on (1,jpi) x (1,jpj) 
     145 
    144146      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    145147      !                            !  2 *** Advance tracers to time n+1 
    146148      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    147        
     149 
    148150      !------------- 
    149151      DO jj = 1, jpj    ! outer loop             !--> tq_abl computed on (1:jpi) x (1:jpj) 
    150       !-------------     
    151          ! Compute matrix elements for interior points  
     152      !------------- 
     153         ! Compute matrix elements for interior points 
    152154         DO jk = 3, jpkam1 
    153155            DO ji = 1, jpi   ! vector opt. 
    154                z_elem_a( ji,     jk              ) = - rDt_abl * Avt_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )   ! lower-diagonal 
    155                z_elem_c( ji,     jk              ) = - rDt_abl * Avt_abl( ji, jj, jk   ) / e3w_abl( jk   )   ! upper-diagonal        
    156                z_elem_b( ji,     jk              ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   !       diagonal            
    157             END DO 
    158          END DO   
    159          ! Boundary conditions   
    160          DO ji = 1, jpi   ! vector opt.  
    161             ! Neumann at the bottom           
    162             z_elem_a( ji,     2              ) = 0._wp 
    163             z_elem_c( ji,     2              ) = - rDt_abl * Avt_abl( ji, jj, 2   ) / e3w_abl( 2   )                                          
     156               z_elem_a( ji, jk ) = - rDt_abl * Avt_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )   ! lower-diagonal 
     157               z_elem_c( ji, jk ) = - rDt_abl * Avt_abl( ji, jj, jk   ) / e3w_abl( jk   )   ! upper-diagonal 
     158               z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   !       diagonal 
     159            END DO 
     160         END DO 
     161         ! Boundary conditions 
     162         DO ji = 1, jpi   ! vector opt. 
     163            ! Neumann at the bottom 
     164            z_elem_a( ji,    2 ) = 0._wp 
     165            z_elem_c( ji,    2 ) = - rDt_abl * Avt_abl( ji, jj,    2 ) / e3w_abl(    2 ) 
    164166            ! Homogeneous Neumann at the top 
    165             z_elem_a( ji,     jpka           ) = - rDt_abl * Avt_abl( ji, jj, jpka ) / e3w_abl( jpka )  
    166             z_elem_c( ji,     jpka          ) = 0._wp 
    167             z_elem_b( ji,     jpka           ) = e3t_abl( jpka ) - z_elem_a( ji,    jpka ) 
    168          END DO             
     167            z_elem_a( ji, jpka ) = - rDt_abl * Avt_abl( ji, jj, jpka ) / e3w_abl( jpka ) 
     168            z_elem_c( ji, jpka ) = 0._wp 
     169            z_elem_b( ji, jpka ) = e3t_abl( jpka ) - z_elem_a( ji, jpka ) 
     170         END DO 
    169171 
    170172         DO jtra = 1,jptq  ! loop on active tracers 
    171                 
     173 
    172174            DO jk = 3, jpkam1 
    173                DO ji = 1,jpi 
    174                   tq_abl  ( ji, jj, jk, nt_a, jtra ) = e3t_abl(jk) * tq_abl  ( ji, jj, jk, nt_n, jtra )   ! initialize right-hand-side 
     175               !DO ji = 2, jpim1 
     176               DO ji = 1,jpi  !!GS: to be checked if needed 
     177                  tq_abl( ji, jj, jk, nt_a, jtra ) = e3t_abl(jk) * tq_abl( ji, jj, jk, nt_n, jtra )   ! initialize right-hand-side 
    175178               END DO 
    176179            END DO 
    177180 
    178181            IF(jtra == jp_ta) THEN 
    179                DO ji = 1,jpi  ! boundary conditions for temperature               
    180                   zztmp1 = psen(ji, jj)  
    181                   zztmp2 = psen(ji, jj) * ( psst(ji, jj) + rt0 )   
    182 #if defined key_si3              
    183                   zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj)  
     182               DO ji = 1,jpi  ! surface boundary condition for temperature 
     183                  zztmp1 = psen(ji, jj) 
     184                  zztmp2 = psen(ji, jj) * ( psst(ji, jj) + rt0 ) 
     185#if defined key_si3 
     186                  zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) 
    184187                  zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * psen_ice(ji,jj) * ptm_su(ji,jj) 
    185 #endif               
    186                   z_elem_b( ji,     2                ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1               
    187                   tq_abl  ( ji, jj, 2   , nt_a, jtra ) = e3t_abl( 2    ) * tq_abl  ( ji, jj, 2   , nt_n, jtra ) + rDt_abl * zztmp2                
     188#endif 
     189                  z_elem_b( ji,        2             ) = e3t_abl(    2 ) - z_elem_c( ji,        2             ) + rDt_abl * zztmp1 
     190                  tq_abl  ( ji, jj,    2, nt_a, jtra ) = e3t_abl(    2 ) * tq_abl  ( ji, jj,    2, nt_n, jtra ) + rDt_abl * zztmp2 
    188191                  tq_abl  ( ji, jj, jpka, nt_a, jtra ) = e3t_abl( jpka ) * tq_abl  ( ji, jj, jpka, nt_n, jtra ) 
    189                END DO  
    190             ELSE    
    191                DO ji = 1,jpi  ! boundary conditions for humidity               
    192                   zztmp1 = pevp(ji, jj)  
    193                   zztmp2 = pevp(ji, jj) * pssq(ji, jj)    
    194 #if defined key_si3              
    195                   zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji,jj)  
    196                   zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji, jj) * pssq_ice(ji, jj)     
    197 #endif    
    198                   z_elem_b( ji,     2                ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 
    199                   tq_abl  ( ji, jj, 2   , nt_a, jtra ) = e3t_abl( 2    ) * tq_abl  ( ji, jj, 2   , nt_n, jtra ) + rDt_abl * zztmp2                
     192               END DO 
     193            ELSE ! jp_qa 
     194               DO ji = 1,jpi  ! surface boundary condition for humidity 
     195                  zztmp1 = pevp(ji, jj) 
     196                  zztmp2 = pevp(ji, jj) * pssq(ji, jj) 
     197#if defined key_si3 
     198                  zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji,jj) 
     199                  zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pevp_ice(ji, jj) * pssq_ice(ji, jj) 
     200#endif 
     201                  z_elem_b( ji,     2                ) = e3t_abl(    2 ) - z_elem_c( ji,        2            ) + rDt_abl * zztmp1 
     202                  tq_abl  ( ji, jj, 2   , nt_a, jtra ) = e3t_abl(    2 ) * tq_abl  ( ji, jj,    2, nt_n, jtra ) + rDt_abl * zztmp2 
    200203                  tq_abl  ( ji, jj, jpka, nt_a, jtra ) = e3t_abl( jpka ) * tq_abl  ( ji, jj, jpka, nt_n, jtra ) 
    201                END DO                                      
     204               END DO 
    202205            END IF 
    203206            !! 
    204207            !! Matrix inversion 
    205208            !! ---------------------------------------------------------- 
    206             DO ji = 1,jpi             
    207                zcff                       =  1._wp / z_elem_b( ji, 2 ) 
    208                zCF   (ji,   2           ) = - zcff * z_elem_c( ji, 2 ) 
    209                tq_abl(ji,jj,2,nt_a,jtra) =    zcff * tq_abl(ji,jj,2,nt_a,jtra) 
    210             END DO              
    211  
    212             DO jk = 3, jpka             
    213                DO ji = 1,jpi             
    214                   zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF   (ji, jk-1 ) ) 
     209            DO ji = 1,jpi 
     210               zcff                            =  1._wp / z_elem_b( ji, 2 ) 
     211               zCF   ( ji,     2             ) = - zcff * z_elem_c( ji, 2 ) 
     212               tq_abl( ji, jj, 2, nt_a, jtra ) =   zcff * tq_abl( ji, jj, 2, nt_a, jtra ) 
     213            END DO 
     214 
     215            DO jk = 3, jpka 
     216               DO ji = 1,jpi 
     217                  zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF( ji, jk-1 ) ) 
    215218                  zCF(ji,jk) = - zcff * z_elem_c( ji, jk ) 
    216219                  tq_abl(ji,jj,jk,nt_a,jtra) = zcff * ( tq_abl(ji,jj,jk  ,nt_a,jtra)   & 
    217                   &                - z_elem_a(ji, jk) * tq_abl(ji,jj,jk-1,nt_a,jtra) ) 
    218                END DO 
    219             END DO 
    220 !!FL at this point we could check positivity of tq_abl(:,:,:,nt_a,jp_qa) ... test to do ...          
    221             DO jk = jpkam1,2,-1             
    222                DO ji = 1,jpi   
     220                     &           - z_elem_a(ji, jk) *  tq_abl(ji,jj,jk-1,nt_a,jtra) ) 
     221               END DO 
     222            END DO 
     223            !!FL at this point we could check positivity of tq_abl(:,:,:,nt_a,jp_qa) ... test to do ... 
     224            DO jk = jpkam1,2,-1 
     225               DO ji = 1,jpi 
    223226                  tq_abl(ji,jj,jk,nt_a,jtra) = tq_abl(ji,jj,jk,nt_a,jtra) +    & 
    224227                     &                        zCF(ji,jk) * tq_abl(ji,jj,jk+1,nt_a,jtra) 
    225228               END DO 
    226229            END DO 
    227           
    228          END DO   !<-- loop on tracers                     
    229          !!  
    230       !------------- 
    231       END DO             ! end outer loop  
    232       !-------------    
    233        
    234        
     230 
     231         END DO   !<-- loop on tracers 
     232         !! 
     233      !------------- 
     234      END DO             ! end outer loop 
     235      !------------- 
     236 
    235237      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    236238      !                            !  3 *** Compute Coriolis term with geostrophic guide 
    237       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<   
    238       !-------------         
    239       DO jk = 2, jpka    ! outer loop 
    240       !------------- 
    241          !              
    242          ! Advance u_abl & v_abl to time n+1 
    243          DO_2D_11_11 
    244             zcff = ( fft_abl(ji,jj) * rDt_abl )*( fft_abl(ji,jj) * rDt_abl )  ! (f dt)**2 
     239      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     240      IF( SemiImp_Cor ) THEN 
     241 
     242         !------------- 
     243         DO jk = 2, jpka    ! outer loop 
     244         !------------- 
     245            ! 
     246            ! Advance u_abl & v_abl to time n+1 
     247            DO_2D_11_11 
     248               zcff = ( fft_abl(ji,jj) * rDt_abl )*( fft_abl(ji,jj) * rDt_abl )  ! (f dt)**2 
     249 
     250               u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *(                                          & 
     251                  &        (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff) * u_abl( ji, jj, jk, nt_n )    & 
     252                  &                     + rDt_abl * fft_abl(ji, jj) * v_abl( ji, jj, jk, nt_n ) )  & 
     253                  &                               / (1._wp + gamma_Cor*gamma_Cor*zcff) 
    245254    
    246             u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *(  & 
    247                &        (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*u_abl( ji, jj, jk, nt_n )    & 
    248                &                 +  rDt_abl * fft_abl(ji, jj) * v_abl ( ji , jj  , jk, nt_n ) )  & 
    249                &                               / (1._wp + gamma_Cor*gamma_Cor*zcff) 
    250                 
    251             v_abl( ji, jj, jk, nt_a ) =  e3t_abl(jk) *(  & 
    252                &        (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff)*v_abl( ji, jj, jk, nt_n )   & 
    253                &                 -  rDt_abl * fft_abl(ji, jj) * u_abl ( ji   , jj, jk, nt_n )  ) & 
    254                &                                / (1._wp + gamma_Cor*gamma_Cor*zcff)                 
    255          END_2D 
    256          !                                    
    257       !------------- 
    258       END DO             ! end outer loop  !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj) 
    259       !-------------                 
    260       ! 
    261       IF( ln_geos_winds ) THEN 
    262          DO jj = 1, jpj    ! outer loop        
    263             DO jk = 1, jpka 
    264                DO ji = 1, jpi  
    265                   u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a )   & 
    266                      &                      - rDt_abl * e3t_abl(jk) * fft_abl(ji  , jj) * pgv_dta(ji  ,jj  ,jk) 
    267                   v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a )   & 
    268                      &                      + rDt_abl * e3t_abl(jk) * fft_abl(ji, jj  ) * pgu_dta(ji  ,jj  ,jk) 
    269                END DO 
    270             END DO 
    271          END DO       
    272       END IF  
    273       !-------------             
    274       ! 
    275       IF( ln_hpgls_frc ) THEN 
    276          DO jj = 1, jpj    ! outer loop        
    277             DO jk = 1, jpka 
    278                DO ji = 1, jpi  
    279                   u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgu_dta(ji,jj,jk) 
    280                   v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgv_dta(ji,jj,jk)   
     255               v_abl( ji, jj, jk, nt_a ) =  e3t_abl(jk) *(                                         & 
     256                  &        (1._wp-gamma_Cor*(1._wp-gamma_Cor)*zcff) * v_abl( ji, jj, jk, nt_n )    & 
     257                  &                     - rDt_abl * fft_abl(ji, jj) * u_abl( ji, jj, jk, nt_n ) )  & 
     258                  &                               / (1._wp + gamma_Cor*gamma_Cor*zcff) 
     259            END_2D 
     260            ! 
     261         !------------- 
     262         END DO             ! end outer loop  !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj) 
     263         !------------- 
     264         ! 
     265         IF( ln_geos_winds ) THEN 
     266            DO jj = 1, jpj    ! outer loop 
     267               DO jk = 1, jpka 
     268                  DO ji = 1, jpi 
     269                     u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a )   & 
     270                        &                      - rDt_abl * e3t_abl(jk) * fft_abl(ji  , jj) * pgv_dta(ji  ,jj  ,jk) 
     271                     v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a )   & 
     272                        &                      + rDt_abl * e3t_abl(jk) * fft_abl(ji, jj  ) * pgu_dta(ji  ,jj  ,jk) 
     273                  END DO 
     274               END DO 
     275            END DO 
     276         END IF 
     277         ! 
     278         IF( ln_hpgls_frc ) THEN 
     279            DO jj = 1, jpj    ! outer loop 
     280               DO jk = 1, jpka 
     281                  DO ji = 1, jpi 
     282                     u_abl( ji, jj, jk, nt_a ) = u_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgu_dta(ji,jj,jk) 
     283                     v_abl( ji, jj, jk, nt_a ) = v_abl( ji, jj, jk, nt_a ) - rDt_abl * e3t_abl(jk) * pgv_dta(ji,jj,jk) 
     284                  ENDDO 
    281285               ENDDO 
    282286            ENDDO 
    283          ENDDO  
    284       END IF 
    285       
    286       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    287       !                            !  4 *** Advance u,v to time n+1  
    288       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    289       ! 
    290       !  Vertical diffusion for u_abl      
     287         END IF 
     288 
     289      ELSE ! SemiImp_Cor = .FALSE. 
     290 
     291         IF( ln_geos_winds ) THEN 
     292 
     293            !------------- 
     294            DO jk = 2, jpka    ! outer loop 
     295            !------------- 
     296               ! 
     297               IF( MOD( kt, 2 ) == 0 ) then 
     298                  ! Advance u_abl & v_abl to time n+1 
     299                  DO jj = 1, jpj 
     300                     DO ji = 1, jpi 
     301                        zcff = fft_abl(ji,jj) * ( v_abl ( ji , jj  , jk, nt_n ) - pgv_dta(ji  ,jj  ,jk)  ) 
     302                        u_abl( ji, jj, jk, nt_a ) =                u_abl( ji, jj, jk, nt_n ) + rDt_abl * zcff 
     303                        zcff = fft_abl(ji,jj) * ( u_abl ( ji , jj  , jk, nt_a ) - pgu_dta(ji  ,jj  ,jk)  ) 
     304                        v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( v_abl( ji, jj, jk, nt_n ) - rDt_abl * zcff ) 
     305                        u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *  u_abl( ji, jj, jk, nt_a ) 
     306                     END DO 
     307                  END DO 
     308               ELSE 
     309                  DO jj = 1, jpj 
     310                     DO ji = 1, jpi 
     311                        zcff = fft_abl(ji,jj) * ( u_abl ( ji , jj  , jk, nt_n ) - pgu_dta(ji  ,jj  ,jk)  ) 
     312                        v_abl( ji, jj, jk, nt_a ) =                v_abl( ji, jj, jk, nt_n ) - rDt_abl * zcff 
     313                        zcff = fft_abl(ji,jj) * ( v_abl ( ji , jj  , jk, nt_a ) - pgv_dta(ji  ,jj  ,jk)  ) 
     314                        u_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *( u_abl( ji, jj, jk, nt_n ) + rDt_abl * zcff ) 
     315                        v_abl( ji, jj, jk, nt_a ) = e3t_abl(jk) *  v_abl( ji, jj, jk, nt_a ) 
     316                     END DO 
     317                  END DO 
     318               END IF 
     319               ! 
     320            !------------- 
     321            END DO             ! end outer loop  !<-- u_abl and v_abl are properly updated on (1:jpi) x (1:jpj) 
     322            !------------- 
     323 
     324         ENDIF ! ln_geos_winds 
     325 
     326      ENDIF ! SemiImp_Cor 
     327      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     328      !                            !  4 *** Advance u,v to time n+1 
     329      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     330      ! 
     331      !  Vertical diffusion for u_abl 
    291332      !------------- 
    292333      DO jj = 1, jpj    ! outer loop 
    293       !-------------     
     334      !------------- 
    294335 
    295336         DO jk = 3, jpkam1 
    296             DO ji = 1, jpi   
    297                z_elem_a( ji,     jk ) = - rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )  ! lower-diagonal 
    298                z_elem_c( ji,     jk ) = - rDt_abl * Avm_abl( ji, jj, jk   ) / e3w_abl( jk   )  ! upper-diagonal                 
    299                z_elem_b( ji,     jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )                             !       diagonal 
    300             END DO 
    301          END DO   
    302              
    303          DO ji = 2, jpi   ! boundary conditions   (Avm_abl and pcd_du must be available at ji=jpi)             
     337            DO ji = 1, jpi 
     338               z_elem_a( ji, jk ) = - rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )  ! lower-diagonal 
     339               z_elem_c( ji, jk ) = - rDt_abl * Avm_abl( ji, jj, jk   ) / e3w_abl( jk   )  ! upper-diagonal 
     340               z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )  !       diagonal 
     341            END DO 
     342         END DO 
     343 
     344         DO ji = 2, jpi   ! boundary conditions   (Avm_abl and pcd_du must be available at ji=jpi) 
    304345            !++ Surface boundary condition 
    305             z_elem_a( ji,     2    ) = 0._wp 
    306             z_elem_c( ji,     2    ) = - rDt_abl * Avm_abl( ji, jj, 2   ) / e3w_abl( 2   )                                        
    307             ! 
    308          zztmp1  = pcd_du(ji, jj) 
    309          zztmp2  = 0.5_wp * pcd_du(ji, jj) * ( pssu(ji-1, jj) + pssu(ji,jj) )        
    310 #if defined key_si3              
     346            z_elem_a( ji, 2 ) = 0._wp 
     347            z_elem_c( ji, 2 ) = - rDt_abl * Avm_abl( ji, jj, 2 ) / e3w_abl( 2 ) 
     348            ! 
     349            zztmp1  = pcd_du(ji, jj) 
     350            zztmp2  = 0.5_wp * pcd_du(ji, jj) * ( pssu(ji-1, jj) + pssu(ji,jj) ) 
     351#if defined key_si3 
    311352            zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) 
    312          zzice  = 0.5_wp * ( pssu_ice(ji-1, jj) + pssu_ice(ji,jj) ) 
    313          zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice 
    314 #endif            
    315          z_elem_b( ji,     2       ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1          
     353            zzice  = 0.5_wp * ( pssu_ice(ji-1, jj) + pssu_ice(ji, jj) ) 
     354            zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice 
     355#endif 
     356            z_elem_b( ji,     2       ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 
    316357            u_abl( ji, jj,    2, nt_a ) =      u_abl( ji, jj,    2, nt_a ) + rDt_abl * zztmp2 
    317           
    318             !++ Top Neumann B.C. 
    319             !z_elem_a( ji,     jpka ) = - 0.5_wp * rDt_abl * ( Avm_abl( ji, jj, jpka )+ Avm_abl( ji+1, jj, jpka ) ) / e3w_abl( jpka )  
    320             !z_elem_c( ji,     jpka ) = 0._wp 
    321             !z_elem_b( ji,     jpka ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka )                                                
    322             !++ Top Dirichlet B.C. 
    323             z_elem_a( ji,     jpka )       = 0._wp 
    324             z_elem_c( ji,     jpka )       = 0._wp 
    325             z_elem_b( ji,     jpka )       = e3t_abl( jpka ) 
    326             u_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pu_dta(ji,jj,jk)               
    327          END DO  
     358 
     359            ! idealized test cases only 
     360            !IF( ln_topbc_neumann ) THEN 
     361            !   !++ Top Neumann B.C. 
     362            !   z_elem_a( ji,     jpka ) = - rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka ) 
     363            !   z_elem_c( ji,     jpka ) = 0._wp 
     364            !   z_elem_b( ji,     jpka ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka ) 
     365            !   !u_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * u_abl   ( ji, jj, jpka, nt_a ) 
     366            !ELSE 
     367               !++ Top Dirichlet B.C. 
     368               z_elem_a( ji,     jpka )       = 0._wp 
     369               z_elem_c( ji,     jpka )       = 0._wp 
     370               z_elem_b( ji,     jpka )       = e3t_abl( jpka ) 
     371               u_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pu_dta(ji,jj,jk) 
     372            !ENDIF 
     373 
     374         END DO 
    328375         !! 
    329376         !! Matrix inversion 
    330377         !! ---------------------------------------------------------- 
    331          DO ji = 2, jpi           
     378         !DO ji = 2, jpi 
     379         DO ji = 1, jpi  !!GS: TBI 
    332380            zcff                 =   1._wp / z_elem_b( ji, 2 ) 
    333             zCF   (ji,   2     ) =  - zcff * z_elem_c( ji, 2 )  
     381            zCF   (ji,   2     ) =  - zcff * z_elem_c( ji, 2 ) 
    334382            u_abl (ji,jj,2,nt_a) =    zcff * u_abl(ji,jj,2,nt_a) 
    335          END DO              
    336  
    337          DO jk = 3, jpka             
    338             DO ji = 2, jpi               
     383         END DO 
     384 
     385         DO jk = 3, jpka 
     386            DO ji = 2, jpi 
    339387               zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF   (ji, jk-1 ) ) 
    340388               zCF(ji,jk) = - zcff * z_elem_c( ji, jk ) 
     
    343391            END DO 
    344392         END DO 
    345              
    346          DO jk = jpkam1,2,-1             
     393 
     394         DO jk = jpkam1,2,-1 
    347395            DO ji = 2, jpi 
    348396               u_abl(ji,jj,jk,nt_a) = u_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * u_abl(ji,jj,jk+1,nt_a) 
    349397            END DO 
    350398         END DO 
    351                                            
    352       !------------- 
    353       END DO             ! end outer loop  
    354       !-------------    
    355  
    356       ! 
    357       !  Vertical diffusion for v_abl      
     399 
     400      !------------- 
     401      END DO             ! end outer loop 
     402      !------------- 
     403 
     404      ! 
     405      !  Vertical diffusion for v_abl 
    358406      !------------- 
    359407      DO jj = 2, jpj   ! outer loop 
    360       !-------------     
     408      !------------- 
    361409         ! 
    362410         DO jk = 3, jpkam1 
    363             DO ji = 1, jpi    
    364                z_elem_a( ji,     jk ) = -rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )   ! lower-diagonal 
    365                z_elem_c( ji,     jk ) = -rDt_abl * Avm_abl( ji, jj, jk   ) / e3w_abl( jk   )   ! upper-diagonal               
    366                z_elem_b( ji,     jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )                              !       diagonal 
    367             END DO 
    368          END DO 
    369  
    370          DO ji = 1, jpi   ! boundary conditions (Avm_abl and pcd_du must be available at jj=jpj)           
     411            DO ji = 1, jpi 
     412               z_elem_a( ji, jk ) = -rDt_abl * Avm_abl( ji, jj, jk-1 ) / e3w_abl( jk-1 )   ! lower-diagonal 
     413               z_elem_c( ji, jk ) = -rDt_abl * Avm_abl( ji, jj, jk   ) / e3w_abl( jk   )   ! upper-diagonal 
     414               z_elem_b( ji, jk ) = e3t_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )                              !       diagonal 
     415            END DO 
     416         END DO 
     417 
     418         DO ji = 1, jpi   ! boundary conditions (Avm_abl and pcd_du must be available at jj=jpj) 
    371419            !++ Surface boundary condition 
    372             z_elem_a( ji,     2    ) = 0._wp 
    373             z_elem_c( ji,     2    ) = - rDt_abl * Avm_abl( ji, jj, 2   ) / e3w_abl( 2   )         
    374             ! 
    375          zztmp1 = pcd_du(ji, jj) 
    376          zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssv(ji, jj) + pssv(ji, jj-1) )   
    377 #if defined key_si3              
     420            z_elem_a( ji, 2 ) = 0._wp 
     421            z_elem_c( ji, 2 ) = - rDt_abl * Avm_abl( ji, jj, 2 ) / e3w_abl( 2 ) 
     422            ! 
     423            zztmp1 = pcd_du(ji, jj) 
     424            zztmp2 = 0.5_wp * pcd_du(ji, jj) * ( pssv(ji, jj) + pssv(ji, jj-1) ) 
     425#if defined key_si3 
    378426            zztmp1 = zztmp1 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) 
    379          zzice  = 0.5_wp * ( pssv_ice(ji, jj) + pssv_ice(ji,jj-1) ) 
    380          zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice 
    381 #endif          
    382             z_elem_b( ji,     2       ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1  
     427            zzice  = 0.5_wp * ( pssv_ice(ji, jj) + pssv_ice(ji, jj-1) ) 
     428            zztmp2 = zztmp2 * pfrac_oce(ji,jj) + (1._wp - pfrac_oce(ji,jj)) * pcd_du_ice(ji, jj) * zzice 
     429#endif 
     430            z_elem_b( ji,     2       ) = e3t_abl( 2 ) - z_elem_c( ji, 2 ) + rDt_abl * zztmp1 
    383431            v_abl( ji, jj,    2, nt_a ) =         v_abl( ji, jj, 2, nt_a ) + rDt_abl * zztmp2 
    384             !++ Top Neumann B.C.             
    385             !z_elem_a( ji,     jpka ) = -rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka )  
    386             !z_elem_c( ji,     jpka ) = 0._wp 
    387             !z_elem_b( ji,     jpka ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka )                                                
    388             !++ Top Dirichlet B.C. 
    389             z_elem_a( ji,     jpka )       = 0._wp 
    390             z_elem_c( ji,     jpka )       = 0._wp 
    391             z_elem_b( ji,     jpka )       = e3t_abl( jpka ) 
    392             v_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pv_dta(ji,jj,jk)              
    393          END DO  
     432 
     433            ! idealized test cases only 
     434            !IF( ln_topbc_neumann ) THEN 
     435            !   !++ Top Neumann B.C. 
     436            !   z_elem_a( ji,     jpka ) = - rDt_abl * Avm_abl( ji, jj, jpka ) / e3w_abl( jpka ) 
     437            !   z_elem_c( ji,     jpka ) = 0._wp 
     438            !   z_elem_b( ji,     jpka ) = e3t_abl( jpka ) - z_elem_a( ji,     jpka ) 
     439            !   !v_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * v_abl   ( ji, jj, jpka, nt_a ) 
     440            !ELSE 
     441               !++ Top Dirichlet B.C. 
     442               z_elem_a( ji,     jpka )       = 0._wp 
     443               z_elem_c( ji,     jpka )       = 0._wp 
     444               z_elem_b( ji,     jpka )       = e3t_abl( jpka ) 
     445               v_abl   ( ji, jj, jpka, nt_a ) = e3t_abl( jpka ) * pv_dta(ji,jj,jk) 
     446            !ENDIF 
     447 
     448         END DO 
    394449         !! 
    395450         !! Matrix inversion 
    396451         !! ---------------------------------------------------------- 
    397          DO ji = 1, jpi               
     452         DO ji = 1, jpi 
    398453            zcff                 =  1._wp / z_elem_b( ji, 2 ) 
    399             zCF   (ji,   2     ) =   - zcff * z_elem_c( ji,     2       )  
    400             v_abl (ji,jj,2,nt_a) =     zcff * v_abl   ( ji, jj, 2, nt_a )  
    401          END DO              
    402  
    403          DO jk = 3, jpka             
    404             DO ji = 1, jpi                    
     454            zCF   (ji,   2     ) =   - zcff * z_elem_c( ji,     2       ) 
     455            v_abl (ji,jj,2,nt_a) =     zcff * v_abl   ( ji, jj, 2, nt_a ) 
     456         END DO 
     457 
     458         DO jk = 3, jpka 
     459            DO ji = 1, jpi 
    405460               zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF   (ji, jk-1 ) ) 
    406461               zCF(ji,jk) = - zcff * z_elem_c( ji, jk ) 
     
    409464            END DO 
    410465         END DO 
    411              
    412          DO jk = jpkam1,2,-1             
    413             DO ji = 1, jpi     
     466 
     467         DO jk = jpkam1,2,-1 
     468            DO ji = 1, jpi 
    414469               v_abl(ji,jj,jk,nt_a) = v_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * v_abl(ji,jj,jk+1,nt_a) 
    415470            END DO 
    416471         END DO 
    417          !                                           
    418       !------------- 
    419       END DO             ! end outer loop  
    420       !-------------    
    421      
    422       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    423       !                            !  5 *** Apply nudging on the dynamics and the tracers  
    424       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    425       z_cft(:,:,:) = 0._wp       
    426        
     472         ! 
     473      !------------- 
     474      END DO             ! end outer loop 
     475      !------------- 
     476 
     477      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     478      !                            !  5 *** Apply nudging on the dynamics and the tracers 
     479      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     480 
    427481      IF( nn_dyn_restore > 0  ) THEN 
    428          !-------------  
     482         !------------- 
    429483         DO jk = 2, jpka    ! outer loop 
    430          !-------------        
     484         !------------- 
    431485            DO_2D_01_01 
    432486               zcff1 = pblh( ji, jj ) 
    433                zsig  = ght_abl(jk) / MAX( jp_pblh_min,  MIN(  jp_pblh_max, zcff1  ) )                         
    434                zsig  =               MIN( jp_bmax    ,  MAX(         zsig, jp_bmin) )  
     487               zsig  = ght_abl(jk) / MAX( jp_pblh_min,  MIN(  jp_pblh_max, zcff1  ) ) 
     488               zsig  =               MIN( jp_bmax    ,  MAX(         zsig, jp_bmin) ) 
    435489               zmsk  = msk_abl(ji,jj) 
    436490               zcff2 = jp_alp3_dyn * zsig**3 + jp_alp2_dyn * zsig**2   & 
    437491                  &  + jp_alp1_dyn * zsig    + jp_alp0_dyn 
    438492               zcff  = (1._wp-zmsk) + zmsk * zcff2 * rn_Dt   ! zcff = 1 for masked points 
    439                                                              ! rn_Dt = rDt_abl / nn_fsbc                           
     493                                                             ! rn_Dt = rDt_abl / nn_fsbc 
    440494               zcff  = zcff * rest_eq(ji,jj) 
    441                z_cft( ji, jj, jk ) = zcff 
    442495               u_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) *  u_abl( ji, jj, jk, nt_a )   & 
    443                   &                               + zcff   * pu_dta( ji, jj, jk       )                       
     496                  &                               + zcff   * pu_dta( ji, jj, jk       ) 
    444497               v_abl( ji, jj, jk, nt_a ) = (1._wp - zcff ) *  v_abl( ji, jj, jk, nt_a )   & 
    445498                  &                               + zcff   * pv_dta( ji, jj, jk       ) 
     
    447500         !------------- 
    448501         END DO             ! end outer loop 
    449          !-------------                
     502         !------------- 
    450503      END IF 
    451504 
    452       !-------------  
     505      !------------- 
    453506      DO jk = 2, jpka    ! outer loop 
    454       !-------------        
     507      !------------- 
    455508         DO_2D_11_11 
    456509            zcff1 = pblh( ji, jj ) 
    457510            zsig  = ght_abl(jk) / MAX( jp_pblh_min,  MIN(  jp_pblh_max, zcff1  ) ) 
    458             zsig  =               MIN( jp_bmax    ,  MAX(         zsig, jp_bmin) )  
     511            zsig  =               MIN( jp_bmax    ,  MAX(         zsig, jp_bmin) ) 
    459512            zmsk  = msk_abl(ji,jj) 
    460513            zcff2 = jp_alp3_tra * zsig**3 + jp_alp2_tra * zsig**2   & 
    461514               &  + jp_alp1_tra * zsig    + jp_alp0_tra 
    462515            zcff  = (1._wp-zmsk) + zmsk * zcff2 * rn_Dt   ! zcff = 1 for masked points 
    463                                                           ! rn_Dt = rDt_abl / nn_fsbc                           
    464             !z_cft( ji, jj, jk ) = zcff 
     516                                                          ! rn_Dt = rDt_abl / nn_fsbc 
    465517            tq_abl( ji, jj, jk, nt_a, jp_ta ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_ta )   & 
    466518               &                                       + zcff   * pt_dta( ji, jj, jk ) 
    467              
     519 
    468520            tq_abl( ji, jj, jk, nt_a, jp_qa ) = (1._wp - zcff ) * tq_abl( ji, jj, jk, nt_a, jp_qa )   & 
    469521               &                                       + zcff   * pq_dta( ji, jj, jk ) 
    470              
     522 
    471523         END_2D 
    472524      !------------- 
    473525      END DO             ! end outer loop 
    474       !-------------       
    475       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    476       !                            !  6 *** MPI exchanges   
    477       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    478       ! 
    479       CALL lbc_lnk_multi( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1.,  v_abl(:,:,:,nt_a      ), 'T', -1. ) 
     526      !------------- 
     527      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     528      !                            !  6 *** MPI exchanges 
     529      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     530      ! 
     531      CALL lbc_lnk_multi( 'ablmod',  u_abl(:,:,:,nt_a      ), 'T', -1.,  v_abl(:,:,:,nt_a)      , 'T', -1.                            ) 
    480532      CALL lbc_lnk_multi( 'ablmod', tq_abl(:,:,:,nt_a,jp_ta), 'T',  1., tq_abl(:,:,:,nt_a,jp_qa), 'T',  1., kfillmode = jpfillnothing )   ! ++++ this should not be needed... 
    481533      ! 
    482       ! first ABL level 
     534#if defined key_iomput 
     535      ! 2D & first ABL level 
     536      IF ( iom_use("pblh"   ) ) CALL iom_put (    "pblh",    pblh(:,:             ) ) 
    483537      IF ( iom_use("uz1_abl") ) CALL iom_put ( "uz1_abl",   u_abl(:,:,2,nt_a      ) ) 
    484538      IF ( iom_use("vz1_abl") ) CALL iom_put ( "vz1_abl",   v_abl(:,:,2,nt_a      ) ) 
     
    489543      IF ( iom_use("tz1_dta") ) CALL iom_put ( "tz1_dta",  pt_dta(:,:,2           ) ) 
    490544      IF ( iom_use("qz1_dta") ) CALL iom_put ( "qz1_dta",  pq_dta(:,:,2           ) ) 
    491       ! all ABL levels 
    492       IF ( iom_use("u_abl"  ) ) CALL iom_put ( "u_abl"  ,   u_abl(:,:,2:jpka,nt_a      ) ) 
    493       IF ( iom_use("v_abl"  ) ) CALL iom_put ( "v_abl"  ,   v_abl(:,:,2:jpka,nt_a      ) ) 
    494       IF ( iom_use("t_abl"  ) ) CALL iom_put ( "t_abl"  ,  tq_abl(:,:,2:jpka,nt_a,jp_ta) ) 
    495       IF ( iom_use("q_abl"  ) ) CALL iom_put ( "q_abl"  ,  tq_abl(:,:,2:jpka,nt_a,jp_qa) ) 
    496       IF ( iom_use("tke_abl") ) CALL iom_put ( "tke_abl", tke_abl(:,:,2:jpka,nt_a      ) ) 
    497       IF ( iom_use("avm_abl") ) CALL iom_put ( "avm_abl", avm_abl(:,:,2:jpka           ) ) 
    498       IF ( iom_use("avt_abl") ) CALL iom_put ( "avt_abl", avm_abl(:,:,2:jpka           ) ) 
    499       IF ( iom_use("mxl_abl") ) CALL iom_put ( "mxl_abl", mxl_abl(:,:,2:jpka           ) ) 
    500       IF ( iom_use("pblh"   ) ) CALL iom_put (  "pblh"  ,    pblh(:,:                  ) ) 
    501       ! debug (to be removed) 
     545      ! debug 2D 
     546      IF( ln_geos_winds ) THEN 
     547         IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2) ) 
     548         IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", pgv_dta(:,:,2) ) 
     549      END IF 
     550      IF( ln_hpgls_frc ) THEN 
     551         IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo",  pgu_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp) ) 
     552         IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", -pgv_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp) ) 
     553      END IF 
     554      ! 3D (all ABL levels) 
     555      IF ( iom_use("u_abl"   ) ) CALL iom_put ( "u_abl"   ,    u_abl(:,:,2:jpka,nt_a      ) ) 
     556      IF ( iom_use("v_abl"   ) ) CALL iom_put ( "v_abl"   ,    v_abl(:,:,2:jpka,nt_a      ) ) 
     557      IF ( iom_use("t_abl"   ) ) CALL iom_put ( "t_abl"   ,   tq_abl(:,:,2:jpka,nt_a,jp_ta) ) 
     558      IF ( iom_use("q_abl"   ) ) CALL iom_put ( "q_abl"   ,   tq_abl(:,:,2:jpka,nt_a,jp_qa) ) 
     559      IF ( iom_use("tke_abl" ) ) CALL iom_put ( "tke_abl" ,  tke_abl(:,:,2:jpka,nt_a      ) ) 
     560      IF ( iom_use("avm_abl" ) ) CALL iom_put ( "avm_abl" ,  avm_abl(:,:,2:jpka           ) ) 
     561      IF ( iom_use("avt_abl" ) ) CALL iom_put ( "avt_abl" ,  avt_abl(:,:,2:jpka           ) ) 
     562      IF ( iom_use("mxlm_abl") ) CALL iom_put ( "mxlm_abl", mxlm_abl(:,:,2:jpka           ) ) 
     563      IF ( iom_use("mxld_abl") ) CALL iom_put ( "mxld_abl", mxld_abl(:,:,2:jpka           ) ) 
     564      ! debug 3D 
    502565      IF ( iom_use("u_dta") ) CALL iom_put ( "u_dta",  pu_dta(:,:,2:jpka) ) 
    503566      IF ( iom_use("v_dta") ) CALL iom_put ( "v_dta",  pv_dta(:,:,2:jpka) ) 
    504567      IF ( iom_use("t_dta") ) CALL iom_put ( "t_dta",  pt_dta(:,:,2:jpka) ) 
    505568      IF ( iom_use("q_dta") ) CALL iom_put ( "q_dta",  pq_dta(:,:,2:jpka) ) 
    506       IF ( iom_use("coeft") ) CALL iom_put ( "coeft",   z_cft(:,:,2:jpka) ) 
    507569      IF( ln_geos_winds ) THEN 
    508          IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo", pgu_dta(:,:,2           ) ) 
    509          IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", pgv_dta(:,:,2           ) ) 
     570         IF ( iom_use("u_geo") ) CALL iom_put ( "u_geo", pgu_dta(:,:,2:jpka) ) 
     571         IF ( iom_use("v_geo") ) CALL iom_put ( "v_geo", pgv_dta(:,:,2:jpka) ) 
    510572      END IF 
    511573      IF( ln_hpgls_frc ) THEN 
    512          IF ( iom_use("uz1_geo") ) CALL iom_put ( "uz1_geo",  pgu_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp)  ) 
    513          IF ( iom_use("vz1_geo") ) CALL iom_put ( "vz1_geo", -pgv_dta(:,:,2)/MAX(fft_abl(:,:),2.5e-5_wp)  ) 
     574         IF ( iom_use("u_geo") ) CALL iom_put ( "u_geo",  pgu_dta(:,:,2:jpka)/MAX( RESHAPE( fft_abl(:,:), (/jpi,jpj,jpka-1/), fft_abl(:,:)), 2.5e-5_wp) ) 
     575         IF ( iom_use("v_geo") ) CALL iom_put ( "v_geo", -pgv_dta(:,:,2:jpka)/MAX( RESHAPE( fft_abl(:,:), (/jpi,jpj,jpka-1/), fft_abl(:,:)), 2.5e-5_wp) ) 
    514576      END IF 
    515       ! 
     577#endif 
    516578      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    517579      !                            !  7 *** Finalize flux computation 
    518       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
    519  
     580      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     581      ! 
    520582      DO_2D_11_11 
    521          ztemp             = tq_abl  ( ji, jj, 2, nt_a, jp_ta )  
    522          zhumi             = tq_abl  ( ji, jj, 2, nt_a, jp_qa )  
    523          !zcff              = pslp_dta( ji, jj ) /   &              !<-- At this point ztemp and zhumi should not be zero ... 
    524          !   &                        (  R_dry*ztemp * ( 1._wp + rctv0*zhumi )  ) 
    525          zcff              = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 
    526          psen ( ji, jj )   =      cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp ) 
    527          pevp ( ji, jj )   = rn_efac*MAX( 0._wp,  zcff * pevp(ji,jj) * ( pssq(ji,jj)       - zhumi ) ) 
    528          rhoa( ji, jj )   = zcff               
     583         ztemp          =  tq_abl( ji, jj, 2, nt_a, jp_ta ) 
     584         zhumi          =  tq_abl( ji, jj, 2, nt_a, jp_qa ) 
     585         zcff           = rho_air( ztemp, zhumi, pslp_dta( ji, jj ) ) 
     586         psen( ji, jj ) =    - cp_air(zhumi) * zcff * psen(ji,jj) * ( psst(ji,jj) + rt0 - ztemp )   !GS: negative sign to respect aerobulk convention 
     587         pevp( ji, jj ) = rn_efac*MAX( 0._wp,  zcff * pevp(ji,jj) * ( pssq(ji,jj)       - zhumi ) ) 
     588         rhoa( ji, jj ) = zcff 
    529589      END_2D 
    530        
     590 
    531591      DO_2D_01_01 
    532          zwnd_i(ji,jj) = u_abl(ji  ,jj,2,nt_a) - 0.5_wp * rn_vfac * ( pssu(ji  ,jj) + pssu(ji-1,jj) )   
    533          zwnd_j(ji,jj) = v_abl(ji,jj  ,2,nt_a) - 0.5_wp * rn_vfac * ( pssv(ji,jj  ) + pssv(ji,jj-1) )  
     592         zwnd_i(ji,jj) = u_abl(ji  ,jj,2,nt_a) - 0.5_wp * ( pssu(ji  ,jj) + pssu(ji-1,jj) )   
     593         zwnd_j(ji,jj) = v_abl(ji,jj  ,2,nt_a) - 0.5_wp * ( pssv(ji,jj  ) + pssv(ji,jj-1) )  
    534594      END_2D 
    535       !  
     595      ! 
    536596      CALL lbc_lnk_multi( 'ablmod', zwnd_i(:,:) , 'T', -1., zwnd_j(:,:) , 'T', -1. ) 
    537597      ! 
     
    539599      DO_2D_11_11 
    540600         zcff          = SQRT(  zwnd_i(ji,jj) * zwnd_i(ji,jj)   & 
    541             &                 + zwnd_j(ji,jj) * zwnd_j(ji,jj)  )  ! * msk_abl(ji,jj) 
     601            &                 + zwnd_j(ji,jj) * zwnd_j(ji,jj) )   ! * msk_abl(ji,jj) 
    542602         zztmp         = rhoa(ji,jj) * pcd_du(ji,jj) 
    543           
     603 
    544604         pwndm (ji,jj) =         zcff 
    545605         ptaum (ji,jj) = zztmp * zcff 
     
    564624 
    565625      IF(sn_cfctl%l_prtctl) THEN 
    566          CALL prt_ctl( tab2d_1=pwndm  , clinfo1=' abl_stp: wndm   : ' ) 
    567          CALL prt_ctl( tab2d_1=ptaui  , clinfo1=' abl_stp: utau   : ',   & 
    568             &          tab2d_2=ptauj  , clinfo2=          'vtau   : ' ) 
     626         CALL prt_ctl( tab2d_1=ptaui , clinfo1=' abl_stp: utau   : ', mask1=umask,   & 
     627            &          tab2d_2=ptauj , clinfo2='          vtau   : ', mask2=vmask ) 
     628         CALL prt_ctl( tab2d_1=pwndm , clinfo1=' abl_stp: wndm   : ' ) 
    569629      ENDIF 
    570630 
    571631#if defined key_si3 
    572          ! ------------------------------------------------------------ ! 
    573          !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
    574          ! ------------------------------------------------------------ ! 
    575          DO_2D_00_00 
    576              
    577             zztmp1 = 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) ) 
    578             zztmp2 = 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 
    579     
    580             ptaui_ice(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj)             & 
    581                &                      +    rhoa(ji  ,jj) * pCd_du_ice(ji  ,jj)  )          & 
    582                &         * ( zztmp1 - rn_vfac * pssu_ice(ji,jj) ) 
    583             ptauj_ice(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1)             & 
    584                &                      +    rhoa(ji,jj  ) * pCd_du_ice(ji,jj  )  )          & 
    585                &         * ( zztmp2 - rn_vfac * pssv_ice(ji,jj) ) 
    586          END_2D 
    587          CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 
    588          ! 
    589          IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=ptaui_ice  , clinfo1=' abl_stp: putaui : '   & 
    590             &                                , tab2d_2=ptauj_ice  , clinfo2='          pvtaui : ' ) 
     632      ! ------------------------------------------------------------ ! 
     633      !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
     634      ! ------------------------------------------------------------ ! 
     635      DO_2D_00_00            
     636         ptaui_ice(ji,jj) = 0.5_wp * ( rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj) + rhoa(ji,jj) * pCd_du_ice(ji,jj)      )   & 
     637            &                      * ( 0.5_wp * ( u_abl(ji+1,jj,2,nt_a) + u_abl(ji,jj,2,nt_a) ) - pssu_ice(ji,jj) ) 
     638         ptauj_ice(ji,jj) = 0.5_wp * ( rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1) + rhoa(ji,jj) * pCd_du_ice(ji,jj)      )   & 
     639            &                      * ( 0.5_wp * ( v_abl(ji,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) - pssv_ice(ji,jj) ) 
     640      END_2D 
     641      CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 
     642      ! 
     643      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=ptaui_ice  , clinfo1=' abl_stp: putaui : '   & 
     644         &                                , tab2d_2=ptauj_ice  , clinfo2='          pvtaui : ' ) 
     645      ! ------------------------------------------------------------ ! 
     646      !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
     647      ! ------------------------------------------------------------ ! 
     648      DO_2D_00_00 
     649 
     650         zztmp1 = 0.5_wp * ( u_abl(ji+1,jj  ,2,nt_a) + u_abl(ji,jj,2,nt_a) ) 
     651         zztmp2 = 0.5_wp * ( v_abl(ji  ,jj+1,2,nt_a) + v_abl(ji,jj,2,nt_a) ) 
     652 
     653         ptaui_ice(ji,jj) = 0.5_wp * (  rhoa(ji+1,jj) * pCd_du_ice(ji+1,jj)             & 
     654            &                      +    rhoa(ji  ,jj) * pCd_du_ice(ji  ,jj)  )          & 
     655            &         * ( zztmp1 - pssu_ice(ji,jj) ) 
     656         ptauj_ice(ji,jj) = 0.5_wp * (  rhoa(ji,jj+1) * pCd_du_ice(ji,jj+1)             & 
     657            &                      +    rhoa(ji,jj  ) * pCd_du_ice(ji,jj  )  )          & 
     658            &         * ( zztmp2 - pssv_ice(ji,jj) ) 
     659      END_2D 
     660      CALL lbc_lnk_multi( 'ablmod', ptaui_ice, 'U', -1., ptauj_ice, 'V', -1. ) 
     661      ! 
     662      IF(sn_cfctl%l_prtctl) THEN 
     663         CALL prt_ctl( tab2d_1=ptaui_ice , clinfo1=' abl_stp: utau_ice : ', mask1=umask,   & 
     664            &          tab2d_2=ptauj_ice , clinfo2='          vtau_ice : ', mask2=vmask ) 
     665      END IF 
    591666#endif 
    592667      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     
    599674   END SUBROUTINE abl_stp 
    600675!=================================================================================================== 
    601  
    602  
    603  
    604  
    605  
    606  
    607  
    608  
    609  
    610  
    611  
    612  
    613  
    614676 
    615677 
     
    634696      !!                (= Kz dz[Ub] * dz[Un] ) 
    635697      !! --------------------------------------------------------------------- 
    636       INTEGER                                 ::   ji, jj, jk, tind, jbak, jkup, jkdwn  
     698      INTEGER                                 ::   ji, jj, jk, tind, jbak, jkup, jkdwn 
    637699      INTEGER, DIMENSION(1:jpi          )     ::   ikbl 
    638700      REAL(wp)                                ::   zcff, zcff2, ztken, zesrf, zetop, ziRic, ztv 
    639       REAL(wp)                                ::   zdU, zdV, zcff1,zshear,zbuoy,zsig, zustar2 
    640       REAL(wp)                                ::   zdU2,zdV2       
    641       REAL(wp)                                ::   zwndi,zwndj 
     701      REAL(wp)                                ::   zdU , zdV , zcff1, zshear, zbuoy, zsig, zustar2 
     702      REAL(wp)                                ::   zdU2, zdV2, zbuoy1, zbuoy2    ! zbuoy for BL89 
     703      REAL(wp)                                ::   zwndi, zwndj 
    642704      REAL(wp), DIMENSION(1:jpi,      1:jpka) ::   zsh2 
    643705      REAL(wp), DIMENSION(1:jpi,1:jpj,1:jpka) ::   zbn2 
    644       REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   zFC, zRH, zCF        
     706      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   zFC, zRH, zCF 
    645707      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   z_elem_a 
    646708      REAL(wp), DIMENSION(1:jpi,1:jpka  )     ::   z_elem_b 
     
    648710      LOGICAL                                 ::   ln_Patankar    = .FALSE. 
    649711      LOGICAL                                 ::   ln_dumpvar     = .FALSE. 
    650       LOGICAL , DIMENSION(1:jpi         )     ::   ln_foundl  
     712      LOGICAL , DIMENSION(1:jpi         )     ::   ln_foundl 
    651713      ! 
    652714      tind  = nt_n 
     
    660722      !------------- 
    661723         ! 
    662          ! Compute vertical shear          
     724         ! Compute vertical shear 
    663725         DO jk = 2, jpkam1 
    664             DO ji = 1,jpi   
    665                zcff        = 1.0_wp / e3w_abl( jk )**2                 
    666                zdU         = zcff* Avm_abl(ji,jj,jk) * (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk  , tind) )**2                            
     726            DO ji = 1, jpi 
     727               zcff        = 1.0_wp / e3w_abl( jk )**2 
     728               zdU         = zcff* Avm_abl(ji,jj,jk) * (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk  , tind) )**2 
    667729               zdV         = zcff* Avm_abl(ji,jj,jk) * (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk  , tind) )**2 
    668                zsh2(ji,jk) = zdU+zdV 
    669             END DO 
    670          END DO    
     730               zsh2(ji,jk) = zdU+zdV   !<-- zsh2 = Km ( ( du/dz )^2 + ( dv/dz )^2 ) 
     731            END DO 
     732         END DO 
    671733         ! 
    672734         ! Compute brunt-vaisala frequency 
    673735         DO jk = 2, jpkam1 
    674             DO ji = 1,jpi  
    675                zcff  = grav * itvref / e3w_abl( jk )   
     736            DO ji = 1,jpi 
     737               zcff  = grav * itvref / e3w_abl( jk ) 
    676738               zcff1 =  tq_abl( ji, jj, jk+1, tind, jp_ta) - tq_abl( ji, jj, jk  , tind, jp_ta) 
    677739               zcff2 =  tq_abl( ji, jj, jk+1, tind, jp_ta) * tq_abl( ji, jj, jk+1, tind, jp_qa)        & 
     
    679741               zbn2(ji,jj,jk) = zcff * ( zcff1 + rctv0 * zcff2 )  !<-- zbn2 defined on (2,jpi) 
    680742            END DO 
    681          END DO  
     743         END DO 
    682744         ! 
    683745         ! Terms for the tridiagonal problem 
    684746         DO jk = 2, jpkam1 
    685             DO ji = 1,jpi  
    686                zshear       =                 zsh2( ji,     jk )   ! zsh2 is already multiplied by Avm_abl at this point 
    687                zsh2(ji,jk)  = zsh2( ji, jk ) / Avm_abl( ji, jj, jk )   ! reformulate zsh2 as a 'true' vertical shear for PBLH computation           
    688                zbuoy        = - Avt_abl( ji, jj, jk ) * zbn2( ji, jj, jk )  
    689                 
    690                z_elem_a( ji,     jk )   = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk   )+Avm_abl( ji, jj, jk-1 ) ) / e3t_abl( jk   ) ! lower-diagonal 
    691                z_elem_c( ji,     jk )   = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk   )+Avm_abl( ji, jj, jk+1 ) ) / e3t_abl( jk+1 ) ! upper-diagonal           
     747            DO ji = 1, jpi 
     748               zshear      = zsh2( ji, jk )                           ! zsh2 is already multiplied by Avm_abl at this point 
     749               zsh2(ji,jk) = zsh2( ji, jk ) / Avm_abl( ji, jj, jk )   ! reformulate zsh2 as a 'true' vertical shear for PBLH computation 
     750               zbuoy       = - Avt_abl( ji, jj, jk ) * zbn2( ji, jj, jk ) 
     751 
     752               z_elem_a( ji, jk ) = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk ) + Avm_abl( ji, jj, jk-1 ) ) / e3t_abl( jk   ) ! lower-diagonal 
     753               z_elem_c( ji, jk ) = - 0.5_wp * rDt_abl * rn_Sch * ( Avm_abl( ji, jj, jk ) + Avm_abl( ji, jj, jk+1 ) ) / e3t_abl( jk+1 ) ! upper-diagonal 
    692754               IF( (zbuoy + zshear) .gt. 0.) THEN    ! Patankar trick to avoid negative values of TKE 
    693                   z_elem_b( ji,     jk )  = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   & 
    694                      &                     + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxl_abl(ji,jj,jk)     ! diagonal        
    695                   tke_abl( ji, jj, jk, nt_a )  = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * ( zbuoy + zshear ) )             ! right-hand-side 
     755                  z_elem_b( ji, jk ) = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   & 
     756                     &               + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxld_abl(ji,jj,jk)    ! diagonal 
     757                  tke_abl( ji, jj, jk, nt_a ) = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl * ( zbuoy + zshear ) )       ! right-hand-side 
    696758               ELSE 
    697                   z_elem_b( ji,     jk )  = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   & 
    698                      &                     + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxl_abl(ji,jj,jk)   &  ! diagonal     
    699                      &                     - e3w_abl(jk) * rDt_abl * zbuoy    
    700                   tke_abl( ji, jj, jk, nt_a )  = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl *  zshear )             ! right-hand-side                      
     759                  z_elem_b( ji, jk ) = e3w_abl(jk) - z_elem_a( ji, jk ) - z_elem_c( ji, jk )   & 
     760                     &               + e3w_abl(jk) * rDt_abl * rn_Ceps * sqrt(tke_abl( ji, jj, jk, nt_n )) / mxld_abl(ji,jj,jk)   &  ! diagonal 
     761                     &               - e3w_abl(jk) * rDt_abl * zbuoy 
     762                  tke_abl( ji, jj, jk, nt_a ) = e3w_abl(jk) * ( tke_abl( ji, jj, jk, nt_n ) + rDt_abl *  zshear )                    ! right-hand-side 
    701763               END IF 
    702764            END DO 
    703          END DO   
    704                              
    705          DO ji = 1,jpi    ! vector opt.             
    706             zesrf   =  MAX( 4.63_wp * ustar2(ji,jj), tke_min )            
    707             zetop   = tke_min              
    708             z_elem_a ( ji,     1    ) = 0._wp; z_elem_c ( ji,     1    ) = 0._wp; z_elem_b ( ji,     1    ) = 1._wp                                                    
    709             z_elem_a ( ji,     jpka ) = 0._wp; z_elem_c ( ji,     jpka ) = 0._wp; z_elem_b ( ji,     jpka ) = 1._wp             
    710             tke_abl( ji, jj,    1, nt_a ) = zesrf 
    711             tke_abl( ji, jj, jpka, nt_a ) = zetop  
    712             zbn2(ji,jj,   1) = zbn2( ji,jj,   2)  
    713             zsh2(ji,      1) = zsh2( ji,      2)                                       
    714             zbn2(ji,jj,jpka) = zbn2( ji,jj,jpkam1)  
    715             zsh2(ji,   jpka) = zsh2( ji  , jpkam1) 
    716          END DO         
     765         END DO 
     766 
     767         DO ji = 1,jpi    ! vector opt. 
     768            zesrf = MAX( rn_Esfc * ustar2(ji,jj), tke_min ) 
     769            zetop = tke_min 
     770 
     771            z_elem_a ( ji,     1       ) = 0._wp 
     772            z_elem_c ( ji,     1       ) = 0._wp 
     773            z_elem_b ( ji,     1       ) = 1._wp 
     774            tke_abl  ( ji, jj, 1, nt_a ) = zesrf 
     775 
     776            !++ Top Neumann B.C. 
     777            !z_elem_a ( ji,     jpka       ) = - 0.5 * rDt_abl * rn_Sch * (Avm_abl(ji,jj, jpka-1 )+Avm_abl(ji,jj, jpka ))  / e3t_abl( jpka ) 
     778            !z_elem_c ( ji,     jpka       ) = 0._wp 
     779            !z_elem_b ( ji,     jpka       ) = e3w_abl(jpka) - z_elem_a(ji, jpka ) 
     780            !tke_abl  ( ji, jj, jpka, nt_a ) = e3w_abl(jpka) * tke_abl( ji,jj, jpka, nt_n ) 
     781 
     782            !++ Top Dirichlet B.C. 
     783            z_elem_a ( ji,     jpka       ) = 0._wp 
     784            z_elem_c ( ji,     jpka       ) = 0._wp 
     785            z_elem_b ( ji,     jpka       ) = 1._wp 
     786            tke_abl  ( ji, jj, jpka, nt_a ) = zetop 
     787 
     788            zbn2 ( ji, jj,    1 ) = zbn2 ( ji, jj,      2 ) 
     789            zsh2 ( ji,        1 ) = zsh2 ( ji,          2 ) 
     790            zbn2 ( ji, jj, jpka ) = zbn2 ( ji, jj, jpkam1 ) 
     791            zsh2 ( ji,     jpka ) = zsh2 ( ji    , jpkam1 ) 
     792         END DO 
    717793         !! 
    718794         !! Matrix inversion 
     
    720796         DO ji = 1,jpi 
    721797            zcff                  =  1._wp / z_elem_b( ji, 1 ) 
    722             zCF    (ji,   1     ) = - zcff * z_elem_c( ji,     1       )  
    723             tke_abl(ji,jj,1,nt_a) =   zcff * tke_abl ( ji, jj, 1, nt_a )  
    724          END DO              
    725  
    726          DO jk = 2, jpka             
     798            zCF    (ji,   1     ) = - zcff * z_elem_c( ji,     1       ) 
     799            tke_abl(ji,jj,1,nt_a) =   zcff * tke_abl ( ji, jj, 1, nt_a ) 
     800         END DO 
     801 
     802         DO jk = 2, jpka 
    727803            DO ji = 1,jpi 
    728804               zcff = 1._wp / ( z_elem_b( ji, jk ) + z_elem_a( ji, jk ) * zCF(ji, jk-1 ) ) 
     
    732808            END DO 
    733809         END DO 
    734              
    735          DO jk = jpkam1,1,-1             
     810 
     811         DO jk = jpkam1,1,-1 
    736812            DO ji = 1,jpi 
    737813               tke_abl(ji,jj,jk,nt_a) = tke_abl(ji,jj,jk,nt_a) + zCF(ji,jk) * tke_abl(ji,jj,jk+1,nt_a) 
    738814            END DO 
    739815         END DO 
    740           
    741 !!FL should not be needed because of Patankar procedure   
     816 
     817!!FL should not be needed because of Patankar procedure 
    742818         tke_abl(2:jpi,jj,1:jpka,nt_a) = MAX( tke_abl(2:jpi,jj,1:jpka,nt_a), tke_min ) 
    743819 
     
    745821         !! Diagnose PBL height 
    746822         !! ---------------------------------------------------------- 
    747           
    748           
    749          !                                                        
     823 
     824 
     825         ! 
    750826         ! arrays zRH, zFC and zCF are available at this point 
    751827         ! and zFC(:, 1 ) = 0. 
    752828         ! diagnose PBL height based on zsh2 and zbn2 
    753829         zFC (  :  ,1) = 0._wp 
    754          ikbl( 1:jpi ) = 0  
    755           
     830         ikbl( 1:jpi ) = 0 
     831 
    756832         DO jk = 2,jpka 
    757             DO ji = 1, jpi  
     833            DO ji = 1, jpi 
    758834               zcff  = ghw_abl( jk-1 ) 
    759835               zcff1 = zcff / ( zcff + rn_epssfc * pblh ( ji, jj ) ) 
     
    781857            ELSE 
    782858               pblh( ji, jj ) = ghw_abl(jpka) 
    783             END IF  
    784          END DO 
    785       !-------------       
    786       END DO       
    787       !------------- 
    788       ! 
    789       ! Optional : could add pblh smoothing if pblh is noisy horizontally ...  
     859            END IF 
     860         END DO 
     861      !------------- 
     862      END DO 
     863      !------------- 
     864      ! 
     865      ! Optional : could add pblh smoothing if pblh is noisy horizontally ... 
    790866      IF(ln_smth_pblh) THEN 
    791          CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) 
     867         CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) !, kfillmode = jpfillnothing) 
    792868         CALL smooth_pblh( pblh, msk_abl ) 
    793          CALL lbc_lnk( 'ablmod', pblh, 'T', 1.)    
     869         CALL lbc_lnk( 'ablmod', pblh, 'T', 1.) !, kfillmode = jpfillnothing) 
    794870      ENDIF 
    795871      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     
    799875      SELECT CASE ( nn_amxl ) 
    800876      ! 
    801       CASE ( 0 )           ! Deardroff 80 length-scale bounded by the distance to surface and bottom          
    802 #   define zlup zRH       
    803 #   define zldw zFC  
     877      CASE ( 0 )           ! Deardroff 80 length-scale bounded by the distance to surface and bottom 
     878#   define zlup zRH 
     879#   define zldw zFC 
    804880         DO jj = 1, jpj     ! outer loop 
    805881            ! 
    806882            DO ji = 1, jpi 
    807                mxl_abl ( ji, jj,    1 )  = 0._wp 
    808                mxl_abl ( ji, jj, jpka )  = mxl_min 
    809                zldw( ji,        1 )  = 0._wp               
    810                zlup( ji,     jpka )  = 0._wp 
    811             END DO 
    812             ! 
    813             DO jk = 2, jpkam1    
    814                DO ji = 1, jpi   
    815                   zbuoy             = MAX( zbn2(ji, jj, jk), rsmall )   
    816                   mxl_abl( ji, jj, jk ) = MAX( mxl_min,  & 
    817                      &               SQRT( 2._wp * tke_abl( ji, jj, jk, nt_a ) / zbuoy )   )  
    818                END DO 
    819             END DO    
     883               mxld_abl( ji, jj,    1 ) = mxl_min 
     884               mxld_abl( ji, jj, jpka ) = mxl_min 
     885               mxlm_abl( ji, jj,    1 ) = mxl_min 
     886               mxlm_abl( ji, jj, jpka ) = mxl_min 
     887               zldw    ( ji,        1 ) = zrough(ji,jj) * rn_Lsfc 
     888               zlup    ( ji,     jpka ) = mxl_min 
     889            END DO 
     890            ! 
     891            DO jk = 2, jpkam1 
     892               DO ji = 1, jpi 
     893                  zbuoy = MAX( zbn2(ji, jj, jk), rsmall ) 
     894                  mxlm_abl( ji, jj, jk ) = MAX( mxl_min,  & 
     895                     &               SQRT( 2._wp * tke_abl( ji, jj, jk, nt_a ) / zbuoy ) ) 
     896               END DO 
     897            END DO 
    820898            ! 
    821899            ! Limit mxl 
    822             DO jk = jpkam1,1,-1    
    823                DO ji = 1, jpi  
    824                   zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxl_abl(ji, jj, jk) ) 
    825                END DO 
    826             END DO    
     900            DO jk = jpkam1,1,-1 
     901               DO ji = 1, jpi 
     902                  zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxlm_abl(ji, jj, jk) ) 
     903               END DO 
     904            END DO 
    827905            ! 
    828906            DO jk = 2, jpka 
    829                DO ji = 1, jpi   
    830                   zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxl_abl(ji, jj, jk) )    
    831                END DO 
    832             END DO  
     907               DO ji = 1, jpi 
     908                  zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxlm_abl(ji, jj, jk) ) 
     909               END DO 
     910            END DO 
     911            ! 
     912!            DO jk = 1, jpka 
     913!               DO ji = 1, jpi 
     914!                  mxlm_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 
     915!                  mxld_abl( ji, jj, jk ) = MIN ( zldw( ji, jk ),  zlup( ji, jk ) ) 
     916!               END DO 
     917!            END DO 
    833918            ! 
    834919            DO jk = 1, jpka 
    835920               DO ji = 1, jpi 
    836                   mxl_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) )    
    837                END DO 
    838             END DO                          
    839             ! 
    840          END DO 
    841 #   undef zlup       
    842 #   undef zldw   
    843          ! 
    844          ! 
    845       CASE ( 1 )             ! length-scale computed as the distance to the PBL height 
    846          DO jj = 1,jpj      ! outer loop 
    847             ! 
    848             DO ji = 1, jpi   ! vector opt. 
    849                zcff = 1._wp / pblh( ji, jj )     ! inverse of hbl               
    850                DO jk = 1, jpka               
    851                   zsig  = MIN( zcff * ghw_abl( jk ), 1. )     
    852                   zcff1 = pblh( ji, jj )                  
    853                   mxl_abl( ji, jj, jk ) =  mxl_min                           & 
    854                      &  +  zsig         * (  amx1*zcff1 + bmx1*mxl_min ) & 
    855                      &  +  zsig *  zsig * (  amx2*zcff1 + bmx2*mxl_min ) & 
    856                      &  +  zsig**3      * (  amx3*zcff1 + bmx3*mxl_min ) & 
    857                      &  +  zsig**4      * (  amx4*zcff1 + bmx4*mxl_min ) & 
    858                      &  +  zsig**5      * (  amx5*zcff1 + bmx5*mxl_min ) 
    859                END DO 
    860             END DO  
    861             !             
    862          END DO             
     921!                  zcff = 2.*SQRT(2.)*(  zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp)  )**(-3._wp/2._wp) 
     922                  zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 
     923                  mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 
     924                  mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ),  zlup( ji, jk ) ), mxl_min ) 
     925               END DO 
     926            END DO 
     927            ! 
     928         END DO 
     929#   undef zlup 
     930#   undef zldw 
     931         ! 
     932         ! 
     933      CASE ( 1 )           ! Modified Deardroff 80 length-scale bounded by the distance to surface and bottom 
     934#   define zlup zRH 
     935#   define zldw zFC 
     936         DO jj = 1, jpj     ! outer loop 
     937            ! 
     938            DO jk = 2, jpkam1 
     939               DO ji = 1,jpi 
     940                              zcff        = 1.0_wp / e3w_abl( jk )**2 
     941                  zdU         = zcff* (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk  , tind) )**2 
     942                  zdV         = zcff* (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk  , tind) )**2 
     943                  zsh2(ji,jk) = SQRT(zdU+zdV)   !<-- zsh2 = SQRT ( ( du/dz )^2 + ( dv/dz )^2 ) 
     944                           ENDDO 
     945                        ENDDO 
     946                        ! 
     947            DO ji = 1, jpi 
     948               zcff                      = zrough(ji,jj) * rn_Lsfc 
     949               mxld_abl ( ji, jj,    1 ) = zcff 
     950               mxld_abl ( ji, jj, jpka ) = mxl_min 
     951               mxlm_abl ( ji, jj,    1 ) = zcff 
     952               mxlm_abl ( ji, jj, jpka ) = mxl_min 
     953               zldw     ( ji,        1 ) = zcff 
     954               zlup     ( ji,     jpka ) = mxl_min 
     955            END DO 
     956            ! 
     957            DO jk = 2, jpkam1 
     958               DO ji = 1, jpi 
     959                  zbuoy    = MAX( zbn2(ji, jj, jk), rsmall ) 
     960                  zcff     = 2.*SQRT(tke_abl( ji, jj, jk, nt_a )) / ( rn_Rod*zsh2(ji,jk) & 
     961                                &             + SQRT( rn_Rod*rn_Rod*zsh2(ji,jk)*zsh2(ji,jk)+2.*zbuoy ) ) 
     962                                  mxlm_abl( ji, jj, jk ) = MAX( mxl_min, zcff ) 
     963               END DO 
     964            END DO 
     965            ! 
     966            ! Limit mxl 
     967            DO jk = jpkam1,1,-1 
     968               DO ji = 1, jpi 
     969                  zlup(ji,jk) = MIN( zlup(ji,jk+1) + (ghw_abl(jk+1)-ghw_abl(jk)) , mxlm_abl(ji, jj, jk) ) 
     970               END DO 
     971            END DO 
     972            ! 
     973            DO jk = 2, jpka 
     974               DO ji = 1, jpi 
     975                  zldw(ji,jk) = MIN( zldw(ji,jk-1) + (ghw_abl(jk)-ghw_abl(jk-1)) , mxlm_abl(ji, jj, jk) ) 
     976               END DO 
     977            END DO 
     978            ! 
     979            DO jk = 1, jpka 
     980               DO ji = 1, jpi 
     981                  !mxlm_abl( ji, jj, jk ) = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 
     982                  !zcff = 2.*SQRT(2.)*(  zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp)  )**(-3._wp/2._wp) 
     983                  zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 
     984                  mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 
     985                  !mxld_abl( ji, jj, jk ) = MIN( zldw( ji, jk ), zlup( ji, jk ) ) 
     986                  mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ),  zlup( ji, jk ) ), mxl_min ) 
     987               END DO 
     988            END DO 
     989 ! 
     990         END DO 
     991#   undef zlup 
     992#   undef zldw 
    863993         ! 
    864994      CASE ( 2 )           ! Bougeault & Lacarrere 89 length-scale 
    865995         ! 
    866 #   define zlup zRH       
    867 #   define zldw zFC            
     996#   define zlup zRH 
     997#   define zldw zFC 
    868998! zCF is used for matrix inversion 
    869 !              
     999! 
    8701000       DO jj = 1, jpj      ! outer loop 
    871           
    872          DO ji = 1, jpi            
    873             zlup( ji,    1 ) = mxl_min 
    874             zldw( ji,    1 ) = mxl_min                
     1001 
     1002         DO ji = 1, jpi 
     1003            zcff             = zrough(ji,jj) * rn_Lsfc 
     1004            zlup( ji,    1 ) = zcff 
     1005            zldw( ji,    1 ) = zcff 
    8751006            zlup( ji, jpka ) = mxl_min 
    876             zldw( ji, jpka ) = mxl_min                 
    877          END DO             
    878           
     1007            zldw( ji, jpka ) = mxl_min 
     1008         END DO 
     1009 
    8791010         DO jk = 2,jpka-1 
    8801011            DO ji = 1, jpi 
    8811012               zlup(ji,jk) = ghw_abl(jpka) - ghw_abl(jk) 
    882                zldw(ji,jk) = ghw_abl(jk  ) - ghw_abl( 1)         
    883             END DO 
    884          END DO          
     1013               zldw(ji,jk) = ghw_abl(jk  ) - ghw_abl( 1) 
     1014            END DO 
     1015         END DO 
    8851016         !! 
    8861017         !! BL89 search for lup 
    887          !! ----------------------------------------------------------            
    888          DO jk=2,jpka-1  
     1018         !! ---------------------------------------------------------- 
     1019         DO jk=2,jpka-1 
    8891020            ! 
    8901021            DO ji = 1, jpi 
     
    8921023               zCF(ji,  jk  ) = - tke_abl( ji, jj, jk, nt_a ) 
    8931024               ln_foundl(ji ) = .false. 
    894             END DO    
    895             !            
     1025            END DO 
     1026            ! 
    8961027            DO jkup=jk+1,jpka-1 
    8971028               DO ji = 1, jpi 
     1029                  zbuoy1 = MAX( zbn2(ji,jj,jkup  ), rsmall ) 
     1030                  zbuoy2 = MAX( zbn2(ji,jj,jkup-1), rsmall ) 
    8981031                  zCF (ji,jkup) = zCF (ji,jkup-1) + 0.5_wp * e3t_abl(jkup) * & 
    899                      &               ( zbn2(ji,jj,jkup  )*(ghw_abl(jkup  )-ghw_abl(jk)) & 
    900                      &               + zbn2(ji,jj,jkup-1)*(ghw_abl(jkup-1)-ghw_abl(jk)) ) 
     1032                     &               ( zbuoy1*(ghw_abl(jkup  )-ghw_abl(jk)) & 
     1033                     &               + zbuoy2*(ghw_abl(jkup-1)-ghw_abl(jk)) ) 
    9011034                  IF( zCF (ji,jkup) * zCF (ji,jkup-1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 
    9021035                     zcff2 = ghw_abl(jkup  ) - ghw_abl(jk) 
    903                      zcff1 = ghw_abl(jkup-1) - ghw_abl(jk)                    
     1036                     zcff1 = ghw_abl(jkup-1) - ghw_abl(jk) 
    9041037                     zcff  = ( zcff1 * zCF(ji,jkup) - zcff2 * zCF(ji,jkup-1) ) /   & 
    905                         &    (         zCF(ji,jkup) -         zCF(ji,jkup-1) )  
    906                      zlup(ji,jk) = zcff                 
     1038                        &    (         zCF(ji,jkup) -         zCF(ji,jkup-1) ) 
     1039                     zlup(ji,jk) = zcff 
     1040                     zlup(ji,jk) = ghw_abl(jkup  ) - ghw_abl(jk) 
    9071041                     ln_foundl(ji) = .true. 
    9081042                  END IF 
     
    9101044            END DO 
    9111045            ! 
    912          END DO    
     1046         END DO 
    9131047         !! 
    9141048         !! BL89 search for ldwn 
    915          !! ----------------------------------------------------------           
    916          DO jk=2,jpka-1          
     1049         !! ---------------------------------------------------------- 
     1050         DO jk=2,jpka-1 
    9171051            ! 
    9181052            DO ji = 1, jpi 
     
    9201054               zCF(ji,  jk  ) = - tke_abl( ji, jj, jk, nt_a ) 
    9211055               ln_foundl(ji ) = .false. 
    922             END DO   
    923             !    
     1056            END DO 
     1057            ! 
    9241058            DO jkdwn=jk-1,1,-1 
    925                DO ji = 1, jpi              
     1059               DO ji = 1, jpi 
     1060                  zbuoy1 = MAX( zbn2(ji,jj,jkdwn+1), rsmall ) 
     1061                  zbuoy2 = MAX( zbn2(ji,jj,jkdwn  ), rsmall ) 
    9261062                  zCF (ji,jkdwn) = zCF (ji,jkdwn+1) + 0.5_wp * e3t_abl(jkdwn+1)  & 
    927                      &               * ( zbn2(ji,jj,jkdwn+1)*(ghw_abl(jk)-ghw_abl(jkdwn+1)) & 
    928                                        + zbn2(ji,jj,jkdwn  )*(ghw_abl(jk)-ghw_abl(jkdwn  )) )    
    929                   IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp  .and. .not. ln_foundl(ji) ) THEN  
     1063                     &               * ( zbuoy1*(ghw_abl(jk)-ghw_abl(jkdwn+1)) & 
     1064                                       + zbuoy2*(ghw_abl(jk)-ghw_abl(jkdwn  )) ) 
     1065                  IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp  .and. .not. ln_foundl(ji) ) THEN 
    9301066                     zcff2 = ghw_abl(jk) - ghw_abl(jkdwn+1) 
    931                      zcff1 = ghw_abl(jk) - ghw_abl(jkdwn  )               
     1067                     zcff1 = ghw_abl(jk) - ghw_abl(jkdwn  ) 
    9321068                     zcff  = ( zcff1 * zCF(ji,jkdwn+1) - zcff2 * zCF(ji,jkdwn) ) /   & 
    933                         &    (         zCF(ji,jkdwn+1) -         zCF(ji,jkdwn) )  
    934                      zldw(ji,jk) = zcff  
    935                      ln_foundl(ji) = .true.                
    936                   END IF                                    
    937                END DO 
    938             END DO 
    939             !       
     1069                        &    (         zCF(ji,jkdwn+1) -         zCF(ji,jkdwn) ) 
     1070                     zldw(ji,jk) = zcff 
     1071                     zldw(ji,jk) = ghw_abl(jk) - ghw_abl(jkdwn  ) 
     1072                     ln_foundl(ji) = .true. 
     1073                  END IF 
     1074               END DO 
     1075            END DO 
     1076            ! 
    9401077         END DO 
    9411078 
    9421079         DO jk = 1, jpka 
    943             DO ji = 1, jpi   
    944                mxl_abl( ji, jj, jk ) = MAX( SQRT( zldw( ji, jk ) * zlup( ji, jk ) ), mxl_min )   
    945             END DO 
    946          END DO   
     1080            DO ji = 1, jpi 
     1081               !zcff = 2.*SQRT(2.)*(  zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp)  )**(-3._wp/2._wp) 
     1082               zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 
     1083               mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 
     1084               mxld_abl( ji, jj, jk ) = MAX( MIN( zldw( ji, jk ),  zlup( ji, jk ) ), mxl_min ) 
     1085            END DO 
     1086         END DO 
    9471087 
    9481088      END DO 
    949 #   undef zlup       
    950 #   undef zldw            
    951          ! 
    952       END SELECT       
     1089#   undef zlup 
     1090#   undef zldw 
     1091         ! 
     1092     CASE ( 3 )           ! Bougeault & Lacarrere 89 length-scale 
     1093         ! 
     1094#   define zlup zRH 
     1095#   define zldw zFC 
     1096! zCF is used for matrix inversion 
     1097! 
     1098       DO jj = 1, jpj      ! outer loop 
     1099          ! 
     1100          DO jk = 2, jpkam1 
     1101             DO ji = 1,jpi 
     1102                            zcff        = 1.0_wp / e3w_abl( jk )**2 
     1103                zdU         = zcff* (u_abl( ji, jj, jk+1, tind)-u_abl( ji, jj, jk  , tind) )**2 
     1104                zdV         = zcff* (v_abl( ji, jj, jk+1, tind)-v_abl( ji, jj, jk  , tind) )**2 
     1105                zsh2(ji,jk) = SQRT(zdU+zdV)   !<-- zsh2 = SQRT ( ( du/dz )^2 + ( dv/dz )^2 ) 
     1106                         ENDDO 
     1107                  ENDDO 
     1108          zsh2(:,      1) = zsh2( :,      2) 
     1109          zsh2(:,   jpka) = zsh2( :, jpkam1) 
     1110 
     1111                 DO ji = 1, jpi 
     1112            zcff              = zrough(ji,jj) * rn_Lsfc 
     1113                        zlup( ji,    1 )  = zcff 
     1114            zldw( ji,    1 )  = zcff 
     1115            zlup( ji, jpka ) = mxl_min 
     1116            zldw( ji, jpka ) = mxl_min 
     1117         END DO 
     1118 
     1119         DO jk = 2,jpka-1 
     1120            DO ji = 1, jpi 
     1121               zlup(ji,jk) = ghw_abl(jpka) - ghw_abl(jk) 
     1122               zldw(ji,jk) = ghw_abl(jk  ) - ghw_abl( 1) 
     1123            END DO 
     1124         END DO 
     1125         !! 
     1126         !! BL89 search for lup 
     1127         !! ---------------------------------------------------------- 
     1128         DO jk=2,jpka-1 
     1129            ! 
     1130            DO ji = 1, jpi 
     1131               zCF(ji,1:jpka) = 0._wp 
     1132               zCF(ji,  jk  ) = - tke_abl( ji, jj, jk, nt_a ) 
     1133               ln_foundl(ji ) = .false. 
     1134            END DO 
     1135            ! 
     1136            DO jkup=jk+1,jpka-1 
     1137               DO ji = 1, jpi 
     1138                  zbuoy1             = MAX( zbn2(ji,jj,jkup  ), rsmall ) 
     1139                  zbuoy2             = MAX( zbn2(ji,jj,jkup-1), rsmall ) 
     1140                  zCF (ji,jkup) = zCF (ji,jkup-1) + 0.5_wp * e3t_abl(jkup) *                 & 
     1141                     &               ( zbuoy1*(ghw_abl(jkup  )-ghw_abl(jk))      & 
     1142                     &               + zbuoy2*(ghw_abl(jkup-1)-ghw_abl(jk)) )    & 
     1143                                         &                            + 0.5_wp * e3t_abl(jkup) * rn_Rod *        & 
     1144                                         &               ( SQRT(tke_abl( ji, jj, jkup  , nt_a ))*zsh2(ji,jkup  ) & 
     1145                                         &               + SQRT(tke_abl( ji, jj, jkup-1, nt_a ))*zsh2(ji,jkup-1) ) 
     1146 
     1147                  IF( zCF (ji,jkup) * zCF (ji,jkup-1) .le. 0._wp .and. .not. ln_foundl(ji) ) THEN 
     1148                     zcff2 = ghw_abl(jkup  ) - ghw_abl(jk) 
     1149                     zcff1 = ghw_abl(jkup-1) - ghw_abl(jk) 
     1150                     zcff  = ( zcff1 * zCF(ji,jkup) - zcff2 * zCF(ji,jkup-1) ) /   & 
     1151                        &    (         zCF(ji,jkup) -         zCF(ji,jkup-1) ) 
     1152                     zlup(ji,jk) = zcff 
     1153                     zlup(ji,jk) = ghw_abl(jkup  ) - ghw_abl(jk) 
     1154                     ln_foundl(ji) = .true. 
     1155                  END IF 
     1156               END DO 
     1157            END DO 
     1158            ! 
     1159         END DO 
     1160         !! 
     1161         !! BL89 search for ldwn 
     1162         !! ---------------------------------------------------------- 
     1163         DO jk=2,jpka-1 
     1164            ! 
     1165            DO ji = 1, jpi 
     1166               zCF(ji,1:jpka) = 0._wp 
     1167               zCF(ji,  jk  ) = - tke_abl( ji, jj, jk, nt_a ) 
     1168               ln_foundl(ji ) = .false. 
     1169            END DO 
     1170            ! 
     1171            DO jkdwn=jk-1,1,-1 
     1172               DO ji = 1, jpi 
     1173                  zbuoy1             = MAX( zbn2(ji,jj,jkdwn+1), rsmall ) 
     1174                  zbuoy2             = MAX( zbn2(ji,jj,jkdwn  ), rsmall ) 
     1175                  zCF (ji,jkdwn) = zCF (ji,jkdwn+1) + 0.5_wp * e3t_abl(jkdwn+1)  & 
     1176                     &               * (zbuoy1*(ghw_abl(jk)-ghw_abl(jkdwn+1))    & 
     1177                     &                 +zbuoy2*(ghw_abl(jk)-ghw_abl(jkdwn  )) )  & 
     1178                                         &                            + 0.5_wp * e3t_abl(jkup) * rn_Rod *          & 
     1179                                         &               ( SQRT(tke_abl( ji, jj, jkdwn+1, nt_a ))*zsh2(ji,jkdwn+1) & 
     1180                                         &               + SQRT(tke_abl( ji, jj, jkdwn  , nt_a ))*zsh2(ji,jkdwn  ) ) 
     1181 
     1182                  IF(zCF (ji,jkdwn) * zCF (ji,jkdwn+1) .le. 0._wp  .and. .not. ln_foundl(ji) ) THEN 
     1183                     zcff2 = ghw_abl(jk) - ghw_abl(jkdwn+1) 
     1184                     zcff1 = ghw_abl(jk) - ghw_abl(jkdwn  ) 
     1185                     zcff  = ( zcff1 * zCF(ji,jkdwn+1) - zcff2 * zCF(ji,jkdwn) ) /   & 
     1186                        &    (         zCF(ji,jkdwn+1) -         zCF(ji,jkdwn) ) 
     1187                     zldw(ji,jk) = zcff 
     1188                     zldw(ji,jk) = ghw_abl(jk) - ghw_abl(jkdwn  ) 
     1189                     ln_foundl(ji) = .true. 
     1190                  END IF 
     1191               END DO 
     1192            END DO 
     1193            ! 
     1194         END DO 
     1195 
     1196         DO jk = 1, jpka 
     1197            DO ji = 1, jpi 
     1198               !zcff = 2.*SQRT(2.)*(  zldw( ji, jk )**(-2._wp/3._wp) + zlup( ji, jk )**(-2._wp/3._wp)  )**(-3._wp/2._wp) 
     1199               zcff = SQRT( zldw( ji, jk ) * zlup( ji, jk ) ) 
     1200               mxlm_abl( ji, jj, jk ) = MAX( zcff, mxl_min ) 
     1201               mxld_abl( ji, jj, jk ) = MAX(  MIN( zldw( ji, jk ),  zlup( ji, jk ) ), mxl_min ) 
     1202            END DO 
     1203         END DO 
     1204 
     1205      END DO 
     1206#   undef zlup 
     1207#   undef zldw 
     1208         ! 
     1209         ! 
     1210      END SELECT 
    9531211      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    9541212      !                            !  Finalize the computation of turbulent visc./diff. 
    9551213      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    956        
     1214 
    9571215      !------------- 
    9581216      DO jj = 1, jpj     ! outer loop 
    9591217      !------------- 
    960          DO jk = 1, jpka    
     1218         DO jk = 1, jpka 
    9611219            DO ji = 1, jpi  ! vector opt. 
    962                zcff              = MAX( rn_phimax, rn_Ric * mxl_abl( ji, jj, jk ) * mxl_abl( ji, jj, jk )  & 
    963                   &                                       * zbn2(ji, jj, jk) / tke_abl( ji, jj, jk, nt_a ) )  
    964                zcff2             =  1. / ( 1. + zcff )   !<-- phi_z(z) 
    965                zcff              = mxl_abl( ji, jj, jk ) * SQRT( tke_abl( ji, jj, jk, nt_a ) ) 
    966 !!FL: MAX function probably useless because of the definition of mxl_min              
     1220               zcff  = MAX( rn_phimax, rn_Ric * mxlm_abl( ji, jj, jk ) * mxld_abl( ji, jj, jk )  & 
     1221               &     * MAX( zbn2(ji, jj, jk), rsmall ) / tke_abl( ji, jj, jk, nt_a ) ) 
     1222               zcff2 =  1. / ( 1. + zcff )   !<-- phi_z(z) 
     1223               zcff  = mxlm_abl( ji, jj, jk ) * SQRT( tke_abl( ji, jj, jk, nt_a ) ) 
     1224               !!FL: MAX function probably useless because of the definition of mxl_min 
    9671225               Avm_abl( ji, jj, jk ) = MAX( rn_Cm * zcff         , avm_bak   ) 
    968                Avt_abl( ji, jj, jk ) = MAX( rn_Ct * zcff * zcff2 , avt_bak   )                               
    969             END DO 
    970          END DO 
    971       !-------------          
    972       END DO       
     1226               Avt_abl( ji, jj, jk ) = MAX( rn_Ct * zcff * zcff2 , avt_bak   ) 
     1227            END DO 
     1228         END DO 
     1229      !------------- 
     1230      END DO 
    9731231      !------------- 
    9741232 
     
    9881246      !! 
    9891247      !! --------------------------------------------------------------------- 
    990      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: msk    
    991      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvar2d 
     1248      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: msk 
     1249      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvar2d 
    9921250      INTEGER                                     :: ji,jj 
    993      REAL(wp)                                    :: smth_a, smth_b 
    994      REAL(wp), DIMENSION(jpi,jpj)                :: zdX,zdY,zFX,zFY 
    995      REAL(wp)                                    :: zumsk,zvmsk 
     1251      REAL(wp)                                    :: smth_a, smth_b 
     1252      REAL(wp), DIMENSION(jpi,jpj)                :: zdX,zdY,zFX,zFY 
     1253      REAL(wp)                                    :: zumsk,zvmsk 
    9961254      !! 
    9971255      !!========================================================= 
     
    10051263         zdX ( ji, jj ) = ( pvar2d( ji+1,jj ) - pvar2d( ji  ,jj ) ) * zumsk 
    10061264      END_2D 
    1007        
    1008      DO_2D_10_11 
     1265 
     1266      DO_2D_10_11 
    10091267         zvmsk = msk(ji,jj) * msk(ji,jj+1) 
    10101268         zdY ( ji, jj ) = ( pvar2d( ji, jj+1 ) - pvar2d( ji  ,jj ) ) * zvmsk 
    1011      END_2D 
    1012        
    1013      DO_2D_10_00 
     1269      END_2D 
     1270 
     1271      DO_2D_10_00 
    10141272         zFY ( ji, jj  ) =   zdY ( ji, jj   )                        & 
    10151273            & +  smth_a*  ( (zdX ( ji, jj+1 ) - zdX( ji-1, jj+1 ))   & 
    10161274            &            -  (zdX ( ji, jj   ) - zdX( ji-1, jj   ))  ) 
    1017      END_2D 
     1275      END_2D 
    10181276 
    10191277      DO_2D_00_10 
     
    10291287  &                 +zFY( ji, jj ) - zFY( ji, jj-1 )  ) 
    10301288      END_2D 
    1031      !! 
     1289 
    10321290!--------------------------------------------------------------------------------------------------- 
    10331291   END SUBROUTINE smooth_pblh 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/ablrst.F90

    r12939 r13229  
    109109      CALL iom_delay_rst( 'WRITE', 'ABL', numraw )   ! save only abl delayed global communication variables 
    110110 
    111       ! Prognostic variables 
     111      ! Prognostic (after timestep + swap time indices = now timestep) variables 
    112112      CALL iom_rstput( iter, nitrst, numraw,   'u_abl',   u_abl(:,:,:,nt_n      ) ) 
    113113      CALL iom_rstput( iter, nitrst, numraw,   'v_abl',   v_abl(:,:,:,nt_n      ) ) 
     
    117117      CALL iom_rstput( iter, nitrst, numraw, 'avm_abl', avm_abl(:,:,:           ) ) 
    118118      CALL iom_rstput( iter, nitrst, numraw, 'avt_abl', avt_abl(:,:,:           ) ) 
    119       CALL iom_rstput( iter, nitrst, numraw, 'mxl_abl', mxl_abl(:,:,:           ) ) 
     119      CALL iom_rstput( iter, nitrst, numraw,'mxld_abl',mxld_abl(:,:,:           ) ) 
    120120      CALL iom_rstput( iter, nitrst, numraw,    'pblh',    pblh(:,:             ) ) 
    121121      ! 
     
    172172      CALL iom_get( numrar, jpdom_auto, 'avm_abl', avm_abl(:,:,:           ) ) 
    173173      CALL iom_get( numrar, jpdom_auto, 'avt_abl', avt_abl(:,:,:           ) ) 
    174       CALL iom_get( numrar, jpdom_auto, 'mxl_abl', mxl_abl(:,:,:           ) ) 
     174      CALL iom_get( numrar, jpdom_auto,'mxld_abl',mxld_abl(:,:,:           ) ) 
    175175      CALL iom_get( numrar, jpdom_auto,    'pblh',    pblh(:,:             ) ) 
    176176      CALL iom_delay_rst( 'READ', 'ABL', numrar )   ! read only abl delayed global communication variables 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/par_abl.F90

    r12939 r13229  
    2828   LOGICAL , PUBLIC            ::   ln_hpgls_frc   !: forcing of ABL winds by large-scale pressure gradient  
    2929   LOGICAL , PUBLIC            ::   ln_smth_pblh   !: smoothing of atmospheric PBL height  
     30   !LOGICAL , PUBLIC            ::   ln_topbc_neumann = .FALSE.  !: idealised testcases only 
    3031 
    31    LOGICAL           , PUBLIC ::   ln_rstart_abl    !: (de)activate abl restart 
    32    CHARACTER(len=256), PUBLIC ::   cn_ablrst_in     !: suffix of abl restart name (input) 
    33    CHARACTER(len=256), PUBLIC ::   cn_ablrst_out    !: suffix of abl restart name (output) 
    34    CHARACTER(len=256), PUBLIC ::   cn_ablrst_indir  !: abl restart input directory 
    35    CHARACTER(len=256), PUBLIC ::   cn_ablrst_outdir !: abl restart output directory 
     32   LOGICAL           , PUBLIC  ::   ln_rstart_abl    !: (de)activate abl restart 
     33   CHARACTER(len=256), PUBLIC  ::   cn_ablrst_in     !: suffix of abl restart name (input) 
     34   CHARACTER(len=256), PUBLIC  ::   cn_ablrst_out    !: suffix of abl restart name (output) 
     35   CHARACTER(len=256), PUBLIC  ::   cn_ablrst_indir  !: abl restart input directory 
     36   CHARACTER(len=256), PUBLIC  ::   cn_ablrst_outdir !: abl restart output directory 
    3637 
    3738   !!--------------------------------------------------------------------- 
     
    4647   REAL(wp), PUBLIC, PARAMETER ::   rn_Cek    = 258._wp                   !: Ekman constant for Richardson number  
    4748   REAL(wp), PUBLIC, PARAMETER ::   rn_epssfc = 1._wp / ( 1._wp + 2.8_wp * 2.8_wp ) 
    48    REAL(wp), PUBLIC            ::   rn_ceps                       !: namelist parameter 
    49    REAL(wp), PUBLIC            ::   rn_cm                         !: namelist parameter 
    50    REAL(wp), PUBLIC            ::   rn_ct                         !: namelist parameter 
    51    REAL(wp), PUBLIC            ::   rn_ce                         !: namelist parameter  
     49   REAL(wp), PUBLIC            ::   rn_Ceps                       !: namelist parameter 
     50   REAL(wp), PUBLIC            ::   rn_Cm                         !: namelist parameter 
     51   REAL(wp), PUBLIC            ::   rn_Ct                         !: namelist parameter 
     52   REAL(wp), PUBLIC            ::   rn_Ce                         !: namelist parameter  
    5253   REAL(wp), PUBLIC            ::   rn_Rod                        !: namelist parameter    
    5354   REAL(wp), PUBLIC            ::   rn_Sch     
     55   REAL(wp), PUBLIC            ::   rn_Esfc 
     56   REAL(wp), PUBLIC            ::   rn_Lsfc 
    5457   REAL(wp), PUBLIC            ::   mxl_min     
    5558   REAL(wp), PUBLIC            ::   rn_ldyn_min                   !: namelist parameter 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/sbcabl.F90

    r12939 r13229  
    7171         &                 ln_hpgls_frc, ln_geos_winds, nn_dyn_restore,           & 
    7272         &                 rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max,   & 
    73          &                 nn_amxl, rn_cm, rn_ct, rn_ce, rn_ceps, rn_Rod, rn_Ric, & 
     73         &                 nn_amxl, rn_Cm, rn_Ct, rn_Ce, rn_Ceps, rn_Rod, rn_Ric, & 
    7474         &                 ln_smth_pblh 
    7575      !!--------------------------------------------------------------------- 
    7676 
    77       ! Namelist namsbc_abl in reference namelist : ABL parameters 
     77                                        ! Namelist namsbc_abl in reference namelist : ABL parameters 
    7878      READ  ( numnam_ref, namsbc_abl, IOSTAT = ios, ERR = 901 ) 
    7979901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in reference namelist' ) 
    80       ! Namelist namsbc_abl in configuration namelist : ABL parameters 
     80      ! 
     81                                        ! Namelist namsbc_abl in configuration namelist : ABL parameters 
    8182      READ  ( numnam_cfg, namsbc_abl, IOSTAT = ios, ERR = 902 ) 
    8283902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_abl in configuration namelist' ) 
     
    165166      rn_Sch  = rn_ce / rn_cm 
    166167      mxl_min = (avm_bak / rn_cm) / sqrt( tke_min ) 
     168      rn_Esfc =  1._wp / SQRT(rn_cm*rn_ceps) 
     169      rn_Lsfc = vkarmn * SQRT(SQRT(rn_cm*rn_ceps)) / rn_cm 
    167170 
    168171      IF(lwp) THEN 
     
    171174         WRITE(numout,*) '    ~~~~~~~~~~~' 
    172175         IF(nn_amxl==0) WRITE(numout,*) 'Deardorff 80 length-scale ' 
    173          IF(nn_amxl==1) WRITE(numout,*) 'length-scale based on the distance to the PBL height ' 
     176         IF(nn_amxl==1) WRITE(numout,*) 'Modified Deardorff 80 length-scale ' 
     177         IF(nn_amxl==2) WRITE(numout,*) 'Bougeault and Lacarrere length-scale '       
     178         IF(nn_amxl==3) WRITE(numout,*) 'Rodier et al. length-scale '    
    174179         WRITE(numout,*) ' Minimum value of atmospheric TKE           = ',tke_min,' m^2 s^-2' 
    175180         WRITE(numout,*) ' Minimum value of atmospheric mixing length = ',mxl_min,' m' 
     
    178183         WRITE(numout,*) ' Constant for Schmidt number                = ',rn_Sch 
    179184         WRITE(numout,*) ' Constant for TKE dissipation               = ',rn_Ceps 
     185         WRITE(numout,*) ' Constant for TKE sfc boundary condition    = ',rn_Esfc 
     186         WRITE(numout,*) ' Constant for mxl sfc boundary condition    = ',rn_Lsfc 
    180187      END IF 
    181188 
     
    202209      ! ABL timestep 
    203210      rDt_abl = nn_fsbc * rn_Dt 
     211      IF(lwp) WRITE(numout,*) ' ABL timestep = ', rDt_abl,' s' 
    204212 
    205213      ! Check parameters for dynamics 
     
    248256         zcff         = 2._wp * omega * SIN( rad * 90._wp )   !++ fmax 
    249257         rest_eq(:,:) = SIN( 0.5_wp*rpi*( (fft_abl(:,:) - zcff) / zcff ) )**8 
    250          !!GS: alternative shape 
    251          !rest_eq(:,:) = SIN( 0.5_wp*rpi*(zcff - ABS(ff_t(:,:))) / (zcff - 3.e-5) )**8 
    252          !WHERE(ABS(ff_t(:,:)).LE.3.e-5) rest_eq(:,:) = 1._wp 
    253258      ELSE 
    254259         rest_eq(:,:) = 1._wp 
     
    271276         CALL fld_read( nit000, nn_fsbc, sf ) ! input fields provided at the first time-step 
    272277 
    273          u_abl(:,:,:,nt_n      ) = sf(jp_wndi)%fnow(:,:,:) 
    274          v_abl(:,:,:,nt_n      ) = sf(jp_wndj)%fnow(:,:,:) 
     278          u_abl(:,:,:,nt_n      ) = sf(jp_wndi)%fnow(:,:,:) 
     279          v_abl(:,:,:,nt_n      ) = sf(jp_wndj)%fnow(:,:,:) 
    275280         tq_abl(:,:,:,nt_n,jp_ta) = sf(jp_tair)%fnow(:,:,:) 
    276281         tq_abl(:,:,:,nt_n,jp_qa) = sf(jp_humi)%fnow(:,:,:) 
     
    279284         avm_abl(:,:,:          ) = avm_bak 
    280285         avt_abl(:,:,:          ) = avt_bak 
    281          mxl_abl(:,:,:          ) = mxl_min 
    282286         pblh   (:,:            ) = ghw_abl( 3 )  !<-- assume that the pbl contains 3 grid points 
    283287         u_abl  (:,:,:,nt_a     ) = 0._wp 
     
    285289         tq_abl (:,:,:,nt_a,:   ) = 0._wp 
    286290         tke_abl(:,:,:,nt_a     ) = 0._wp 
     291 
     292         mxlm_abl(:,:,:         ) = mxl_min 
     293         mxld_abl(:,:,:         ) = mxl_min 
    287294      ENDIF 
    288295 
     
    335342            &                tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa),   &   !   <<= in 
    336343            &                sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m     ,   &   !   <<= in 
     344            &                sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1),   &   !   <<= in 
    337345            &                sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) ,   &   !   <<= in 
    338346            &                tsk_m, zssq, zcd_du, zsen, zevp                       )   !   =>> out 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/iceistate.F90

    r12939 r13229  
    3232   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    3333   USE fldread        ! read input fields 
     34 
     35# if defined key_agrif 
     36   USE agrif_oce 
     37   USE agrif_ice 
     38   USE agrif_ice_interp  
     39# endif    
    3440 
    3541   IMPLICIT NONE 
     
    168174      ! 2) overwrite some of the fields with namelist parameters or netcdf file 
    169175      !------------------------------------------------------------------------ 
     176 
     177 
    170178      IF( ln_iceini ) THEN 
    171179         !                             !---------------! 
    172          IF( ln_iceini_file )THEN      ! Read a file   ! 
    173             !                          !---------------! 
    174             WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
    175             ELSEWHERE                     ;   zswitch(:,:) = 0._wp 
     180          
     181         IF( Agrif_Root() ) THEN 
     182 
     183            IF( ln_iceini_file )THEN      ! Read a file   ! 
     184               !                          !---------------! 
     185               WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
     186               ELSEWHERE                     ;   zswitch(:,:) = 0._wp 
     187               END WHERE 
     188               ! 
     189               CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 
     190               ! 
     191               ! -- mandatory fields -- ! 
     192               zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
     193               zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
     194               zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
     195 
     196               ! -- optional fields -- ! 
     197               !    if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 
     198               ! 
     199               ! ice salinity 
     200               IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 
     201                  &     si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     202               ! 
     203               ! temperatures 
     204               IF    ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 
     205                  &    TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 
     206                  si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     207                  si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     208                  si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     209               ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
     210                  si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 
     211               ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
     212                  si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 
     213               ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 
     214                  si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 
     215               ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 
     216                  si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
     217               ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 
     218                  si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 
     219               ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 
     220                  si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
     221               ENDIF 
     222               ! 
     223               ! pond concentration 
     224               IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
     225                  &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
     226                  &                              * si(jp_ati)%fnow(:,:,1)  
     227               ! 
     228               ! pond depth 
     229               IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
     230                  &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     231               ! 
     232               zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
     233               ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
     234               zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
     235               ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
     236               zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
     237               zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
     238               ! 
     239               ! change the switch for the following 
     240               WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)  
     241               ELSEWHERE                         ;   zswitch(:,:) = 0._wp 
     242               END WHERE 
     243 
     244               !                          !---------------! 
     245            ELSE                          ! Read namelist ! 
     246               !                          !---------------! 
     247               ! no ice if (sst - Tfreez) >= thresold 
     248               WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp  
     249               ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1) 
     250               END WHERE 
     251               ! 
     252               ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     253               WHERE( ff_t(:,:) >= 0._wp ) 
     254                  zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 
     255                  zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 
     256                  zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 
     257                  zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 
     258                  ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 
     259                  zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
     260                  ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
     261                  zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
     262                  zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     263               ELSEWHERE 
     264                  zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
     265                  zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 
     266                  zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 
     267                  zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 
     268                  ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 
     269                  zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 
     270                  ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 
     271                  zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
     272                  zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
     273               END WHERE 
     274               ! 
     275            ENDIF 
     276 
     277 
     278 
     279            ! make sure ponds = 0 if no ponds scheme 
     280            IF ( .NOT.ln_pnd ) THEN 
     281               zapnd_ini(:,:) = 0._wp 
     282               zhpnd_ini(:,:) = 0._wp 
     283            ENDIF 
     284             
     285            !-------------! 
     286            ! fill fields ! 
     287            !-------------! 
     288            ! select ice covered grid points 
     289            npti = 0 ; nptidx(:) = 0 
     290            DO_2D_11_11 
     291               IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
     292                  npti         = npti  + 1 
     293                  nptidx(npti) = (jj - 1) * jpi + ji 
     294               ENDIF 
     295            END_2D 
     296 
     297            ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
     298            CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti)  , zht_i_ini ) 
     299            CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti)  , zht_s_ini ) 
     300            CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)  , zat_i_ini ) 
     301            CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 
     302            CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 
     303            CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti)  , zt_su_ini ) 
     304            CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti)  , zsm_i_ini ) 
     305            CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
     306            CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
     307 
     308            ! allocate temporary arrays 
     309            ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
     310               &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
     311             
     312            ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
     313            CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
     314               &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
     315               &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 
     316               &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
     317 
     318            ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
     319            DO jl = 1, jpl 
     320               zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 
     321               zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 
     322            END DO 
     323            CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d   , h_i    ) 
     324            CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d   , h_s    ) 
     325            CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d   , a_i    ) 
     326            CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d   , zti_3d ) 
     327            CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d   , zts_3d ) 
     328            CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d  , t_su   ) 
     329            CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d   , s_i    ) 
     330            CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
     331            CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
     332 
     333            ! deallocate temporary arrays 
     334            DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
     335               &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     336 
     337            ! calculate extensive and intensive variables 
     338            CALL ice_var_salprof ! for sz_i 
     339            DO jl = 1, jpl 
     340               DO_2D_11_11 
     341                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
     342                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
     343                  sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
     344               END_2D 
     345            END DO 
     346            ! 
     347            DO jl = 1, jpl 
     348               DO_3D_11_11( 1, nlay_s ) 
     349                  t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
     350                  e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
     351                     &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
     352               END_3D 
     353            END DO 
     354            ! 
     355            DO jl = 1, jpl 
     356               DO_3D_11_11( 1, nlay_i ) 
     357                  t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
     358                  ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
     359                  e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
     360                     &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
     361                     &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
     362                     &                       - rcp   * ( ztmelts - rt0 ) ) 
     363               END_3D 
     364            END DO 
     365 
     366            ! Melt ponds 
     367            WHERE( a_i > epsi10 ) 
     368               a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     369            ELSEWHERE 
     370               a_ip_frac(:,:,:) = 0._wp 
    176371            END WHERE 
     372            v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     373              
     374            ! specific temperatures for coupled runs 
     375            tn_ice(:,:,:) = t_su(:,:,:) 
     376            t1_ice(:,:,:) = t_i (:,:,1,:) 
    177377            ! 
    178             CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 
    179             ! 
    180             ! -- mandatory fields -- ! 
    181             zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
    182             zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
    183             zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
    184  
    185             ! -- optional fields -- ! 
    186             !    if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 
    187             ! 
    188             ! ice salinity 
    189             IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 
    190                &     si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    191             ! 
    192             ! temperatures 
    193             IF    ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 
    194                &    TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 
    195                si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    196                si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    197                si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    198             ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
    199                si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 
    200             ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
    201                si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 
    202             ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 
    203                si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 
    204             ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 
    205                si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    206             ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 
    207                si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 
    208             ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 
    209                si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    210             ENDIF 
    211             ! 
    212             ! pond concentration 
    213             IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
    214                &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
    215                &                              * si(jp_ati)%fnow(:,:,1)  
    216             ! 
    217             ! pond depth 
    218             IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
    219                &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    220             ! 
    221             zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
    222             ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
    223             zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
    224             ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
    225             zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
    226             zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
    227             ! 
    228             ! change the switch for the following 
    229             WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)  
    230             ELSEWHERE                         ;   zswitch(:,:) = 0._wp 
     378          
     379#if  defined key_agrif 
     380         ELSE 
     381  
     382            Agrif_SpecialValue    = -9999. 
     383            Agrif_UseSpecialValue = .TRUE. 
     384            CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 
     385            use_sign_north = .TRUE. 
     386            sign_north = -1. 
     387            CALL Agrif_init_variable(u_iceini_id  ,procname=interp_u_ice) 
     388            CALL Agrif_init_variable(v_iceini_id  ,procname=interp_v_ice) 
     389            Agrif_SpecialValue    = 0._wp 
     390            use_sign_north = .FALSE. 
     391            Agrif_UseSpecialValue = .FALSE. 
     392        ! lbc ????  
     393   ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i 
     394            CALL ice_var_glo2eqv 
     395            CALL ice_var_zapsmall 
     396            CALL ice_var_agg(2) 
     397 
     398            ! Melt ponds 
     399            WHERE( a_i > epsi10 ) 
     400               a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     401            ELSEWHERE 
     402               a_ip_frac(:,:,:) = 0._wp 
    231403            END WHERE 
    232             !                          !---------------! 
    233          ELSE                          ! Read namelist ! 
    234             !                          !---------------! 
    235             ! no ice if (sst - Tfreez) >= thresold 
    236             WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp  
    237             ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1) 
    238             END WHERE 
    239             ! 
    240             ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
    241             WHERE( ff_t(:,:) >= 0._wp ) 
    242                zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 
    243                zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 
    244                zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 
    245                zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 
    246                ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 
    247                zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
    248                ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
    249                zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    250                zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     404            WHERE( a_ip > 0._wp )       ! ???????     
     405               h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
    251406            ELSEWHERE 
    252                zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
    253                zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 
    254                zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 
    255                zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 
    256                ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 
    257                zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 
    258                ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 
    259                zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    260                zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
    261             END WHERE 
    262             ! 
    263          ENDIF 
    264  
    265          ! make sure ponds = 0 if no ponds scheme 
    266          IF ( .NOT.ln_pnd ) THEN 
    267             zapnd_ini(:,:) = 0._wp 
    268             zhpnd_ini(:,:) = 0._wp 
    269          ENDIF 
    270           
    271          !-------------! 
    272          ! fill fields ! 
    273          !-------------! 
    274          ! select ice covered grid points 
    275          npti = 0 ; nptidx(:) = 0 
    276          DO_2D_11_11 
    277             IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
    278                npti         = npti  + 1 
    279                nptidx(npti) = (jj - 1) * jpi + ji 
    280             ENDIF 
    281          END_2D 
    282  
    283          ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
    284          CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti)  , zht_i_ini ) 
    285          CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti)  , zht_s_ini ) 
    286          CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)  , zat_i_ini ) 
    287          CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 
    288          CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 
    289          CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti)  , zt_su_ini ) 
    290          CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti)  , zsm_i_ini ) 
    291          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
    292          CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
    293  
    294          ! allocate temporary arrays 
    295          ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
    296             &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
    297           
    298          ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
    299          CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
    300             &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
    301             &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 
    302             &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
    303  
    304          ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
    305          DO jl = 1, jpl 
    306             zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 
    307             zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 
    308          END DO 
    309          CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d   , h_i    ) 
    310          CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d   , h_s    ) 
    311          CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d   , a_i    ) 
    312          CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d   , zti_3d ) 
    313          CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d   , zts_3d ) 
    314          CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d  , t_su   ) 
    315          CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d   , s_i    ) 
    316          CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
    317          CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
    318  
    319          ! deallocate temporary arrays 
    320          DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    321             &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
    322  
    323          ! calculate extensive and intensive variables 
    324          CALL ice_var_salprof ! for sz_i 
    325          DO jl = 1, jpl 
    326             DO_2D_11_11 
    327                v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
    328                v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
    329                sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
    330             END_2D 
    331          END DO 
    332          ! 
    333          DO jl = 1, jpl 
    334             DO_3D_11_11( 1, nlay_s ) 
    335                t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
    336                e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
    337                   &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    338             END_3D 
    339          END DO 
    340          ! 
    341          DO jl = 1, jpl 
    342             DO_3D_11_11( 1, nlay_i ) 
    343                t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
    344                ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
    345                e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
    346                   &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
    347                   &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
    348                   &                       - rcp   * ( ztmelts - rt0 ) ) 
    349             END_3D 
    350          END DO 
    351  
    352          ! Melt ponds 
    353          WHERE( a_i > epsi10 ) 
    354             a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
    355          ELSEWHERE 
    356             a_ip_frac(:,:,:) = 0._wp 
    357          END WHERE 
    358          v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
    359            
    360          ! specific temperatures for coupled runs 
    361          tn_ice(:,:,:) = t_su(:,:,:) 
    362          t1_ice(:,:,:) = t_i (:,:,1,:) 
    363          ! 
     407               h_ip(:,:,:) = 0._wp 
     408            END WHERE    
     409 
     410            tn_ice(:,:,:) = t_su(:,:,:) 
     411            t1_ice(:,:,:) = t_i (:,:,1,:) 
     412#endif 
     413          ENDIF ! Agrif_Root 
    364414      ENDIF ! ln_iceini 
    365415      ! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/icestp.F90

    r12489 r13229  
    240240      CALL par_init                ! set some ice run parameters 
    241241      ! 
     242#if defined key_agrif 
     243      CALL Agrif_Declare_Var_ice  !  "      "   "   "      "  Sea ice 
     244#endif 
     245      ! 
    242246      !                                ! Allocate the ice arrays (sbc_ice already allocated in sbc_init) 
    243247      ierr =        ice_alloc        ()      ! ice variables 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice.F90

    r10068 r13229  
    1616 
    1717   INTEGER, PUBLIC ::  u_ice_id, v_ice_id, tra_ice_id 
     18   INTEGER, PUBLIC ::  u_iceini_id, v_iceini_id, tra_iceini_id 
    1819   INTEGER, PUBLIC ::  nbstep_ice = 0    ! child time position in sea-ice model 
    1920 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_interp.F90

    r12807 r13229  
    1414   !!---------------------------------------------------------------------- 
    1515   !!  agrif_interp_ice    : interpolation of ice at "after" sea-ice time step 
    16    !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice  
    17    !!  agrif_interp_v_ice   : atomic routine to interpolate v_ice  
    18    !!  agrif_interp_tra_ice : atomic routine to interpolate ice properties  
     16   !!  interp_u_ice   : atomic routine to interpolate u_ice  
     17   !!  interp_v_ice   : atomic routine to interpolate v_ice  
     18   !!  interp_tra_ice : atomic routine to interpolate ice properties  
    1919   !!---------------------------------------------------------------------- 
    2020   USE par_oce 
     
    2323   USE ice 
    2424   USE agrif_ice 
     25   USE agrif_oce 
    2526   USE phycst , ONLY: rt0 
    2627    
     
    2930 
    3031   PUBLIC   agrif_interp_ice   ! called by agrif_user.F90 
     32   PUBLIC   interp_tra_ice, interp_u_ice, interp_v_ice  ! called by iceistate.F90 
    3133 
    3234   !!---------------------------------------------------------------------- 
     
    6870      Agrif_SpecialValue    = -9999. 
    6971      Agrif_UseSpecialValue = .TRUE. 
     72 
     73      use_sign_north = .TRUE. 
     74      sign_north = -1. 
     75      if (cd_type == 'T') use_sign_north = .FALSE. 
     76 
    7077      SELECT CASE( cd_type ) 
    7178      CASE('U')   ;   CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta ) 
     
    7582      Agrif_SpecialValue    = 0._wp 
    7683      Agrif_UseSpecialValue = .FALSE. 
     84       
     85      use_sign_north = .FALSE. 
    7786      ! 
    7887   END SUBROUTINE agrif_interp_ice 
     
    156165      ! and it is ok since we conserve tracers (same as in the ocean). 
    157166      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 
    158       
     167 
    159168      IF( before ) THEN  ! parent grid 
    160169         jm = 1 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_update.F90

    r12377 r13229  
    6666      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/1,0/), procname = update_tra_ice  ) 
    6767#endif 
     68      use_sign_north = .TRUE. 
     69      sign_north = -1. 
     70 
    6871# if ! defined DECAL_FEEDBACK 
    6972      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
     
    7376      CALL Agrif_Update_Variable( v_ice_id   , locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname=update_v_ice) 
    7477#endif 
     78      use_sign_north = .FALSE. 
    7579!      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  ) 
    7680!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce.F90

    r13065 r13229  
    1919   
    2020   !                                              !!* Namelist namagrif: AGRIF parameters 
     21   LOGICAL , PUBLIC ::   ln_init_chfrpar = .FALSE. !: set child grids initial state from parent 
    2122   LOGICAL , PUBLIC ::   ln_agrif_2way = .TRUE.    !: activate two way nesting  
    2223   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: use zeros (.false.) or not (.true.) in 
     
    2930   ! 
    3031   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points) 
     32 
    3133   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator 
    3234   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator 
     
    4951   INTEGER , PUBLIC,              SAVE                 ::  Kbb_a, Kmm_a, Krhs_a   !: AGRIF module-specific copies of time-level indices 
    5052 
    51 # if defined key_vertical 
    5253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent 
    5354   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent 
    54 # endif 
    5555 
    5656   INTEGER, PUBLIC :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
     
    5858   INTEGER, PUBLIC :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates 
    5959   INTEGER, PUBLIC :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers 
     60   INTEGER, PUBLIC :: tsini_id, uini_id, vini_id, sshini_id                   ! AGRIF profile for initialization 
    6061# if defined key_top 
    6162   INTEGER, PUBLIC :: trn_id, trn_sponge_id 
     
    6970   INTEGER, PUBLIC :: glamt_id, gphit_id 
    7071   INTEGER, PUBLIC :: kindic_agr 
     72 
     73   ! North fold 
     74!$AGRIF_DO_NOT_TREAT 
     75   LOGICAL, PUBLIC :: use_sign_north 
     76   REAL, PUBLIC :: sign_north 
     77   LOGICAL, PUBLIC :: l_ini_child = .FALSE. 
     78# if defined key_vertical 
     79   LOGICAL, PUBLIC :: l_vremap    = .TRUE. 
     80# else 
     81   LOGICAL, PUBLIC :: l_vremap    = .FALSE. 
     82# endif 
     83!$AGRIF_END_DO_NOT_TREAT 
    7184    
    7285   !!---------------------------------------------------------------------- 
     
    92105         &      tabspongedone_trn(jpi,jpj),           & 
    93106# endif    
    94 # if defined key_vertical 
    95107         &      ht0_parent(jpi,jpj), mbkt_parent(jpi,jpj),  & 
    96108         &      hu0_parent(jpi,jpj), mbku_parent(jpi,jpj),  & 
    97109         &      hv0_parent(jpi,jpj), mbkv_parent(jpi,jpj),  & 
    98 # endif       
    99110         &      tabspongedone_u  (jpi,jpj),           & 
    100111         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) ) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90

    r13130 r13229  
    9595      ! 
    9696      ! --- West --- ! 
    97       ibdy1 = nn_hls + 2                  ! halo + land + 1 
    98       ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    99       ! 
    100       IF( .NOT.ln_dynspg_ts ) THEN  ! Store tangential transport 
     97      IF( lk_west ) THEN 
     98         ibdy1 = nn_hls + 2                  ! halo + land + 1 
     99         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
     100         ! 
     101         IF( .NOT.ln_dynspg_ts ) THEN  ! Store tangential transport 
     102            DO ji = mi0(ibdy1), mi1(ibdy2) 
     103               uu_b(ji,:,Krhs_a) = 0._wp 
     104 
     105               DO jk = 1, jpkm1 
     106                  DO jj = 1, jpj 
     107                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     108                  END DO 
     109               END DO 
     110 
     111               DO jj = 1, jpj 
     112                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
     113               END DO 
     114            END DO 
     115         ENDIF 
     116         ! 
    101117         DO ji = mi0(ibdy1), mi1(ibdy2) 
    102             uu_b(ji,:,Krhs_a) = 0._wp 
    103  
     118            zub(ji,:) = 0._wp    ! Correct tangential transport 
    104119            DO jk = 1, jpkm1 
    105120               DO jj = 1, jpj 
    106                   uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    107                END DO 
    108             END DO 
    109  
    110             DO jj = 1, jpj 
    111                uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
    112             END DO 
    113          END DO 
    114       ENDIF 
    115       ! 
    116       DO ji = mi0(ibdy1), mi1(ibdy2) 
    117          zub(ji,:) = 0._wp    ! Correct tangential transport 
    118          DO jk = 1, jpkm1 
    119             DO jj = 1, jpj 
    120                zub(ji,jj) = zub(ji,jj) &  
    121                   & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 
    122             END DO 
    123          END DO 
    124          DO jj=1,jpj 
    125             zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    126          END DO 
     121                  zub(ji,jj) = zub(ji,jj) &  
     122                     & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 
     123               END DO 
     124            END DO 
     125            DO jj=1,jpj 
     126               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     127            END DO 
    127128             
    128          DO jk = 1, jpkm1 
    129             DO jj = 1, jpj 
    130                uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk) 
    131             END DO 
    132          END DO 
    133       END DO 
    134              
    135       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    136          DO ji = mi0(ibdy1), mi1(ibdy2) 
    137             zvb(ji,:) = 0._wp 
    138129            DO jk = 1, jpkm1 
    139130               DO jj = 1, jpj 
    140                   zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    141                END DO 
    142             END DO 
    143             DO jj = 1, jpj 
    144                zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    145             END DO 
     131                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk) 
     132               END DO 
     133            END DO 
     134         END DO 
     135             
     136         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     137            DO ji = mi0(ibdy1), mi1(ibdy2) 
     138               zvb(ji,:) = 0._wp 
     139               DO jk = 1, jpkm1 
     140                  DO jj = 1, jpj 
     141                     zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     142                  END DO 
     143               END DO 
     144               DO jj = 1, jpj 
     145                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     146               END DO 
     147               DO jk = 1, jpkm1 
     148                  DO jj = 1, jpj 
     149                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk) 
     150                  END DO 
     151               END DO 
     152            END DO 
     153         ENDIF 
     154      ENDIF 
     155 
     156      ! --- East --- ! 
     157      IF( lk_east ) THEN 
     158         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     159         ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     160         ! 
     161         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     162            DO ji = mi0(ibdy1), mi1(ibdy2) 
     163               uu_b(ji,:,Krhs_a) = 0._wp 
     164               DO jk = 1, jpkm1 
     165                  DO jj = 1, jpj 
     166                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) &  
     167                         & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     168                  END DO 
     169               END DO 
     170               DO jj = 1, jpj 
     171                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
     172               END DO 
     173            END DO 
     174         ENDIF 
     175         ! 
     176         DO ji = mi0(ibdy1), mi1(ibdy2) 
     177            zub(ji,:) = 0._wp    ! Correct transport 
    146178            DO jk = 1, jpkm1 
    147179               DO jj = 1, jpj 
    148                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk) 
    149                END DO 
    150             END DO 
    151          END DO 
    152       ENDIF 
    153  
    154       ! --- East --- ! 
    155       ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    156       ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    157       ! 
    158       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    159          DO ji = mi0(ibdy1), mi1(ibdy2) 
    160             uu_b(ji,:,Krhs_a) = 0._wp 
     180                  zub(ji,jj) = zub(ji,jj) &  
     181                     & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     182               END DO 
     183            END DO 
     184            DO jj=1,jpj 
     185               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     186            END DO 
     187             
    161188            DO jk = 1, jpkm1 
    162189               DO jj = 1, jpj 
    163                   uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) &  
    164                       & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    165                END DO 
    166             END DO 
    167             DO jj = 1, jpj 
    168                uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
    169             END DO 
    170          END DO 
    171       ENDIF 
    172       ! 
    173       DO ji = mi0(ibdy1), mi1(ibdy2) 
    174          zub(ji,:) = 0._wp    ! Correct transport 
    175          DO jk = 1, jpkm1 
    176             DO jj = 1, jpj 
    177                zub(ji,jj) = zub(ji,jj) &  
    178                   & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    179             END DO 
    180          END DO 
    181          DO jj=1,jpj 
    182             zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     190                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
     191                    & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 
     192               END DO 
     193            END DO 
    183194         END DO 
    184195             
    185          DO jk = 1, jpkm1 
    186             DO jj = 1, jpj 
    187                uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    188                  & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 
    189             END DO 
    190          END DO 
    191       END DO 
    192              
    193       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    194          ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
    195          ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
    196          DO ji = mi0(ibdy1), mi1(ibdy2) 
    197             zvb(ji,:) = 0._wp 
    198             DO jk = 1, jpkm1 
     196         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     197            ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     198            ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
     199            DO ji = mi0(ibdy1), mi1(ibdy2) 
     200               zvb(ji,:) = 0._wp 
     201               DO jk = 1, jpkm1 
     202                  DO jj = 1, jpj 
     203                     zvb(ji,jj) = zvb(ji,jj) & 
     204                        & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     205                  END DO 
     206               END DO 
    199207               DO jj = 1, jpj 
    200                   zvb(ji,jj) = zvb(ji,jj) & 
     208                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     209               END DO 
     210               DO jk = 1, jpkm1 
     211                  DO jj = 1, jpj 
     212                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
     213                         & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 
     214                  END DO 
     215               END DO 
     216            END DO 
     217         ENDIF 
     218      ENDIF 
     219 
     220      ! --- South --- ! 
     221      IF( lk_south ) THEN 
     222         jbdy1 = nn_hls + 2                  ! halo + land + 1 
     223         jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
     224         ! 
     225         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     226            DO jj = mj0(jbdy1), mj1(jbdy2) 
     227               vv_b(:,jj,Krhs_a) = 0._wp 
     228               DO jk = 1, jpkm1 
     229                  DO ji = 1, jpi 
     230                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
     231                         & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     232                  END DO 
     233               END DO 
     234               DO ji=1,jpi 
     235                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)      
     236               END DO 
     237            END DO 
     238         ENDIF 
     239         ! 
     240         DO jj = mj0(jbdy1), mj1(jbdy2) 
     241            zvb(:,jj) = 0._wp    ! Correct transport 
     242            DO jk=1,jpkm1 
     243               DO ji=1,jpi 
     244                  zvb(ji,jj) = zvb(ji,jj) &  
    201245                     & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    202246               END DO 
    203247            END DO 
    204             DO jj = 1, jpj 
     248            DO ji = 1, jpi 
    205249               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    206250            END DO 
    207             DO jk = 1, jpkm1 
    208                DO jj = 1, jpj 
    209                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    210                       & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 
    211                END DO 
    212             END DO 
    213          END DO 
    214       ENDIF 
    215  
    216       ! --- South --- ! 
    217       jbdy1 = nn_hls + 2                  ! halo + land + 1 
    218       jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    219       ! 
    220       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    221          DO jj = mj0(jbdy1), mj1(jbdy2) 
    222             vv_b(:,jj,Krhs_a) = 0._wp 
     251 
    223252            DO jk = 1, jpkm1 
    224253               DO ji = 1, jpi 
    225                   vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    226                       & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    227                END DO 
    228             END DO 
    229             DO ji=1,jpi 
    230                vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)      
    231             END DO 
    232          END DO 
    233       ENDIF 
    234       ! 
    235       DO jj = mj0(jbdy1), mj1(jbdy2) 
    236          zvb(:,jj) = 0._wp    ! Correct transport 
    237          DO jk=1,jpkm1 
    238             DO ji=1,jpi 
    239                zvb(ji,jj) = zvb(ji,jj) &  
    240                   & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    241             END DO 
    242          END DO 
    243          DO ji = 1, jpi 
    244             zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    245          END DO 
    246  
    247          DO jk = 1, jpkm1 
     254                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
     255                    & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     256               END DO 
     257            END DO 
     258         END DO 
     259             
     260         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     261            DO jj = mj0(jbdy1), mj1(jbdy2) 
     262               zub(:,jj) = 0._wp 
     263               DO jk = 1, jpkm1 
     264                  DO ji = 1, jpi 
     265                     zub(ji,jj) = zub(ji,jj) &  
     266                        & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     267                  END DO 
     268               END DO 
     269               DO ji = 1, jpi 
     270                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     271               END DO 
     272                
     273               DO jk = 1, jpkm1 
     274                  DO ji = 1, jpi 
     275                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
     276                        & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     277                  END DO 
     278               END DO 
     279            END DO 
     280         ENDIF 
     281      ENDIF 
     282 
     283      ! --- North --- ! 
     284      IF( lk_north ) THEN 
     285         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     286         jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     287         ! 
     288         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     289            DO jj = mj0(jbdy1), mj1(jbdy2) 
     290               vv_b(:,jj,Krhs_a) = 0._wp 
     291               DO jk = 1, jpkm1 
     292                  DO ji = 1, jpi 
     293                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
     294                         & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     295                  END DO 
     296               END DO 
     297               DO ji=1,jpi 
     298                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 
     299               END DO 
     300            END DO 
     301         ENDIF 
     302         ! 
     303         DO jj = mj0(jbdy1), mj1(jbdy2) 
     304            zvb(:,jj) = 0._wp    ! Correct transport 
     305            DO jk=1,jpkm1 
     306               DO ji=1,jpi 
     307                  zvb(ji,jj) = zvb(ji,jj) &  
     308                     & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     309               END DO 
     310            END DO 
    248311            DO ji = 1, jpi 
    249                vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    250                  & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    251             END DO 
    252          END DO 
    253       END DO 
    254              
    255       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    256          DO jj = mj0(jbdy1), mj1(jbdy2) 
    257             zub(:,jj) = 0._wp 
     312               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     313            END DO 
     314 
    258315            DO jk = 1, jpkm1 
    259316               DO ji = 1, jpi 
    260                   zub(ji,jj) = zub(ji,jj) &  
    261                      & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    262                END DO 
    263             END DO 
    264             DO ji = 1, jpi 
    265                zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    266             END DO 
     317                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
     318                     & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     319               END DO 
     320            END DO 
     321         END DO 
     322             
     323         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     324            jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     325            jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
     326            DO jj = mj0(jbdy1), mj1(jbdy2) 
     327               zub(:,jj) = 0._wp 
     328               DO jk = 1, jpkm1 
     329                  DO ji = 1, jpi 
     330                     zub(ji,jj) = zub(ji,jj) &  
     331                        & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     332                  END DO 
     333               END DO 
     334               DO ji = 1, jpi 
     335                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     336               END DO 
    267337                
    268             DO jk = 1, jpkm1 
    269                DO ji = 1, jpi 
    270                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    271                     & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    272                END DO 
    273             END DO 
    274          END DO 
    275       ENDIF 
    276  
    277       ! --- North --- ! 
    278       jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    279       jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    280       ! 
    281       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    282          DO jj = mj0(jbdy1), mj1(jbdy2) 
    283             vv_b(:,jj,Krhs_a) = 0._wp 
    284             DO jk = 1, jpkm1 
    285                DO ji = 1, jpi 
    286                   vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    287                       & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    288                END DO 
    289             END DO 
    290             DO ji=1,jpi 
    291                vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 
    292             END DO 
    293          END DO 
    294       ENDIF 
    295       ! 
    296       DO jj = mj0(jbdy1), mj1(jbdy2) 
    297          zvb(:,jj) = 0._wp    ! Correct transport 
    298          DO jk=1,jpkm1 
    299             DO ji=1,jpi 
    300                zvb(ji,jj) = zvb(ji,jj) &  
    301                   & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    302             END DO 
    303          END DO 
    304          DO ji = 1, jpi 
    305             zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    306          END DO 
    307  
    308          DO jk = 1, jpkm1 
    309             DO ji = 1, jpi 
    310                vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    311                  & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    312             END DO 
    313          END DO 
    314       END DO 
    315              
    316       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    317          jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
    318          jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
    319          DO jj = mj0(jbdy1), mj1(jbdy2) 
    320             zub(:,jj) = 0._wp 
    321             DO jk = 1, jpkm1 
    322                DO ji = 1, jpi 
    323                   zub(ji,jj) = zub(ji,jj) &  
    324                      & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    325                END DO 
    326             END DO 
    327             DO ji = 1, jpi 
    328                zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    329             END DO 
    330                 
    331             DO jk = 1, jpkm1 
    332                DO ji = 1, jpi 
    333                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    334                     & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    335                END DO 
    336             END DO 
    337          END DO 
     338               DO jk = 1, jpkm1 
     339                  DO ji = 1, jpi 
     340                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
     341                       & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     342                  END DO 
     343               END DO 
     344            END DO 
     345         ENDIF 
    338346      ENDIF 
    339347      ! 
     
    354362      ! 
    355363      !--- West ---! 
    356       istart = nn_hls + 2                              ! halo + land + 1 
    357       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    358       DO ji = mi0(istart), mi1(iend) 
    359          DO jj=1,jpj 
    360             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    361             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    362          END DO 
    363       END DO 
     364      IF( lk_west ) THEN 
     365         istart = nn_hls + 2                              ! halo + land + 1 
     366         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     367         DO ji = mi0(istart), mi1(iend) 
     368            DO jj=1,jpj 
     369               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     370               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     371            END DO 
     372         END DO 
     373      ENDIF 
    364374      ! 
    365375      !--- East ---! 
    366       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    367       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    368       DO ji = mi0(istart), mi1(iend) 
    369          DO jj=1,jpj 
    370             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    371          END DO 
    372       END DO 
    373       istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    374       iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    375       DO ji = mi0(istart), mi1(iend) 
    376          DO jj=1,jpj 
    377             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    378          END DO 
    379       END DO 
     376      IF( lk_east ) THEN 
     377         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     378         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     379         DO ji = mi0(istart), mi1(iend) 
     380            DO jj=1,jpj 
     381               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     382            END DO 
     383         END DO 
     384         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     385         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     386         DO ji = mi0(istart), mi1(iend) 
     387            DO jj=1,jpj 
     388               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     389            END DO 
     390         END DO 
     391      ENDIF 
    380392      ! 
    381393      !--- South ---! 
    382       jstart = nn_hls + 2                              ! halo + land + 1 
    383       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    384       DO jj = mj0(jstart), mj1(jend) 
    385          DO ji=1,jpi 
    386             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    387             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    388          END DO 
    389       END DO 
     394      IF( lk_south ) THEN 
     395         jstart = nn_hls + 2                              ! halo + land + 1 
     396         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     397         DO jj = mj0(jstart), mj1(jend) 
     398            DO ji=1,jpi 
     399               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     400               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     401            END DO 
     402         END DO 
     403      ENDIF 
    390404      ! 
    391405      !--- North ---! 
    392       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    393       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    394       DO jj = mj0(jstart), mj1(jend) 
    395          DO ji=1,jpi 
    396             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    397          END DO 
    398       END DO 
    399       jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    400       jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    401       DO jj = mj0(jstart), mj1(jend) 
    402          DO ji=1,jpi 
    403             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    404          END DO 
    405       END DO 
     406      IF( lk_north ) THEN 
     407         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     408         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     409         DO jj = mj0(jstart), mj1(jend) 
     410            DO ji=1,jpi 
     411               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     412            END DO 
     413         END DO 
     414         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     415         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     416         DO jj = mj0(jstart), mj1(jend) 
     417            DO ji=1,jpi 
     418               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     419            END DO 
     420         END DO 
     421      ENDIF 
    406422      ! 
    407423   END SUBROUTINE Agrif_dyn_ts 
     
    421437      ! 
    422438      !--- West ---! 
    423       istart = nn_hls + 2                              ! halo + land + 1 
    424       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    425       DO ji = mi0(istart), mi1(iend) 
    426          DO jj=1,jpj 
    427             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    428             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    429          END DO 
    430       END DO 
     439      IF( lk_west ) THEN 
     440         istart = nn_hls + 2                              ! halo + land + 1 
     441         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     442         DO ji = mi0(istart), mi1(iend) 
     443            DO jj=1,jpj 
     444               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     445               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     446            END DO 
     447         END DO 
     448      ENDIF 
    431449      ! 
    432450      !--- East ---! 
    433       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    434       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    435       DO ji = mi0(istart), mi1(iend) 
    436          DO jj=1,jpj 
    437             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    438          END DO 
    439       END DO 
    440       istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    441       iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    442       DO ji = mi0(istart), mi1(iend) 
    443          DO jj=1,jpj 
    444             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    445          END DO 
    446       END DO 
     451      IF( lk_east ) THEN 
     452         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     453         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     454         DO ji = mi0(istart), mi1(iend) 
     455            DO jj=1,jpj 
     456               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     457            END DO 
     458         END DO 
     459         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     460         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     461         DO ji = mi0(istart), mi1(iend) 
     462            DO jj=1,jpj 
     463               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     464            END DO 
     465         END DO 
     466      ENDIF 
    447467      ! 
    448468      !--- South ---! 
    449       jstart = nn_hls + 2                              ! halo + land + 1 
    450       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    451       DO jj = mj0(jstart), mj1(jend) 
    452          DO ji=1,jpi 
    453             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    454             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    455          END DO 
    456       END DO 
     469      IF( lk_south ) THEN 
     470         jstart = nn_hls + 2                              ! halo + land + 1 
     471         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     472         DO jj = mj0(jstart), mj1(jend) 
     473            DO ji=1,jpi 
     474               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     475               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     476            END DO 
     477         END DO 
     478      ENDIF 
    457479      ! 
    458480      !--- North ---! 
    459       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    460       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    461       DO jj = mj0(jstart), mj1(jend) 
    462          DO ji=1,jpi 
    463             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    464          END DO 
    465       END DO 
    466       jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    467       jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    468       DO jj = mj0(jstart), mj1(jend) 
    469          DO ji=1,jpi 
    470             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    471          END DO 
    472       END DO 
     481      IF( lk_north ) THEN 
     482         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     483         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     484         DO jj = mj0(jstart), mj1(jend) 
     485            DO ji=1,jpi 
     486               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     487            END DO 
     488         END DO 
     489         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     490         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     491         DO jj = mj0(jstart), mj1(jend) 
     492            DO ji=1,jpi 
     493               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     494            END DO 
     495         END DO 
     496      ENDIF 
    473497      ! 
    474498   END SUBROUTINE Agrif_dyn_ts_flux 
     
    489513      ! 
    490514      ! Enforce volume conservation if no time refinement:   
    491       IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.   
     515      IF    ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.   
    492516      ! 
    493517      ! Interpolate barotropic fluxes 
     
    542566      ! 
    543567      ! --- West --- ! 
    544       istart = nn_hls + 2                              ! halo + land + 1 
    545       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    546       DO ji = mi0(istart), mi1(iend) 
    547          DO jj = 1, jpj 
    548             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     568      IF( lk_west ) THEN 
     569        istart = nn_hls + 2                              ! halo + land + 1 
     570         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     571         DO ji = mi0(istart), mi1(iend) 
     572            DO jj = 1, jpj 
     573               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     574            ENDDO 
    549575         ENDDO 
    550       ENDDO 
     576      ENDIF 
    551577      ! 
    552578      ! --- East --- ! 
    553       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    554       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    555       DO ji = mi0(istart), mi1(iend) 
    556          DO jj = 1, jpj 
    557             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     579      IF( lk_east ) THEN 
     580         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     581         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     582         DO ji = mi0(istart), mi1(iend) 
     583            DO jj = 1, jpj 
     584               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     585            ENDDO 
    558586         ENDDO 
    559       ENDDO 
     587      ENDIF 
    560588      ! 
    561589      ! --- South --- ! 
    562       jstart = nn_hls + 2                              ! halo + land + 1 
    563       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    564       DO jj = mj0(jstart), mj1(jend) 
    565          DO ji = 1, jpi 
    566             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     590      IF( lk_south ) THEN 
     591         jstart = nn_hls + 2                              ! halo + land + 1 
     592         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     593         DO jj = mj0(jstart), mj1(jend) 
     594            DO ji = 1, jpi 
     595               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     596            ENDDO 
    567597         ENDDO 
    568       ENDDO 
     598      ENDIF 
    569599      ! 
    570600      ! --- North --- ! 
    571       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    572       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    573       DO jj = mj0(jstart), mj1(jend) 
    574          DO ji = 1, jpi 
    575             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     601      IF( lk_north ) THEN 
     602         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     603         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     604         DO jj = mj0(jstart), mj1(jend) 
     605            DO ji = 1, jpi 
     606               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     607            ENDDO 
    576608         ENDDO 
    577       ENDDO 
     609      ENDIF 
    578610      ! 
    579611   END SUBROUTINE Agrif_ssh 
     
    593625      ! 
    594626      ! --- West --- ! 
    595       istart = nn_hls + 2                              ! halo + land + 1 
    596       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    597       DO ji = mi0(istart), mi1(iend) 
    598          DO jj = 1, jpj 
    599             ssha_e(ji,jj) = hbdy(ji,jj) 
     627      IF( lk_west ) THEN 
     628         istart = nn_hls + 2                              ! halo + land + 1 
     629         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     630         DO ji = mi0(istart), mi1(iend) 
     631            DO jj = 1, jpj 
     632               ssha_e(ji,jj) = hbdy(ji,jj) 
     633            ENDDO 
    600634         ENDDO 
    601       ENDDO 
     635      ENDIF 
    602636      ! 
    603637      ! --- East --- ! 
    604       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    605       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    606       DO ji = mi0(istart), mi1(iend) 
    607          DO jj = 1, jpj 
    608             ssha_e(ji,jj) = hbdy(ji,jj) 
     638      IF( lk_east ) THEN 
     639         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     640         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     641         DO ji = mi0(istart), mi1(iend) 
     642            DO jj = 1, jpj 
     643               ssha_e(ji,jj) = hbdy(ji,jj) 
     644            ENDDO 
    609645         ENDDO 
    610       ENDDO 
     646      ENDIF 
    611647      ! 
    612648      ! --- South --- ! 
    613       jstart = nn_hls + 2                              ! halo + land + 1 
    614       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    615       DO jj = mj0(jstart), mj1(jend) 
    616          DO ji = 1, jpi 
    617             ssha_e(ji,jj) = hbdy(ji,jj) 
     649      IF( lk_south ) THEN 
     650         jstart = nn_hls + 2                              ! halo + land + 1 
     651         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     652         DO jj = mj0(jstart), mj1(jend) 
     653            DO ji = 1, jpi 
     654               ssha_e(ji,jj) = hbdy(ji,jj) 
     655            ENDDO 
    618656         ENDDO 
    619       ENDDO 
     657      ENDIF 
    620658      ! 
    621659      ! --- North --- ! 
    622       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    623       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    624       DO jj = mj0(jstart), mj1(jend) 
    625          DO ji = 1, jpi 
    626             ssha_e(ji,jj) = hbdy(ji,jj) 
     660      IF( lk_north ) THEN 
     661         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     662         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     663         DO jj = mj0(jstart), mj1(jend) 
     664            DO ji = 1, jpi 
     665               ssha_e(ji,jj) = hbdy(ji,jj) 
     666            ENDDO 
    627667         ENDDO 
    628       ENDDO 
     668      ENDIF 
    629669      ! 
    630670   END SUBROUTINE Agrif_ssh_ts 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90

    r13065 r13229  
    131131 
    132132         ! --- West --- ! 
    133          ztabramp(:,:) = 0._wp 
    134          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    135          DO ji = mi0(ind1), mi1(ind1)                 
    136             ztabramp(ji,:) = ssumask(ji,:) 
    137          END DO 
    138          ! 
    139          zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
    140          zmskwest(jpj+1:jpjmax) = 0._wp 
     133         IF( lk_west ) THEN 
     134            ztabramp(:,:) = 0._wp 
     135            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     136            DO ji = mi0(ind1), mi1(ind1)                 
     137               ztabramp(ji,:) = ssumask(ji,:) 
     138            END DO 
     139            ! 
     140            zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     141            zmskwest(jpj+1:jpjmax) = 0._wp 
     142         ENDIF 
    141143 
    142144         ! --- East --- ! 
    143          ztabramp(:,:) = 0._wp 
    144          ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    145          DO ji = mi0(ind1), mi1(ind1)                  
    146             ztabramp(ji,:) = ssumask(ji,:) 
    147          END DO 
    148          ! 
    149          zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
    150          zmskeast(jpj+1:jpjmax) = 0._wp 
     145         IF( lk_east ) THEN 
     146            ztabramp(:,:) = 0._wp 
     147            ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     148            DO ji = mi0(ind1), mi1(ind1)                  
     149               ztabramp(ji,:) = ssumask(ji,:) 
     150            END DO 
     151            ! 
     152            zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     153            zmskeast(jpj+1:jpjmax) = 0._wp 
     154         ENDIF 
    151155 
    152156         ! --- South --- ! 
    153          ztabramp(:,:) = 0._wp 
    154          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    155          DO jj = mj0(ind1), mj1(ind1)                  
    156             ztabramp(:,jj) = ssvmask(:,jj) 
    157          END DO 
    158          ! 
    159          zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
    160          zmsksouth(jpi+1:jpimax) = 0._wp 
     157         IF( lk_south ) THEN 
     158            ztabramp(:,:) = 0._wp 
     159            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     160            DO jj = mj0(ind1), mj1(ind1)                  
     161               ztabramp(:,jj) = ssvmask(:,jj) 
     162            END DO 
     163            ! 
     164            zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     165            zmsksouth(jpi+1:jpimax) = 0._wp 
     166         ENDIF 
    161167 
    162168         ! --- North --- ! 
    163          ztabramp(:,:) = 0._wp 
    164          ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    165          DO jj = mj0(ind1), mj1(ind1)                  
    166             ztabramp(:,jj) = ssvmask(:,jj) 
    167          END DO 
    168          ! 
    169          zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
    170          zmsknorth(jpi+1:jpimax) = 0._wp 
     169         IF( lk_north ) THEN 
     170            ztabramp(:,:) = 0._wp 
     171            ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     172            DO jj = mj0(ind1), mj1(ind1)                  
     173               ztabramp(:,jj) = ssvmask(:,jj) 
     174            END DO 
     175            ! 
     176            zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     177            zmsknorth(jpi+1:jpimax) = 0._wp 
     178         ENDIF 
    171179 
    172180         ! JC: SPONGE MASKING TO BE SORTED OUT: 
     
    197205 
    198206         ! --- West --- ! 
    199          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    200          ind2 = nn_hls + 1 + nbghostcells + ispongearea  
    201          DO ji = mi0(ind1), mi1(ind2)    
    202             DO jj = 1, jpj                
    203                ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
    204             END DO 
    205          END DO 
    206  
    207          ! ghost cells: 
    208          ind1 = 1 
    209          ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    210          DO ji = mi0(ind1), mi1(ind2)    
    211             DO jj = 1, jpj                
    212                ztabramp(ji,jj) = zmskwest(jj) 
    213             END DO 
    214          END DO 
     207         IF( lk_west ) THEN 
     208            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     209            ind2 = nn_hls + 1 + nbghostcells + ispongearea  
     210            DO ji = mi0(ind1), mi1(ind2)    
     211               DO jj = 1, jpj                
     212                  ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
     213               END DO 
     214            END DO 
     215 
     216            ! ghost cells: 
     217            ind1 = 1 
     218            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     219            DO ji = mi0(ind1), mi1(ind2)    
     220               DO jj = 1, jpj                
     221                  ztabramp(ji,jj) = zmskwest(jj) 
     222               END DO 
     223            END DO 
     224         ENDIF 
    215225 
    216226         ! --- East --- ! 
    217          ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
    218          ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    219          DO ji = mi0(ind1), mi1(ind2) 
    220             DO jj = 1, jpj 
    221                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
    222             ENDDO 
    223          END DO 
    224  
    225          ! ghost cells: 
    226          ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    227          ind2 = jpiglo 
    228          DO ji = mi0(ind1), mi1(ind2) 
    229             DO jj = 1, jpj 
    230                ztabramp(ji,jj) = zmskeast(jj) 
    231             ENDDO 
    232          END DO 
     227         IF( lk_east ) THEN 
     228            ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
     229            ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     230            DO ji = mi0(ind1), mi1(ind2) 
     231               DO jj = 1, jpj 
     232                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
     233               ENDDO 
     234            END DO 
     235 
     236            ! ghost cells: 
     237            ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     238            ind2 = jpiglo 
     239            DO ji = mi0(ind1), mi1(ind2) 
     240               DO jj = 1, jpj 
     241                  ztabramp(ji,jj) = zmskeast(jj) 
     242               ENDDO 
     243            END DO 
     244         ENDIF 
    233245 
    234246         ! --- South --- ! 
    235          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    236          ind2 = nn_hls + 1 + nbghostcells + jspongearea  
    237          DO jj = mj0(ind1), mj1(ind2)  
    238             DO ji = 1, jpi 
    239                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
    240             END DO 
    241          END DO 
    242  
    243          ! ghost cells: 
    244          ind1 = 1 
    245          ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    246          DO jj = mj0(ind1), mj1(ind2)  
    247             DO ji = 1, jpi 
    248                ztabramp(ji,jj) = zmsksouth(ji) 
    249             END DO 
    250          END DO 
     247         IF( lk_south ) THEN 
     248            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     249            ind2 = nn_hls + 1 + nbghostcells + jspongearea  
     250            DO jj = mj0(ind1), mj1(ind2)  
     251               DO ji = 1, jpi 
     252                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
     253               END DO 
     254            END DO 
     255 
     256            ! ghost cells: 
     257            ind1 = 1 
     258            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     259            DO jj = mj0(ind1), mj1(ind2)  
     260               DO ji = 1, jpi 
     261                  ztabramp(ji,jj) = zmsksouth(ji) 
     262               END DO 
     263            END DO 
     264         ENDIF 
    251265 
    252266         ! --- North --- ! 
    253          ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
    254          ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    255          DO jj = mj0(ind1), mj1(ind2) 
    256             DO ji = 1, jpi 
    257                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
    258             END DO 
    259          END DO 
    260  
    261          ! ghost cells: 
    262          ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    263          ind2 = jpjglo 
    264          DO jj = mj0(ind1), mj1(ind2) 
    265             DO ji = 1, jpi 
    266                ztabramp(ji,jj) = zmsknorth(ji) 
    267             END DO 
    268          END DO 
     267         IF( lk_north ) THEN 
     268            ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
     269            ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     270            DO jj = mj0(ind1), mj1(ind2) 
     271               DO ji = 1, jpi 
     272                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
     273               END DO 
     274            END DO 
     275 
     276            ! ghost cells: 
     277            ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     278            ind2 = jpjglo 
     279            DO jj = mj0(ind1), mj1(ind2) 
     280               DO ji = 1, jpi 
     281                  ztabramp(ji,jj) = zmsknorth(ji) 
     282               END DO 
     283            END DO 
     284         ENDIF 
    269285 
    270286      ENDIF 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_update.F90

    r12489 r13229  
    2626   USE domvvl         ! Need interpolation routines  
    2727   USE vremap         ! Vertical remapping 
     28   USE lbclnk  
    2829 
    2930   IMPLICIT NONE 
     
    8586      Agrif_UseSpecialValueInUpdate = .FALSE. 
    8687      Agrif_SpecialValueFineGrid = 0. 
     88 
     89      use_sign_north = .TRUE. 
     90      sign_north = -1. 
     91 
    8792      !      
    8893# if ! defined DECAL_FEEDBACK 
     
    127132      END IF 
    128133      ! 
     134      use_sign_north = .FALSE. 
     135      ! 
    129136   END SUBROUTINE Agrif_Update_Dyn 
    130137 
     
    148155#  if defined VOL_REFLUX 
    149156      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
     157         use_sign_north = .TRUE. 
     158         sign_north = -1. 
    150159         ! Refluxing on ssh: 
    151160#  if defined DECAL_FEEDBACK_2D 
     
    156165         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/ 0, 0/),locupdate2=(/-1,-1/),procname = reflux_sshv) 
    157166#  endif 
     167         use_sign_north = .FALSE. 
    158168      END IF 
    159169#  endif 
     
    826836   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    827837      !!--------------------------------------------- 
    828       !!           *** ROUTINE correct_u_bdy *** 
     838      !!           *** ROUTINE correct_v_bdy *** 
    829839      !!--------------------------------------------- 
    830840      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_top_interp.F90

    r12377 r13229  
    119119            tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
    120120         END DO 
    121  
    122121      ENDIF 
    123122      ! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90

    r13130 r13229  
    2828      ! 
    2929      !                    !* Agrif initialization 
    30       CALL agrif_nemo_init 
    31       CALL Agrif_InitValues_cont_dom 
    3230      CALL Agrif_InitValues_cont 
    3331# if defined key_top 
     
    4038   END SUBROUTINE Agrif_initvalues 
    4139 
    42    SUBROUTINE Agrif_InitValues_cont_dom 
    43       !!---------------------------------------------------------------------- 
    44       !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
    45       !!---------------------------------------------------------------------- 
    46       ! 
    47       CALL agrif_declare_var_dom 
    48       ! 
    49    END SUBROUTINE Agrif_InitValues_cont_dom 
    50  
    51    SUBROUTINE agrif_declare_var_dom 
    52       !!---------------------------------------------------------------------- 
    53       !!                 *** ROUTINE agrif_declare_var_dom *** 
    54       !!---------------------------------------------------------------------- 
    55       USE par_oce, ONLY:  nbghostcells       
     40   SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 
     41 
     42       USE domvvl 
     43       USE domain 
     44       USE par_oce 
     45       USE agrif_oce 
     46       USE agrif_oce_interp 
     47       USE oce 
     48       USE lib_mpp 
     49       USe lbclnk 
     50 
     51      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
     52      INTEGER :: jn 
     53 
     54      IF(lwp) WRITE(numout,*) ' ' 
     55      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
     56      IF(lwp) WRITE(numout,*) ' ' 
     57 
     58      l_ini_child = .TRUE. 
     59      Agrif_SpecialValue    = 0._wp 
     60      Agrif_UseSpecialValue = .TRUE. 
     61      uu(:,:,:,:) = 0.  ;  vv(:,:,:,:) = 0.   ;  ts(:,:,:,:,:) = 0. 
     62        
     63      Krhs_a = Kbb ; Kmm_a = Kbb 
     64 
     65      ! Brutal fix to pas 1x1 refinment.  
     66  !    IF(Agrif_Irhox() == 1) THEN 
     67  !       CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 
     68  !    ELSE 
     69      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
     70 
     71  !    ENDIF 
     72! just for VORTEX because Parent velocities can actually be exactly zero 
     73!      Agrif_UseSpecialValue = .FALSE. 
     74      Agrif_UseSpecialValue = ln_spc_dyn 
     75      use_sign_north = .TRUE. 
     76      sign_north = -1. 
     77      CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
     78      CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
     79      use_sign_north = .FALSE. 
     80 
     81      Agrif_UseSpecialValue = .FALSE.            ! 
     82      l_ini_child = .FALSE. 
     83 
     84      Krhs_a = Kaa ; Kmm_a = Kmm 
     85 
     86      DO jn = 1, jpts 
     87         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
     88      END DO 
     89      uu(:,:,:,Kbb) =  uu(:,:,:,Kbb) * umask(:,:,:)      
     90      vv(:,:,:,Kbb) =  vv(:,:,:,Kbb) * vmask(:,:,:)  
     91 
     92 
     93      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 
     94      CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 
     95 
     96   END SUBROUTINE agrif_istate    
     97 
     98   SUBROUTINE agrif_declare_var_ini 
     99      !!---------------------------------------------------------------------- 
     100      !!                 *** ROUTINE agrif_declare_var *** 
     101      !!---------------------------------------------------------------------- 
     102      USE agrif_util 
     103      USE agrif_oce 
     104      USE par_oce 
     105      USE zdf_oce  
     106      USE oce 
     107      USE dom_oce 
    56108      ! 
    57109      IMPLICIT NONE 
    58110      ! 
    59111      INTEGER :: ind1, ind2, ind3 
    60       !!---------------------------------------------------------------------- 
     112      External :: nemo_mapping 
     113      !!---------------------------------------------------------------------- 
     114 
     115! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 
     116! The procnames will not be called at these boundaries 
     117      IF (jperio == 1) THEN 
     118         CALL Agrif_Set_NearCommonBorderX(.TRUE.) 
     119         CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 
     120      ENDIF 
     121 
     122      IF ( .NOT. lk_south ) THEN 
     123         CALL Agrif_Set_NearCommonBorderY(.TRUE.) 
     124      ENDIF 
    61125 
    62126      ! 1. Declaration of the type of variable which have to be interpolated 
    63127      !--------------------------------------------------------------------- 
    64       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    65       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    66       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
    67       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    68       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    69  
     128      ind1 =              nbghostcells 
     129      ind2 = nn_hls + 2 + nbghostcells_x 
     130      ind3 = nn_hls + 2 + nbghostcells_y_s 
     131 
     132      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 
     133      CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 
     134      CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 
     135 
     136      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     137      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     138 
     139    
     140      ! Initial or restart velues 
     141       
     142      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsini_id) 
     143      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/)     ,uini_id )  
     144      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/)     ,vini_id ) 
     145      CALL agrif_declare_variable((/2,2/)    ,(/ind2,ind3/)        ,(/'x','y'/),(/1,1/),(/jpi,jpj/),sshini_id) 
     146      !  
     147      
    70148      ! 2. Type of interpolation 
    71149      !------------------------- 
     150      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     151 
     152      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
     153      CALL Agrif_Set_interp  (mbkt_id,interp=AGRIF_constant) 
     154      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
     155      CALL Agrif_Set_interp  (ht0_id ,interp=AGRIF_constant) 
     156 
    72157      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    73158      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    74159 
    75       ! 3. Location of interpolation 
     160      ! Initial fields 
     161      CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 
     162      CALL Agrif_Set_interp  (tsini_id ,interp=AGRIF_linear) 
     163      CALL Agrif_Set_bcinterp(uini_id  ,interp=AGRIF_linear) 
     164      CALL Agrif_Set_interp  (uini_id  ,interp=AGRIF_linear) 
     165      CALL Agrif_Set_bcinterp(vini_id  ,interp=AGRIF_linear) 
     166      CALL Agrif_Set_interp  (vini_id  ,interp=AGRIF_linear) 
     167      CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 
     168      CALL Agrif_Set_interp  (sshini_id,interp=AGRIF_linear) 
     169 
     170       ! 3. Location of interpolation 
    76171      !----------------------------- 
     172!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     173! JC: check near the boundary only until matching in sponge has been sorted out: 
     174      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     175 
     176      ! extend the interpolation zone by 1 more point than necessary: 
     177      ! RB check here 
     178      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     179      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     180       
    77181      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    78       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     182      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))   
     183 
     184      CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     185      CALL Agrif_Set_bc( uini_id  , (/0,ind1-1/) )  
     186      CALL Agrif_Set_bc( vini_id  , (/0,ind1-1/) ) 
     187      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    79188 
    80189      ! 4. Update type 
     
    87196      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    88197#endif 
    89  
    90    END SUBROUTINE agrif_declare_var_dom 
    91  
    92    SUBROUTINE Agrif_InitValues_cont 
    93       !!---------------------------------------------------------------------- 
    94       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    95       !!---------------------------------------------------------------------- 
    96       USE agrif_oce 
     198       
     199   !   CALL Agrif_Set_ExternalMapping(nemo_mapping) 
     200      ! 
     201   END SUBROUTINE agrif_declare_var_ini 
     202 
     203 
     204   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
     205      !!---------------------------------------------------------------------- 
     206      !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
     207      !!---------------------------------------------------------------------- 
     208   
     209         !!---------------------------------------------------------------------- 
     210         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     211         !! 
     212         !! ** Purpose ::   Declaration of variables to be interpolated 
     213         !!---------------------------------------------------------------------- 
     214      USE agrif_oce_update 
    97215      USE agrif_oce_interp 
    98216      USE agrif_oce_sponge 
     217      USE Agrif_Util 
     218      USE oce  
    99219      USE dom_oce 
    100       USE oce 
     220      USE zdf_oce 
     221      USE nemogcm 
     222      USE agrif_oce 
     223      ! 
     224      USE lbclnk 
    101225      USE lib_mpp 
    102       USE lbclnk 
     226      USE in_out_manager 
    103227      ! 
    104228      IMPLICIT NONE 
    105229      ! 
    106       INTEGER :: ji, jj 
     230      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa 
     231      ! 
    107232      LOGICAL :: check_namelist 
    108233      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    109 #if defined key_vertical 
    110234      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
    111 #endif 
    112       !!---------------------------------------------------------------------- 
    113  
    114       ! 1. Declaration of the type of variable which have to be interpolated 
    115       !--------------------------------------------------------------------- 
    116       CALL agrif_declare_var 
    117  
    118       ! 2. First interpolations of potentially non zero fields 
    119       !------------------------------------------------------- 
    120  
    121 #if defined key_vertical 
     235      INTEGER :: ji, jj, jk 
     236      !!---------------------------------------------------------------------- 
     237     
     238     ! CALL Agrif_Declare_Var_ini 
     239 
     240      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     241 
    122242      ! Build consistent parent bathymetry and number of levels 
    123243      ! on the child grid  
     
    126246      mbkt_parent(:,:) = 0 
    127247      ! 
    128       CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
    129       CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     248  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     249  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     250      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 
     251      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 
    130252      ! 
    131253      ! Assume step wise change of bathymetry near interface 
     
    149271      ENDIF 
    150272      ! 
    151       CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
    152       CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
     273      CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1. ) 
     274      CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1. ) 
    153275      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
    154       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     276      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 
    155277      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
    156278      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    157 #endif 
    158  
     279 
     280      IF ( ln_init_chfrpar ) THEN  
     281         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
     282         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     283         DO jk = 1, jpk 
     284               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
     285                        &             / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     286                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     287         END DO 
     288      ENDIF 
     289 
     290      ! check if masks and bathymetries match 
     291      IF(ln_chk_bathy) THEN 
     292         Agrif_UseSpecialValue = .FALSE. 
     293         ! 
     294         IF(lwp) WRITE(numout,*) ' ' 
     295         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     296         ! 
     297         kindic_agr = 0 
     298         IF( .NOT. l_vremap ) THEN 
     299            ! 
     300            ! check if tmask and vertical scale factors agree with parent in sponge area: 
     301            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     302            ! 
     303         ELSE 
     304            ! 
     305            ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     306            DO ji = 1, jpi 
     307               DO jj = 1, jpj 
     308                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     309                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     310                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     311               END DO 
     312            END DO 
     313 
     314            CALL mpp_sum( 'agrif_user', kindic_agr ) 
     315            IF( kindic_agr /= 0 ) THEN 
     316               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     317            ELSE 
     318               IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     319               IF(lwp) WRITE(numout,*) ' ' 
     320            ENDIF   
     321         ENDIF 
     322      ENDIF 
     323 
     324      IF( l_vremap ) THEN 
     325      ! Additional constrain that should be removed someday: 
     326         IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     327            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 
     328         ENDIF 
     329      ENDIF 
     330      ! 
     331   END SUBROUTINE Agrif_Init_Domain 
     332 
     333 
     334   SUBROUTINE Agrif_InitValues_cont 
     335         !!---------------------------------------------------------------------- 
     336         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     337         !! 
     338         !! ** Purpose ::   Declaration of variables to be interpolated 
     339         !!---------------------------------------------------------------------- 
     340      USE agrif_oce_update 
     341      USE agrif_oce_interp 
     342      USE agrif_oce_sponge 
     343      USE Agrif_Util 
     344      USE oce  
     345      USE dom_oce 
     346      USE zdf_oce 
     347      USE nemogcm 
     348      USE agrif_oce 
     349      ! 
     350      USE lbclnk 
     351      USE lib_mpp 
     352      USE in_out_manager 
     353      ! 
     354      IMPLICIT NONE 
     355      ! 
     356      LOGICAL :: check_namelist 
     357      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     358      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     359      INTEGER :: ji, jj 
     360 
     361      ! 1. Declaration of the type of variable which have to be interpolated 
     362      !--------------------------------------------------------------------- 
     363      CALL agrif_declare_var 
     364 
     365      ! 2. First interpolations of potentially non zero fields 
     366      !------------------------------------------------------- 
    159367      Agrif_SpecialValue    = 0._wp 
    160368      Agrif_UseSpecialValue = .TRUE. 
     
    163371      tabspongedone_tsn = .FALSE. 
    164372      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    165       ! reset ts(:,:,:,:,Krhs_a) to zero 
     373      ! reset tsa to zero 
    166374      ts(:,:,:,:,Krhs_a) = 0._wp 
    167375 
    168376      Agrif_UseSpecialValue = ln_spc_dyn 
     377      use_sign_north = .TRUE. 
     378      sign_north = -1. 
    169379      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    170380      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     
    175385      tabspongedone_v = .FALSE. 
    176386      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     387      use_sign_north = .FALSE. 
    177388      uu(:,:,:,Krhs_a) = 0._wp 
    178389      vv(:,:,:,Krhs_a) = 0._wp 
     
    185396      IF ( ln_dynspg_ts ) THEN 
    186397         Agrif_UseSpecialValue = ln_spc_dyn 
     398         use_sign_north = .TRUE. 
     399         sign_north = -1. 
    187400         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    188401         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    189402         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    190403         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     404         use_sign_north = .FALSE. 
    191405         ubdy(:,:) = 0._wp 
    192406         vbdy(:,:) = 0._wp 
    193407      ENDIF 
    194  
    195       Agrif_UseSpecialValue = .FALSE. 
    196  
    197       ! 3. Some controls 
     408      Agrif_UseSpecialValue = .FALSE.  
     409 
    198410      !----------------- 
    199411      check_namelist = .TRUE. 
    200412 
    201413      IF( check_namelist ) THEN  
    202  
    203          ! Check time steps            
    204          IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
    205             WRITE(cl_check1,*)  NINT(Agrif_Parent(rn_Dt)) 
    206             WRITE(cl_check2,*)  NINT(rn_Dt) 
    207             WRITE(cl_check3,*)  NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot()) 
    208             CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    209                   &               'parent grid value : '//cl_check1    ,   &  
    210                   &               'child  grid value : '//cl_check2    ,   &  
    211                   &               'value on child grid should be changed to : '//cl_check3 ) 
    212          ENDIF 
    213  
    214          ! Check run length 
    215          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    216                Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    217             WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    218             WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    219             CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
    220                   &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
    221                   &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    222             nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    223             nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    224          ENDIF 
    225  
    226414         ! Check free surface scheme 
    227415         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     
    251439            STOP 
    252440         ENDIF 
    253  
    254       ENDIF 
    255  
    256       ! check if masks and bathymetries match 
    257       IF(ln_chk_bathy) THEN 
    258          Agrif_UseSpecialValue = .FALSE. 
    259          ! 
    260          IF(lwp) WRITE(numout,*) ' ' 
    261          IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
    262          ! 
    263          kindic_agr = 0 
    264 # if ! defined key_vertical 
    265          ! 
    266          ! check if tmask and vertical scale factors agree with parent in sponge area: 
    267          CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    268          ! 
    269 # else 
    270          ! 
    271          ! In case of vertical interpolation, check only that total depths agree between child and parent: 
    272          DO_2D_00_00 
    273             IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    274             IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    275             IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    276          END_2D 
    277 # endif 
    278          CALL mpp_sum( 'agrif_user', kindic_agr ) 
    279          IF( kindic_agr /= 0 ) THEN 
    280             CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
    281          ELSE 
    282             IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
    283             IF(lwp) WRITE(numout,*) ' ' 
    284          END IF   
    285          !     
    286 !!$         IF(lwp) WRITE(numout,*) ' ' 
    287 !!$         IF(lwp) WRITE(numout,*) 'AGRIF: Check longitude and latitude near bdys. Level: ', Agrif_Level() 
    288 !!$         ! 
    289 !!$         ! check glamt in sponge area: 
    290 !!$         kindic_agr = 0 
    291 !!$         CALL Agrif_Bc_variable(glamt_id,calledweight=1.,procname=interpglamt) 
    292 !!$         CALL mpp_sum( 'agrif_user', kindic_agr ) 
    293 !!$         IF( kindic_agr /= 0 ) THEN 
    294 !!$            CALL ctl_stop('==> Child glamt is NOT correct near boundaries.')1 
    295 !!$         ELSE 
    296 !!$            IF(lwp) WRITE(numout,*) '==> Child glamt is ok near boundaries.' 
    297 !!$            IF(lwp) WRITE(numout,*) ' ' 
    298 !!$         END IF   
    299 !!$         ! 
    300 !!$         ! check gphit in sponge area: 
    301 !!$         kindic_agr = 0 
    302 !!$         CALL Agrif_Bc_variable(gphit_id,calledweight=1.,procname=interpgphit) 
    303 !!$         CALL mpp_sum( 'agrif_user', kindic_agr ) 
    304 !!$         IF( kindic_agr /= 0 ) THEN 
    305 !!$            CALL ctl_stop('==> Child gphit is NOT correct near boundaries.') 
    306 !!$         ELSE 
    307 !!$            IF(lwp) WRITE(numout,*) '==> Child gphit is ok near boundaries.' 
    308 !!$            IF(lwp) WRITE(numout,*) ' ' 
    309 !!$         END IF   
    310          ! 
    311       ENDIF 
    312  
    313 # if defined key_vertical 
    314       ! Additional constrain that should be removed someday: 
    315       IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
    316     CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 
    317       ENDIF 
    318 # endif 
    319       !  
     441      ENDIF 
     442 
    320443   END SUBROUTINE Agrif_InitValues_cont 
    321444 
     
    337460      ! 1. Declaration of the type of variable which have to be interpolated 
    338461      !--------------------------------------------------------------------- 
    339       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    340       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    341       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
     462      ind1 =              nbghostcells 
     463      ind2 = nn_hls + 2 + nbghostcells_x 
     464      ind3 = nn_hls + 2 + nbghostcells_y_s 
    342465# if defined key_vertical 
    343       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
    344       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
    345  
    346       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
    347       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
    348       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
    349       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
    350       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
    351       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
     466      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     467      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     468      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
     469      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     470      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
     471      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
     472      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
     473      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    352474# else 
    353       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    354       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
    355  
    356       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
    357       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
    358       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
    359       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
    360       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
    361       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
     475      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     476      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
     477      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
     478      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
     479      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
     480      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
     481      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
     482      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
    362483# endif 
    363  
    364       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 
    365       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
    366       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
    367  
    368 # if defined key_vertical 
    369       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 
    370       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 
    371 # endif 
    372  
    373       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,3/),scales_t_id) 
    374  
    375       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
    376       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
    377       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
    378       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
    379       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
    380       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
    381  
    382       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    383  
    384       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     484      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
     485      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     486      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
     487      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
     488      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
     489      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
     490 
     491!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
     492!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
     493      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     494 
     495 
     496      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
    385497!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    386498!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    387499# if defined key_vertical 
    388          CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
     500         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
    389501# else 
    390          CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
     502         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    391503# endif 
    392504      ENDIF 
    393  
     505      
    394506      ! 2. Type of interpolation 
    395507      !------------------------- 
    396508      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    397  
    398509      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    399510      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    400511 
    401512      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
     513      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     514      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    402515 
    403516      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
     
    415528!< 
    416529 
    417       CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    418       CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    419  
    420       CALL Agrif_Set_bcinterp(  e3t_id,interp=AGRIF_constant) 
    421       CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
    422       CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
    423  
    424 # if defined key_vertical 
    425       CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
    426       CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
    427 # endif 
    428  
    429       IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     530      IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     531     
     532 
     533!      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
     534!      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
    430535 
    431536      ! 3. Location of interpolation 
     
    445550      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    446551 
    447 !      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
    448 ! JC: check near the boundary only until matching in sponge has been sorted out: 
    449       CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     552      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    450553      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )   
    451554      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )   
    452555 
    453 # if defined key_vertical  
    454       ! extend the interpolation zone by 1 more point than necessary: 
    455       CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    456       CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    457 # endif 
    458  
    459       IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    460  
    461556      ! 4. Update type 
    462557      !---------------  
    463       CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    464558 
    465559# if defined UPD_HIGH 
     
    473567      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
    474568 
    475       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     569  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    476570!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
    477571!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
    478572!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
    479       ENDIF 
     573   !   ENDIF 
    480574 
    481575#else 
     
    489583      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    490584 
    491       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     585 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    492586!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    493587!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    494588!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    495       ENDIF 
     589 !     ENDIF 
    496590 
    497591#endif 
     
    501595#if defined key_si3 
    502596SUBROUTINE Agrif_InitValues_cont_ice 
    503       !!---------------------------------------------------------------------- 
    504       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    505       !!---------------------------------------------------------------------- 
    506597      USE Agrif_Util 
    507598      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
     
    511602      USE agrif_ice_interp 
    512603      USE lib_mpp 
    513       ! 
    514       IMPLICIT NONE 
    515       !!---------------------------------------------------------------------- 
    516       ! 
    517       ! Declaration of the type of variable which have to be interpolated (parent=>child) 
    518       !---------------------------------------------------------------------------------- 
    519       CALL agrif_declare_var_ice 
     604      !!---------------------------------------------------------------------- 
     605      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     606      !!---------------------------------------------------------------------- 
    520607 
    521608      ! Controls 
     
    524611      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    525612      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 
    526       !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 
     613      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account      
    527614      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    528615 
     
    545632      !!                 *** ROUTINE agrif_declare_var_ice *** 
    546633      !!---------------------------------------------------------------------- 
     634 
    547635      USE Agrif_Util 
    548636      USE ice 
    549       USE par_oce, ONLY : nbghostcells 
     637      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 
    550638      ! 
    551639      IMPLICIT NONE 
    552640      ! 
    553641      INTEGER :: ind1, ind2, ind3 
    554       !!---------------------------------------------------------------------- 
     642         !!---------------------------------------------------------------------- 
    555643      ! 
    556644      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
     
    561649      !                            2,2 = two ghost lines 
    562650      !------------------------------------------------------------------------------------- 
    563       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    564       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    565       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
    566       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    567       CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  ) 
    568       CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  ) 
     651      ind1 =              nbghostcells 
     652      ind2 = nn_hls + 2 + nbghostcells_x 
     653      ind3 = nn_hls + 2 + nbghostcells_y_s 
     654      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
     655      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  ) 
     656      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  ) 
     657 
     658      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 
     659      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_iceini_id  ) 
     660      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_iceini_id  ) 
    569661 
    570662      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     
    574666      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    575667 
     668      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear) 
     669      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear) 
     670      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  ) 
     671      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   ) 
     672      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear) 
     673      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear) 
     674 
    576675      ! 3. Set location of interpolations 
    577676      !---------------------------------- 
     
    579678      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    580679      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     680 
     681      CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 
     682      CALL Agrif_Set_bc(u_iceini_id  ,(/0,ind1/)) 
     683      CALL Agrif_Set_bc(v_iceini_id  ,(/0,ind1/)) 
    581684 
    582685      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     
    586689      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    587690      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    588 #else 
     691# else 
    589692      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    590693      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    591694      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    592 #endif 
     695# endif 
    593696 
    594697   END SUBROUTINE agrif_declare_var_ice 
     
    614717      USE agrif_top_sponge 
    615718      !! 
    616       IMPLICIT NONE 
    617       ! 
    618       CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    619       LOGICAL :: check_namelist 
    620       !!---------------------------------------------------------------------- 
    621  
    622       ! 1. Declaration of the type of variable which have to be interpolated 
    623       !--------------------------------------------------------------------- 
    624       CALL agrif_declare_var_top 
    625  
    626       ! 2. First interpolations of potentially non zero fields 
    627       !------------------------------------------------------- 
    628       Agrif_SpecialValue=0._wp 
    629       Agrif_UseSpecialValue = .TRUE. 
    630       CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    631       Agrif_UseSpecialValue = .FALSE. 
    632       CALL Agrif_Sponge 
    633       tabspongedone_trn = .FALSE. 
    634       CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    635       ! reset ts(:,:,:,:,Krhs_a) to zero 
    636       tr(:,:,:,:,Krhs_a) = 0._wp 
    637  
    638       ! 3. Some controls 
    639       !----------------- 
    640       check_namelist = .TRUE. 
    641  
    642       IF( check_namelist ) THEN 
    643          ! Check time steps 
    644       IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
    645          WRITE(cl_check1,*)  Agrif_Parent(rn_Dt) 
    646          WRITE(cl_check2,*)  rn_Dt 
    647          WRITE(cl_check3,*)  rn_Dt*Agrif_Rhot() 
     719   
     720   !! 
     721   IMPLICIT NONE 
     722   ! 
     723   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     724   LOGICAL :: check_namelist 
     725      !!---------------------------------------------------------------------- 
     726 
     727 
     728   ! 1. Declaration of the type of variable which have to be interpolated 
     729   !--------------------------------------------------------------------- 
     730   CALL agrif_declare_var_top 
     731 
     732   ! 2. First interpolations of potentially non zero fields 
     733   !------------------------------------------------------- 
     734   Agrif_SpecialValue=0. 
     735   Agrif_UseSpecialValue = .TRUE. 
     736   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     737   Agrif_UseSpecialValue = .FALSE. 
     738   CALL Agrif_Sponge 
     739   tabspongedone_trn = .FALSE. 
     740   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     741   ! reset tsa to zero 
     742   tra(:,:,:,:) = 0. 
     743 
     744   ! 3. Some controls 
     745   !----------------- 
     746   check_namelist = .TRUE. 
     747 
     748   IF( check_namelist ) THEN 
     749      ! Check time steps 
     750      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     751         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     752         WRITE(cl_check2,*)  rdt 
     753         WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    648754         CALL ctl_stop( 'incompatible time step between grids',   & 
    649755               &               'parent grid value : '//cl_check1    ,   &  
     
    664770         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    665771      ENDIF 
    666  
    667772   ENDIF 
    668773   ! 
     
    684789      !!---------------------------------------------------------------------- 
    685790 
     791 
     792 
     793!RB_CMEMS : declare here init for top       
    686794      ! 1. Declaration of the type of variable which have to be interpolated 
    687795      !--------------------------------------------------------------------- 
    688       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    689       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    690       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
     796      ind1 =              nbghostcells 
     797      ind2 = nn_hls + 2 + nbghostcells_x 
     798      ind3 = nn_hls + 2 + nbghostcells_y_s 
    691799# if defined key_vertical 
    692       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
    693       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
     800      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
     801      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    694802# else 
    695       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    696       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
     803! LAURENT: STRANGE why (3,3) here ? 
     804      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     805      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    697806# endif 
    698807 
     
    734843      !!                     *** ROUTINE agrif_init *** 
    735844      !!---------------------------------------------------------------------- 
    736       USE agrif_oce  
    737       USE agrif_ice 
    738       USE in_out_manager 
    739       USE lib_mpp 
     845   USE agrif_oce  
     846   USE agrif_ice 
     847   USE dom_oce 
     848   USE in_out_manager 
     849   USE lib_mpp 
    740850      !! 
    741851      IMPLICIT NONE 
    742852      ! 
    743853      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    744       NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
     854      NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
    745855                       & ln_spc_dyn, ln_chk_bathy 
    746856      !!-------------------------------------------------------------------------------------- 
     
    758868         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    759869         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way 
    760          WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 
    761          WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 
    762          WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.' 
    763          WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.' 
     870         WRITE(numout,*) '      child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 
     871         WRITE(numout,*) '      ad. sponge coeft for tracers      rn_sponge_tra = ', rn_sponge_tra 
     872         WRITE(numout,*) '      ad. sponge coeft for dynamics     rn_sponge_tra = ', rn_sponge_dyn 
     873         WRITE(numout,*) '      ad. time relaxation for tracers   rn_trelax_tra = ', rn_trelax_tra 
     874         WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn 
    764875         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    765876         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    766877      ENDIF 
    767       ! 
    768       ! 
    769       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     878 
     879      lk_west  = .NOT. ( Agrif_Ix() == 1 ) 
     880      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 
     881      lk_south = .NOT. ( Agrif_Iy() == 1 ) 
     882      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 
     883 
     884      ! 
     885      ! Set the number of ghost cells according to periodicity 
     886      nbghostcells_x = nbghostcells 
     887      nbghostcells_y_s = nbghostcells 
     888      nbghostcells_y_n = nbghostcells 
     889      ! 
     890      IF ( jperio == 1 ) nbghostcells_x = 0 
     891      IF ( .NOT. lk_south ) nbghostcells_y_s = 0 
     892 
     893      ! Some checks 
     894      IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x )   & 
     895          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 
     896      IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )   & 
     897          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 
     898      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    770899      ! 
    771900   END SUBROUTINE agrif_nemo_init 
    772901 
    773902# if defined key_mpp_mpi 
    774  
    775903   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    776904      !!---------------------------------------------------------------------- 
     
    831959# endif 
    832960 
     961   SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 
     962      !!---------------------------------------------------------------------- 
     963      !!                   *** ROUTINE Nemo_mapping *** 
     964      !!---------------------------------------------------------------------- 
     965      USE dom_oce 
     966      !! 
     967      IMPLICIT NONE 
     968      ! 
     969      INTEGER :: ndim 
     970      INTEGER :: ptx, pty 
     971      INTEGER, DIMENSION(ndim,2,2) :: bounds 
     972      INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 
     973      LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 
     974      INTEGER :: nb_chunks 
     975      ! 
     976      INTEGER :: i 
     977 
     978      IF (agrif_debug_interp) THEN 
     979         DO i=1,ndim 
     980            WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 
     981         ENDDO 
     982      ENDIF 
     983 
     984      IF( bounds(2,2,2) > jpjglo) THEN 
     985         IF( bounds(2,1,2) <=jpjglo) THEN 
     986            nb_chunks = 2 
     987            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     988            ALLOCATE(correction_required(nb_chunks)) 
     989            DO i = 1,nb_chunks 
     990               bounds_chunks(i,:,:,:) = bounds 
     991            END DO 
     992         
     993      ! FIRST CHUNCK (for j<=jpjglo)    
     994 
     995      ! Original indices 
     996            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     997            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     998            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     999            bounds_chunks(1,2,2,1) = jpjglo 
     1000 
     1001            bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1002            bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1003            bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1004            bounds_chunks(1,2,2,2) = jpjglo 
     1005 
     1006      ! Correction required or not 
     1007            correction_required(1)=.FALSE. 
     1008        
     1009      ! SECOND CHUNCK (for j>jpjglo) 
     1010 
     1011      ! Original indices 
     1012            bounds_chunks(2,1,1,1) = bounds(1,1,2) 
     1013            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1014            bounds_chunks(2,2,1,1) = jpjglo-2 
     1015            bounds_chunks(2,2,2,1) = bounds(2,2,2) 
     1016 
     1017      ! Where to find them 
     1018      ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 
     1019 
     1020            IF( ptx == 2) THEN ! T, V points 
     1021               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1022               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1023            ELSE ! U, F points 
     1024               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1025               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1026            ENDIF 
     1027 
     1028            IF( pty == 2) THEN ! T, U points 
     1029               bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1030               bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo) 
     1031            ELSE ! V, F points 
     1032               bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1033               bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo) 
     1034            ENDIF 
     1035      ! Correction required or not 
     1036            correction_required(2)=.TRUE. 
     1037 
     1038         ELSE 
     1039            nb_chunks = 1 
     1040            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1041            ALLOCATE(correction_required(nb_chunks)) 
     1042            DO i=1,nb_chunks 
     1043               bounds_chunks(i,:,:,:) = bounds 
     1044            END DO 
     1045 
     1046            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1047            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1048            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1049            bounds_chunks(1,2,2,1) = bounds(2,2,2) 
     1050 
     1051            bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1052            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1053 
     1054            bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 
     1055            bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 
     1056 
     1057            IF( ptx == 2) THEN ! T, V points 
     1058               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1059               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1060            ELSE ! U, F points 
     1061               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1062               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1063            ENDIF 
     1064 
     1065            IF (pty == 2) THEN ! T, U points 
     1066               bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1067               bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 
     1068            ELSE ! V, F points 
     1069               bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1070               bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 
     1071            ENDIF 
     1072 
     1073            correction_required(1)=.TRUE.           
     1074         ENDIF 
     1075 
     1076      ELSE IF (bounds(1,1,2) < 1) THEN 
     1077         IF (bounds(1,2,2) > 0) THEN 
     1078            nb_chunks = 2 
     1079            ALLOCATE(correction_required(nb_chunks)) 
     1080            correction_required=.FALSE. 
     1081            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1082            DO i=1,nb_chunks 
     1083               bounds_chunks(i,:,:,:) = bounds 
     1084            END DO 
     1085               
     1086            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1087            bounds_chunks(1,1,2,2) = 1+jpiglo-2 
     1088           
     1089            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1090            bounds_chunks(1,1,2,1) = 1 
     1091        
     1092            bounds_chunks(2,1,1,2) = 2 
     1093            bounds_chunks(2,1,2,2) = bounds(1,2,2) 
     1094           
     1095            bounds_chunks(2,1,1,1) = 2 
     1096            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1097 
     1098         ELSE 
     1099            nb_chunks = 1 
     1100            ALLOCATE(correction_required(nb_chunks)) 
     1101            correction_required=.FALSE. 
     1102            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1103            DO i=1,nb_chunks 
     1104               bounds_chunks(i,:,:,:) = bounds 
     1105            END DO     
     1106            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1107            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 
     1108           
     1109            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1110           bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1111         ENDIF 
     1112      ELSE 
     1113         nb_chunks=1   
     1114         ALLOCATE(correction_required(nb_chunks)) 
     1115         correction_required=.FALSE. 
     1116         ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1117         DO i=1,nb_chunks 
     1118            bounds_chunks(i,:,:,:) = bounds 
     1119         END DO 
     1120         bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1121         bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1122         bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1123         bounds_chunks(1,2,2,2) = bounds(2,2,2) 
     1124           
     1125         bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1126         bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1127         bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1128         bounds_chunks(1,2,2,1) = bounds(2,2,2)               
     1129      ENDIF 
     1130         
     1131   END SUBROUTINE nemo_mapping 
     1132 
     1133   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
     1134 
     1135   USE dom_oce 
     1136 
     1137   INTEGER :: ptx, pty, i1, isens 
     1138   INTEGER :: agrif_external_switch_index 
     1139 
     1140   IF( isens == 1 ) THEN 
     1141      IF( ptx == 2 ) THEN ! T, V points 
     1142         agrif_external_switch_index = jpiglo-i1+2 
     1143      ELSE ! U, F points 
     1144         agrif_external_switch_index = jpiglo-i1+1       
     1145      ENDIF 
     1146   ELSE IF( isens ==2 ) THEN 
     1147      IF ( pty == 2 ) THEN ! T, U points 
     1148         agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1149      ELSE ! V, F points 
     1150         agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1151      ENDIF 
     1152   ENDIF 
     1153 
     1154   END FUNCTION agrif_external_switch_index 
     1155 
     1156   SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 
     1157      !!---------------------------------------------------------------------- 
     1158      !!                   *** ROUTINE Correct_field *** 
     1159      !!---------------------------------------------------------------------- 
     1160    
     1161   USE dom_oce 
     1162   USE agrif_oce 
     1163 
     1164   INTEGER :: i1,i2,j1,j2 
     1165   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1166 
     1167   INTEGER :: i,j 
     1168   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1169 
     1170   tab2dtemp = tab2d 
     1171 
     1172   IF( .NOT. use_sign_north ) THEN 
     1173      DO j=j1,j2 
     1174         DO i=i1,i2 
     1175            tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1176         END DO 
     1177      END DO 
     1178   ELSE 
     1179      DO j=j1,j2 
     1180         DO i=i1,i2 
     1181            tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1182         END DO 
     1183      END DO 
     1184   ENDIF 
     1185 
     1186   END SUBROUTINE Correct_field 
     1187 
    8331188#else 
    8341189   SUBROUTINE Subcalledbyagrif 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/dom_oce.F90

    r12993 r13229  
    214214#if defined key_agrif 
    215215   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .TRUE.    !: agrif flag 
     216   LOGICAL, PUBLIC            ::   lk_south, lk_north, lk_west, lk_east !: Child grid boundaries (interpolation or not) 
    216217#else 
    217218   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90

    r13176 r13229  
    187187      ENDIF 
    188188      ! 
     189 
    189190      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    190191      ! 
     192 
     193#if defined key_agrif 
     194      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
     195#endif 
    191196      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file 
    192197      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
     
    296301902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' ) 
    297302      IF(lwm) WRITE ( numond, namrun ) 
     303 
     304#if defined key_agrif 
     305      IF( .NOT. Agrif_Root() ) THEN 
     306            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 
     307            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot() 
     308      ENDIF 
     309#endif 
    298310      ! 
    299311      IF(lwp) THEN                  ! control print 
     
    388400      IF(lwm) WRITE( numond, namdom ) 
    389401      ! 
     402#if defined key_agrif 
     403      IF( .NOT. Agrif_Root() ) THEN 
     404            rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 
     405      ENDIF 
     406#endif 
     407      ! 
    390408      IF(lwp) THEN 
    391409         WRITE(numout,*) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/istate.F90

    r13124 r13229  
    3434   USE lib_mpp         ! MPP library 
    3535   USE restart         ! restart 
     36#if defined key_agrif 
     37   USE agrif_oce_interp 
     38   USE agrif_oce 
     39#endif    
    3640 
    3741   IMPLICIT NONE 
     
    6973!!gm  Why not include in the first call of dta_tsd ?   
    7074!!gm  probably associated with the use of internal damping... 
    71                      CALL dta_tsd_init        ! Initialisation of T & S input data 
     75       CALL dta_tsd_init        ! Initialisation of T & S input data 
    7276!!gm to be moved in usrdef of C1D case 
    7377!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     
    8387#endif 
    8488 
     89#if defined key_agrif 
     90      IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 
     91         numror = 0                           ! define numror = 0 -> no restart file to read 
     92         ln_1st_euler = .true.                ! Set time-step indicator at nit000 (euler forward) 
     93         CALL day_init  
     94         CALL agrif_istate( Kbb, Kmm, Kaa )   ! Interp from parent 
     95         ! 
     96         ts  (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb)  
     97         ssh (:,:,Kmm)     = ssh(:,:,Kbb) 
     98         uu   (:,:,:,Kmm)   = uu  (:,:,:,Kbb) 
     99         vv   (:,:,:,Kmm)   = vv  (:,:,:,Kbb) 
     100      ELSE 
     101#endif 
    85102      IF( ln_rstart ) THEN                    ! Restart from a file 
    86103         !                                    ! ------------------- 
     
    99116            ! 
    100117            ssh(:,:,Kbb)   = 0._wp               ! set the ocean at rest 
     118            uu  (:,:,:,Kbb) = 0._wp 
     119            vv  (:,:,:,Kbb) = 0._wp   
     120            ! 
    101121            IF( ll_wd ) THEN 
    102122               ssh(:,:,Kbb) =  -ssh_ref  ! Added in 30 here for bathy that adds 30 as Iterative test CEOD  
     
    110130               END_2D 
    111131            ENDIF  
    112             uu  (:,:,:,Kbb) = 0._wp 
    113             vv  (:,:,:,Kbb) = 0._wp   
    114             ! 
     132             ! 
    115133         ELSE                                 ! user defined initial T and S 
    116134            CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb)  )          
     
    147165         !  
    148166      ENDIF  
     167#if defined key_agrif 
     168      ENDIF 
     169#endif 
    149170      !  
    150171      ! Initialize "now" and "before" barotropic velocities: 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/dynspg_ts.F90

    r13065 r13229  
    513513         END_2D 
    514514         ! 
     515         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
     516         IF( ln_bdy )   CALL bdy_ssh( ssha_e ) 
     517#if defined key_agrif 
     518         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn ) 
     519#endif 
     520 
    515521         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
    516522         ! 
     
    525531         END IF 
    526532         ! 
    527          ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
    528          IF( ln_bdy )   CALL bdy_ssh( ssha_e ) 
    529 #if defined key_agrif 
    530          IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn ) 
    531 #endif 
    532533         !   
    533534         ! Sea Surface Height at u-,v-points (vvl case only) 
     
    643644         ENDIF 
    644645        
    645          IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only) 
     646         IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 
    646647            hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 
    647648            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 
    648649            hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 
    649650            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 
     651         ENDIF 
     652         !                                                 ! open boundaries 
     653         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 
     654#if defined key_agrif                                                            
     655         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif 
     656#endif 
     657         ! 
     658         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only) 
    650659            CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  & 
    651660                 &                         , hu_e , 'U',  1._wp, hv_e , 'V',  1._wp  & 
     
    655664         ENDIF 
    656665         ! 
    657          ! 
    658          !                                                 ! open boundaries 
    659          IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 
    660 #if defined key_agrif                                                            
    661          IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif 
    662 #endif 
    663666         !                                             !* Swap 
    664667         !                                             !  ---- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DYN/sshwzv.F90

    r13138 r13229  
    200200      ENDIF 
    201201      ! 
     202#if defined key_agrif  
    202203      IF( .NOT. AGRIF_Root() ) THEN 
    203204         ! 
     
    206207         DO jk = 1, jpkm1 
    207208            ! --- West --- ! 
    208             DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 
    209                DO jj = 1, jpj 
    210                   pww(ji,jj,jk) = 0._wp  
     209            IF( lk_west ) THEN 
     210               DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 
     211                  DO jj = 1, jpj 
     212                     pww(ji,jj,jk) = 0._wp  
     213                  END DO 
    211214               END DO 
    212             END DO 
     215            ENDIF 
    213216            ! 
    214217            ! --- East --- ! 
    215             DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 
    216                DO jj = 1, jpj 
    217                   pww(ji,jj,jk) = 0._wp 
     218            IF( lk_east ) THEN 
     219               DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 
     220                  DO jj = 1, jpj 
     221                     pww(ji,jj,jk) = 0._wp 
     222                  END DO 
    218223               END DO 
    219             END DO 
     224            ENDIF 
    220225            ! 
    221226            ! --- South --- ! 
    222             DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 
    223                DO ji = 1, jpi 
    224                   pww(ji,jj,jk) = 0._wp 
     227            IF( lk_south ) THEN 
     228               DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 
     229                  DO ji = 1, jpi 
     230                     pww(ji,jj,jk) = 0._wp 
     231                  END DO 
    225232               END DO 
    226             END DO 
     233            ENDIF 
    227234            ! 
    228235            ! --- North --- ! 
    229             DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 
    230                DO ji = 1, jpi 
    231                   pww(ji,jj,jk) = 0._wp 
     236            IF( lk_north ) THEN 
     237               DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 
     238                  DO ji = 1, jpi 
     239                     pww(ji,jj,jk) = 0._wp 
     240                  END DO 
    232241               END DO 
    233             END DO 
     242            ENDIF 
    234243         END DO 
    235244         ! 
    236245      ENDIF  
     246#endif 
    237247      ! 
    238248      IF( ln_timing )   CALL timing_stop('wzv') 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/FLO/floblk.F90

    r12939 r13229  
    4141      INTEGER, INTENT( in  ) ::   Kbb, Kmm ! ocean time level indices 
    4242      !! 
     43#ifndef key_agrif 
     44 
     45!RB super quick fix to compile with agrif 
     46 
    4347      INTEGER :: jfl              ! dummy loop arguments 
    4448      INTEGER :: ind, ifin, iloop 
     
    364368         GO TO 222 
    365369      ENDIF 
     370#endif 
    366371      ! 
    367372      ! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90

    r13130 r13229  
    11121112                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
    11131113                     idmspc = idmspc - 1 
    1114                   ELSE 
    1115                      CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   & 
    1116                         &                         'we do not accept data with '//cldmspc//' spatial dimensions',   & 
    1117                         &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
     1114                  !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation 
     1115                  !ELSE 
     1116                  !   CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,',   & 
     1117                  !      &                         'we do not accept data with '//cldmspc//' spatial dimensions'  ,   & 
     1118                  !      &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
    11181119                  ENDIF 
    11191120            ENDIF 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lib_mpp.F90

    r13124 r13229  
    137137 
    138138   ! Communications summary report 
    139    CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines 
    140    CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines 
    141    CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_dlg                   !: names of delayed global comm calling routines 
     139   CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines 
     140   CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines 
     141   CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE ::   crname_dlg                   !: names of delayed global comm calling routines 
    142142   INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp 
    143143   INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90

    r13176 r13229  
    103103            &           'the domain is lay out for distributed memory computing!' ) 
    104104         ! 
     105#if defined key_agrif 
     106    IF (.NOT.agrif_root()) THEN 
     107      call agrif_nemo_init() 
     108    ENDIF 
     109#endif 
    105110   END SUBROUTINE mpp_init 
    106111 
     
    341346            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpjglo == nbcellsy + 2*( nbghostcells + 1 + nn_hls )' ) 
    342347         IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' ) 
     348         CALL agrif_nemo_init() 
    343349      ENDIF 
    344350#endif 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/OBS/diaobs.F90

    r12489 r13229  
    9494   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdataqc   !: Profile data after quality control 
    9595 
    96    CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
     96   CHARACTER(len=lca), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
    9797 
    9898   !!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcblk.F90

    r13186 r13229  
    7474#endif 
    7575 
    76    INTEGER , PUBLIC            ::   jpfld         ! maximum number of files to read 
    77    INTEGER , PUBLIC, PARAMETER ::   jp_wndi = 1   ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    78    INTEGER , PUBLIC, PARAMETER ::   jp_wndj = 2   ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    79    INTEGER , PUBLIC, PARAMETER ::   jp_tair = 3   ! index of 10m air temperature             (Kelvin) 
    80    INTEGER , PUBLIC, PARAMETER ::   jp_humi = 4   ! index of specific humidity               ( % ) 
    81    INTEGER , PUBLIC, PARAMETER ::   jp_qsr  = 5   ! index of solar heat                      (W/m2) 
    82    INTEGER , PUBLIC, PARAMETER ::   jp_qlw  = 6   ! index of Long wave                       (W/m2) 
    83    INTEGER , PUBLIC, PARAMETER ::   jp_prec = 7   ! index of total precipitation (rain+snow) (Kg/m2/s) 
    84    INTEGER , PUBLIC, PARAMETER ::   jp_snow = 8   ! index of snow (solid prcipitation)       (kg/m2/s) 
    85    INTEGER , PUBLIC, PARAMETER ::   jp_slp  = 9   ! index of sea level pressure              (Pa) 
    86    INTEGER , PUBLIC, PARAMETER ::   jp_hpgi =10   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 
    87    INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
    88  
     76   INTEGER , PUBLIC, PARAMETER ::   jp_wndi  =  1   ! index of 10m wind velocity (i-component) (m/s)    at T-point 
     77   INTEGER , PUBLIC, PARAMETER ::   jp_wndj  =  2   ! index of 10m wind velocity (j-component) (m/s)    at T-point 
     78   INTEGER , PUBLIC, PARAMETER ::   jp_tair  =  3   ! index of 10m air temperature             (Kelvin) 
     79   INTEGER , PUBLIC, PARAMETER ::   jp_humi  =  4   ! index of specific humidity               ( % ) 
     80   INTEGER , PUBLIC, PARAMETER ::   jp_qsr   =  5   ! index of solar heat                      (W/m2) 
     81   INTEGER , PUBLIC, PARAMETER ::   jp_qlw   =  6   ! index of Long wave                       (W/m2) 
     82   INTEGER , PUBLIC, PARAMETER ::   jp_prec  =  7   ! index of total precipitation (rain+snow) (Kg/m2/s) 
     83   INTEGER , PUBLIC, PARAMETER ::   jp_snow  =  8   ! index of snow (solid prcipitation)       (kg/m2/s) 
     84   INTEGER , PUBLIC, PARAMETER ::   jp_slp   =  9   ! index of sea level pressure              (Pa) 
     85   INTEGER , PUBLIC, PARAMETER ::   jp_uoatm = 10   ! index of surface current (i-component) 
     86   !                                                !          seen by the atmospheric forcing (m/s) at T-point 
     87   INTEGER , PUBLIC, PARAMETER ::   jp_voatm = 11   ! index of surface current (j-component) 
     88   !                                                !          seen by the atmospheric forcing (m/s) at T-point 
     89   INTEGER , PUBLIC, PARAMETER ::   jp_hpgi  = 12   ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 
     90   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj  = 13   ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
     91   INTEGER , PUBLIC, PARAMETER ::   jpfld    = 13   ! maximum number of files to read 
     92 
     93   ! Warning: keep this structure allocatable for Agrif... 
    8994   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input atmospheric fields (file informations, fields read) 
    9095 
     
    98103   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
    99104   ! 
     105   LOGICAL  ::   ln_crt_fbk     ! Add surface current feedback to the wind stress computation  (Renault et al. 2020) 
     106   REAL(wp) ::   rn_stau_a      ! Alpha and Beta coefficients of Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta 
     107   REAL(wp) ::   rn_stau_b      !  
     108   ! 
    100109   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation 
    101110   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation 
    102    REAL(wp), PUBLIC ::   rn_vfac   ! multiplication factor for ice/ocean velocity in the calculation of wind stress 
    103111   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements 
    104112   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements 
    105113   ! 
    106    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
    107    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme) 
    108    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
     114   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral coeffs over ocean (L15 bulk scheme and ABL) 
     115   REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
     116   REAL(wp),         ALLOCATABLE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 
    109117 
    110118   LOGICAL  ::   ln_skin_cs     ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB 
     
    113121   LOGICAL  ::   ln_humi_dpt    ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB 
    114122   LOGICAL  ::   ln_humi_rlh    ! humidity read in files ("sn_humi") is relative humidity     [%] if .true. !LB 
     123   LOGICAL  ::   ln_tpot        !!GS: flag to compute or not potential temperature 
    115124   ! 
    116125   INTEGER  ::   nhumi          ! choice of the bulk algorithm 
     
    162171      !! 
    163172      CHARACTER(len=100)            ::   cn_dir                ! Root directory for location of atmospheric forcing files 
    164       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i        ! array of namelist informations on the fields to read 
    165       TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    166       TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
    167       TYPE(FLD_N) ::   sn_slp , sn_hpgi, sn_hpgj               !       "                        " 
     173      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
     174      TYPE(FLD_N) ::   sn_wndi, sn_wndj , sn_humi, sn_qsr      ! informations about the fields to be read 
     175      TYPE(FLD_N) ::   sn_qlw , sn_tair , sn_prec, sn_snow     !       "                        " 
     176      TYPE(FLD_N) ::   sn_slp , sn_uoatm, sn_voatm             !       "                        " 
     177      TYPE(FLD_N) ::   sn_hpgi, sn_hpgj                        !       "                        " 
     178      INTEGER     ::   ipka                                    ! number of levels in the atmospheric variable 
    168179      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    169          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj,       & 
     180         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm,     & 
     181         &                 sn_hpgi, sn_hpgj,                                          & 
    170182         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF,             &   ! bulk algorithm 
    171183         &                 cn_dir , rn_zqt, rn_zu,                                    & 
    172          &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15,           & 
     184         &                 rn_pfac, rn_efac, ln_Cd_L12, ln_Cd_L15, ln_tpot,           & 
     185         &                 ln_crt_fbk, rn_stau_a, rn_stau_b,                          &   ! current feedback 
    173186         &                 ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh  ! cool-skin / warm-layer !LB 
    174187      !!--------------------------------------------------------------------- 
     
    242255      !                                   !* set the bulk structure 
    243256      !                                      !- store namelist information in an array 
    244       IF( ln_blk ) jpfld = 9 
    245       IF( ln_abl ) jpfld = 11 
    246       ALLOCATE( slf_i(jpfld) ) 
    247       ! 
    248       slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    249       slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw 
    250       slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    251       slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    252       slf_i(jp_slp ) = sn_slp 
    253       IF( ln_abl ) THEN 
    254          slf_i(jp_hpgi) = sn_hpgi   ;   slf_i(jp_hpgj) = sn_hpgj 
    255       END IF 
     257      ! 
     258      slf_i(jp_wndi ) = sn_wndi    ;   slf_i(jp_wndj ) = sn_wndj 
     259      slf_i(jp_qsr  ) = sn_qsr     ;   slf_i(jp_qlw  ) = sn_qlw 
     260      slf_i(jp_tair ) = sn_tair    ;   slf_i(jp_humi ) = sn_humi 
     261      slf_i(jp_prec ) = sn_prec    ;   slf_i(jp_snow ) = sn_snow 
     262      slf_i(jp_slp  ) = sn_slp 
     263      slf_i(jp_uoatm) = sn_uoatm   ;   slf_i(jp_voatm) = sn_voatm 
     264      slf_i(jp_hpgi ) = sn_hpgi    ;   slf_i(jp_hpgj ) = sn_hpgj 
     265      ! 
     266      IF( .NOT. ln_abl ) THEN   ! force to not use jp_hpgi and jp_hpgj, should already be done in namelist_* but we never know... 
     267         slf_i(jp_hpgi)%clname = 'NOT USED' 
     268         slf_i(jp_hpgj)%clname = 'NOT USED' 
     269      ENDIF 
    256270      ! 
    257271      !                                      !- allocate the bulk structure 
     
    264278      DO jfpr= 1, jpfld 
    265279         ! 
    266          IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
    267             ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
    268             sf(jfpr)%fnow(:,:,1) = 0._wp 
     280         IF(   ln_abl    .AND.                                                      & 
     281            &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   & 
     282            &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN 
     283            ipka = jpka   ! ABL: some fields are 3D input 
     284         ELSE 
     285            ipka = 1 
     286         ENDIF 
     287         ! 
     288         ALLOCATE( sf(jfpr)%fnow(jpi,jpj,ipka) ) 
     289         ! 
     290         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to default) 
     291            IF(     jfpr == jp_slp  ) THEN 
     292               sf(jfpr)%fnow(:,:,1:ipka) = 101325._wp   ! use standard pressure in Pa 
     293            ELSEIF( jfpr == jp_prec .OR. jfpr == jp_snow .OR. jfpr == jp_uoatm .OR. jfpr == jp_voatm ) THEN 
     294               sf(jfpr)%fnow(:,:,1:ipka) = 0._wp        ! no precip or no snow or no surface currents 
     295            ELSEIF( ( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) .AND. .NOT. ln_abl ) THEN 
     296               DEALLOCATE( sf(jfpr)%fnow )              ! deallocate as not used in this case 
     297            ELSE 
     298               WRITE(ctmp1,*) 'sbc_blk_init: no default value defined for field number', jfpr 
     299               CALL ctl_stop( ctmp1 ) 
     300            ENDIF 
    269301         ELSE                                                  !-- used field  --! 
    270             IF(   ln_abl    .AND.                                                      & 
    271                &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   & 
    272                &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input 
    273                ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 
    274                IF( sf(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 
    275             ELSE                                                                                ! others or Bulk fields are 2D fiels 
    276                ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
    277                IF( sf(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
    278             ENDIF 
     302            IF( sf(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,ipka,2) )   ! allocate array for temporal interpolation 
    279303            ! 
    280304            IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 )   & 
     
    327351         WRITE(numout,*) '      factor applied on precipitation (total & snow)      rn_pfac      = ', rn_pfac 
    328352         WRITE(numout,*) '      factor applied on evaporation                       rn_efac      = ', rn_efac 
    329          WRITE(numout,*) '      factor applied on ocean/ice velocity                rn_vfac      = ', rn_vfac 
    330353         WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))' 
    331354         WRITE(numout,*) '      use ice-atm drag from Lupkes2012                    ln_Cd_L12    = ', ln_Cd_L12 
    332355         WRITE(numout,*) '      use ice-atm drag from Lupkes2015                    ln_Cd_L15    = ', ln_Cd_L15 
     356         WRITE(numout,*) '      use surface current feedback on wind stress         ln_crt_fbk   = ', ln_crt_fbk 
     357         IF(ln_crt_fbk) THEN 
     358         WRITE(numout,*) '         Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta' 
     359         WRITE(numout,*) '            Alpha                                         rn_stau_a    = ', rn_stau_a 
     360         WRITE(numout,*) '            Beta                                          rn_stau_b    = ', rn_stau_b 
     361         ENDIF 
    333362         ! 
    334363         WRITE(numout,*) 
     
    429458      !                                            ! compute the surface ocean fluxes using bulk formulea 
    430459      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    431          CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in 
    432             &                sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1),   &   !   <<= in 
    433             &                sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m,       &   !   <<= in 
    434             &                sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
    435             &                tsk_m, zssq, zcd_du, zsen, zevp )                       !   =>> out 
    436  
    437          CALL blk_oce_2(     sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1),   &   !   <<= in 
    438             &                sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1),   &   !   <<= in 
    439             &                sf(jp_snow)%fnow(:,:,1), tsk_m,                     &   !   <<= in 
    440             &                zsen, zevp )                                            !   <=> in out 
     460         CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1),   &   !   <<= in 
     461            &                sf(jp_tair )%fnow(:,:,1), sf(jp_humi )%fnow(:,:,1),   &   !   <<= in 
     462            &                sf(jp_slp  )%fnow(:,:,1), sst_m, ssu_m, ssv_m,        &   !   <<= in 
     463            &                sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1),   &   !   <<= in 
     464            &                sf(jp_qsr  )%fnow(:,:,1), sf(jp_qlw  )%fnow(:,:,1),   &   !   <<= in (wl/cs) 
     465            &                tsk_m, zssq, zcd_du, zsen, zevp )                         !   =>> out 
     466 
     467         CALL blk_oce_2(     sf(jp_tair )%fnow(:,:,1), sf(jp_qsr  )%fnow(:,:,1),   &   !   <<= in 
     468            &                sf(jp_qlw  )%fnow(:,:,1), sf(jp_prec )%fnow(:,:,1),   &   !   <<= in 
     469            &                sf(jp_snow )%fnow(:,:,1), tsk_m,                      &   !   <<= in 
     470            &                zsen, zevp )                                              !   <=> in out 
    441471      ENDIF 
    442472      ! 
     
    470500 
    471501 
    472    SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi, &  ! inp 
    473       &                  pslp , pst   , pu   , pv,        &  ! inp 
    474       &                  pqsr , pqlw  ,                   &  ! inp 
    475       &                  ptsk, pssq , pcd_du, psen , pevp   )  ! out 
     502   SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, phumi,        &  ! inp 
     503      &                      pslp , pst  , pu   , pv,            &  ! inp 
     504      &                      puatm, pvatm, pqsr , pqlw ,         &  ! inp 
     505      &                      ptsk , pssq , pcd_du, psen, pevp   )   ! out 
    476506      !!--------------------------------------------------------------------- 
    477507      !!                     ***  ROUTINE blk_oce_1  *** 
     
    498528      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pu     ! surface current at U-point (i-component) [m/s] 
    499529      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pv     ! surface current at V-point (j-component) [m/s] 
     530      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   puatm  ! surface current seen by the atm at T-point (i-component) [m/s] 
     531      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pvatm  ! surface current seen by the atm at T-point (j-component) [m/s] 
    500532      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqsr   ! 
    501533      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqlw   ! 
     
    508540      INTEGER  ::   ji, jj               ! dummy loop indices 
    509541      REAL(wp) ::   zztmp                ! local variable 
     542      REAL(wp) ::   zstmax, zstau 
     543#if defined key_cyclone 
    510544      REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
     545#endif 
     546      REAL(wp), DIMENSION(jpi,jpj) ::   ztau_i, ztau_j    ! wind stress components at T-point 
    511547      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    512548      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
     
    532568      zwnd_j(:,:) = 0._wp 
    533569      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    534       DO_2D_00_00 
    535          pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 
    536          pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 
     570      DO_2D_11_11 
     571         zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 
     572         zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 
     573         ! ... scalar wind at T-point (not masked) 
     574         wndm(ji,jj) = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) 
     575      END_2D 
     576#else 
     577      ! ... scalar wind module at T-point (not masked) 
     578      DO_2D_11_11 
     579         wndm(ji,jj) = SQRT(  pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj)  ) 
    537580      END_2D 
    538581#endif 
    539       DO_2D_00_00 
    540          zwnd_i(ji,jj) = (  pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    541          zwnd_j(ji,jj) = (  pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    542       END_2D 
    543       CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. ) 
    544       ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    545       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    546          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
    547  
    548582      ! ----------------------------------------------------------------------------- ! 
    549583      !      I   Solar FLUX                                                           ! 
     
    593627         !#LB: because AGRIF hates functions that return something else than a scalar, need to 
    594628         !     use scalar version of gamma_moist() ... 
    595          DO_2D_11_11 
    596             ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
    597          END_2D 
    598       ENDIF 
    599  
    600  
     629         IF( ln_tpot ) THEN 
     630            DO_2D_11_11 
     631               ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
     632            END_2D 
     633         ELSE 
     634            ztpot = ptair(:,:) 
     635         ENDIF 
     636      ENDIF 
    601637 
    602638      !! Time to call the user-selected bulk parameterization for 
     
    674710         pevp(:,:) = pevp(:,:) * tmask(:,:,1) 
    675711 
    676          ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array... 
    677          zcd_oce = 0._wp 
    678          WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm 
    679          zwnd_i = zcd_oce * zwnd_i 
    680          zwnd_j = zcd_oce * zwnd_j 
    681  
    682          CALL iom_put( "taum_oce", taum )   ! output wind stress module 
     712         DO_2D_11_11 
     713            IF( wndm(ji,jj) > 0._wp ) THEN 
     714               zztmp = taum(ji,jj) / wndm(ji,jj) 
     715#if defined key_cyclone 
     716               ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
     717               ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
     718#else 
     719               ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 
     720               ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 
     721#endif 
     722            ELSE 
     723               ztau_i(ji,jj) = 0._wp 
     724               ztau_j(ji,jj) = 0._wp                  
     725            ENDIF 
     726         END_2D 
     727 
     728         IF( ln_crt_fbk ) THEN   ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715) 
     729            zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp )   ! set the max value of Stau corresponding to a wind of 3 m/s (<0) 
     730            DO_2D_01_01   ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop 
     731               zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax )   ! stau (<0) must be smaller than zstmax 
     732               ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj  ) + pu(ji,jj) ) - puatm(ji,jj) ) 
     733               ztau_j(ji,jj) = ztau_j(ji,jj) + zstau * ( 0.5_wp * ( pv(ji  ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) ) 
     734               taum(ji,jj) = SQRT( ztau_i(ji,jj) * ztau_i(ji,jj) + ztau_j(ji,jj) * ztau_j(ji,jj) ) 
     735            END_2D 
     736         ENDIF 
    683737 
    684738         ! ... utau, vtau at U- and V_points, resp. 
    685739         !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    686740         !     Note that coastal wind stress is not used in the code... so this extra care has no effect 
    687          DO_2D_00_00 
    688             utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zwnd_i(ji,jj) + zwnd_i(ji+1,jj  ) ) & 
    689                &          * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
    690             vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) ) & 
    691                &          * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
     741         DO_2D_00_00              ! start loop at 2, in case ln_crt_fbk = T 
     742            utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj  ) ) & 
     743               &              * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 
     744            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( ztau_j(ji,jj) + ztau_j(ji  ,jj+1) ) & 
     745               &              * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 
    692746         END_2D 
    693          CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     747 
     748         IF( ln_crt_fbk ) THEN 
     749            CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 
     750         ELSE 
     751            CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     752         ENDIF 
     753 
     754         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    694755 
    695756         IF(sn_cfctl%l_prtctl) THEN 
     
    862923      ! 
    863924      INTEGER  ::   ji, jj    ! dummy loop indices 
    864       REAL(wp) ::   zwndi_t , zwndj_t             ! relative wind components at T-point 
    865925      REAL(wp) ::   zootm_su                      ! sea-ice surface mean temperature 
    866926      REAL(wp) ::   zztmp1, zztmp2                ! temporary arrays 
     
    873933      ! ------------------------------------------------------------ ! 
    874934      ! C-grid ice dynamics :   U & V-points (same as ocean) 
    875       DO_2D_00_00 
    876          zwndi_t = (  pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj  ) + puice(ji,jj) )  ) 
    877          zwndj_t = (  pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji  ,jj-1) + pvice(ji,jj) )  ) 
    878          wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     935      DO_2D_11_11 
     936         wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 
    879937      END_2D 
    880       CALL lbc_lnk( 'sbcblk', wndm_ice, 'T',  1. ) 
    881938      ! 
    882939      ! Make ice-atm. drag dependent on ice concentration 
     
    898955 
    899956      IF( ln_blk ) THEN 
    900          ! ------------------------------------------------------------- ! 
    901          !    Wind stress relative to the moving ice ( U10m - U_ice )    ! 
    902          ! ------------------------------------------------------------- ! 
    903          zztmp1 = rn_vfac * 0.5_wp 
     957         ! ---------------------------------------------------- ! 
     958         !    Wind stress relative to nonmoving ice ( U10m )    ! 
     959         ! ---------------------------------------------------- ! 
     960         ! supress moving ice in wind stress computation as we don't know how to do it properly... 
    904961         DO_2D_01_01    ! at T point  
    905             putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj  ) + puice(ji,jj) ) ) 
    906             pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji  ,jj-1) + pvice(ji,jj) ) ) 
     962            putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 
     963            pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 
    907964         END_2D 
    908965         ! 
     
    918975         IF(sn_cfctl%l_prtctl)  CALL prt_ctl( tab2d_1=putaui  , clinfo1=' blk_ice: putaui : '   & 
    919976            &                               , tab2d_2=pvtaui  , clinfo2='          pvtaui : ' ) 
    920       ELSE 
     977      ELSE ! ln_abl 
    921978         zztmp1 = 11637800.0_wp 
    922979         zztmp2 =    -5897.8_wp 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcblk_phy.F90

    r12939 r13229  
    640640      !!                           ***  FUNCTION alpha_sw_vctr  *** 
    641641      !! 
    642       !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (P =~ 1010 hpa) 
     642      !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 
    643643      !! 
    644644      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
     
    654654      !!                           ***  FUNCTION alpha_sw_sclr  *** 
    655655      !! 
    656       !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (P =~ 1010 hpa) 
     656      !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 
    657657      !! 
    658658      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcmod.F90

    r13015 r13229  
    121121#endif 
    122122      ! 
     123      ! 
    123124      IF(lwp) THEN                  !* Control print 
    124125         WRITE(numout,*) '   Namelist namsbc (partly overwritten with CPP key setting)' 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/STO/stopar.F90

    r12939 r13229  
    5656   INTEGER,          DIMENSION(:),       ALLOCATABLE :: sto3d_ord  ! order of autoregressive process 
    5757 
    58    CHARACTER(len=1), DIMENSION(:),       ALLOCATABLE :: sto2d_typ  ! nature of grid point (T, U, V, W, F, I) 
    59    CHARACTER(len=1), DIMENSION(:),       ALLOCATABLE :: sto3d_typ  ! nature of grid point (T, U, V, W, F, I) 
     58   CHARACTER(len=lca), DIMENSION(:),       ALLOCATABLE :: sto2d_typ  ! nature of grid point (T, U, V, W, F, I) 
     59   CHARACTER(len=lca), DIMENSION(:),       ALLOCATABLE :: sto3d_typ  ! nature of grid point (T, U, V, W, F, I) 
    6060   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto2d_sgn  ! control of the sign accross the north fold 
    6161   REAL(wp),         DIMENSION(:),       ALLOCATABLE :: sto3d_sgn  ! control of the sign accross the north fold 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traqsr.F90

    r12738 r13229  
    110110      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         - 
    111111      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    112       REAL(wp) ::   zz0 , zz1                !    -         - 
    113       REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
    114       REAL(wp) ::   zlogc, zlogc2, zlogc3  
    115       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
    116       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    117       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
     112      REAL(wp) ::   zz0 , zz1 , ze3t, zlui   !    -         - 
     113      REAL(wp) ::   zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze 
     114      REAL(wp) ::   zlogc, zlogze, zlogCtot, zlogCze 
     115      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: ze0, ze1, ze2, ze3 
     116      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d 
    118117      !!---------------------------------------------------------------------- 
    119118      ! 
     
    160159      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    161160         ! 
    162          ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , & 
    163             &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , & 
    164             &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   )  
     161         ALLOCATE( ze0 (jpi,jpj)           , ze1 (jpi,jpj) ,  & 
     162            &      ze2 (jpi,jpj)           , ze3 (jpi,jpj) ,  & 
     163            &      ztmp3d(jpi,jpj,nksr + 1)                     ) 
    165164         ! 
    166165         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    167166            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
     167            ! 
     168            ! Separation in R-G-B depending on the surface Chl 
     169            ! perform and store as many of the 2D calculations as possible 
     170            ! before the 3D loop (use the temporary 2D arrays to replace the 
     171            ! most expensive calculations) 
     172            ! 
     173            DO_2D_00_00 
     174                       ! zlogc = log(zchl) 
     175               zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )      
     176                       ! zc1 : log(zCze)  = log (1.12  * zchl**0.803) 
     177               zc1   = 0.113328685307 + 0.803 * zlogc                          
     178                       ! zc2 : log(zCtot) = log(40.6  * zchl**0.459) 
     179               zc2   = 3.703768066608 + 0.459 * zlogc                            
     180                       ! zc3 : log(zze)   = log(568.2 * zCtot**(-0.746)) 
     181               zc3   = 6.34247346942  - 0.746 * zc2                            
     182                       ! IF( log(zze) > log(102.) ) log(zze) = log(200.0 * zCtot**(-0.293)) 
     183               IF( zc3 > 4.62497281328 ) zc3 = 5.298317366548 - 0.293 * zc2         
     184               !    
     185               ze0(ji,jj) = zlogc                                                 ! ze0 = log(zchl) 
     186               ze1(ji,jj) = EXP( zc1 )                                            ! ze1 = zCze 
     187               ze2(ji,jj) = 1._wp / ( 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) ) ! ze2 = 1/zdelpsi 
     188               ze3(ji,jj) = EXP( - zc3 )                                          ! ze3 = 1/zze 
     189            END_2D 
     190             
     191! 
     192            DO_3D_00_00 ( 1, nksr + 1 ) 
     193               ! zchl    = ALOG( ze0(ji,jj) ) 
     194               zlogc = ze0(ji,jj) 
     195               ! 
     196               zCb       = 0.768 + zlogc * ( 0.087 - zlogc * ( 0.179 + zlogc * 0.025 ) ) 
     197               zCmax     = 0.299 - zlogc * ( 0.289 - zlogc * 0.579 ) 
     198               zpsimax   = 0.6   - zlogc * ( 0.640 - zlogc * ( 0.021 + zlogc * 0.115 ) ) 
     199               ! zdelpsi = 0.710 + zlogc * ( 0.159 + zlogc * 0.021 ) 
     200               ! 
     201               zCze   = ze1(ji,jj) 
     202               zrdpsi = ze2(ji,jj)                                                 ! 1/zdelpsi 
     203               zpsi   = ze3(ji,jj) * gdepw(ji,jj,jk,Kmm)                           ! gdepw/zze 
     204               ! 
     205               ! NB. make sure zchl value is such that: zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
     206               zchl = MIN( 10. , MAX( 0.03, zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) * zrdpsi )**2 ) ) ) ) 
     207               ! Convert chlorophyll value to attenuation coefficient look-up table index 
     208               ztmp3d(ji,jj,jk) = 41 + 20.*LOG10(zchl) + 1.e-15 
     209            END_3D 
     210         ELSE                                !* constant chlorophyll 
     211            zchl = 0.05 
     212            ! NB. make sure constant value is such that:  
     213            zchl = MIN( 10. , MAX( 0.03, zchl ) ) 
     214            ! Convert chlorophyll value to attenuation coefficient look-up table index 
     215            zlui = 41 + 20.*LOG10(zchl) + 1.e-15 
    168216            DO jk = 1, nksr + 1 
    169                DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl 
    170                   DO ji = 2, jpim1 
    171                      zchl    = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
    172                      zCtot   = 40.6  * zchl**0.459 
    173                      zze     = 568.2 * zCtot**(-0.746) 
    174                      IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 
    175                      zpsi    = gdepw(ji,jj,jk,Kmm) / zze 
    176                      ! 
    177                      zlogc   = LOG( zchl ) 
    178                      zlogc2  = zlogc * zlogc 
    179                      zlogc3  = zlogc * zlogc * zlogc 
    180                      zCb     = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 
    181                      zCmax   = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 
    182                      zpsimax = 0.6   - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 
    183                      zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 
    184                      zCze    = 1.12  * (zchl)**0.803  
    185                      ! 
    186                      zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 
    187                   END DO 
    188                   ! 
    189                END DO 
     217               ztmp3d(:,:,jk) = zlui  
    190218            END DO 
    191          ELSE                                !* constant chrlorophyll 
    192            DO jk = 1, nksr + 1 
    193               zchl3d(:,:,jk) = 0.05  
    194             ENDDO 
    195219         ENDIF 
    196220         ! 
    197221         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    198222         DO_2D_00_00 
    199             ze0(ji,jj,1) = rn_abs * qsr(ji,jj) 
    200             ze1(ji,jj,1) = zcoef  * qsr(ji,jj) 
    201             ze2(ji,jj,1) = zcoef  * qsr(ji,jj) 
    202             ze3(ji,jj,1) = zcoef  * qsr(ji,jj) 
    203             zea(ji,jj,1) =          qsr(ji,jj) 
     223            ze0(ji,jj) = rn_abs * qsr(ji,jj) 
     224            ze1(ji,jj) = zcoef  * qsr(ji,jj) 
     225            ze2(ji,jj) = zcoef  * qsr(ji,jj) 
     226            ze3(ji,jj) = zcoef  * qsr(ji,jj) 
     227            ! store the surface SW radiation; re-use the surface ztmp3d array  
     228            ! since the surface attenuation coefficient is not used 
     229            ztmp3d(ji,jj,1) =       qsr(ji,jj) 
    204230         END_2D 
    205231         ! 
    206          DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
    207             DO_2D_00_00 
    208                zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 
    209                irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    210                zekb(ji,jj) = rkrgb(1,irgb) 
    211                zekg(ji,jj) = rkrgb(2,irgb) 
    212                zekr(ji,jj) = rkrgb(3,irgb) 
    213             END_2D 
    214  
    215             DO_2D_00_00 
    216                zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       ) 
    217                zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 
    218                zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 
    219                zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 
    220                ze0(ji,jj,jk) = zc0 
    221                ze1(ji,jj,jk) = zc1 
    222                ze2(ji,jj,jk) = zc2 
    223                ze3(ji,jj,jk) = zc3 
    224                zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
    225             END_2D 
    226          END DO 
     232         !* interior equi-partition in R-G-B depending on vertical profile of Chl 
     233         DO_3D_00_00 ( 2, nksr + 1 ) 
     234            ze3t = e3t(ji,jj,jk-1,Kmm) 
     235            irgb = NINT( ztmp3d(ji,jj,jk) ) 
     236            zc0 = ze0(ji,jj) * EXP( - ze3t * xsi0r ) 
     237            zc1 = ze1(ji,jj) * EXP( - ze3t * rkrgb(1,irgb) ) 
     238            zc2 = ze2(ji,jj) * EXP( - ze3t * rkrgb(2,irgb) ) 
     239            zc3 = ze3(ji,jj) * EXP( - ze3t * rkrgb(3,irgb) ) 
     240            ze0(ji,jj) = zc0 
     241            ze1(ji,jj) = zc1 
     242            ze2(ji,jj) = zc2 
     243            ze3(ji,jj) = zc3 
     244            ztmp3d(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
     245         END_3D 
    227246         ! 
    228247         DO_3D_00_00( 1, nksr ) 
    229             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
     248            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 
    230249         END_3D 
    231250         ! 
    232          DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )  
     251         DEALLOCATE( ze0 , ze1 , ze2 , ze3 , ztmp3d )  
    233252         ! 
    234253      CASE( np_2BD  )            !==  2-bands fluxes  ==! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_hgr.F90

    r13176 r13229  
    9595#if defined key_agrif 
    9696      ! ! Upper left longitude and latitude from parent: 
     97      ! Laurent: Should be modify in case of an east-west cyclic parent grid 
    9798      IF (.NOT.Agrif_root()) THEN 
    9899         zlam0 = zlam1 + Agrif_irhox() * REAL(Agrif_Parent(Ni0glo) -2, wp) * ze1deg * zcos_alpha  & 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_nam.F90

    r13065 r13229  
    7373#if defined key_agrif 
    7474      IF( .NOT. Agrif_Root() ) THEN 
    75          kpi  = nbcellsx + 2 * ( nbghostcells + 1 )   ! Global Domain size: add nbghostcells + 1 "land" point on each side 
    76          kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     75         kpi  = nbcellsx + 2 * ( nbghostcells_x  + 1 )   ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     76         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    7777      ENDIF 
    7878#endif 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/nemogcm.F90

    r13176 r13229  
    145145#if defined key_agrif 
    146146      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    147       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    148       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     147      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
    149148# if defined key_top 
    150149      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    151 # endif 
    152 # if defined key_si3 
    153       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    154150# endif 
    155151#endif 
     
    402398      ! Initialise time level indices 
    403399      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    404  
     400#if defined key_agrif 
     401      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     402#endif  
    405403      !                             !-------------------------------! 
    406404      !                             !  NEMO general initialization  ! 
     
    417415      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration 
    418416                           CALL     wad_init        ! Wetting and drying options 
     417 
     418#if defined key_agrif 
     419     CALL Agrif_Declare_Var_ini   !  "      "   "   "      "  DOM 
     420#endif 
    419421                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
     422 
     423 
     424 
    420425      IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization  
    421426      IF( sn_cfctl%l_prtctl )   & 
     
    438443      ENDIF 
    439444      ! 
    440        
     445 
    441446                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
    442447 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_kind.F90

    r10068 r13229  
    3131    
    3232   !                                                                !!** Integer ** 
    33    INTEGER, PUBLIC, PARAMETER ::   lc = 256                          !: Lenght of Character strings 
     33   INTEGER, PUBLIC, PARAMETER ::   lc  = 256                          !: Lenght of Character strings 
     34   INTEGER, PUBLIC, PARAMETER ::   lca = 400                          !: Lenght of Character arrays 
    3435 
    3536   !!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_oce.F90

    r13065 r13229  
    4747   ! global domain size for AGRIF     !!! * total AGRIF computational domain * 
    4848   INTEGER, PUBLIC            ::   nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1 
    49    INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3                                          !: number of ghost cells 
    50    INTEGER, PUBLIC            ::   nbcellsx   ! = jpiglo - 2 * (nbghostcells + 1 + nn_hls)   !: number of cells in i-direction 
    51    INTEGER, PUBLIC            ::   nbcellsy   ! = jpjglo - 2 * (nbghostcells + 1 + nn_hls)   !: number of cells in j-direction 
     49   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3 !: number of ghost cells: default value 
     50   INTEGER, PUBLIC            ::   nbghostcells_x   !: number of ghost cells in i-direction 
     51   INTEGER, PUBLIC            ::   nbghostcells_y_s   !: number of ghost cells in j-direction at south 
     52   INTEGER, PUBLIC            ::   nbghostcells_y_n   !: number of ghost cells in j-direction at north                       !: number of ghost cells 
     53   INTEGER, PUBLIC            ::   nbcellsx   ! = jpiglo - 2 - 2*nbghostcells_x   !: number of cells in i-direction 
     54   INTEGER, PUBLIC            ::   nbcellsy   ! = jpjglo - 2 - 2*nbghostcells-y   !: number of cells in j-direction 
    5255 
    5356   ! local domain size                !!! * local computational domain * 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/stpctl.F90

    r13186 r13229  
    119119      !                                   !==            test of local extrema           ==! 
    120120      !                                   !==  done by all processes at every time step  ==! 
    121       ! 
    122       ! define zmax default value. needed for land processors 
    123       IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
    124          zmax(:) = -HUGE(1._wp) 
    125       ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
    126          zmax(:) =  0._wp 
    127          zmax(3) = -1._wp      ! avoid salinity minimum at 0. 
    128       ENDIF 
    129       ! 
    130121      llmsk(:,:,1) = ssmask(:,:) == 1._wp 
    131       IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    132          IF( ll_wd ) THEN 
    133             zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     122      IF( ll_wd ) THEN 
     123         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     124      ELSE 
     125         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
     126      ENDIF 
     127      llmsk(:,:,:) = umask(:,:,:) == 1._wp 
     128      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
     129      llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
     130      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
     131      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     132      IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
     133         zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
     134         zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     135         IF( ln_zad_Aimp ) THEN 
     136            zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
     137            llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
     138            zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = llmsk )                  ! implicit vertical vel. max 
    134139         ELSE 
    135             zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
    136          ENDIF 
    137       ENDIF 
    138       zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) )                                       ! velocity max (zonal only) 
    139       llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
    140       IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    141          zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
    142          zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
    143          IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
    144             zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
    145             zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
    146             IF( ln_zad_Aimp ) THEN 
    147                zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
    148                llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
    149                IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    150                   zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk )                  ! implicit vertical vel. max 
    151                ENDIF 
    152             ENDIF 
    153          ENDIF 
     140            zmax(7:8) = 0._wp 
     141         ENDIF 
     142      ELSE 
     143         zmax(5:8) = 0._wp 
    154144      ENDIF 
    155145      zmax(9) = REAL( nstop, wp )                                              ! stop indicator 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAS/nemogcm.F90

    r13176 r13229  
    9393#if defined key_agrif 
    9494      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    95       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    9695      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    9796# if defined key_top 
    9897      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    99 # endif 
    100 # if defined key_si3 
    101       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    10298# endif 
    10399#endif 
     
    348344      ! Initialise time level indices 
    349345      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
     346#if defined key_agrif 
     347      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     348#endif  
    350349 
    351350      !                             !-------------------------------! 
     
    361360                           CALL phy_cst         ! Physical constants 
    362361                           CALL eos_init        ! Equation of seawater 
     362#if defined key_agrif 
     363     CALL Agrif_Declare_Var_ini   !  "      "   "   "      "  DOM 
     364#endif 
    363365                           CALL dom_init( Nbb, Nnn, Naa, 'SAS') ! Domain 
    364366      IF( sn_cfctl%l_prtctl )   & 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/CANAL/MY_SRC/stpctl.F90

    r13186 r13229  
    119119      !                                   !==            test of local extrema           ==! 
    120120      !                                   !==  done by all processes at every time step  ==! 
    121       ! 
    122       ! define zmax default value. needed for land processors 
    123       IF( ll_colruns ) THEN    ! default value: must not be kept when calling mpp_max -> must be as small as possible 
    124          zmax(:) = -HUGE(1._wp) 
    125       ELSE                     ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 
    126          zmax(:) =  0._wp 
    127          zmax(3) = -1._wp      ! avoid salinity minimum at 0. 
    128       ENDIF 
    129       ! 
    130121      llmsk(:,:,1) = ssmask(:,:) == 1._wp 
    131       IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    132          IF( ll_wd ) THEN 
    133             zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     122      IF( ll_wd ) THEN 
     123         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) )   ! ssh max 
     124      ELSE 
     125         zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
     126      ENDIF 
     127      llmsk(:,:,:) = umask(:,:,:) == 1._wp 
     128      zmax(2) = MAXVAL(  ABS( uu(:,:,:,Kmm) ), mask = llmsk )                     ! velocity max (zonal only) 
     129      llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
     130      zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
     131      zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
     132      IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
     133         zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
     134         zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
     135         IF( ln_zad_Aimp ) THEN 
     136            zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
     137            llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
     138            zmax(8) = MAXVAL(  ABS( wi(:,:,:) ) , mask = llmsk )                  ! implicit vertical vel. max 
    134139         ELSE 
    135             zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm)           ), mask = llmsk(:,:,1) )   ! ssh max 
    136          ENDIF 
    137       ENDIF 
    138       zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) )                                       ! velocity max (zonal only) 
    139       llmsk(:,:,:) = tmask(:,:,:) == 1._wp 
    140       IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    141          zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     ! minus salinity max 
    142          zmax(4) = MAXVAL(  ts(:,:,:,jp_sal,Kmm), mask = llmsk )                     !       salinity max 
    143          IF( ll_colruns .OR. jpnij == 1 ) THEN     ! following variables are used only in the netcdf file 
    144             zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  ! minus temperature max 
    145             zmax(6) = MAXVAL(  ts(:,:,:,jp_tem,Kmm), mask = llmsk )                  !       temperature max 
    146             IF( ln_zad_Aimp ) THEN 
    147                zmax(7) = MAXVAL(   Cu_adv(:,:,:)   , mask = llmsk )                  ! partitioning coeff. max 
    148                llmsk(:,:,:) = wmask(:,:,:) == 1._wp 
    149                IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN   ! avoid huge values sent back for land processors... 
    150                   zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk )                  ! implicit vertical vel. max 
    151                ENDIF 
    152             ENDIF 
    153          ENDIF 
     140            zmax(7:8) = 0._wp 
     141         ENDIF 
     142      ELSE 
     143         zmax(5:8) = 0._wp 
    154144      ENDIF 
    155145      zmax(9) = REAL( nstop, wp )                                              ! stop indicator 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/README.rst

    r11743 r13229  
    205205   :style: unsrt 
    206206   :labelprefix: T 
     207 
     208CPL_OASIS 
     209--------- 
     210| This test case checks the OASIS interface in OCE/SBC, allowing to set up  
     211a coupled configuration through OASIS. See CPL_OASIS/README.md for more information. 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/STATION_ASF/EXPREF/launch_sasf.sh

    r13186 r13229  
    11#!/bin/bash 
    22 
    3 ################################################################ 
    4 # 
    5 # Script to launch a set of STATION_ASF simulations 
    6 # 
    7 # L. Brodeau, 2020 
    8 # 
    9 ################################################################ 
     3# NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 
     4NEMO_DIR=`pwd | sed -e "s|/tests/STATION_ASF/EXPREF||g"` 
    105 
    11 # What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 
     6echo "Using NEMO_DIR=${NEMO_DIR}" 
     7 
     8# what directory inside "tests" actually contains the compiled test-case? 
    129TC_DIR="STATION_ASF2" 
    1310 
    14 # DATA_IN_DIR => Directory containing sea-surface + atmospheric forcings 
     11# => so the executable to use is: 
     12NEMO_EXE="${NEMO_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 
     13 
     14# Directory where to run the simulation: 
     15WORK_DIR="${HOME}/tmp/STATION_ASF" 
     16 
     17 
     18# FORC_DIR => Directory containing sea-surface + atmospheric forcings 
    1519#             (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 
    1620if [ `hostname` = "merlat"        ]; then 
    17     DATA_IN_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     21    FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    1822elif [ `hostname` = "luitel"        ]; then 
    19     DATA_IN_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     23    FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    2024elif [ `hostname` = "ige-meom-cal1" ]; then 
    21     DATA_IN_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     25    FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    2226elif [ `hostname` = "salvelinus" ]; then 
    23     DATA_IN_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
     27    FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 
    2428else 
    25     echo "Oops! We don't know `hostname` yet! Define 'DATA_IN_DIR' in the script!"; exit  
     29    echo "Boo!"; exit 
    2630fi 
    27  
    28 expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 
    29  
    30 # NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe + setup: 
    31 NEMO_WRK_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 
    32  
    33 # Directory where to run the simulation: 
    34 PROD_DIR="${HOME}/tmp/STATION_ASF" 
     31#====================== 
     32mkdir -p ${WORK_DIR} 
    3533 
    3634 
    37 ####### End of normal user configurable section ####### 
     35if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 
    3836 
    39 #================================================================================ 
    40  
    41 # NEMO executable to use is: 
    42 NEMO_EXE="${NEMO_WRK_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 
    43  
    44  
    45 echo "###########################################################" 
    46 echo "#        S T A T I O N   A i r  -  S e a   F l u x        #" 
    47 echo "###########################################################" 
    48 echo 
    49 echo " We shall work in here: ${STATION_ASF_DIR}/" 
    50 echo " NEMOGCM   work    depository is: ${NEMO_WRK_DIR}/" 
    51 echo "   ==> NEMO EXE to use: ${NEMO_EXE}" 
    52 echo " Input forcing data into: ${DATA_IN_DIR}/" 
    53 echo " Production will be done into: ${PROD_DIR}/" 
    54 echo 
    55  
    56 mkdir -p ${PROD_DIR} 
    57  
    58 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 
    59  
    60 echo 
    61 echo " *** Using the following NEMO executable:" 
    62 echo "  ${NEMO_EXE} " 
    63 echo 
    64  
    65 NEMO_EXPREF="${NEMO_WRK_DIR}/tests/STATION_ASF/EXPREF" 
     37NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF" 
    6638if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi 
    6739 
    68 rsync -avP ${NEMO_EXE}          ${PROD_DIR}/ 
     40rsync -avP ${NEMO_EXE}          ${WORK_DIR}/ 
    6941 
    7042for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 
    7143    if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi 
    72     rsync -avPL ${NEMO_EXPREF}/${ff} ${PROD_DIR}/ 
     44    rsync -avPL ${NEMO_EXPREF}/${ff} ${WORK_DIR}/ 
    7345done 
    7446 
    7547# Copy forcing to work directory: 
    76 rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/ 
     48rsync -avP ${FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/ 
    7749 
    7850for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 
     
    8658    scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 
    8759 
    88     rm -f ${PROD_DIR}/namelist_cfg 
    89     rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg 
     60    rm -f ${WORK_DIR}/namelist_cfg 
     61    rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${WORK_DIR}/namelist_cfg 
    9062 
    91     cd ${PROD_DIR}/ 
     63    cd ${WORK_DIR}/ 
    9264    echo 
    9365    echo "Launching NEMO !" 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/VORTEX/EXPREF/1_namelist_cfg

    r12489 r13229  
    9898&namagrif      !  AGRIF zoom                                            ("key_agrif") 
    9999!----------------------------------------------------------------------- 
    100    ln_spc_dyn    = .true.  !  use 0 as special value for dynamics 
    101    rn_sponge_tra =  800.   !  coefficient for tracer   sponge layer [m2/s] 
    102    rn_sponge_dyn =  800.   !  coefficient for dynamics sponge layer [m2/s] 
    103    ln_chk_bathy  = .FALSE. ! 
     100   rn_sponge_tra =  0.00768   !  coefficient for tracer   sponge layer [] 
     101   rn_sponge_dyn =  0.00768   !  coefficient for dynamics sponge layer [] 
    104102/ 
    105103!!====================================================================== 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/demo_cfgs.txt

    r12377 r13229  
    1111BENCH OCE ICE TOP 
    1212STATION_ASF OCE 
     13CPL_OASIS  OCE TOP ICE NST 
Note: See TracChangeset for help on using the changeset viewer.