Changeset 13571


Ignore:
Timestamp:
2020-10-06T18:17:44+02:00 (7 months ago)
Author:
mocavero
Message:

Align branch with trunk

Location:
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src
Files:
166 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/ice.F90

    r12489 r13571  
    7070   !! a_ip        |      -      |    Ice pond concentration       |       | 
    7171   !! v_ip        |      -      |    Ice pond volume per unit area| m     | 
     72   !! v_il        |    v_il_1d  |    Ice pond lid volume per area | m     | 
    7273   !!                                                                     | 
    7374   !!-------------|-------------|---------------------------------|-------| 
     
    8586   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     | 
    8687   !! h_ip        | h_ip_1d     |    Ice pond thickness           | m     | 
     88   !! h_il        | h_il_1d     |    Ice pond lid thickness       | m     | 
    8789   !!                                                                     | 
    8890   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   | 
     
    112114   !! hm_ip       |      -      |    Mean ice pond depth          | m     | 
    113115   !! vt_ip       |      -      |    Total ice pond vol. per unit area| m | 
     116   !! hm_il       |      -      |    Mean ice pond lid depth      | m     | 
     117   !! vt_il       |      -      |    Total ice pond lid vol. per area | m | 
    114118   !!===================================================================== 
    115119 
     
    137141   REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice 
    138142   LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016  
    139    REAL(wp), PUBLIC ::   rn_depfra        !:    fraction of ocean depth that ice must reach to initiate landfast ice 
    140    REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)  
    141    REAL(wp), PUBLIC ::   rn_lfrelax       !:    relaxation time scale (s-1) to reach static friction 
    142    REAL(wp), PUBLIC ::   rn_tensile       !:    isotropic tensile strength 
     143   REAL(wp), PUBLIC ::   rn_lf_depfra     !:    fraction of ocean depth that ice must reach to initiate landfast ice 
     144   REAL(wp), PUBLIC ::   rn_lf_bfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)  
     145   REAL(wp), PUBLIC ::   rn_lf_relax      !:    relaxation time scale (s-1) to reach static friction 
     146   REAL(wp), PUBLIC ::   rn_lf_tensile    !:    isotropic tensile strength 
    143147   ! 
    144148   !                                     !!** ice-ridging/rafting namelist (namdyn_rdgrft) ** 
     
    151155   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
    152156   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     157   INTEGER , PUBLIC ::   nn_rhg_chkcvg    !: check ice rheology convergence  
    153158   ! 
    154159   !                                     !!** ice-advection namelist (namdyn_adv) ** 
     
    158163   !                                     !!** ice-surface boundary conditions namelist (namsbc) ** 
    159164                                          ! -- icethd_dh -- ! 
    160    REAL(wp), PUBLIC ::   rn_blow_s        !: coef. for partitioning of snowfall between leads and sea ice 
     165   REAL(wp), PUBLIC ::   rn_snwblow       !: coef. for partitioning of snowfall between leads and sea ice 
     166                                          ! -- icethd_zdf and icealb -- ! 
     167   INTEGER , PUBLIC ::   nn_snwfra        !: calculate the fraction of ice covered by snow 
     168   !                                      !   = 0  fraction = 1 (if snow) or 0 (if no snow) 
     169   !                                      !   = 1  fraction = 1-exp(-0.2*rhos*hsnw) [MetO formulation] 
     170   !                                      !   = 2  fraction = hsnw / (hsnw+0.02)    [CICE formulation] 
    161171                                          ! -- icethd -- ! 
    162172   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     
    166176   !                                      !   = 1  Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity 
    167177   !                                      !   = 2  Redistribute a single flux over categories 
     178                                          ! -- icethd_zdf -- ! 
    168179   LOGICAL , PUBLIC ::   ln_cndflx        !: use conduction flux as surface boundary condition (instead of qsr and qns)  
    169180   LOGICAL , PUBLIC ::   ln_cndemulate    !: emulate conduction flux (if not provided)  
     
    172183   INTEGER, PUBLIC, PARAMETER ::   np_cnd_ON  = 1  !: forcing from conduction flux (SM0L) (compute qcn and qsr_tr via sbcblk.F90 or sbccpl.F90) 
    173184   INTEGER, PUBLIC, PARAMETER ::   np_cnd_EMU = 2  !: emulate conduction flux via icethd_zdf.F90 (BL99) (1st round compute qcn and qsr_tr, 2nd round use it) 
    174  
     185   INTEGER, PUBLIC ::   nn_qtrice         !: Solar flux transmitted thru the surface scattering layer: 
     186   !                                      !   = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow)  
     187   !                                      !   = 1  Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 
     188   ! 
    175189   !                                     !!** ice-vertical diffusion namelist (namthd_zdf) ** 
    176190   LOGICAL , PUBLIC ::   ln_cndi_U64      !: thermal conductivity: Untersteiner (1964) 
    177191   LOGICAL , PUBLIC ::   ln_cndi_P07      !: thermal conductivity: Pringle et al (2007) 
    178    REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    179192   REAL(wp), PUBLIC ::   rn_cnd_s         !: thermal conductivity of the snow [W/m/K]    
     193   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation in sea ice, Grenfell et al. (2006) [1/m] 
     194   REAL(wp), PUBLIC ::   rn_kappa_s       !: coef. for the extinction of radiation in snw (nn_qtrice=0) [1/m] 
     195   REAL(wp), PUBLIC ::   rn_kappa_smlt    !: coef. for the extinction of radiation in melt snw (nn_qtrice=1) [1/m] 
     196   REAL(wp), PUBLIC ::   rn_kappa_sdry    !: coef. for the extinction of radiation in dry  snw (nn_qtrice=1) [1/m] 
     197   LOGICAL , PUBLIC ::   ln_zdf_chkcvg    !: check convergence of heat diffusion scheme 
    180198 
    181199   !                                     !!** ice-salinity namelist (namthd_sal) ** 
     
    190208   !                                     !!** ice-ponds namelist (namthd_pnd) 
    191209   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    192    LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012 
     210   LOGICAL , PUBLIC ::   ln_pnd_LEV       !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 
     211   REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum ice fraction that contributes to melt ponds 
     212   REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum ice fraction that contributes to melt ponds 
    193213   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    194214   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    195215   REAL(wp), PUBLIC ::   rn_hpnd          !: prescribed pond depth    (0<rn_hpnd<1) 
     216   LOGICAL,  PUBLIC ::   ln_pnd_lids      !: Allow ponds to have frozen lids 
    196217   LOGICAL , PUBLIC ::   ln_pnd_alb       !: melt ponds affect albedo 
    197218 
     
    218239 
    219240   !                                     !!** define arrays 
    220    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce,v_oce !: surface ocean velocity used in ice dynamics 
    221    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_i_new    !: ice collection thickness accreted in leads 
    222    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
    223    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
    224    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i     !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
    225    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i      !: Divergence of the velocity field             [s-1] 
    226    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i     !: Shear of the velocity field                  [s-1] 
    227    ! 
    228    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    229    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
    230    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsb_ice_bot !: net downward heat flux from the ice to the ocean 
    231    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    232  
    233    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: mass flux from snow-ocean mass exchange             [kg.m-2.s-1] 
    234    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sni !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 
    235    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sum !: mass flux from surface melt component of wfx_snw    [kg.m-2.s-1] 
    236    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_pnd     !: mass flux from melt pond-ocean mass exchange        [kg.m-2.s-1] 
    237    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: mass flux from snow precipitation on ice            [kg.m-2.s-1] 
    238    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: mass flux from sublimation of snow/ice              [kg.m-2.s-1] 
    239    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sub !: mass flux from snow sublimation                     [kg.m-2.s-1] 
    240    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice_sub !: mass flux from ice sublimation                      [kg.m-2.s-1] 
    241  
    242    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_dyn !: mass flux from dynamical component of wfx_snw       [kg.m-2.s-1] 
    243  
    244    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: mass flux from ice-ocean mass exchange                   [kg.m-2.s-1] 
    245    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: mass flux from snow ice growth component of wfx_ice      [kg.m-2.s-1] 
    246    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: mass flux from lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
    247    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: mass flux from bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
    248    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
    249    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: mass flux from bottom melt component of wfx_ice          [kg.m-2.s-1] 
    250    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: mass flux from surface melt component of wfx_ice         [kg.m-2.s-1] 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_lam     !: mass flux from lateral melt component of wfx_ice         [kg.m-2.s-1] 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                        [kg.m-2.s-1] 
    254  
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1] 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice bottom melt                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_lam     !: salt flux due to ice lateral melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice surface melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
    259    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to snow-ice growth                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    260    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to growth in open water                [pss.kg.m-2.s-1 => g.m-2.s-1] 
    261    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation         [pss.kg.m-2.s-1 => g.m-2.s-1] 
    263    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] 
    264    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sub     !: salt flux due to ice sublimation                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
    265  
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth           [W.m-2] 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt             [W.m-2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt            [W.m-2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation    [W.m-2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice      [W.m-2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                             [W.m-2] 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping => must be 0   [W.m-2] 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_atm_oi   !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_oce_ai   !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
     241   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_oce,v_oce     !: surface ocean velocity used in ice dynamics 
     242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht_i_new        !: ice collection thickness accreted in leads 
     243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   strength        !: ice strength 
     244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
     245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   delta_i         !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
     246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   divu_i          !: Divergence of the velocity field             [s-1] 
     247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   shear_i         !: Shear of the velocity field                  [s-1] 
     248   ! 
     249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   t_bo            !: Sea-Ice bottom temperature [Kelvin]      
     250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qlead           !: heat balance of the lead (or of the open ocean) 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsb_ice_bot     !: net downward heat flux from the ice to the ocean 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fhld            !: heat flux from the lead used for bottom melting 
     253 
     254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw         !: mass flux from snow-ocean mass exchange             [kg.m-2.s-1] 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sni     !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sum     !: mass flux from surface melt component of wfx_snw    [kg.m-2.s-1] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_pnd         !: mass flux from melt pond-ocean mass exchange        [kg.m-2.s-1] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_spr         !: mass flux from snow precipitation on ice            [kg.m-2.s-1] 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sub         !: mass flux from sublimation of snow/ice              [kg.m-2.s-1] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sub     !: mass flux from snow sublimation                     [kg.m-2.s-1] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_ice_sub     !: mass flux from ice sublimation                      [kg.m-2.s-1] 
     262 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_dyn     !: mass flux from dynamical component of wfx_snw       [kg.m-2.s-1] 
     264 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_ice         !: mass flux from ice-ocean mass exchange                   [kg.m-2.s-1] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sni         !: mass flux from snow ice growth component of wfx_ice      [kg.m-2.s-1] 
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_opw         !: mass flux from lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_bog         !: mass flux from bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_dyn         !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_bom         !: mass flux from bottom melt component of wfx_ice          [kg.m-2.s-1] 
     271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sum         !: mass flux from surface melt component of wfx_ice         [kg.m-2.s-1] 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_lam         !: mass flux from lateral melt component of wfx_ice         [kg.m-2.s-1] 
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_res         !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_err_sub     !: mass flux error after sublimation                        [kg.m-2.s-1] 
     275 
     276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_bog         !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1] 
     277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_bom         !: salt flux due to ice bottom melt                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_lam         !: salt flux due to ice lateral melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
     279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_sum         !: salt flux due to ice surface melt                    [pss.kg.m-2.s-1 => g.m-2.s-1] 
     280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_sni         !: salt flux due to snow-ice growth                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_opw         !: salt flux due to growth in open water                [pss.kg.m-2.s-1 => g.m-2.s-1] 
     282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_bri         !: salt flux due to brine rejection                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_dyn         !: salt flux due to porous ridged ice formation         [pss.kg.m-2.s-1 => g.m-2.s-1] 
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_res         !: salt flux due to correction on ice thick. (residual) [pss.kg.m-2.s-1 => g.m-2.s-1] 
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sfx_sub         !: salt flux due to ice sublimation                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     286 
     287   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_bog         !: total heat flux causing bottom ice growth           [W.m-2] 
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_bom         !: total heat flux causing bottom ice melt             [W.m-2] 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sum         !: total heat flux causing surface ice melt            [W.m-2] 
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_opw         !: total heat flux causing open water ice formation    [W.m-2] 
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_dif         !: total heat flux causing Temp change in the ice      [W.m-2] 
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_snw         !: heat flux for snow melt                             [W.m-2] 
     293   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_err_dif     !: heat flux remaining due to change in non-solar flux [W.m-2] 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_atm_oi       !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_oce_ai       !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
    276296    
    277297   ! heat flux associated with ice-atmosphere mass exchange 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation            [W.m-2] 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  [W.m-2] 
     298   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sub         !: heat flux for sublimation            [W.m-2] 
     299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_spr         !: heat flux of the snow precipitation  [W.m-2] 
    280300 
    281301   ! heat flux associated with ice-ocean mass exchange 
    282    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from ridging                      [W.m-2] 
    284    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: heat flux due to correction on ice thick. (residual)  [W.m-2] 
    285  
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot    !: transmitted solar radiation under ice 
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice         !: temperature of the first layer                (ln_cndflx=T) [K] 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice        !: effective conductivity at the top of ice/snow (ln_cndflx=T) [W.m-2.K-1] 
     302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_thd         !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
     303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_dyn         !: ice-ocean heat flux from ridging                      [W.m-2] 
     304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_res         !: heat flux due to correction on ice thick. (residual)  [W.m-2] 
     305 
     306   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d      !: maximum ice concentration 2d array 
     307   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot     !: transmitted solar radiation under ice 
     308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice          !: temperature of the first layer          (ln_cndflx=T) [K] 
     309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice         !: effective conductivity of the 1st layer (ln_cndflx=T) [W.m-2.K-1] 
    290310 
    291311   !!---------------------------------------------------------------------- 
     
    293313   !!---------------------------------------------------------------------- 
    294314   !! Variables defined for each ice category 
    295    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness                           (m) 
    296    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
    297    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area                (m) 
    298    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area               (m) 
    299    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_s       !: Snow thickness                          (m) 
    300    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature             (K) 
    301    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   s_i       !: Sea-Ice Bulk salinity                   (pss) 
    302    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sv_i      !: Sea-Ice Bulk salinity * volume per area (pss.m) 
    303    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age                             (s) 
    304    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area              (s) 
    305    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume 
     315   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_i           !: Ice thickness                           (m) 
     316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i           !: Ice fractional areas (concentration) 
     317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_i           !: Ice volume per unit area                (m) 
     318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s           !: Snow volume per unit area               (m) 
     319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_s           !: Snow thickness                          (m) 
     320   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   t_su          !: Sea-Ice Surface Temperature             (K) 
     321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   s_i           !: Sea-Ice Bulk salinity                   (pss) 
     322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sv_i          !: Sea-Ice Bulk salinity * volume per area (pss.m) 
     323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   o_i           !: Sea-Ice Age                             (s) 
     324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   oa_i          !: Sea-Ice Age times ice area              (s) 
     325   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   bv_i          !: brine volume 
    306326 
    307327   !! Variables summed over all categories, or associated to all the ice in a single grid cell 
    308    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity                          (m/s) 
    309    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area                 (m) 
    310    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   st_i         !: Total ice salinity content                              (pss.m) 
    311    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
    312    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
    313    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s  !: ice and snow total heat content                         (J/m2) 
    314    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories                (K) 
    315    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_s         !: mean snw temperature over all categories                (K) 
    316    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories 
    317    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sm_i         !: mean sea ice salinity averaged over all categories      (pss) 
    318    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories            (K) 
    319    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_i         !: mean ice  thickness over all categories                 (m) 
    320    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_s         !: mean snow thickness over all categories                 (m) 
    321    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories                        (s) 
    322    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction on ocean bottom (landfast param activated) 
    323  
    324    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures     [K] 
    325    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow enthalpy         [J/m2] 
    326    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures      [K] 
    327    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice enthalpy          [J/m2] 
    328    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i     !: ice salinity          [PSS] 
    329  
    330    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond concentration 
    331    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area      [m] 
    332    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond fraction (a_ip/a_i) 
    333    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond depth                          [m] 
    334  
    335    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond concentration 
    336    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_ip      !: mean melt pond depth                     [m] 
    337    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per gridcell area [m] 
    338  
    339    !!---------------------------------------------------------------------- 
    340    !! * Old values of global variables 
    341    !!---------------------------------------------------------------------- 
    342    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b, h_ip_b    !: snow and ice volumes/thickness 
    343    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b, oa_i_b                 !: 
    344    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                                 !: snow heat content 
    345    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                                 !: ice temperatures 
    346    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b                      !: ice velocity 
    347    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                                !: ice concentration (total) 
     328   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice, v_ice  !: components of the ice velocity                          (m/s) 
     329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_i , vt_s   !: ice and snow total volume per unit area                 (m) 
     330   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   st_i          !: Total ice salinity content                              (pss.m) 
     331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i          !: ice total fractional area (ice concentration) 
     332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ato_i         !: =1-at_i ; total open water fractional area 
     333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   et_i , et_s   !: ice and snow total heat content                         (J/m2) 
     334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_i          !: mean ice temperature over all categories                (K) 
     335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_s          !: mean snw temperature over all categories                (K) 
     336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   bvm_i         !: brine volume averaged over all categories 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sm_i          !: mean sea ice salinity averaged over all categories      (pss) 
     338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_su         !: mean surface temperature over all categories            (K) 
     339   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_i          !: mean ice  thickness over all categories                 (m) 
     340   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_s          !: mean snow thickness over all categories                 (m) 
     341   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   om_i          !: mean ice age over all categories                        (s) 
     342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tau_icebfr    !: ice friction on ocean bottom (landfast param activated) 
     343 
     344   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s           !: Snow temperatures     [K] 
     345   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s           !: Snow enthalpy         [J/m2] 
     346   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i           !: ice temperatures      [K] 
     347   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i           !: ice enthalpy          [J/m2] 
     348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i          !: ice salinity          [PSS] 
     349 
     350   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip          !: melt pond concentration 
     351   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_ip          !: melt pond volume per grid cell area      [m] 
     352   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip_frac     !: melt pond fraction (a_ip/a_i) 
     353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip_eff      !: melt pond effective fraction (not covered up by lid) (a_ip/a_i) 
     354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_ip          !: melt pond depth                          [m] 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_il          !: melt pond lid volume                     [m] 
     356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_il          !: melt pond lid thickness                  [m] 
     357 
     358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_ip         !: total melt pond concentration 
     359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_ip         !: mean melt pond depth                     [m] 
     360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_ip         !: total melt pond volume per gridcell area [m] 
     361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_il         !: mean melt pond lid depth                     [m] 
     362   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_il         !: total melt pond lid volume per gridcell area [m] 
     363 
     364   !!---------------------------------------------------------------------- 
     365   !! * Global variables at before time step 
     366   !!---------------------------------------------------------------------- 
     367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 
     368   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b              !: 
     369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
     370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
     371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
     372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total) 
    348373             
    349374   !!---------------------------------------------------------------------- 
    350375   !! * Ice thickness distribution variables 
    351376   !!---------------------------------------------------------------------- 
    352    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    353    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hi_mean        !: Mean ice thickness in catgories  
     377   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max            !: Boundary of ice thickness categories in thickness space 
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean           !: Mean ice thickness in catgories  
    354379   ! 
    355380   !!---------------------------------------------------------------------- 
    356381   !! * Ice diagnostics 
    357382   !!---------------------------------------------------------------------- 
    358    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi   !: transport of ice volume 
    359    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs   !: transport of snw volume 
    360    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_ei   !: transport of ice enthalpy [W/m2] 
    361    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_es   !: transport of snw enthalpy [W/m2] 
    362    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv   !: transport of salt content 
    363    ! 
    364    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
    365    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice     !: ice salt content variation   []  
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice     !: ice volume variation   [m/s]  
    367    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw     !: snw volume variation   [m/s]  
    368  
     383   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi       !: transport of ice volume 
     384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs       !: transport of snw volume 
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_ei       !: transport of ice enthalpy [W/m2] 
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_es       !: transport of snw enthalpy [W/m2] 
     387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv       !: transport of salt content 
     388   ! 
     389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat         !: snw/ice heat content variation   [W/m2]  
     390   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice         !: ice salt content variation   []  
     391   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice         !: ice volume variation   [m/s]  
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s]  
     393   ! 
    369394   !!---------------------------------------------------------------------- 
    370395   !! * Ice conservation 
    371396   !!---------------------------------------------------------------------- 
    372    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v        !: conservation of ice volume 
    373    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s        !: conservation of ice salt 
    374    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t        !: conservation of ice heat 
    375    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv       !: conservation of ice volume 
    376    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs       !: conservation of ice salt 
    377    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft       !: conservation of ice heat 
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v            !: conservation of ice volume 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s            !: conservation of ice salt 
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t            !: conservation of ice heat 
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv           !: conservation of ice volume 
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs           !: conservation of ice salt 
     402   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft           !: conservation of ice heat 
    378403   ! 
    379404   !!---------------------------------------------------------------------- 
     
    381406   !!---------------------------------------------------------------------- 
    382407   ! Extra sea ice diagnostics to address the data request 
    383    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si          !: Temperature at Snow-ice interface (K)  
    384    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si         !: mean temperature at the snow-ice interface (K)  
    385    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot   !: Bottom  conduction flux (W/m2) 
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top   !: Surface conduction flux (W/m2) 
    387  
     408   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si            !: Temperature at Snow-ice interface (K)  
     409   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si           !: mean temperature at the snow-ice interface (K)  
     410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot     !: Bottom  conduction flux (W/m2) 
     411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top     !: Surface conduction flux (W/m2) 
    388412   ! 
    389413   !!---------------------------------------------------------------------- 
     
    424448         &      hfx_sum    (jpi,jpj) , hfx_bom   (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
    425449         &      hfx_opw    (jpi,jpj) , hfx_thd   (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
    426          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)             , STAT=ierr(ii) ) 
     450         &      hfx_err_dif(jpi,jpj) , wfx_err_sub(jpi,jpj)                   , STAT=ierr(ii) ) 
    427451 
    428452      ! * Ice global state variables 
     
    448472 
    449473      ii = ii + 1 
    450       ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    451  
    452       ii = ii + 1 
    453       ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
     474      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl),  & 
     475         &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 
     476 
     477      ii = ii + 1 
     478      ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) ) 
    454479 
    455480      ! * Old values of global variables 
    456481      ii = ii + 1 
    457       ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl)        , h_i_b(jpi,jpj,jpl), h_ip_b(jpi,jpj,jpl),  & 
    458          &      a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,               & 
    459          &      oa_i_b(jpi,jpj,jpl)                                                   , STAT=ierr(ii) ) 
     482      ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl)        , h_i_b(jpi,jpj,jpl),         & 
     483         &      a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 
     484         &      STAT=ierr(ii) ) 
    460485 
    461486      ii = ii + 1 
     
    484509      IF( ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) 
    485510      ! 
     511 
    486512   END FUNCTION ice_alloc 
    487513 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/ice1d.F90

    r10786 r13571  
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
    5252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dyn_1d 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
    5453   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
    5554   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qt_oce_ai_1d 
     
    124123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oa_i_1d       !: 
    125124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_1d        !: 
    126    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: ice ponds 
    127126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !: 
    128127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ip_1d       !: 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_frac_1d  !: 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_il_1d       !: Ice pond lid 
     129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_il_1d       !: 
    130130 
    131131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d      !: corresponding to the 2D var  t_s 
     
    146146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sss_1d 
    147147 
     148   ! convergence check 
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tice_cvgerr_1d   !: convergence of ice/snow temp (dT)          [K] 
     150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tice_cvgstp_1d   !: convergence of ice/snow temp (subtimestep) [-] 
    148151   !  
    149152   !!---------------------- 
     
    157160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ip_2d 
    158161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_ip_2d  
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_il_2d  
    159163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_su_2d  
    160164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_2d 
     
    175179      !!---------------------------------------------------------------------! 
    176180      INTEGER ::   ice1D_alloc   ! return value 
    177       INTEGER ::   ierr(7), ii 
     181      INTEGER ::   ierr(8), ii 
    178182      !!---------------------------------------------------------------------! 
    179183      ierr(:) = 0 
     
    189193         &      hfx_thd_1d(jpij) , hfx_spr_1d    (jpij) ,                      & 
    190194         &      hfx_snw_1d(jpij) , hfx_sub_1d    (jpij) ,                      & 
    191          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
     195         &      hfx_res_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
    192196      ! 
    193197      ii = ii + 1 
     
    208212         &      dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm  (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) ,  &     
    209213         &      dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , s_i_1d  (jpij) , s_i_new (jpij) ,  & 
    210          &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) ,                   & 
    211          &      h_ip_1d (jpij) , a_ip_frac_1d(jpij) ,                                                   & 
     214         &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) , v_il_1d (jpij) ,  & 
     215         &      h_il_1d (jpij) , h_ip_1d (jpij) ,                                                       & 
    212216         &      sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d    (jpij) , STAT=ierr(ii) ) 
    213217      ! 
     
    224228      ! 
    225229      ii = ii + 1 
     230      ALLOCATE( tice_cvgerr_1d(jpij) , tice_cvgstp_1d(jpij) , STAT=ierr(ii) ) 
     231      ! 
     232      ii = ii + 1 
    226233      ALLOCATE( a_i_2d (jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d (jpij,jpl) , h_ib_2d(jpij,jpl) ,  & 
    227234         &      v_i_2d (jpij,jpl) , v_s_2d (jpij,jpl) , oa_i_2d(jpij,jpl) , sv_i_2d(jpij,jpl) ,  & 
    228          &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) ,                      & 
     235         &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , v_il_2d(jpij,jpl) ,  & 
    229236         &      STAT=ierr(ii) ) 
    230237 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icealb.F90

    r13295 r13571  
    1414   !!   ice_alb_init   : initialisation of albedo computation 
    1515   !!---------------------------------------------------------------------- 
    16    USE ice, ONLY: jpl ! sea-ice: number of categories 
    1716   USE phycst         ! physical constants 
    1817   USE dom_oce        ! domain: ocean 
     18   USE ice, ONLY: jpl ! sea-ice: number of categories 
     19   USE icevar         ! sea-ice: operations 
    1920   ! 
    2021   USE in_out_manager ! I/O manager 
     
    4748CONTAINS 
    4849 
    49    SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, palb_cs, palb_os ) 
     50   SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice ) 
    5051      !!---------------------------------------------------------------------- 
    5152      !!               ***  ROUTINE ice_alb  *** 
     
    99100      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pafrac_pnd   !  melt pond relative fraction (per unit ice area) 
    100101      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_pnd       !  melt pond depth 
    101       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_cs      !  albedo of ice under clear    sky 
    102       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_os      !  albedo of ice under overcast sky 
    103       ! 
     102      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   pcloud_fra   !  cloud fraction 
     103      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_ice     !  albedo of ice 
     104      ! 
     105      REAL(wp), DIMENSION(jpi,jpj,jpl) :: za_s_fra   ! ice fraction covered by snow 
    104106      INTEGER  ::   ji, jj, jl                ! dummy loop indices 
    105107      REAL(wp) ::   z1_c1, z1_c2,z1_c3, z1_c4 ! local scalar 
     
    108110      REAL(wp) ::   zalb_ice, zafrac_ice      ! bare sea ice albedo & relative ice fraction 
    109111      REAL(wp) ::   zalb_snw, zafrac_snw      ! snow-covered sea ice albedo & relative snow fraction 
     112      REAL(wp) ::   zalb_cs, zalb_os          ! albedo of ice under clear/overcast sky 
    110113      !!--------------------------------------------------------------------- 
    111114      ! 
     
    118121      z1_c4 = 1. / 0.03 
    119122      ! 
     123      CALL ice_var_snwfra( ph_snw, za_s_fra )   ! calculate ice fraction covered by snow 
     124      ! 
    120125      DO jl = 1, jpl 
    121126         DO_2D( 1, 1, 1, 1 ) 
    122             !                       !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time) 
    123             IF( ph_snw(ji,jj,jl) == 0._wp ) THEN 
    124                zafrac_snw = 0._wp 
    125                IF( ld_pnd_alb ) THEN 
    126                   zafrac_pnd = pafrac_pnd(ji,jj,jl) 
    127                ELSE 
    128                   zafrac_pnd = 0._wp 
    129                ENDIF 
    130                zafrac_ice = 1._wp - zafrac_pnd 
     127            ! 
     128            !---------------------------------------------! 
     129            !--- Specific snow, ice and pond fractions ---! 
     130            !---------------------------------------------!                
     131            zafrac_snw = za_s_fra(ji,jj,jl) 
     132            IF( ld_pnd_alb ) THEN 
     133               zafrac_pnd = MIN( pafrac_pnd(ji,jj,jl), 1._wp - zafrac_snw ) ! make sure (a_ip_eff + a_s_fra) <= 1 
    131134            ELSE 
    132                zafrac_snw = 1._wp      ! Snow fully "shades" melt ponds and ice 
    133135               zafrac_pnd = 0._wp 
    134                zafrac_ice = 0._wp 
    135             ENDIF 
    136             ! 
     136            ENDIF 
     137            zafrac_ice = MAX( 0._wp, 1._wp - zafrac_pnd - zafrac_snw ) ! max for roundoff errors 
     138            ! 
     139            !---------------! 
     140            !--- Albedos ---! 
     141            !---------------!                
    137142            !                       !--- Bare ice albedo (for hi > 150cm) 
    138143            IF( ld_pnd_alb ) THEN 
    139144               zalb_ice = rn_alb_idry 
    140145            ELSE 
    141                IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN  ;   zalb_ice = rn_alb_imlt 
    142                ELSE                                                               ;   zalb_ice = rn_alb_idry   ;   ENDIF 
     146               IF( ph_snw(ji,jj,jl) == 0._wp .AND. pt_su(ji,jj,jl) >= rt0 ) THEN   ;   zalb_ice = rn_alb_imlt 
     147               ELSE                                                                ;   zalb_ice = rn_alb_idry   ;   ENDIF 
    143148            ENDIF 
    144149            !                       !--- Bare ice albedo (for hi < 150cm) 
     
    156161            ENDIF 
    157162            !                       !--- Ponded ice albedo 
    158             IF( ld_pnd_alb ) THEN 
    159                zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )  
    160             ELSE 
    161                zalb_pnd = rn_alb_dpnd 
    162             ENDIF 
     163            zalb_pnd = rn_alb_dpnd - ( rn_alb_dpnd - zalb_ice ) * EXP( - ph_pnd(ji,jj,jl) * z1_href_pnd )  
     164            ! 
    163165            !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    164             palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
    165             ! 
    166             palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  & 
    167                &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  & 
    168                &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 
    169             ! 
     166            zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     167            ! 
     168            zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
     169               &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
     170            ! 
     171            ! albedo depends on cloud fraction because of non-linear spectral effects 
     172            palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 
     173 
    170174         END_2D 
    171175      END DO 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icecor.F90

    r13295 r13571  
    8181      DO jl = 1, jpl 
    8282         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
    83       END DO 
    84      
     83      END DO     
     84      !                             !----------------------------------------------------- 
     85      !                             !  Rebin categories with thickness out of bounds     ! 
     86      !                             !----------------------------------------------------- 
     87      IF ( jpl > 1 )   CALL ice_itd_reb( kt ) 
     88      ! 
    8589      !                             !----------------------------------------------------- 
    8690      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
     
    96100      ENDIF 
    97101      !                             !----------------------------------------------------- 
    98       !                             !  Rebin categories with thickness out of bounds     ! 
    99       !                             !----------------------------------------------------- 
    100       IF ( jpl > 1 )   CALL ice_itd_reb( kt ) 
    101  
    102       !                             !----------------------------------------------------- 
    103102      CALL ice_var_zapsmall         !  Zap small values                                  ! 
    104103      !                             !----------------------------------------------------- 
     
    106105      !                             !----------------------------------------------------- 
    107106      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values ! 
    108          DO_2D( 0, 0, 0, 0 ) 
     107         DO_2D( 0, 0, 0, 0 )        !----------------------------------------------------- 
    109108            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice 
    110109               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icectl.F90

    r13295 r13571  
    350350      !!                   ***  ROUTINE ice_ctl ***  
    351351      !!                  
    352       !! ** Purpose :   Alerts in case of model crash 
     352      !! ** Purpose :   control checks 
    353353      !!------------------------------------------------------------------- 
    354354      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    355       INTEGER  ::   ji, jj, jk,  jl   ! dummy loop indices 
    356       INTEGER  ::   inb_altests       ! number of alert tests (max 20) 
    357       INTEGER  ::   ialert_id         ! number of the current alert 
    358       REAL(wp) ::   ztmelts           ! ice layer melting point 
     355      INTEGER  ::   ja, ji, jj, jk, jl ! dummy loop indices 
     356      INTEGER  ::   ialert_id          ! number of the current alert 
     357      REAL(wp) ::   ztmelts            ! ice layer melting point 
    359358      CHARACTER (len=30), DIMENSION(20) ::   cl_alname   ! name of alert 
    360359      INTEGER           , DIMENSION(20) ::   inb_alp     ! number of alerts positive 
    361360      !!------------------------------------------------------------------- 
    362  
    363       inb_altests = 10 
    364       inb_alp(:)  =  0 
    365  
    366       ! Alert if incompatible volume and concentration 
    367       ialert_id = 2 ! reference number of this alert 
    368       cl_alname(ialert_id) = ' Incompat vol and con         '    ! name of the alert 
     361      inb_alp(:) = 0 
     362      ialert_id = 0 
     363       
     364      ! Alert if very high salinity 
     365      ialert_id = ialert_id + 1 ! reference number of this alert 
     366      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    369367      DO jl = 1, jpl 
    370368         DO_2D( 1, 1, 1, 1 ) 
    371             IF(  v_i(ji,jj,jl) /= 0._wp   .AND.   a_i(ji,jj,jl) == 0._wp   ) THEN 
    372                WRITE(numout,*) ' ALERTE 2 :   Incompatible volume and concentration ' 
    373                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     369            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     370               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
     371                  WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 
     372                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     373                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     374               ENDIF 
    374375            ENDIF 
    375376         END_2D 
    376377      END DO 
    377378 
    378       ! Alerte if very thick ice 
    379       ialert_id = 3 ! reference number of this alert 
    380       cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert 
    381       jl = jpl  
    382       DO_2D( 1, 1, 1, 1 ) 
    383          IF(   h_i(ji,jj,jl)  >  50._wp   ) THEN 
    384             WRITE(numout,*) ' ALERTE 3 :   Very thick ice' 
    385             !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 :   Very thick ice ' ) 
    386             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    387          ENDIF 
    388       END_2D 
    389  
    390       ! Alert if very fast ice 
    391       ialert_id = 4 ! reference number of this alert 
    392       cl_alname(ialert_id) = ' Very fast ice               ' ! name of the alert 
    393       DO_2D( 1, 1, 1, 1 ) 
    394          IF(   MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2.  .AND.  & 
    395             &  at_i(ji,jj) > 0._wp   ) THEN 
    396             WRITE(numout,*) ' ALERTE 4 :   Very fast ice' 
    397             !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 :   Very fast ice ' ) 
    398             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    399          ENDIF 
    400       END_2D 
    401  
    402       ! Alert on salt flux 
    403       ialert_id = 5 ! reference number of this alert 
    404       cl_alname(ialert_id) = ' High salt flux               ' ! name of the alert 
    405       DO_2D( 1, 1, 1, 1 ) 
    406          IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN  ! = 1 psu/day for 1m ocean depth 
    407             WRITE(numout,*) ' ALERTE 5 :   High salt flux' 
    408             !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 :   High salt flux ' ) 
    409             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    410          ENDIF 
    411       END_2D 
    412  
    413       ! Alert if there is ice on continents 
    414       ialert_id = 6 ! reference number of this alert 
    415       cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert 
    416       DO_2D( 1, 1, 1, 1 ) 
    417          IF(   tmask(ji,jj,1) <= 0._wp   .AND.   at_i(ji,jj) > 0._wp   ) THEN  
    418             WRITE(numout,*) ' ALERTE 6 :   Ice on continents' 
    419             !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 :   Ice on continents ' ) 
    420             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    421          ENDIF 
    422       END_2D 
    423  
    424 ! 
    425 !     ! Alert if very fresh ice 
    426       ialert_id = 7 ! reference number of this alert 
    427       cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert 
     379      ! Alert if very low salinity 
     380      ialert_id = ialert_id + 1 ! reference number of this alert 
     381      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    428382      DO jl = 1, jpl 
    429383         DO_2D( 1, 1, 1, 1 ) 
    430             IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
    431                WRITE(numout,*) ' ALERTE 7 :   Very fresh ice' 
    432 !                 CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 :   Very fresh ice ' ) 
    433                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     384            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     385               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
     386                  WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 
     387                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     388                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     389               ENDIF 
    434390            ENDIF 
    435391         END_2D 
    436392      END DO 
    437 ! 
    438       ! Alert if qns very big 
    439       ialert_id = 8 ! reference number of this alert 
    440       cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert 
    441       DO_2D( 1, 1, 1, 1 ) 
    442          IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
    443             ! 
    444             WRITE(numout,*) ' ALERTE 8 :   Very high non-solar heat flux' 
    445             !CALL ice_prt( kt, ji, jj, 2, '   ') 
    446             inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    447             ! 
    448          ENDIF 
    449       END_2D 
    450       !+++++ 
    451  
    452 !     ! Alert if too old ice 
    453       ialert_id = 9 ! reference number of this alert 
    454       cl_alname(ialert_id) = ' Very old   ice               ' ! name of the alert 
    455       DO jl = 1, jpl 
    456          DO_2D( 1, 1, 1, 1 ) 
    457             IF ( ( ( ABS( o_i(ji,jj,jl) ) > rDt_ice ) .OR. & 
    458                    ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 
    459                           ( a_i(ji,jj,jl) > 0._wp ) ) THEN 
    460                WRITE(numout,*) ' ALERTE 9 :   Wrong ice age' 
    461                !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 :   Wrong ice age ') 
    462                inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    463             ENDIF 
    464          END_2D 
    465       END DO 
    466    
    467       ! Alert if very warm ice 
    468       ialert_id = 10 ! reference number of this alert 
    469       cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert 
    470       inb_alp(ialert_id) = 0 
     393 
     394      ! Alert if very cold ice 
     395      ialert_id = ialert_id + 1 ! reference number of this alert 
     396      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    471397      DO jl = 1, jpl 
    472398         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    473399            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    474             IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > 1.e-10   & 
    475                &                            .AND.  a_i(ji,jj,jl) > 0._wp   ) THEN 
    476                WRITE(numout,*) ' ALERTE 10 :   Very warm ice' 
     400            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     401               WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 
     402               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
    477403              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    478404            ENDIF 
    479405         END_3D 
    480406      END DO 
     407   
     408      ! Alert if very warm ice 
     409      ialert_id = ialert_id + 1 ! reference number of this alert 
     410      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
     411      DO jl = 1, jpl 
     412         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     413            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
     414            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     415               WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 
     416               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
     417              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     418            ENDIF 
     419         END_3D 
     420      END DO 
     421       
     422      ! Alerte if very thick ice 
     423      ialert_id = ialert_id + 1 ! reference number of this alert 
     424      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
     425      jl = jpl  
     426      DO_2D( 1, 1, 1, 1 ) 
     427         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
     428            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
     429            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     430            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     431         ENDIF 
     432      END_2D 
     433 
     434      ! Alerte if very thin ice 
     435      ialert_id = ialert_id + 1 ! reference number of this alert 
     436      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
     437      jl = 1  
     438      DO_2D( 1, 1, 1, 1 ) 
     439         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
     440            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
     441            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     442            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     443         ENDIF 
     444      END_2D 
     445 
     446      ! Alert if very fast ice 
     447      ialert_id = ialert_id + 1 ! reference number of this alert 
     448      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
     449      DO_2D( 1, 1, 1, 1 ) 
     450         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
     451            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
     452            WRITE(numout,*) ' at i,j = ',ji,jj 
     453            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     454         ENDIF 
     455      END_2D 
     456 
     457      ! Alert if there is ice on continents 
     458      ialert_id = ialert_id + 1 ! reference number of this alert 
     459      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
     460      DO_2D( 1, 1, 1, 1 ) 
     461         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
     462            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
     463            WRITE(numout,*) ' at i,j = ',ji,jj 
     464            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     465         ENDIF 
     466      END_2D 
     467 
     468      ! Alert if incompatible ice concentration and volume 
     469      ialert_id = ialert_id + 1 ! reference number of this alert 
     470      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
     471      DO_2D( 1, 1, 1, 1 ) 
     472         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
     473            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
     474            WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
     475            WRITE(numout,*) ' at i,j = ',ji,jj 
     476            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     477         ENDIF 
     478      END_2D 
    481479 
    482480      ! sum of the alerts on all processors 
    483481      IF( lk_mpp ) THEN 
    484          DO ialert_id = 1, inb_altests 
    485             CALL mpp_sum('icectl', inb_alp(ialert_id)) 
     482         DO ja = 1, ialert_id 
     483            CALL mpp_sum('icectl', inb_alp(ja)) 
    486484         END DO 
    487485      ENDIF 
     
    489487      ! print alerts 
    490488      IF( lwp ) THEN 
    491          ialert_id = 1                                 ! reference number of this alert 
    492          cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert 
    493489         WRITE(numout,*) ' time step ',kt 
    494490         WRITE(numout,*) ' All alerts at the end of ice model ' 
    495          DO ialert_id = 1, inb_altests 
    496             WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! ' 
     491         DO ja = 1, ialert_id 
     492            WRITE(numout,*) ja, cl_alname(ja)//' : ', inb_alp(ja), ' times ! ' 
    497493         END DO 
    498494      ENDIF 
     
    543539               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    544540               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    545                WRITE(numout,*) 
    546541               WRITE(numout,*) ' - Cell values ' 
    547542               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
     
    552547               DO jl = 1, jpl 
    553548                  WRITE(numout,*) ' - Category (', jl,')' 
     549                  WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    554550                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl) 
    555551                  WRITE(numout,*) ' h_i           : ', h_i(ji,jj,jl) 
     
    588584               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    589585               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    590                WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)   
    591586               WRITE(numout,*) 
    592587                
     
    605600                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    606601                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)    
    607                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    608602               END DO !jl 
    609603                
     
    713707         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ') 
    714708         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ') 
    715          CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ') 
    716709         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ') 
    717710         CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ') 
     
    721714            CALL prt_ctl_info(' - Layer : ', ivar=jk) 
    722715            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
     716            CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' e_i       : ') 
    723717         END DO 
    724718      END DO 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn.F90

    r13295 r13571  
    100100      WHERE( a_ip(:,:,:) >= epsi20 ) 
    101101         h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
     102         h_il(:,:,:) = v_il(:,:,:) / a_ip(:,:,:) 
    102103      ELSEWHERE 
    103104         h_ip(:,:,:) = 0._wp 
     105         h_il(:,:,:) = 0._wp 
    104106      END WHERE 
    105107      ! 
     
    127129         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s  
    128130         DO_2D( 1, 1, 1, 1 ) 
    129             zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 
    130             zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 
    131             u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1.0_wp, zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
    132             v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1.0_wp, zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
     131            zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp ) 
     132            zcoefv = ( REAL(jpjglo+1)*0.5_wp - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5_wp - 1._wp ) 
     133            u_ice(ji,jj) = rn_uice * 1.5_wp * SIGN( 1.0_wp, zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
     134            v_ice(ji,jj) = rn_vice * 1.5_wp * SIGN( 1.0_wp, zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
    133135         END_2D 
    134136         ! --- 
     
    218220      NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  & 
    219221         &             rn_ishlat ,                                                           & 
    220          &             ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 
     222         &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile 
    221223      !!------------------------------------------------------------------- 
    222224      ! 
     
    239241         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics        rn_ishlat       = ', rn_ishlat 
    240242         WRITE(numout,*) '      Landfast: param from Lemieux 2016                      ln_landfast_L16 = ', ln_landfast_L16 
    241          WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_depfra       = ', rn_depfra 
    242          WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_icebfr       = ', rn_icebfr 
    243          WRITE(numout,*) '         relax time scale (s-1) to reach static friction     rn_lfrelax      = ', rn_lfrelax 
    244          WRITE(numout,*) '         isotropic tensile strength                          rn_tensile      = ', rn_tensile 
     243         WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_lf_depfra    = ', rn_lf_depfra 
     244         WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_lf_bfr       = ', rn_lf_bfr 
     245         WRITE(numout,*) '         relax time scale (s-1) to reach static friction     rn_lf_relax     = ', rn_lf_relax 
     246         WRITE(numout,*) '         isotropic tensile strength                          rn_lf_tensile   = ', rn_lf_tensile 
    245247         WRITE(numout,*) 
    246248      ENDIF 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_adv.F90

    r12489 r13571  
    8282         !                             !-----------------------! 
    8383         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & 
    84             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     84            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 
    8585         !                             !-----------------------! 
    8686      CASE( np_advPRA )                ! PRATHER scheme        ! 
    8787         !                             !-----------------------! 
    8888         CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, h_i, h_s, h_ip, & 
    89             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     89            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 
    9090      END SELECT 
    9191 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_adv_pra.F90

    r13295 r13571  
    4444   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxap , syap , sxxap , syyap , sxyap    ! melt pond fraction 
    4545   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvp , syvp , sxxvp , syyvp , sxyvp    ! melt pond volume 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvl , syvl , sxxvl , syyvl , sxyvl    ! melt pond lid volume 
    4647 
    4748   !! * Substitutions 
     
    5556 
    5657   SUBROUTINE ice_dyn_adv_pra(         kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  & 
    57       &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     58      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    5859      !!---------------------------------------------------------------------- 
    5960      !!                **  routine ice_dyn_adv_pra  ** 
     
    8182      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    8283      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     84      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid thickness 
    8385      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    8486      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    8587      ! 
    86       INTEGER  ::   ji,jj, jk, jl, jt       ! dummy loop indices 
     88      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    8789      INTEGER  ::   icycle                  ! number of sub-timestep for the advection 
    8890      REAL(wp) ::   zdt                     !   -      - 
     
    9092      REAL(wp), DIMENSION(jpi,jpj)            ::   zati1, zati2 
    9193      REAL(wp), DIMENSION(jpi,jpj)            ::   zudy, zvdx 
    92       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max 
     94      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max, zs_i, zsi_max 
     95      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   ze_i, zei_max 
     96      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   ze_s, zes_max 
    9397      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zarea 
    9498      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi 
    95       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp 
     99      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp, z0vl 
    96100      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   z0es 
    97101      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   z0ei 
     
    100104      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 
    101105      ! 
    102       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
     106      ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 
     107      ! thickness and salinity 
     108      WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 
     109      ELSEWHERE                      ; zs_i(:,:,:) = 0._wp 
     110      END WHERE 
    103111      DO jl = 1, jpl 
    104112         DO_2D( 0, 0, 0, 0 ) 
     
    115123               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    116124               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
     125            zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
     126               &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
     127               &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
     128               &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
    117129         END_2D 
    118130      END DO 
    119       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 
     131      CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
     132      ! 
     133      ! enthalpies 
     134      DO jk = 1, nlay_i 
     135         WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 
     136         ELSEWHERE                      ; ze_i(:,:,jk,:) = 0._wp 
     137         END WHERE 
     138      END DO 
     139      DO jk = 1, nlay_s 
     140         WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 
     141         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
     142         END WHERE 
     143      END DO 
     144      DO jl = 1, jpl 
     145         DO_3D( 0, 0, 0, 0, 1, nlay_i ) 
     146            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
     147               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
     148               &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
     149               &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
     150         END_3D 
     151      END DO 
     152      DO jl = 1, jpl 
     153         DO_3D( 0, 0, 0, 0, 1, nlay_s ) 
     154            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
     155               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
     156               &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
     157               &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
     158         END_3D 
     159      END DO 
     160      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
     161      CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 
     162      ! 
    120163      ! 
    121164      ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- ! 
     
    156199               z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    157200            END DO 
    158             IF ( ln_pnd_H12 ) THEN 
    159                z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction 
    160                z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume 
     201            IF ( ln_pnd_LEV ) THEN 
     202               z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond fraction 
     203               z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond volume 
     204               IF ( ln_pnd_lids ) THEN 
     205                  z0vl(:,:,jl) = pv_il(:,:,jl) * e1e2t(:,:)   ! Melt pond lid volume 
     206               ENDIF 
    161207            ENDIF 
    162208         END DO 
     
    189235            END DO 
    190236            ! 
    191             IF ( ln_pnd_H12 ) THEN 
     237            IF ( ln_pnd_LEV ) THEN 
    192238               CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    193239               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )  
    194240               CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    195241               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )  
     242               IF ( ln_pnd_lids ) THEN 
     243                  CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     244                  CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     245               ENDIF 
    196246            ENDIF 
    197247            !                                                               !--------------------------------------------! 
     
    220270                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
    221271            END DO 
    222             IF ( ln_pnd_H12 ) THEN 
     272            IF ( ln_pnd_LEV ) THEN 
    223273               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    224274               CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
    225275               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    226276               CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
    227             ENDIF 
     277               IF ( ln_pnd_lids ) THEN 
     278                  CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     279                  CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     280               ENDIF 
     281           ENDIF 
    228282            ! 
    229283         ENDIF 
     
    242296               pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    243297            END DO 
    244             IF ( ln_pnd_H12 ) THEN 
     298            IF ( ln_pnd_LEV ) THEN 
    245299               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    246300               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     301               IF ( ln_pnd_lids ) THEN 
     302                  pv_il(:,:,jl) = z0vl(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     303               ENDIF 
    247304            ENDIF 
    248305         END DO 
     
    259316         !     Remove negative values (conservation is ensured) 
    260317         !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    261          CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     318         CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    262319         ! 
    263320         ! --- Make sure ice thickness is not too big --- ! 
    264321         !     (because ice thickness can be too large where ice concentration is very small) 
    265          CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     322         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 
     323            &            pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    266324         ! 
    267325         ! --- Ensure snow load is not too big --- ! 
     
    325383 
    326384         !  Calculate fluxes and moments between boxes i<-->i+1               
    327          DO_2D( 0, 0, 1, 1 ) 
     385         DO_2D( 0, 0, 1, 1 )                   !  Flux from i to i+1 WHEN u GT 0 
    328386            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
    329387            zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 
     
    350408         END_2D 
    351409 
    352          DO_2D( 0, 0, 1, 0 ) 
     410         DO_2D( 0, 0, 1, 0 )                   !  Flux from i+1 to i when u LT 0. 
    353411            zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
    354412            zalg  (ji,jj) = zalf 
     
    369427         END_2D 
    370428 
    371          DO_2D( 0, 0, 0, 0 ) 
     429         DO_2D( 0, 0, 0, 0 )                   !  Readjust moments remaining in the box. 
    372430            zbt  =       zbet(ji-1,jj) 
    373431            zbt1 = 1.0 - zbet(ji-1,jj) 
     
    383441 
    384442         !   Put the temporary moments into appropriate neighboring boxes.     
    385          DO_2D( 0, 0, 0, 0 ) 
     443         DO_2D( 0, 0, 0, 0 )                   !   Flux from i to i+1 IF u GT 0. 
    386444            zbt  =       zbet(ji-1,jj) 
    387445            zbt1 = 1.0 - zbet(ji-1,jj) 
     
    403461         END_2D 
    404462 
    405          DO_2D( 0, 0, 0, 0 ) 
     463         DO_2D( 0, 0, 0, 0 )                   !  Flux from i+1 to i IF u LT 0. 
    406464            zbt  =       zbet(ji,jj) 
    407465            zbt1 = 1.0 - zbet(ji,jj) 
     
    482540  
    483541         !  Calculate fluxes and moments between boxes j<-->j+1               
    484          DO_2D( 1, 1, 0, 0 ) 
     542         DO_2D( 1, 1, 0, 0 )                   !  Flux from j to j+1 WHEN v GT 0 
    485543            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
    486544            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 
     
    507565         END_2D 
    508566         ! 
    509          DO_2D( 1, 0, 0, 0 ) 
     567         DO_2D( 1, 0, 0, 0 )                   !  Flux from j+1 to j when v LT 0. 
    510568            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)  
    511569            zalg  (ji,jj) = zalf 
     
    541599 
    542600         !   Put the temporary moments into appropriate neighboring boxes.     
    543          DO_2D( 0, 0, 0, 0 ) 
     601         DO_2D( 0, 0, 0, 0 )                   !  Flux from j to j+1 IF v GT 0. 
    544602            zbt  =       zbet(ji,jj-1) 
    545603            zbt1 = 1.0 - zbet(ji,jj-1) 
     
    562620         END_2D 
    563621 
    564          DO_2D( 0, 0, 0, 0 ) 
     622         DO_2D( 0, 0, 0, 0 )                   !  Flux from j+1 to j IF v LT 0. 
    565623            zbt  =       zbet(ji,jj) 
    566624            zbt1 = 1.0 - zbet(ji,jj) 
     
    591649 
    592650 
    593    SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     651   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 
     652      &                  pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    594653      !!------------------------------------------------------------------- 
    595654      !!                  ***  ROUTINE Hbig  *** 
     
    605664      !! ** input   : Max thickness of the surrounding 9-points 
    606665      !!------------------------------------------------------------------- 
    607       REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step 
    608       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts 
    609       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip 
     666      REAL(wp)                    , INTENT(in   ) ::   pdt                                   ! tracer time-step 
     667      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max, psi_max   ! max ice thick from surrounding 9-pts 
     668      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pes_max 
     669      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pei_max 
     670      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 
    610671      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s 
    611       ! 
    612       INTEGER  ::   ji, jj, jl         ! dummy loop indices 
    613       REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra 
     672      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i 
     673      ! 
     674      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
     675      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 
    614676      !!------------------------------------------------------------------- 
    615677      ! 
     
    617679      ! 
    618680      DO jl = 1, jpl 
    619  
    620681         DO_2D( 1, 1, 1, 1 ) 
    621682            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     
    623684               !                               ! -- check h_ip -- ! 
    624685               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    625                IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     686               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    626687                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    627688                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
     
    650711               ENDIF            
    651712               !                   
     713               !                               ! -- check s_i -- ! 
     714               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     715               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     716               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     717                  zfra = psi_max(ji,jj,jl) / zsi 
     718                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     719                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     720               ENDIF 
     721               ! 
    652722            ENDIF 
    653723         END_2D 
    654724      END DO  
     725      ! 
     726      !                                           ! -- check e_i/v_i -- ! 
     727      DO jl = 1, jpl 
     728         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     729            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     730               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     731               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     732               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     733                  zfra = pei_max(ji,jj,jk,jl) / zei 
     734                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     735                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     736               ENDIF 
     737            ENDIF 
     738         END_3D 
     739      END DO 
     740      !                                           ! -- check e_s/v_s -- ! 
     741      DO jl = 1, jpl 
     742         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     743            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     744               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     745               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     746               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     747                  zfra = pes_max(ji,jj,jk,jl) / zes 
     748                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     749                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     750               ENDIF 
     751            ENDIF 
     752         END_3D 
     753      END DO 
    655754      ! 
    656755   END SUBROUTINE Hbig 
     
    724823         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   & 
    725824         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   & 
    726          &      sxap(jpi,jpj,jpl)  , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
    727          &      sxvp(jpi,jpj,jpl)  , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     825         &      sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
     826         &      sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     827         &      sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) ,   & 
    728828         ! 
    729829         &      sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & 
     
    820920            END DO 
    821921            ! 
    822             IF( ln_pnd_H12 ) THEN                                    ! melt pond fraction 
    823                CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap  ) 
    824                CALL iom_get( numrir, jpdom_auto, 'syap' , syap  ) 
    825                CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap ) 
    826                CALL iom_get( numrir, jpdom_auto, 'syyap', syyap ) 
    827                CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap ) 
    828                !                                                     ! melt pond volume 
    829                CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp  ) 
    830                CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp  ) 
    831                CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp ) 
    832                CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp ) 
    833                CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp ) 
     922            IF( ln_pnd_LEV ) THEN                                    ! melt pond fraction 
     923               IF( iom_varid( numror, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 
     924                  CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap  ) 
     925                  CALL iom_get( numrir, jpdom_auto, 'syap' , syap  ) 
     926                  CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap ) 
     927                  CALL iom_get( numrir, jpdom_auto, 'syyap', syyap ) 
     928                  CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap ) 
     929                  !                                                     ! melt pond volume 
     930                  CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp  ) 
     931                  CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp  ) 
     932                  CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp ) 
     933                  CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp ) 
     934                  CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp ) 
     935               ELSE 
     936                  sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp   ! melt pond fraction 
     937                  sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp   ! melt pond volume 
     938               ENDIF 
     939                  ! 
     940               IF ( ln_pnd_lids ) THEN                               ! melt pond lid volume 
     941                  IF( iom_varid( numror, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN 
     942                     CALL iom_get( numrir, jpdom_auto, 'sxvl' , sxvl  ) 
     943                     CALL iom_get( numrir, jpdom_auto, 'syvl' , syvl  ) 
     944                     CALL iom_get( numrir, jpdom_auto, 'sxxvl', sxxvl ) 
     945                     CALL iom_get( numrir, jpdom_auto, 'syyvl', syyvl ) 
     946                     CALL iom_get( numrir, jpdom_auto, 'sxyvl', sxyvl ) 
     947                  ELSE 
     948                     sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp   ! melt pond lid volume 
     949                  ENDIF 
     950               ENDIF 
    834951            ENDIF 
    835952            ! 
     
    845962            sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow layers heat content 
    846963            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
    847             IF( ln_pnd_H12 ) THEN 
    848                sxap  = 0._wp   ;   syap  = 0._wp   ;   sxxap  = 0._wp   ;   syyap  = 0._wp   ;   sxyap  = 0._wp   ! melt pond fraction 
    849                sxvp  = 0._wp   ;   syvp  = 0._wp   ;   sxxvp  = 0._wp   ;   syyvp  = 0._wp   ;   sxyvp  = 0._wp   ! melt pond volume 
     964            IF( ln_pnd_LEV ) THEN 
     965               sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp       ! melt pond fraction 
     966               sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp       ! melt pond volume 
     967               IF ( ln_pnd_lids ) THEN 
     968                  sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp       ! melt pond lid volume 
     969               ENDIF 
    850970            ENDIF 
    851971         ENDIF 
     
    9101030         END DO 
    9111031         ! 
    912          IF( ln_pnd_H12 ) THEN                                       ! melt pond fraction 
     1032         IF( ln_pnd_LEV ) THEN                                       ! melt pond fraction 
    9131033            CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap  ) 
    9141034            CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap  ) 
     
    9221042            CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 
    9231043            CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 
     1044            ! 
     1045            IF ( ln_pnd_lids ) THEN                                  ! melt pond lid volume 
     1046               CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl  ) 
     1047               CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl  ) 
     1048               CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) 
     1049               CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) 
     1050               CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) 
     1051            ENDIF 
    9241052         ENDIF 
    9251053         ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_adv_umx.F90

    r13295 r13571  
    6060 
    6161   SUBROUTINE ice_dyn_adv_umx( kn_umx, kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  & 
    62       &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     62      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    6363      !!---------------------------------------------------------------------- 
    6464      !!                  ***  ROUTINE ice_dyn_adv_umx  *** 
     
    8585      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond concentration 
    8686      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     87      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    8788      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    8889      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
     
    9293      REAL(wp) ::   zamsk                   ! 1 if advection of concentration, 0 if advection of other tracers 
    9394      REAL(wp) ::   zdt, zvi_cen 
    94       REAL(wp), DIMENSION(1)           ::   zcflprv, zcflnow   ! for global communication 
    95       REAL(wp), DIMENSION(jpi,jpj)     ::   zudy, zvdx, zcu_box, zcv_box 
    96       REAL(wp), DIMENSION(jpi,jpj)     ::   zati1, zati2 
    97       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zu_cat, zv_cat 
    98       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zua_ho, zva_ho, zua_ups, zva_ups 
    99       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_ai , z1_aip, zhvar 
    100       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zhi_max, zhs_max, zhip_max 
     95      REAL(wp), DIMENSION(1)                  ::   zcflprv, zcflnow   ! for global communication 
     96      REAL(wp), DIMENSION(jpi,jpj)            ::   zudy, zvdx, zcu_box, zcv_box 
     97      REAL(wp), DIMENSION(jpi,jpj)            ::   zati1, zati2 
     98      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zu_cat, zv_cat 
     99      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zua_ho, zva_ho, zua_ups, zva_ups 
     100      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z1_ai , z1_aip, zhvar 
     101      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zhi_max, zhs_max, zhip_max, zs_i, zsi_max 
     102      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   ze_i, zei_max 
     103      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   ze_s, zes_max 
    101104      ! 
    102105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs  
     
    105108      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 
    106109      ! 
    107       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
     110      ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 
     111      ! thickness and salinity 
     112      WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 
     113      ELSEWHERE                      ; zs_i(:,:,:) = 0._wp 
     114      END WHERE 
    108115      DO jl = 1, jpl 
    109116         DO_2D( 0, 0, 0, 0 ) 
     
    120127               &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    121128               &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
    122          END_2D 
    123       END DO 
    124       CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 
     129            zsi_max (ji,jj,jl) = MAX( epsi20, zs_i (ji,jj,jl), zs_i (ji+1,jj  ,jl), zs_i (ji  ,jj+1,jl), & 
     130               &                                               zs_i (ji-1,jj  ,jl), zs_i (ji  ,jj-1,jl), & 
     131               &                                               zs_i (ji+1,jj+1,jl), zs_i (ji-1,jj-1,jl), & 
     132               &                                               zs_i (ji+1,jj-1,jl), zs_i (ji-1,jj+1,jl) ) 
     133         END_2D 
     134      END DO 
     135      CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 
     136      ! 
     137      ! enthalpies 
     138      DO jk = 1, nlay_i 
     139         WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 
     140         ELSEWHERE                      ; ze_i(:,:,jk,:) = 0._wp 
     141         END WHERE 
     142      END DO 
     143      DO jk = 1, nlay_s 
     144         WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 
     145         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
     146         END WHERE 
     147      END DO 
     148      DO jl = 1, jpl 
     149         DO_3D( 0, 0, 0, 0, 1, nlay_i ) 
     150            zei_max(ji,jj,jk,jl) = MAX( epsi20, ze_i(ji,jj,jk,jl), ze_i(ji+1,jj  ,jk,jl), ze_i(ji  ,jj+1,jk,jl), & 
     151               &                                                   ze_i(ji-1,jj  ,jk,jl), ze_i(ji  ,jj-1,jk,jl), & 
     152               &                                                   ze_i(ji+1,jj+1,jk,jl), ze_i(ji-1,jj-1,jk,jl), & 
     153               &                                                   ze_i(ji+1,jj-1,jk,jl), ze_i(ji-1,jj+1,jk,jl) ) 
     154         END_3D 
     155      END DO 
     156      DO jl = 1, jpl 
     157         DO_3D( 0, 0, 0, 0, 1, nlay_s ) 
     158            zes_max(ji,jj,jk,jl) = MAX( epsi20, ze_s(ji,jj,jk,jl), ze_s(ji+1,jj  ,jk,jl), ze_s(ji  ,jj+1,jk,jl), & 
     159               &                                                   ze_s(ji-1,jj  ,jk,jl), ze_s(ji  ,jj-1,jk,jl), & 
     160               &                                                   ze_s(ji+1,jj+1,jk,jl), ze_s(ji-1,jj-1,jk,jl), & 
     161               &                                                   ze_s(ji+1,jj-1,jk,jl), ze_s(ji-1,jj+1,jk,jl) ) 
     162         END_3D 
     163      END DO 
     164      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1. ) 
     165      CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1. ) 
    125166      ! 
    126167      ! 
     
    318359         ! 
    319360         !== melt ponds ==! 
    320          IF ( ln_pnd_H12 ) THEN 
     361         IF ( ln_pnd_LEV ) THEN 
    321362            ! concentration 
    322363            zamsk = 1._wp 
     
    328369            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
    329370               &                                      zhvar, pv_ip, zua_ups, zva_ups ) 
     371            ! lid 
     372            IF ( ln_pnd_lids ) THEN 
     373               zamsk = 0._wp 
     374               zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) 
     375               CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
     376                  &                                      zhvar, pv_il, zua_ups, zva_ups ) 
     377            ENDIF 
    330378         ENDIF 
    331379         ! 
     
    342390         ! Remove negative values (conservation is ensured) 
    343391         !    (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    344          CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     392         CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    345393         ! 
    346394         ! --- Make sure ice thickness is not too big --- ! 
    347395         !     (because ice thickness can be too large where ice concentration is very small) 
    348          CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     396         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 
     397            &            pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    349398         ! 
    350399         ! --- Ensure snow load is not too big --- ! 
     
    9571006      !                                                     !--  Laplacian in j-direction  --! 
    9581007      DO jl = 1, jpl 
    959          DO_2D( 1, 0, 0, 0 ) 
     1008         DO_2D( 1, 0, 0, 0 )         ! First derivative (gradient) 
    9601009            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    9611010         END_2D 
    962          DO_2D( 0, 0, 0, 0 ) 
     1011         DO_2D( 0, 0, 0, 0 )         ! Second derivative (Laplacian) 
    9631012            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    9641013         END_2D 
     
    9681017      !                                                     !--  BiLaplacian in j-direction  --! 
    9691018      DO jl = 1, jpl 
    970          DO_2D( 1, 0, 0, 0 ) 
     1019         DO_2D( 1, 0, 0, 0 )         ! First derivative 
    9711020            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    9721021         END_2D 
    973          DO_2D( 0, 0, 0, 0 ) 
     1022         DO_2D( 0, 0, 0, 0 )         ! Second derivative 
    9741023            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    9751024         END_2D 
     
    14091458 
    14101459 
    1411    SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     1460   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 
     1461      &                  pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    14121462      !!------------------------------------------------------------------- 
    14131463      !!                  ***  ROUTINE Hbig  *** 
     
    14231473      !! ** input   : Max thickness of the surrounding 9-points 
    14241474      !!------------------------------------------------------------------- 
    1425       REAL(wp)                    , INTENT(in   ) ::   pdt                          ! tracer time-step 
    1426       REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max   ! max ice thick from surrounding 9-pts 
    1427       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip 
     1475      REAL(wp)                    , INTENT(in   ) ::   pdt                                   ! tracer time-step 
     1476      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max, psi_max   ! max ice thick from surrounding 9-pts 
     1477      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pes_max 
     1478      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pei_max 
     1479      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 
    14281480      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s 
    1429       ! 
    1430       INTEGER  ::   ji, jj, jl         ! dummy loop indices 
    1431       REAL(wp) ::   z1_dt, zhip, zhi, zhs, zfra 
     1481      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i 
     1482      ! 
     1483      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
     1484      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 
    14321485      !!------------------------------------------------------------------- 
    14331486      ! 
     
    14351488      ! 
    14361489      DO jl = 1, jpl 
    1437  
    14381490         DO_2D( 1, 1, 1, 1 ) 
    14391491            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     
    14411493               !                               ! -- check h_ip -- ! 
    14421494               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    1443                IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     1495               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    14441496                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    14451497                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
     
    14681520               ENDIF            
    14691521               !                   
     1522               !                               ! -- check s_i -- ! 
     1523               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     1524               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     1525               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1526                  zfra = psi_max(ji,jj,jl) / zsi 
     1527                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     1528                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     1529               ENDIF 
     1530               ! 
    14701531            ENDIF 
    14711532         END_2D 
    14721533      END DO  
     1534      ! 
     1535      !                                           ! -- check e_i/v_i -- ! 
     1536      DO jl = 1, jpl 
     1537         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     1538            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1539               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1540               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     1541               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1542                  zfra = pei_max(ji,jj,jk,jl) / zei 
     1543                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1544                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     1545               ENDIF 
     1546            ENDIF 
     1547         END_3D 
     1548      END DO 
     1549      !                                           ! -- check e_s/v_s -- ! 
     1550      DO jl = 1, jpl 
     1551         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     1552            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     1553               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1554               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     1555               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1556                  zfra = pes_max(ji,jj,jk,jl) / zes 
     1557                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1558                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     1559               ENDIF 
     1560            ENDIF 
     1561         END_3D 
     1562      END DO 
    14731563      ! 
    14741564   END SUBROUTINE Hbig 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_rdgrft.F90

    r13295 r13571  
    502502      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    503503      REAL(wp)                  ::   airft1, oirft1, aprft1 
    504       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg  ! area etc of new ridges 
    505       REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft  ! area etc of rafted ice 
     504      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
     505      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
    506506      ! 
    507507      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
     
    530530      DO jl1 = 1, jpl 
    531531 
    532          CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 
     532         IF( nn_icesal /= 2 )  THEN       
     533            CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 
     534         ENDIF 
    533535 
    534536         DO ji = 1, npti 
     
    573575               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft  
    574576 
    575                IF ( ln_pnd_H12 ) THEN 
     577               IF ( ln_pnd_LEV ) THEN 
    576578                  aprdg1     = a_ip_2d(ji,jl1) * afrdg 
    577579                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
     
    580582                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 
    581583                  vprft (ji) = v_ip_2d(ji,jl1) * afrft 
     584                  IF ( ln_pnd_lids ) THEN 
     585                     vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 
     586                     vlrft (ji) = v_il_2d(ji,jl1) * afrft 
     587                  ENDIF 
    582588               ENDIF 
    583589 
     
    606612               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji) 
    607613               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1 
    608                IF ( ln_pnd_H12 ) THEN 
     614               IF ( ln_pnd_LEV ) THEN 
    609615                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    610616                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
     617                  IF ( ln_pnd_lids ) THEN 
     618                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 
     619                  ENDIF 
    611620               ENDIF 
    612621            ENDIF 
     
    700709                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    701710                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    702                   IF ( ln_pnd_H12 ) THEN 
     711                  IF ( ln_pnd_LEV ) THEN 
    703712                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
    704713                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   ) 
    705714                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &  
    706715                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   ) 
     716                     IF ( ln_pnd_lids ) THEN 
     717                        v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + (   vlrdg(ji) * rn_fpndrdg * fvol   (ji) & 
     718                           &                                   + vlrft(ji) * rn_fpndrft * zswitch(ji) ) 
     719                     ENDIF 
    707720                  ENDIF 
    708721                   
     
    735748      !---------------- 
    736749      ! In case ridging/rafting lead to very small negative values (sometimes it happens) 
    737       CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d ) 
     750      CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 
    738751      ! 
    739752   END SUBROUTINE rdgrft_shift 
     
    841854         CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    842855         CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     856         CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    843857         DO jl = 1, jpl 
    844858            DO jk = 1, nlay_s 
     
    867881         CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    868882         CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     883         CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    869884         DO jl = 1, jpl 
    870885            DO jk = 1, nlay_s 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_rhg.F90

    r12377 r13571  
    108108      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
    109109      !! 
    110       NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast 
     110      NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg 
    111111      !!------------------------------------------------------------------- 
    112112      ! 
     
    122122         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    123123         WRITE(numout,*) '   Namelist : namdyn_rhg:' 
    124          WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP = ', ln_rhg_EVP 
    125          WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP    = ', ln_aEVP 
    126          WRITE(numout,*) '         creep limit                                       rn_creepl  = ', rn_creepl 
    127          WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc     = ', rn_ecc 
    128          WRITE(numout,*) '         number of iterations for subcycling               nn_nevp    = ', nn_nevp 
    129          WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast  = ', rn_relast 
     124         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP    = ', ln_rhg_EVP 
     125         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP       = ', ln_aEVP 
     126         WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl 
     127         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc 
     128         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp       = ', nn_nevp 
     129         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast     = ', rn_relast 
     130         WRITE(numout,*) '      check convergence of rheology                        nn_rhg_chkcvg = ', nn_rhg_chkcvg 
     131         IF    ( nn_rhg_chkcvg == 0 ) THEN   ;   WRITE(numout,*) '         no check' 
     132         ELSEIF( nn_rhg_chkcvg == 1 ) THEN   ;   WRITE(numout,*) '         check cvg at the main time step' 
     133         ELSEIF( nn_rhg_chkcvg == 2 ) THEN   ;   WRITE(numout,*) '         check cvg at both main and rheology time steps' 
     134         ENDIF 
    130135      ENDIF 
    131136      ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_rhg_evp.F90

    r13570 r13571  
    4141   USE prtctl         ! Print control 
    4242 
     43   USE netcdf         ! NetCDF library for convergence test 
    4344   IMPLICIT NONE 
    4445   PRIVATE 
     
    5051#  include "do_loop_substitute.h90" 
    5152#  include "domzgr_substitute.h90" 
     53 
     54   !! for convergence tests 
     55   INTEGER ::   ncvgid   ! netcdf file id 
     56   INTEGER ::   nvarid   ! netcdf variable id 
     57   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
    5258   !!---------------------------------------------------------------------- 
    5359   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
     
    121127      REAL(wp) ::   ecc2, z1_ecc2                                       ! square of yield ellipse eccenticity 
    122128      REAL(wp) ::   zalph1, z1_alph1, zalph2, z1_alph2                  ! alpha coef from Bouillon 2009 or Kimmritz 2017 
     129      REAl(wp) ::   zbetau, zbetav 
    123130      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume 
    124       REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2       ! temporary scalars 
     131      REAL(wp) ::   zp_delf, zds2, zdt, zdt2, zdiv, zdiv2               ! temporary scalars 
    125132      REAL(wp) ::   zTauO, zTauB, zRHS, zvel                            ! temporary scalars 
    126133      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice 
    127134      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    128135      ! 
    129       REAL(wp) ::   zresm                                               ! Maximal error on ice velocity 
    130136      REAL(wp) ::   zintb, zintn                                        ! dummy argument 
    131137      REAL(wp) ::   zfac_x, zfac_y 
    132138      REAL(wp) ::   zshear, zdum1, zdum2 
    133139      ! 
    134       REAL(wp), DIMENSION(jpi,jpj) ::   zp_delt                         ! P/delta at T points 
     140      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points 
    135141      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017 
    136142      ! 
     
    139145      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points 
    140146      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points 
    141       REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
     147      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points 
    142148      ! 
    143149      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
    144150      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components 
    145 !!$      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr           ! check convergence 
    146151      REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope: 
    147152      !                                                                 !    ocean surface (ssh_m) if ice is not embedded 
     
    157162      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    158163      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    159       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask, zwf                     ! mask at F points for the ice 
     164      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    160165 
    161166      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
    162167      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2)  below which ice velocity becomes very small 
    163168      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
     169      !! --- check convergence 
     170      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice 
    164171      !! --- diags 
    165       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
    166172      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3 
    167173      !! --- SIMIP diags 
     
    176182      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 
    177183      ! 
    178 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     184      ! for diagnostics and convergence tests 
     185      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
     186      DO_2D( 1, 1, 1, 1 ) 
     187         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     188         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     189      END_2D 
     190      ! 
     191      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    179192      !------------------------------------------------------------------------------! 
    180193      ! 0) mask at F points for the ice 
     
    191204 
    192205      ! Lateral boundary conditions on velocity (modify zfmask) 
    193       zwf(:,:) = zfmask(:,:) 
    194206      DO_2D( 0, 0, 0, 0 ) 
    195207         IF( zfmask(ji,jj) == 0._wp ) THEN 
    196             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 
     208            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     209               &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
    197210         ENDIF 
    198211      END_2D 
    199212      DO jj = 2, jpjm1 
    200213         IF( zfmask(1,jj) == 0._wp ) THEN 
    201             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     214            zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    202215         ENDIF 
    203216         IF( zfmask(jpi,jj) == 0._wp ) THEN 
    204             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    205          ENDIF 
     217            zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
     218        ENDIF 
    206219      END DO 
    207220      DO ji = 2, jpim1 
    208221         IF( zfmask(ji,1) == 0._wp ) THEN 
    209             zfmask(ji,1  ) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     222            zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    210223         ENDIF 
    211224         IF( zfmask(ji,jpj) == 0._wp ) THEN 
    212             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     225            zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    213226         ENDIF 
    214227      END DO 
     
    228241      z1_ecc2 = 1._wp / ecc2 
    229242 
    230       ! Time step for subcycling 
    231       zdtevp   = rDt_ice / REAL( nn_nevp ) 
    232       z1_dtevp = 1._wp / zdtevp 
    233  
    234243      ! alpha parameters (Bouillon 2009) 
    235244      IF( .NOT. ln_aEVP ) THEN 
    236          zalph1 = ( 2._wp * rn_relast * rDt_ice ) * z1_dtevp 
     245         zdtevp   = rDt_ice / REAL( nn_nevp ) 
     246         zalph1 =   2._wp * rn_relast * REAL( nn_nevp ) 
    237247         zalph2 = zalph1 * z1_ecc2 
    238248 
    239249         z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 
    240250         z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
     251      ELSE 
     252         zdtevp   = rdt_ice 
     253         ! zalpha parameters set later on adaptatively 
    241254      ENDIF 
     255      z1_dtevp = 1._wp / zdtevp 
    242256          
    243257      ! Initialise stress tensor  
     
    250264 
    251265      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 
    252       IF( ln_landfast_L16 ) THEN   ;   zkt = rn_tensile 
     266      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_lf_tensile 
    253267      ELSE                         ;   zkt = 0._wp 
    254268      ENDIF 
     
    322336            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    323337            ! ice-bottom stress at U points 
    324             zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm) 
    325             ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
     338            zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 
     339            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    326340            ! ice-bottom stress at V points 
    327             zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm) 
    328             ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
     341            zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 
     342            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    329343            ! ice_bottom stress at T points 
    330             zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj) 
    331             tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
     344            zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 
     345            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    332346         END_2D 
    333347#if defined key_mpi3 
     
    353367         l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
    354368         ! 
    355 !!$         IF(sn_cfctl%l_prtctl) THEN   ! Convergence test 
    356 !!$            DO jj = 1, jpjm1 
    357 !!$               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
    358 !!$               zv_ice(:,jj) = v_ice(:,jj) 
    359 !!$            END DO 
    360 !!$         ENDIF 
     369         ! convergence test 
     370         IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN 
     371            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     372               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
     373               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
     374            END_2D 
     375         ENDIF 
    361376 
    362377         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
     
    369384 
    370385         END_2D 
    371          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 
    372  
    373          DO_2D( 0, 1, 0, 1 ) 
     386 
     387         DO_2D( 0, 0, 0, 0 ) 
    374388 
    375389            ! shear**2 at T points (doc eq. A16) 
     
    391405             
    392406            ! delta at T points 
    393             zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
    394  
    395             ! P/delta at T points 
    396             zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
    397  
    398             ! alpha & beta for aEVP 
     407            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     408 
     409         END_2D 
     410         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp ) 
     411 
     412         ! P/delta at T points 
     413         DO_2D( 1, 1, 1, 1 ) 
     414            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
     415         END_2D 
     416 
     417         DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
     418 
     419            ! divergence at T points (duplication to avoid communications) 
     420            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     421               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     422               &    ) * r1_e1e2t(ji,jj) 
     423             
     424            ! tension at T points (duplication to avoid communications) 
     425            zdt  = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     426               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     427               &   ) * r1_e1e2t(ji,jj) 
     428             
     429            ! alpha for aEVP 
    399430            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 
    400431            !   alpha = beta = sqrt(4*gamma) 
     
    404435               zalph2   = zalph1 
    405436               z1_alph2 = z1_alph1 
     437               ! explicit: 
     438               ! z1_alph1 = 1._wp / zalph1 
     439               ! z1_alph2 = 1._wp / zalph1 
     440               ! zalph1 = zalph1 - 1._wp 
     441               ! zalph2 = zalph1 
    406442            ENDIF 
    407443             
    408444            ! stress at T points (zkt/=0 if landfast) 
    409             zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 
    410             zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
     445            zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1 
     446            zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
    411447           
    412448         END_2D 
    413 #if defined key_mpi3 
    414          CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 
    415 #else 
    416          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 
    417 #endif 
     449         ! Save beta at T-points for further computations 
     450         IF( ln_aEVP ) THEN 
     451            DO_2D( 1, 1, 1, 1 ) 
     452               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     453            END_2D 
     454         ENDIF 
     455          
    418456         DO_2D( 1, 0, 1, 0 ) 
    419457 
    420             ! alpha & beta for aEVP 
     458            ! alpha for aEVP 
    421459            IF( ln_aEVP ) THEN 
    422                zalph2   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     460               zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 
    423461               z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
    424                zbeta(ji,jj) = zalph2 
     462               ! explicit: 
     463               ! z1_alph2 = 1._wp / zalph2 
     464               ! zalph2 = zalph2 - 1._wp 
    425465            ENDIF 
    426466             
     
    488528               ! 
    489529               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    490                   v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    491                      &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    492                      &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    493                      &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    494                      &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     530                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     531                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     532                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     533                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     534                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &  
     535                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     536                     &                                    ) / ( zbetav + 1._wp )                                              & 
     537                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    495538                     &           )   * zmsk00y(ji,jj) 
    496539               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    497                   v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    498                      &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    499                      &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    500                      &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    501                      &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    502                      &            )   * zmsk00y(ji,jj) 
     540                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     541                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     542                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     543                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     544                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     545                     &            )  * zmsk00y(ji,jj) 
    503546               ENDIF 
    504547            END_2D 
     
    541584               ! 
    542585               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    543                   u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    544                      &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    545                      &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    546                      &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    547                      &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     586                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     587                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     588                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     589                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     590                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     591                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     592                     &                                    ) / ( zbetau + 1._wp )                                              & 
     593                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    548594                     &           )   * zmsk00x(ji,jj) 
    549595               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    550                   u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    551                      &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    552                      &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    553                      &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    554                      &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    555                      &            )   * zmsk00x(ji,jj) 
     596                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     597                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     598                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     599                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     600                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     601                     &           )   * zmsk00x(ji,jj) 
    556602               ENDIF 
    557603            END_2D 
     
    596642               ! 
    597643               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    598                   u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    599                      &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    600                      &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    601                      &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    602                      &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     644                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     645                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     646                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     647                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     648                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     649                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     650                     &                                    ) / ( zbetau + 1._wp )                                              & 
     651                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    603652                     &           )   * zmsk00x(ji,jj) 
    604653               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    605                   u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    606                      &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    607                      &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    608                      &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    609                      &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    610                      &            )   * zmsk00x(ji,jj) 
     654                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     655                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     656                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     657                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     658                     &             ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     659                     &           )   * zmsk00x(ji,jj) 
    611660               ENDIF 
    612661            END_2D 
     
    649698               ! 
    650699               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    651                   v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    652                      &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    653                      &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    654                      &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    655                      &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     700                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     701                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     702                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     703                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     704                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
     705                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     706                     &                                    ) / ( zbetav + 1._wp )                                              &  
     707                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    656708                     &           )   * zmsk00y(ji,jj) 
    657709               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    658                   v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    659                      &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    660                      &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    661                      &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    662                      &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    663                      &            )   * zmsk00y(ji,jj) 
     710                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     711                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     712                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     713                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     714                     &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                   & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     715                     &           )   * zmsk00y(ji,jj) 
    664716               ENDIF 
    665717            END_2D 
     
    678730         ENDIF 
    679731 
    680 !!$         IF(sn_cfctl%l_prtctl) THEN   ! Convergence test 
    681 !!$            DO jj = 2 , jpjm1 
    682 !!$               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    683 !!$            END DO 
    684 !!$            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    685 !!$            CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    686 !!$         ENDIF 
     732         ! convergence test 
     733         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
    687734         ! 
    688735         !                                                ! ==================== ! 
    689736      END DO                                              !  end loop over jter  ! 
    690737      !                                                   ! ==================== ! 
     738      IF( ln_aEVP )   CALL iom_put( 'beta_evp' , zbeta ) 
    691739      ! 
    692740      !------------------------------------------------------------------------------! 
     
    702750      END_2D 
    703751       
    704       DO_2D( 0, 0, 0, 0 ) 
     752      DO_2D( 0, 0, 0, 0 )   ! no vector loop 
    705753          
    706754         ! tension**2 at T points 
     
    724772          
    725773         ! delta at T points 
    726          zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
    727          rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
    728          pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
     774         zdelta(ji,jj)   = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
     775         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta(ji,jj) ) ) ! 0 if delta=0 
     776         pdelta_i(ji,jj) = zdelta(ji,jj) + rn_creepl * rswitch 
    729777 
    730778      END_2D 
     
    749797      ! 5) diagnostics 
    750798      !------------------------------------------------------------------------------! 
    751       DO_2D( 1, 1, 1, 1 ) 
    752          zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    753       END_2D 
    754  
    755799      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 
    756800      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 
     
    816860         DEALLOCATE( zsig1 , zsig2 , zsig3 ) 
    817861      ENDIF 
    818        
     862 
    819863      ! --- SIMIP --- ! 
    820864      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 
     
    881925      ENDIF 
    882926      ! 
     927      ! --- convergence tests --- ! 
     928      IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 
     929         IF( iom_use('uice_cvg') ) THEN 
     930            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
     931               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 
     932                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     933            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
     934               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
     935                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     936            ENDIF 
     937         ENDIF 
     938      ENDIF       
     939      ! 
     940      DEALLOCATE( zmsk00, zmsk15 ) 
     941      ! 
    883942   END SUBROUTINE ice_dyn_rhg_evp 
     943 
     944 
     945   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     946      !!---------------------------------------------------------------------- 
     947      !!                    ***  ROUTINE rhg_cvg  *** 
     948      !!                      
     949      !! ** Purpose :   check convergence of oce rheology 
     950      !! 
     951      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity 
     952      !!                during the sub timestepping of rheology so as: 
     953      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 
     954      !!                This routine is called every sub-iteration, so it is cpu expensive 
     955      !! 
     956      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)    
     957      !!---------------------------------------------------------------------- 
     958      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
     959      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     960      !! 
     961      INTEGER           ::   it, idtime, istatus 
     962      INTEGER           ::   ji, jj          ! dummy loop indices 
     963      REAL(wp)          ::   zresm           ! local real  
     964      CHARACTER(len=20) ::   clname 
     965      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
     966      !!---------------------------------------------------------------------- 
     967 
     968      ! create file 
     969      IF( kt == nit000 .AND. kiter == 1 ) THEN 
     970         ! 
     971         IF( lwp ) THEN 
     972            WRITE(numout,*) 
     973            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 
     974            WRITE(numout,*) '~~~~~~~' 
     975         ENDIF 
     976         ! 
     977         IF( lwm ) THEN 
     978            clname = 'ice_cvg.nc' 
     979            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     980            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 
     981            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime ) 
     982            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid ) 
     983            istatus = NF90_ENDDEF(ncvgid) 
     984         ENDIF 
     985         ! 
     986      ENDIF 
     987 
     988      ! time 
     989      it = ( kt - 1 ) * kitermax + kiter 
     990       
     991      ! convergence 
     992      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 
     993         zresm = 0._wp 
     994      ELSE 
     995         DO_2D( 1, 1, 1, 1 ) 
     996            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     997               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
     998         END_2D 
     999         zresm = MAXVAL( zres ) 
     1000         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
     1001      ENDIF 
     1002 
     1003      IF( lwm ) THEN 
     1004         ! write variables 
     1005         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 
     1006         ! close file 
     1007         IF( kt == nitend )   istatus = NF90_CLOSE(ncvgid) 
     1008      ENDIF 
     1009       
     1010   END SUBROUTINE rhg_cvg 
    8841011 
    8851012 
     
    9391066   END SUBROUTINE rhg_evp_rst 
    9401067 
     1068    
    9411069#else 
    9421070   !!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/iceistate.F90

    r13295 r13571  
    4747   !                             !! ** namelist (namini) ** 
    4848   LOGICAL, PUBLIC  ::   ln_iceini        !: Ice initialization or not 
    49    LOGICAL, PUBLIC  ::   ln_iceini_file   !: Ice initialization from 2D netcdf file 
     49   INTEGER, PUBLIC  ::   nn_iceini_file   !: Ice initialization: 
     50                                  !        0 = Initialise sea ice based on SSTs 
     51                                  !        1 = Initialise sea ice from single category netcdf file 
     52                                  !        2 = Initialise sea ice from multi category restart file 
    5053   REAL(wp) ::   rn_thres_sst 
    5154   REAL(wp) ::   rn_hti_ini_n, rn_hts_ini_n, rn_ati_ini_n, rn_smi_ini_n, rn_tmi_ini_n, rn_tsu_ini_n, rn_tms_ini_n 
    5255   REAL(wp) ::   rn_hti_ini_s, rn_hts_ini_s, rn_ati_ini_s, rn_smi_ini_s, rn_tmi_ini_s, rn_tsu_ini_s, rn_tms_ini_s 
    53    REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n 
    54    REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s 
     56   REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n, rn_hld_ini_n 
     57   REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s, rn_hld_ini_s 
    5558   ! 
    56    !                              ! if ln_iceini_file = T 
    57    INTEGER , PARAMETER ::   jpfldi = 9           ! maximum number of files to read 
     59   !                              ! if nn_iceini_file = 1 
     60   INTEGER , PARAMETER ::   jpfldi = 10          ! maximum number of files to read 
    5861   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness    (m) 
    5962   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snw thickness    (m) 
     
    6568   INTEGER , PARAMETER ::   jp_apd = 8           ! index of pnd fraction     (-) 
    6669   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
     70   INTEGER , PARAMETER ::   jp_hld = 10          ! index of pnd lid depth    (m) 
    6771   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6872 
     
    8993      !! ** Steps   :   1) Set initial surface and basal temperatures 
    9094      !!                2) Recompute or read sea ice state variables 
    91       !!                3) Fill in the ice thickness distribution using gaussian 
    92       !!                4) Fill in space-dependent arrays for state variables 
    93       !!                5) snow-ice mass computation 
    94       !!                6) store before fields 
     95      !!                3) Fill in space-dependent arrays for state variables 
     96      !!                4) snow-ice mass computation 
    9597      !! 
    9698      !! ** Notes   : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even 
     
    107109      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, ztm_s_ini            !data from namelist or nc file 
    108110      REAL(wp), DIMENSION(jpi,jpj)     ::   zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    109       REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini                       !data from namelist or nc file 
    110       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !locak arrays 
    111       !! 
    112       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
     111      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini, zhlid_ini            !data from namelist or nc file 
     112      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
     113      !! 
     114      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d 
    113115      !-------------------------------------------------------------------- 
    114116 
     
    164166      a_ip     (:,:,:) = 0._wp 
    165167      v_ip     (:,:,:) = 0._wp 
    166       a_ip_frac(:,:,:) = 0._wp 
     168      v_il     (:,:,:) = 0._wp 
     169      a_ip_eff (:,:,:) = 0._wp 
    167170      h_ip     (:,:,:) = 0._wp 
     171      h_il     (:,:,:) = 0._wp 
    168172      ! 
    169173      ! ice velocities 
     
    174178      ! 2) overwrite some of the fields with namelist parameters or netcdf file 
    175179      !------------------------------------------------------------------------ 
    176  
    177  
    178180      IF( ln_iceini ) THEN 
    179          !                             !---------------! 
    180           
     181         ! 
    181182         IF( Agrif_Root() ) THEN 
    182  
    183             IF( ln_iceini_file )THEN      ! Read a file   ! 
     183            !                             !---------------! 
     184            IF( nn_iceini_file == 1 )THEN ! Read a file   ! 
    184185               !                          !---------------! 
    185186               WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
     
    195196 
    196197               ! -- 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               !    if fields do not exist then set them to the values present in the namelist (except for temperatures) 
    198199               ! 
    199200               ! ice salinity 
     
    207208                  si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    208209                  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) 
    221210               ENDIF 
     211               IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
     212                  &     si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 
     213               IF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) & ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
     214                  &     si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 
     215               IF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) & ! if T_s is read and not T_su, set T_su = T_s 
     216                  &     si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 
     217               IF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) & ! if T_i is read and not T_su, set T_su = T_i 
     218                  &     si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
     219               IF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) & ! if T_su is read and not T_s, set T_s = T_su 
     220                  &     si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 
     221               IF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) & ! if T_i is read and not T_s, set T_s = T_i 
     222                  &     si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    222223               ! 
    223224               ! pond concentration 
     
    229230               IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
    230231                  &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     232               ! 
     233               ! pond lid depth 
     234               IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) & 
     235                  &     si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zswitch + rn_hld_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    231236               ! 
    232237               zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
     
    236241               zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
    237242               zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
     243               zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1) 
    238244               ! 
    239245               ! change the switch for the following 
     
    261267                  zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    262268                  zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     269                  zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 
    263270               ELSEWHERE 
    264271                  zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
     
    271278                  zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    272279                  zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
     280                  zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:) 
    273281               END WHERE 
    274282               ! 
     
    281289               zapnd_ini(:,:) = 0._wp 
    282290               zhpnd_ini(:,:) = 0._wp 
     291               zhlid_ini(:,:) = 0._wp 
    283292            ENDIF 
    284293             
    285             !-------------! 
    286             ! fill fields ! 
    287             !-------------! 
     294            IF ( .NOT.ln_pnd_lids ) THEN 
     295               zhlid_ini(:,:) = 0._wp 
     296            ENDIF 
     297             
     298            !----------------! 
     299            ! 3) fill fields ! 
     300            !----------------! 
    288301            ! select ice covered grid points 
    289302            npti = 0 ; nptidx(:) = 0 
     
    305318            CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
    306319            CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
    307  
     320            CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini ) 
     321             
    308322            ! 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              
     323            ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & 
     324               &      zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), & 
     325               &      zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) ) 
     326 
    312327            ! 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 ) 
     328            CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                  & 
     329               &              zhi_2d          , zhs_2d          , zai_2d         ,                  & 
     330               &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti),                  & 
     331               &              s_i_1d(1:npti)  , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), & 
     332               &              zti_2d          , zts_2d          , ztsu_2d        ,                  & 
     333               &              zsi_2d          , zaip_2d         , zhip_2d        , zhil_2d ) 
    317334 
    318335            ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
     
    330347            CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
    331348            CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
     349            CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d  , h_il   ) 
    332350 
    333351            ! deallocate temporary arrays 
    334352            DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    335                &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     353               &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) 
    336354 
    337355            ! calculate extensive and intensive variables 
     
    363381               END_3D 
    364382            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 
    371             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,:) 
    377             ! 
    378           
     383             
    379384#if  defined key_agrif 
    380385         ELSE 
     
    391396            Agrif_UseSpecialValue = .FALSE. 
    392397        ! 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 
     398   ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, t_su, e_s, e_i 
    394399            CALL ice_var_glo2eqv 
    395400            CALL ice_var_zapsmall 
    396401            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 
    403             END WHERE 
    404             WHERE( a_ip > 0._wp )       ! ???????     
    405                h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
    406             ELSEWHERE 
    407                h_ip(:,:,:) = 0._wp 
    408             END WHERE    
    409  
    410             tn_ice(:,:,:) = t_su(:,:,:) 
    411             t1_ice(:,:,:) = t_i (:,:,1,:) 
    412402#endif 
    413           ENDIF ! Agrif_Root 
     403         ENDIF ! Agrif_Root 
     404         ! 
     405         ! Melt ponds 
     406         WHERE( a_i > epsi10 )   ;   a_ip_eff(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     407         ELSEWHERE               ;   a_ip_eff(:,:,:) = 0._wp 
     408         END WHERE 
     409         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     410         v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
     411          
     412         ! specific temperatures for coupled runs 
     413         tn_ice(:,:,:) = t_su(:,:,:) 
     414         t1_ice(:,:,:) = t_i (:,:,1,:) 
     415         ! 
     416         ! ice concentration should not exceed amax 
     417         at_i(:,:) = SUM( a_i, dim=3 ) 
     418         DO jl = 1, jpl 
     419            WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
     420         END DO 
     421         at_i(:,:) = SUM( a_i, dim=3 ) 
     422         ! 
    414423      ENDIF ! ln_iceini 
    415424      ! 
    416       at_i(:,:) = SUM( a_i, dim=3 ) 
    417       ! 
    418425      !---------------------------------------------- 
    419       ! 3) Snow-ice mass (case ice is fully embedded) 
     426      ! 4) Snow-ice mass (case ice is fully embedded) 
    420427      !---------------------------------------------- 
    421428      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
     
    469476!          ENDIF 
    470477      ENDIF 
    471        
    472       !------------------------------------ 
    473       ! 4) store fields at before time-step 
    474       !------------------------------------ 
    475       ! it is only necessary for the 1st interpolation by Agrif 
    476       a_i_b  (:,:,:)   = a_i  (:,:,:) 
    477       e_i_b  (:,:,:,:) = e_i  (:,:,:,:) 
    478       v_i_b  (:,:,:)   = v_i  (:,:,:) 
    479       v_s_b  (:,:,:)   = v_s  (:,:,:) 
    480       e_s_b  (:,:,:,:) = e_s  (:,:,:,:) 
    481       sv_i_b (:,:,:)   = sv_i (:,:,:) 
    482       oa_i_b (:,:,:)   = oa_i (:,:,:) 
    483       u_ice_b(:,:)     = u_ice(:,:) 
    484       v_ice_b(:,:)     = v_ice(:,:) 
    485       ! total concentration is needed for Lupkes parameterizations 
    486       at_i_b (:,:)     = at_i (:,:)  
    487  
    488 !!clem: output of initial state should be written here but it is impossible because 
    489 !!      the ocean and ice are in the same file 
    490 !!      CALL dia_wri_state( Kmm, 'output.init' ) 
     478 
     479      !!clem: output of initial state should be written here but it is impossible because 
     480      !!      the ocean and ice are in the same file 
     481      !!      CALL dia_wri_state( 'output.init' ) 
    491482      ! 
    492483   END SUBROUTINE ice_istate 
     
    505496      !! 
    506497      !!----------------------------------------------------------------------------- 
    507       INTEGER ::   ios, ifpr, ierror   ! Local integers 
    508  
     498      INTEGER ::   ios   ! Local integer output status for namelist read 
     499      INTEGER ::   ifpr, ierror 
    509500      ! 
    510501      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
    511       TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 
     502      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd, sn_hld 
    512503      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    513504      ! 
    514       NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 
     505      NAMELIST/namini/ ln_iceini, nn_iceini_file, rn_thres_sst, & 
    515506         &             rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 
    516507         &             rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 
    517508         &             rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 
    518          &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 
    519          &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir 
     509         &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, rn_hld_ini_n, rn_hld_ini_s, & 
     510         &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, sn_hld, cn_dir 
    520511      !!----------------------------------------------------------------------------- 
    521512      ! 
     
    529520      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_smi) = sn_smi 
    530521      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_tsu) = sn_tsu   ;   slf_i(jp_tms) = sn_tms 
    531       slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd 
     522      slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd   ;   slf_i(jp_hld) = sn_hld 
    532523      ! 
    533524      IF(lwp) THEN                          ! control print 
     
    537528         WRITE(numout,*) '   Namelist namini:' 
    538529         WRITE(numout,*) '      ice initialization (T) or not (F)                ln_iceini      = ', ln_iceini 
    539          WRITE(numout,*) '      ice initialization from a netcdf file            ln_iceini_file = ', ln_iceini_file 
     530         WRITE(numout,*) '      ice initialization from a netcdf file            nn_iceini_file = ', nn_iceini_file 
    540531         WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst 
    541          IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 
     532         IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 
    542533            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s  
    543534            WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s 
     
    549540            WRITE(numout,*) '      initial pnd fraction  in the north-south         rn_apd_ini     = ', rn_apd_ini_n,rn_apd_ini_s 
    550541            WRITE(numout,*) '      initial pnd depth     in the north-south         rn_hpd_ini     = ', rn_hpd_ini_n,rn_hpd_ini_s 
     542            WRITE(numout,*) '      initial pnd lid depth in the north-south         rn_hld_ini     = ', rn_hld_ini_n,rn_hld_ini_s 
    551543         ENDIF 
    552544      ENDIF 
    553545      ! 
    554       IF( ln_iceini_file ) THEN                      ! Ice initialization using input file 
     546      IF( nn_iceini_file == 1 ) THEN                      ! Ice initialization using input file 
    555547         ! 
    556548         ! set si structure 
     
    573565         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
    574566         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
    575          CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 
     567         rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 
     568         CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 & rn_hld_ini = 0 when no ponds' ) 
     569      ENDIF 
     570      ! 
     571      IF( .NOT.ln_pnd_lids ) THEN 
     572         rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 
    576573      ENDIF 
    577574      ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/iceitd.F90

    r13295 r13571  
    4747   LOGICAL                    ::   ln_cat_usr   ! ice categories are defined by rn_catbnd 
    4848   REAL(wp), DIMENSION(0:100) ::   rn_catbnd    ! ice categories bounds 
     49   REAL(wp)                   ::   rn_himax     ! maximum ice thickness allowed 
    4950   ! 
    5051   !! * Substitutions 
     
    314315            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 
    315316               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin  
    316                IF( ln_pnd_H12 )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
     317               IF( ln_pnd_LEV )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
    317318               h_i_1d(ji) = rn_himin 
    318319            ENDIF 
     
    420421      CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    421422      CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     423      CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    422424      CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    423425      DO jl = 1, jpl 
     
    484486               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans 
    485487               !   
    486                IF ( ln_pnd_H12 ) THEN 
     488               IF ( ln_pnd_LEV ) THEN 
    487489                  ztrans          = a_ip_2d(ji,jl1) * zworka(ji)     ! Pond fraction 
    488490                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 
     
    492494                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    493495                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
     496                  ! 
     497                  IF ( ln_pnd_lids ) THEN                            ! Pond lid volume 
     498                     ztrans          = v_il_2d(ji,jl1) * zworka(ji) 
     499                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 
     500                     v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 
     501                  ENDIF 
    494502               ENDIF 
    495503               ! 
     
    536544      ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 
    537545      !       because of truncation error ( i.e. 1. - 1. /= 0 ) 
    538       CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d ) 
     546      CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 
    539547 
    540548      ! at_i must be <= rn_amax 
     
    568576      CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    569577      CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     578      CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    570579      CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    571580      DO jl = 1, jpl 
     
    693702      REAL(wp) ::   zhmax, znum, zden, zalpha   !   -      - 
    694703      ! 
    695       NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin 
     704      NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin, rn_himax 
    696705      !!------------------------------------------------------------------ 
    697706      ! 
     
    710719         WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean 
    711720         WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr 
    712          WRITE(numout,*) '      minimum ice thickness                                             rn_himin   = ', rn_himin  
     721         WRITE(numout,*) '      minimum ice thickness allowed                                     rn_himin   = ', rn_himin  
     722         WRITE(numout,*) '      maximum ice thickness allowed                                     rn_himax   = ', rn_himax  
    713723      ENDIF 
    714724      ! 
     
    747757      END DO 
    748758      ! 
    749       hi_max(jpl) = 99._wp          ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 
     759      hi_max(jpl) = rn_himax        ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 
    750760      ! 
    751761      IF(lwp) WRITE(numout,*) 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icerst.F90

    r13286 r13571  
    1818   USE phycst  , ONLY : rt0 
    1919   USE sbc_oce , ONLY : nn_fsbc, ln_cpl 
     20   USE sbc_oce , ONLY : nn_components, jp_iam_sas   ! SAS ss[st]_m init 
     21   USE sbc_oce , ONLY : sst_m, sss_m                ! SAS ss[st]_m init 
     22   USE oce     , ONLY : ts                          ! SAS ss[st]_m init 
     23   USE eosbn2  , ONLY : l_useCT, eos_pt_from_ct     ! SAS ss[st]_m init 
    2024   USE iceistate      ! sea-ice: initial state 
    2125   USE icectl         ! sea-ice: control 
     
    132136      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip  ) 
    133137      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip  ) 
     138      CALL iom_rstput( iter, nitrst, numriw, 'v_il' , v_il  ) 
    134139      ! Snow enthalpy 
    135140      DO jk = 1, nlay_s  
     
    172177      INTEGER           ::   jk 
    173178      LOGICAL           ::   llok 
    174       INTEGER           ::   id0, id1, id2, id3, id4   ! local integer 
     179      INTEGER           ::   id0, id1, id2, id3, id4, id5   ! local integer 
    175180      CHARACTER(len=25) ::   znam 
    176181      CHARACTER(len=2)  ::   zchar, zchar1 
     
    251256            v_ip(:,:,:) = 0._wp 
    252257         ENDIF 
     258         ! melt pond lids 
     259         id3 = iom_varid( numrir, 'v_il' , ldstop = .FALSE. ) 
     260         IF( id3 > 0 ) THEN 
     261            CALL iom_get( numrir, jpdom_auto, 'v_il', v_il) 
     262         ELSE 
     263            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds lids output then set it to zero' 
     264            v_il(:,:,:) = 0._wp 
     265         ENDIF 
    253266         ! fields needed for Met Office (Jules) coupling 
    254267         IF( ln_cpl ) THEN 
    255             id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
    256             id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
    257             IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
     268            id4 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
     269            id5 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
     270            IF( id4 > 0 .AND. id5 > 0 ) THEN         ! fields exist 
    258271               CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 
    259272               CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice  ) 
     
    270283      ELSE                 ! == case of a simplified restart == ! 
    271284         !                 ! ---------------------------------- ! 
    272          CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 
     285         CALL ctl_warn('ice_rst_read: you are attempting to use an unsuitable ice restart') 
    273286         ! 
    274          CALL ice_istate_init 
     287         IF( .NOT. ln_iceini .OR. nn_iceini_file == 2 ) THEN 
     288            CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and nn_iceini_file=0 or 1') 
     289         ELSE 
     290            CALL ctl_warn('ice_rst_read: using ice_istate to set initial conditions instead') 
     291         ENDIF 
     292         ! 
     293         IF( nn_components == jp_iam_sas ) THEN   ! SAS case: ss[st]_m were not initialized by sbc_ssm_init 
     294            ! 
     295            IF(lwp) WRITE(numout,*) '  SAS: default initialisation of ss[st]_m arrays used in ice_istate' 
     296            IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem, Kmm), ts(:,:,1,jp_sal, Kmm) ) 
     297            ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem, Kmm) 
     298            ENDIF 
     299            sss_m(:,:) = ts(:,:,1,jp_sal, Kmm) 
     300         ENDIF 
     301         ! 
    275302         CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
    276303         ! 
    277          IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
    278             &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
    279          ! 
    280304      ENDIF 
    281305 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icesbc.F90

    r13295 r13571  
    119119      INTEGER  ::   ji, jj, jl      ! dummy loop index 
    120120      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
    121       REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    122       REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
     121      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    123122      !!-------------------------------------------------------------------- 
    124123      ! 
     
    134133      CALL iom_miss_val( "icetemp", zmiss_val ) 
    135134 
    136       ! --- cloud-sky and overcast-sky ice albedos --- ! 
    137       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) 
    138  
    139       ! albedo depends on cloud fraction because of non-linear spectral effects 
    140 !!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument ! 
    141       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    142       ! 
     135      ! --- ice albedo --- ! 
     136      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) 
     137 
    143138      ! 
    144139      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 
     
    285280      INTEGER ::   ios, ioptio   ! Local integer 
    286281      !! 
    287       NAMELIST/namsbc/ rn_cio, rn_blow_s, nn_flxdist, ln_cndflx, ln_cndemulate 
     282      NAMELIST/namsbc/ rn_cio, nn_snwfra, rn_snwblow, nn_flxdist, ln_cndflx, ln_cndemulate, nn_qtrice 
    288283      !!------------------------------------------------------------------- 
    289284      ! 
     
    299294         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    300295         WRITE(numout,*) '   Namelist namsbc:' 
    301          WRITE(numout,*) '      drag coefficient for oceanic stress              rn_cio        = ', rn_cio 
    302          WRITE(numout,*) '      coefficient for ice-lead partition of snowfall   rn_blow_s     = ', rn_blow_s 
    303          WRITE(numout,*) '      Multicategory heat flux formulation              nn_flxdist    = ', nn_flxdist 
    304          WRITE(numout,*) '      Use conduction flux as surface condition         ln_cndflx     = ', ln_cndflx 
    305          WRITE(numout,*) '         emulate conduction flux                       ln_cndemulate = ', ln_cndemulate 
     296         WRITE(numout,*) '      drag coefficient for oceanic stress                       rn_cio        = ', rn_cio 
     297         WRITE(numout,*) '      fraction of ice covered by snow (options 0,1,2)           nn_snwfra     = ', nn_snwfra 
     298         WRITE(numout,*) '      coefficient for ice-lead partition of snowfall            rn_snwblow    = ', rn_snwblow 
     299         WRITE(numout,*) '      Multicategory heat flux formulation                       nn_flxdist    = ', nn_flxdist 
     300         WRITE(numout,*) '      Use conduction flux as surface condition                  ln_cndflx     = ', ln_cndflx 
     301         WRITE(numout,*) '         emulate conduction flux                                ln_cndemulate = ', ln_cndemulate 
     302         WRITE(numout,*) '      solar flux transmitted thru the surface scattering layer  nn_qtrice     = ', nn_qtrice 
     303         WRITE(numout,*) '         = 0  Grenfell and Maykut 1977' 
     304         WRITE(numout,*) '         = 1  Lebrun 2019' 
    306305      ENDIF 
    307306      ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icestp.F90

    r13216 r13571  
    201201         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file  
    202202         ! 
    203          IF( ln_icectl )                CALL ice_ctl( kt )            ! -- alerts in case of model crash 
     203         IF( ln_icectl )                CALL ice_ctl( kt )            ! -- Control checks 
    204204         ! 
    205205      ENDIF   ! End sea-ice time step only 
     
    224224      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
    225225      ! 
    226       INTEGER :: ji, jj, ierr 
     226      INTEGER ::   ierr 
    227227      !!---------------------------------------------------------------------- 
    228228      IF(lwp) WRITE(numout,*) 
     
    252252      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') 
    253253      ! 
    254       CALL ice_itd_init                ! ice thickness distribution initialization 
    255       ! 
    256       CALL ice_thd_init                ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 
    257       ! 
    258       !                                ! Initial sea-ice state 
    259       IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
    260          CALL ice_istate_init 
    261          CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
    262       ELSE                                    ! start from a restart file 
    263          CALL ice_rst_read( Kbb, Kmm, Kaa ) 
    264       ENDIF 
    265       CALL ice_var_glo2eqv 
    266       CALL ice_var_agg(1) 
    267       ! 
    268       CALL ice_sbc_init                ! set ice-ocean and ice-atm. coupling parameters 
    269       ! 
    270       CALL ice_dyn_init                ! set ice dynamics parameters 
    271       ! 
    272       CALL ice_update_init             ! ice surface boundary condition 
    273       ! 
    274       CALL ice_alb_init                ! ice surface albedo 
    275       ! 
    276       CALL ice_dia_init                ! initialization for diags 
    277       ! 
    278       fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction 
    279       tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu 
    280       ! 
    281254      !                                ! set max concentration in both hemispheres 
    282255      WHERE( gphit(:,:) > 0._wp )   ;   rn_amax_2d(:,:) = rn_amax_n  ! NH 
    283256      ELSEWHERE                     ;   rn_amax_2d(:,:) = rn_amax_s  ! SH 
    284257      END WHERE 
    285  
     258      ! 
     259      CALL diag_set0                   ! set diag of mass, heat and salt fluxes to 0: needed for Agrif child grids 
     260      ! 
     261      CALL ice_itd_init                ! ice thickness distribution initialization 
     262      ! 
     263      CALL ice_thd_init                ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 
     264      ! 
     265      CALL ice_sbc_init                ! set ice-ocean and ice-atm. coupling parameters 
     266      ! 
     267      CALL ice_istate_init             ! Initial sea-ice state 
     268      IF ( ln_rstart .OR. nn_iceini_file == 2 ) THEN 
     269         CALL ice_rst_read( Kbb, Kmm, Kaa )         ! start from a restart file 
     270      ELSE 
     271         CALL ice_istate( nit000, Kbb, Kmm, Kaa )   ! start from rest or read a file 
     272      ENDIF 
     273      CALL ice_var_glo2eqv 
     274      CALL ice_var_agg(1) 
     275      ! 
     276      CALL ice_dyn_init                ! set ice dynamics parameters 
     277      ! 
     278      CALL ice_update_init             ! ice surface boundary condition 
     279      ! 
     280      CALL ice_alb_init                ! ice surface albedo 
     281      ! 
     282      CALL ice_dia_init                ! initialization for diags 
     283      ! 
     284      fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction 
     285      tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu 
     286      ! 
    286287      IF( ln_rstart )   CALL iom_close( numrir )  ! close input ice restart file 
    287288      ! 
     
    366367      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume 
    367368      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content 
    368       oa_i_b(:,:,:)   = oa_i(:,:,:)     ! areal age content 
    369369      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy 
    370370      e_i_b (:,:,:,:) = e_i (:,:,:,:)   ! ice thermal energy 
     
    375375         h_i_b(:,:,:) = 0._wp 
    376376         h_s_b(:,:,:) = 0._wp 
    377       END WHERE 
    378        
    379       WHERE( a_ip(:,:,:) >= epsi20 ) 
    380          h_ip_b(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)   ! ice pond thickness 
    381       ELSEWHERE 
    382          h_ip_b(:,:,:) = 0._wp 
    383377      END WHERE 
    384378      ! 
     
    424418      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
    425419      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
    426       hfx_err_rem(:,:) = 0._wp 
    427420      hfx_err_dif(:,:) = 0._wp 
    428421      wfx_err_sub(:,:) = 0._wp 
     
    445438      diag_trp_ei(:,:) = 0._wp   ;   diag_trp_es(:,:) = 0._wp 
    446439      diag_trp_sv(:,:) = 0._wp 
    447  
     440       
    448441   END SUBROUTINE diag_set0 
    449442 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd.F90

    r13295 r13571  
    3535   ! 
    3636   USE in_out_manager ! I/O manager 
     37   USE iom            ! I/O manager library 
    3738   USE lib_mpp        ! MPP library 
    3839   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
     
    5152   LOGICAL ::   ln_icedO         ! activate ice growth in open-water (T) or not (F) 
    5253   LOGICAL ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F) 
     54   LOGICAL ::   ln_leadhfx       !  heat in the leads is used to melt sea-ice before warming the ocean 
     55 
     56   !! for convergence tests 
     57   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztice_cvgerr, ztice_cvgstp 
    5358 
    5459   !! * Substitutions 
     
    101106         WRITE(numout,*) 'ice_thd: sea-ice thermodynamics' 
    102107         WRITE(numout,*) '~~~~~~~' 
     108      ENDIF 
     109 
     110      ! convergence tests 
     111      IF( ln_zdf_chkcvg ) THEN 
     112         ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) ) 
     113         ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 
    103114      ENDIF 
    104115       
     
    159170         ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
    160171         IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
    161             fhld (ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     172            IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     173            ELSE                    ;   fhld(ji,jj) = 0._wp 
     174            ENDIF 
    162175            qlead(ji,jj) = 0._wp 
    163176         ELSE 
     
    208221            !                                                       ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 
    209222            ! 
    210             s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp  ! --- some init --- !  (important to have them here)  
     223            s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here)  
    211224            dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp  
    212225            dh_i_sub  (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 
     
    218231                              CALL ice_thd_dh                           ! Ice-Snow thickness    
    219232                              CALL ice_thd_pnd                          ! Melt ponds formation 
    220                               CALL ice_thd_ent( e_i_1d(1:npti,:), .true. )      ! Ice enthalpy remapping 
     233                              CALL ice_thd_ent( e_i_1d(1:npti,:) )      ! Ice enthalpy remapping 
    221234            ENDIF 
    222235                              CALL ice_thd_sal( ln_icedS )          ! --- Ice salinity --- !     
     
    241254      ! 
    242255      IF( ln_icedO )          CALL ice_thd_do                       ! --- Frazil ice growth in leads --- ! 
     256      ! 
     257      ! convergence tests 
     258      IF( ln_zdf_chkcvg ) THEN 
     259         CALL iom_put( 'tice_cvgerr', ztice_cvgerr ) ; DEALLOCATE( ztice_cvgerr ) 
     260         CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) 
     261      ENDIF 
    243262      ! 
    244263      ! controls 
     
    347366         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    348367         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    349          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     368         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    350369         ! 
    351370         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
     
    399418         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res       ) 
    400419         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif   ) 
    401          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem   ) 
    402420         CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai     ) 
    403421         ! 
     
    434452         sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 
    435453         v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 
     454         v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 
    436455         oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 
    437456          
     
    453472         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    454473         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    455          CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     474         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    456475         ! 
    457476         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
     
    491510         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res     ) 
    492511         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 
    493          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem ) 
    494512         CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai   ) 
    495513         ! 
     
    508526         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    509527         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
     528         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    510529         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
     530         ! check convergence of heat diffusion scheme 
     531         IF( ln_zdf_chkcvg ) THEN 
     532            CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) 
     533            CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) 
     534         ENDIF 
    511535         ! 
    512536      END SELECT 
     
    529553      INTEGER  ::   ios   ! Local integer output status for namelist read 
    530554      !! 
    531       NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 
     555      NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 
    532556      !!------------------------------------------------------------------- 
    533557      ! 
     
    543567         WRITE(numout,*) '~~~~~~~~~~~~' 
    544568         WRITE(numout,*) '   Namelist namthd:' 
    545          WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)   ln_icedH  = ', ln_icedH 
    546          WRITE(numout,*) '      activate lateral melting (T) or not (F)                 ln_icedA  = ', ln_icedA 
    547          WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)        ln_icedO  = ', ln_icedO 
    548          WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)   ln_icedS  = ', ln_icedS 
     569         WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)                ln_icedH   = ', ln_icedH 
     570         WRITE(numout,*) '      activate lateral melting (T) or not (F)                              ln_icedA   = ', ln_icedA 
     571         WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)                     ln_icedO   = ', ln_icedO 
     572         WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)                ln_icedS   = ', ln_icedS 
     573         WRITE(numout,*) '      heat in the leads is used to melt sea-ice before warming the ocean   ln_leadhfx = ', ln_leadhfx 
    549574     ENDIF 
    550575      ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_dh.F90

    r13226 r13571  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   ice_thd_dh        : vertical sea-ice growth and melt 
    15    !!   ice_thd_snwblow   : distribute snow fall between ice and ocean 
    16   !!---------------------------------------------------------------------- 
     15   !!---------------------------------------------------------------------- 
    1716   USE dom_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
     
    2019   USE ice1D          ! sea-ice: thermodynamics variables 
    2120   USE icethd_sal     ! sea-ice: salinity profiles 
     21   USE icevar         ! for CALL ice_var_snwblow 
    2222   ! 
    2323   USE in_out_manager ! I/O manager 
     
    2929 
    3030   PUBLIC   ice_thd_dh        ! called by ice_thd 
    31    PUBLIC   ice_thd_snwblow   ! called in sbcblk/sbccpl and here 
    32  
    33    INTERFACE ice_thd_snwblow 
    34       MODULE PROCEDURE ice_thd_snwblow_1d, ice_thd_snwblow_2d 
    35    END INTERFACE 
    3631 
    3732   !!---------------------------------------------------------------------- 
     
    186181      ! Snow precipitation 
    187182      !------------------- 
    188       CALL ice_thd_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
     183      CALL ice_var_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
    189184 
    190185      zdeltah(1:npti,:) = 0._wp 
     
    636631   END SUBROUTINE ice_thd_dh 
    637632 
    638  
    639    !!-------------------------------------------------------------------------- 
    640    !! INTERFACE ice_thd_snwblow 
    641    !! 
    642    !! ** Purpose :   Compute distribution of precip over the ice 
    643    !! 
    644    !!                Snow accumulation in one thermodynamic time step 
    645    !!                snowfall is partitionned between leads and ice. 
    646    !!                If snow fall was uniform, a fraction (1-at_i) would fall into leads 
    647    !!                but because of the winds, more snow falls on leads than on sea ice 
    648    !!                and a greater fraction (1-at_i)^beta of the total mass of snow  
    649    !!                (beta < 1) falls in leads. 
    650    !!                In reality, beta depends on wind speed,  
    651    !!                and should decrease with increasing wind speed but here, it is  
    652    !!                considered as a constant. an average value is 0.66 
    653    !!-------------------------------------------------------------------------- 
    654 !!gm  I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... 
    655    SUBROUTINE ice_thd_snwblow_2d( pin, pout ) 
    656       REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( 1. - a_i_b ) 
    657       REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 
    658       pout = ( 1._wp - ( pin )**rn_blow_s ) 
    659    END SUBROUTINE ice_thd_snwblow_2d 
    660  
    661    SUBROUTINE ice_thd_snwblow_1d( pin, pout ) 
    662       REAL(wp), DIMENSION(:), INTENT(in   ) :: pin 
    663       REAL(wp), DIMENSION(:), INTENT(inout) :: pout 
    664       pout = ( 1._wp - ( pin )**rn_blow_s ) 
    665    END SUBROUTINE ice_thd_snwblow_1d 
    666  
    667633#else 
    668634   !!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_do.F90

    r13295 r13571  
    385385            END DO 
    386386            ! --- Ice enthalpy remapping --- ! 
    387             CALL ice_thd_ent( ze_i_2d(1:npti,:,jl), .false. )  
     387            CALL ice_thd_ent( ze_i_2d(1:npti,:,jl) )  
    388388         END DO 
    389389 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_ent.F90

    r13226 r13571  
    3838CONTAINS 
    3939  
    40    SUBROUTINE ice_thd_ent( qnew, compute_hfx_err ) 
     40   SUBROUTINE ice_thd_ent( qnew ) 
    4141      !!------------------------------------------------------------------- 
    4242      !!               ***   ROUTINE ice_thd_ent  *** 
     
    6464      !!------------------------------------------------------------------- 
    6565      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   qnew             ! new enthlapies (J.m-3, remapped) 
    66       LOGICAL, INTENT(in)                     ::   compute_hfx_err  ! determines whether to compute diag. 
    67                                                                     ! error or not 
    6866      ! 
    6967      INTEGER  :: ji         !  dummy loop indices 
     
    130128      ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do),  
    131129      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
    132       IF( compute_hfx_err ) THEN 
    133          DO ji = 1, npti 
    134             hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice *  & 
    135                &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 
    136          END DO 
    137       END IF 
    138   
     130      !DO ji = 1, npti 
     131      !   hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice *  & 
     132      !      &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  
     133      !END DO 
     134       
    139135   END SUBROUTINE ice_thd_ent 
    140136 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_pnd.F90

    r12489 r13571  
    3535   !                                   ! associated indices: 
    3636   INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme 
    37    INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant pond scheme 
    38    INTEGER, PARAMETER ::   np_pndH12 = 2   ! Evolutive pond scheme (Holland et al. 2012) 
     37   INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant ice pond scheme 
     38   INTEGER, PARAMETER ::   np_pndLEV = 2   ! Level ice pond scheme 
    3939 
    4040   !!---------------------------------------------------------------------- 
     
    4949      !!               ***  ROUTINE ice_thd_pnd   *** 
    5050      !!                
    51       !! ** Purpose :   change melt pond fraction 
     51      !! ** Purpose :   change melt pond fraction and thickness 
    5252      !!                 
    53       !! ** Method  :   brut force 
    5453      !!------------------------------------------------------------------- 
    5554      ! 
     
    5857      CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==! 
    5958         ! 
    60       CASE (np_pndH12)   ;   CALL pnd_H12    !==  Holland et al 2012 melt ponds  ==! 
     59      CASE (np_pndLEV)   ;   CALL pnd_LEV    !==  Level ice melt ponds  ==! 
    6160         ! 
    6261      END SELECT 
     
    8685         ! 
    8786         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    88             a_ip_frac_1d(ji) = rn_apnd 
    8987            h_ip_1d(ji)      = rn_hpnd     
    90             a_ip_1d(ji)      = a_ip_frac_1d(ji) * a_i_1d(ji) 
     88            a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
     89            h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
    9190         ELSE 
    92             a_ip_frac_1d(ji) = 0._wp 
    9391            h_ip_1d(ji)      = 0._wp     
    9492            a_ip_1d(ji)      = 0._wp 
     93            h_il_1d(ji)      = 0._wp 
    9594         ENDIF 
    9695         ! 
     
    10099 
    101100 
    102    SUBROUTINE pnd_H12 
    103       !!------------------------------------------------------------------- 
    104       !!                ***  ROUTINE pnd_H12  *** 
    105       !! 
    106       !! ** Purpose    : Compute melt pond evolution 
    107       !! 
    108       !! ** Method     : Empirical method. A fraction of meltwater is accumulated in ponds  
    109       !!                 and sent to ocean when surface is freezing 
    110       !! 
    111       !!                 pond growth:      Vp = Vp + dVmelt 
    112       !!                    with dVmelt = R/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
    113       !!                 pond contraction: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp) 
    114       !!                    with Tp = -2degC 
    115       !!   
    116       !! ** Tunable parameters : (no real expertise yet, ideas?) 
     101   SUBROUTINE pnd_LEV 
     102      !!------------------------------------------------------------------- 
     103      !!                ***  ROUTINE pnd_LEV  *** 
     104      !! 
     105      !! ** Purpose : Compute melt pond evolution 
     106      !! 
     107      !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 
     108      !!              We  work with volumes and then redistribute changes into thickness and concentration 
     109      !!              assuming linear relationship between the two.  
     110      !! 
     111      !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 --- 
     112      !!                                     dVmelt = (1-r)/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
     113      !!                                        dh_i  = meltwater from ice surface melt 
     114      !!                                        dh_s  = meltwater from snow melt 
     115      !!                                        (1-r) = fraction of melt water that is not flushed 
     116      !! 
     117      !!              - limtations:       a_ip must not exceed (1-r)*a_i 
     118      !!                                  h_ip must not exceed 0.5*h_i 
     119      !! 
     120      !!              - pond shrinking: 
     121      !!                       if lids:   Vp = Vp -dH * a_ip 
     122      !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 --- 
     123      !! 
     124      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H  
     125      !!                                                                      H = lid thickness 
     126      !!                                                                      Lf = latent heat of fusion 
     127      !!                                                                      Tp = -2C 
     128      !! 
     129      !!                                                                And solved implicitely as: 
     130      !!                                                                   H(t+dt)**2 -H(t) * H(t+dt) -ki * (Tp-Tsu) * dt / (rhoi*Lf) = 0 
     131      !! 
     132      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 --- 
     133      !! 
     134      !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 --- 
     135      !!                                     perm = permability of sea-ice 
     136      !!                                     visc = water viscosity 
     137      !!                                     Hp   = height of top of the pond above sea-level 
     138      !!                                     Hi   = ice thickness thru which there is flushing 
     139      !! 
     140      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness 
     141      !! 
     142      !!              - pond thickness and area is retrieved from pond volume assuming a linear relationship between h_ip and a_ip: 
     143      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect 
     144      !! 
     145      !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 
    117146      !!  
    118       !! ** Note       : Stolen from CICE for quick test of the melt pond 
    119       !!                 radiation and freshwater interfaces 
    120       !!                 Coupling can be radiative AND freshwater 
    121       !!                 Advection, ridging, rafting are called 
    122       !! 
    123       !! ** References : Holland, M. M. et al (J Clim 2012) 
    124       !!------------------------------------------------------------------- 
    125       REAL(wp), PARAMETER ::   zrmin       = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding 
    126       REAL(wp), PARAMETER ::   zrmax       = 0.70_wp  ! maximum     -           -         -         -            - 
    127       REAL(wp), PARAMETER ::   zpnd_aspect = 0.8_wp   ! pond aspect ratio 
    128       REAL(wp), PARAMETER ::   zTp         = -2._wp   ! reference temperature 
    129       ! 
    130       REAL(wp) ::   zfr_mlt          ! fraction of available meltwater retained for melt ponding 
    131       REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding 
    132       REAL(wp) ::   z1_Tp            ! inverse reference temperature 
    133       REAL(wp) ::   z1_rhow          ! inverse freshwater density 
    134       REAL(wp) ::   z1_zpnd_aspect   ! inverse pond aspect ratio 
    135       REAL(wp) ::   zfac, zdum 
    136       ! 
    137       INTEGER  ::   ji   ! loop indices 
    138       !!------------------------------------------------------------------- 
    139       z1_rhow        = 1._wp / rhow  
    140       z1_zpnd_aspect = 1._wp / zpnd_aspect 
    141       z1_Tp          = 1._wp / zTp  
     147      !! ** Note       :   mostly stolen from CICE 
     148      !! 
     149      !! ** References :   Flocco and Feltham (JGR, 2007) 
     150      !!                   Flocco et al       (JGR, 2010) 
     151      !!                   Holland et al      (J. Clim, 2012) 
     152      !!------------------------------------------------------------------- 
     153      REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array 
     154      !! 
     155      REAL(wp), PARAMETER ::   zaspect =  0.8_wp      ! pond aspect ratio 
     156      REAL(wp), PARAMETER ::   zTp     = -2._wp       ! reference temperature 
     157      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity 
     158      !! 
     159      REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding 
     160      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes 
     161      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh 
     162      REAL(wp) ::   zv_ip_max                         ! max pond volume allowed 
     163      REAL(wp) ::   zdT                               ! zTp-t_su 
     164      REAL(wp) ::   zsbr                              ! Brine salinity 
     165      REAL(wp) ::   zperm                             ! permeability of sea ice 
     166      REAL(wp) ::   zfac, zdum                        ! temporary arrays 
     167      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse 
     168      !! 
     169      INTEGER  ::   ji, jk                            ! loop indices 
     170      !!------------------------------------------------------------------- 
     171      z1_rhow   = 1._wp / rhow  
     172      z1_aspect = 1._wp / zaspect 
     173      z1_Tp     = 1._wp / zTp  
    142174 
    143175      DO ji = 1, npti 
    144          !                                                        !--------------------------------! 
    145          IF( h_i_1d(ji) < rn_himin) THEN                          ! Case ice thickness < rn_himin ! 
    146             !                                                     !--------------------------------! 
    147             !--- Remove ponds on thin ice 
     176         !                                                            !----------------------------------------------------! 
     177         IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction ! 
     178            !                                                         !----------------------------------------------------! 
     179            !--- Remove ponds on thin ice or tiny ice fractions 
    148180            a_ip_1d(ji)      = 0._wp 
    149             a_ip_frac_1d(ji) = 0._wp 
    150181            h_ip_1d(ji)      = 0._wp 
    151             !                                                     !--------------------------------! 
    152          ELSE                                                     ! Case ice thickness >= rn_himin ! 
    153             !                                                     !--------------------------------! 
    154             v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! record pond volume at previous time step 
    155             ! 
    156             ! available meltwater for melt ponding [m, >0] and fraction 
    157             zdv_mlt = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
    158             zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  ! from CICE doc 
    159             !zfr_mlt = zrmin + zrmax * a_i_1d(ji)             ! from Holland paper  
    160             ! 
    161             !--- Pond gowth ---! 
    162             ! v_ip should never be negative, otherwise code crashes 
    163             v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt ) 
    164             ! 
    165             ! melt pond mass flux (<0) 
     182            h_il_1d(ji)      = 0._wp 
     183            !                                                         !--------------------------------! 
     184         ELSE                                                         ! Case ice thickness >= rn_himin ! 
     185            !                                                         !--------------------------------! 
     186            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     187            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     188            ! 
     189            !------------------! 
     190            ! case ice melting ! 
     191            !------------------! 
     192            ! 
     193            !--- available meltwater for melt ponding ---! 
     194            zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
     195            zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed 
     196            zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors?  
     197            ! 
     198            !--- overflow ---! 
     199            ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
     200            !    a_ip_max = zfr_mlt * a_i 
     201            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     202            zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
     203            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     204 
     205            ! If pond depth exceeds half the ice thickness then reduce the pond volume 
     206            !    h_ip_max = 0.5 * h_i 
     207            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     208            zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
     209            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     210             
     211            !--- Pond growing ---! 
     212            v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
     213            ! 
     214            !--- Lid melting ---! 
     215            IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
     216            ! 
     217            !--- mass flux ---! 
    166218            IF( zdv_mlt > 0._wp ) THEN 
    167                zfac = zfr_mlt * zdv_mlt * rhow * r1_Dt_ice 
     219               zfac = zdv_mlt * rhow * r1_Dt_ice                        ! melt pond mass flux < 0 [kg.m-2.s-1] 
    168220               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    169221               ! 
    170                ! adjust ice/snow melting flux to balance melt pond flux (>0) 
    171                zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) 
     222               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux 
    172223               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 
    173224               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    174225            ENDIF 
     226 
     227            !-------------------! 
     228            ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
     229            !-------------------! 
     230            ! 
     231            zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
    175232            ! 
    176233            !--- Pond contraction (due to refreezing) ---! 
    177             v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp ) 
    178             ! 
    179             ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac 
    180             !    h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i 
    181             a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_zpnd_aspect * a_i_1d(ji) ) 
    182             a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 
    183             h_ip_1d(ji)      = zpnd_aspect * a_ip_frac_1d(ji) 
     234            IF( ln_pnd_lids ) THEN 
     235               ! 
     236               !--- Lid growing and subsequent pond shrinking ---!  
     237               zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
     238                  &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
     239                
     240               ! Lid growing 
     241               v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 
     242                
     243               ! Pond shrinking 
     244               v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 
     245 
     246            ELSE 
     247               ! Pond shrinking 
     248               v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 
     249            ENDIF 
     250            ! 
     251            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     252            ! v_ip     = h_ip * a_ip 
     253            ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 
     254            a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     255            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     256 
     257            !---------------!             
     258            ! Pond flushing ! 
     259            !---------------! 
     260            ! height of top of the pond above sea-level 
     261            zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 
     262             
     263            ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 
     264            DO jk = 1, nlay_i 
     265               zsbr = - 1.2_wp                                  & 
     266                  &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
     267                  &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
     268                  &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 
     269               ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
     270            END DO 
     271            zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
     272             
     273            ! Do the drainage using Darcy's law 
     274            zdv_flush   = -zperm * rho0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 
     275            zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) 
     276            v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
     277             
     278            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     279            a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     280            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     281 
     282            !--- Corrections and lid thickness ---! 
     283            IF( ln_pnd_lids ) THEN 
     284               !--- retrieve lid thickness from volume ---! 
     285               IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
     286               ELSE                              ;   h_il_1d(ji) = 0._wp 
     287               ENDIF 
     288               !--- remove ponds if lids are much larger than ponds ---! 
     289               IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
     290                  a_ip_1d(ji)      = 0._wp 
     291                  h_ip_1d(ji)      = 0._wp 
     292                  h_il_1d(ji)      = 0._wp 
     293               ENDIF 
     294            ENDIF 
    184295            ! 
    185296         ENDIF 
     297          
    186298      END DO 
    187299      ! 
    188    END SUBROUTINE pnd_H12 
     300   END SUBROUTINE pnd_LEV 
    189301 
    190302 
     
    203315      INTEGER  ::   ios, ioptio   ! Local integer 
    204316      !! 
    205       NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
     317      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, & 
     318         &                          ln_pnd_CST , rn_apnd, rn_hpnd,         & 
     319         &                          ln_pnd_lids, ln_pnd_alb 
    206320      !!------------------------------------------------------------------- 
    207321      ! 
     
    217331         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    218332         WRITE(numout,*) '   Namelist namicethd_pnd:' 
    219          WRITE(numout,*) '      Melt ponds activated or not                                     ln_pnd     = ', ln_pnd 
    220          WRITE(numout,*) '         Evolutive  melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 
    221          WRITE(numout,*) '         Prescribed melt pond fraction and depth                      ln_pnd_CST = ', ln_pnd_CST 
    222          WRITE(numout,*) '            Prescribed pond fraction                                  rn_apnd    = ', rn_apnd 
    223          WRITE(numout,*) '            Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd 
    224          WRITE(numout,*) '         Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb 
     333         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd 
     334         WRITE(numout,*) '         Level ice melt pond scheme                               ln_pnd_LEV   = ', ln_pnd_LEV 
     335         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min 
     336         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max 
     337         WRITE(numout,*) '         Constant ice melt pond scheme                            ln_pnd_CST   = ', ln_pnd_CST 
     338         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd 
     339         WRITE(numout,*) '            Prescribed pond depth                                 rn_hpnd      = ', rn_hpnd 
     340         WRITE(numout,*) '         Frozen lids on top of melt ponds                         ln_pnd_lids  = ', ln_pnd_lids 
     341         WRITE(numout,*) '         Melt ponds affect albedo or not                          ln_pnd_alb   = ', ln_pnd_alb 
    225342      ENDIF 
    226343      ! 
     
    229346      IF( .NOT.ln_pnd ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndNO     ;   ENDIF 
    230347      IF( ln_pnd_CST  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF 
    231       IF( ln_pnd_H12  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF 
     348      IF( ln_pnd_LEV  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndLEV    ;   ENDIF 
    232349      IF( ioptio /= 1 )   & 
    233          & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' ) 
     350         & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' ) 
    234351      ! 
    235352      SELECT CASE( nice_pnd ) 
    236353      CASE( np_pndNO )          
    237          IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 
     354         IF( ln_pnd_alb  ) THEN ; ln_pnd_alb  = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' )  ; ENDIF 
     355         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF 
     356      CASE( np_pndCST )          
     357         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF 
    238358      END SELECT 
    239359      ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_sal.F90

    r12489 r13571  
    5555      !!               -> nn_icesal = 3 -> Sice = S(z)   [multiyear ice] 
    5656      !!--------------------------------------------------------------------- 
    57       LOGICAL, INTENT(in) ::   ld_sal            ! gravity drainage and flushing or not  
     57      LOGICAL, INTENT(in) ::   ld_sal          ! gravity drainage and flushing or not  
    5858      ! 
    59       INTEGER  ::   ji, jk                       ! dummy loop indices  
    60       REAL(wp) ::   iflush, igravdr              ! local scalars 
    61       REAL(wp) ::   zs_sni, zs_i_gd, zs_i_fl, zs_i_si, zs_i_bg   ! local scalars 
     59      INTEGER  ::   ji                         ! dummy loop indices  
     60      REAL(wp) ::   zs_sni, zds                ! local scalars 
    6261      REAL(wp) ::   z1_time_gd, z1_time_fl 
    6362      !!--------------------------------------------------------------------- 
     
    6867      CASE( 2 )       !  time varying salinity with linear profile  ! 
    6968         !            !---------------------------------------------! 
    70          z1_time_gd = 1._wp / rn_time_gd * rDt_ice 
    71          z1_time_fl = 1._wp / rn_time_fl * rDt_ice 
     69         z1_time_gd = rDt_ice / rn_time_gd 
     70         z1_time_fl = rDt_ice / rn_time_fl 
    7271         ! 
    7372         DO ji = 1, npti 
    7473            ! 
    75             !--------------------------------------------------------- 
    76             !  Update ice salinity from snow-ice and bottom growth 
    77             !--------------------------------------------------------- 
    7874            IF( h_i_1d(ji) > 0._wp ) THEN 
    79                zs_sni  = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi                     ! Salinity of snow ice 
    80                zs_i_si = ( zs_sni      - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice     
    81                zs_i_bg = ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog  (ji) / h_i_1d(ji) ! bottom growth 
    82                ! Update salinity (nb: salt flux already included in icethd_dh) 
    83                s_i_1d(ji) = s_i_1d(ji) + zs_i_bg + zs_i_si 
     75               ! 
     76               ! --- Update ice salinity from snow-ice and bottom growth --- ! 
     77               zs_sni = sss_1d(ji) * ( rhoi - rhos ) * r1_rhoi                           ! salinity of snow ice 
     78               zds    =       ( zs_sni      - s_i_1d(ji) ) * dh_snowice(ji) / h_i_1d(ji) ! snow-ice     
     79               zds    = zds + ( s_i_new(ji) - s_i_1d(ji) ) * dh_i_bog  (ji) / h_i_1d(ji) ! bottom growth 
     80               ! update salinity (nb: salt flux already included in icethd_dh) 
     81               s_i_1d(ji) = s_i_1d(ji) + zds 
     82               ! 
     83               ! --- Update ice salinity from brine drainage and flushing --- ! 
     84               IF( ld_sal ) THEN 
     85                  IF( t_su_1d(ji) >= rt0 ) THEN             ! flushing (summer time) 
     86                     zds = - MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl 
     87                  ELSEIF( t_su_1d(ji) <= t_bo_1d(ji) ) THEN ! gravity drainage 
     88                     zds = - MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd 
     89                  ELSE 
     90                     zds = 0._wp 
     91                  ENDIF 
     92                  ! update salinity 
     93                  s_i_1d(ji) = s_i_1d(ji) + zds 
     94                  ! salt flux 
     95                  sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice 
     96               ENDIF 
     97               ! 
     98               ! --- salinity must stay inbounds --- ! 
     99               zds =       MAX( 0._wp, rn_simin - s_i_1d(ji) ) ! > 0 if s_i < simin 
     100               zds = zds + MIN( 0._wp, rn_simax - s_i_1d(ji) ) ! < 0 if s_i > simax 
     101               ! update salinity 
     102               s_i_1d(ji) = s_i_1d(ji) + zds 
     103               ! salt flux 
     104               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * zds * r1_Dt_ice 
     105               ! 
    84106            ENDIF 
    85107            ! 
    86             IF( ld_sal ) THEN 
    87                !--------------------------------------------------------- 
    88                !  Update ice salinity from brine drainage and flushing 
    89                !--------------------------------------------------------- 
    90                iflush   = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rt0         ) )  ! =1 if summer  
    91                igravdr  = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )  ! =1 if t_su < t_bo 
    92  
    93                zs_i_gd = - igravdr * MAX( s_i_1d(ji) - rn_sal_gd , 0._wp ) * z1_time_gd  ! gravity drainage  
    94                zs_i_fl = - iflush  * MAX( s_i_1d(ji) - rn_sal_fl , 0._wp ) * z1_time_fl  ! flushing 
    95                 
    96                ! Update salinity    
    97                s_i_1d(ji) = s_i_1d(ji) + zs_i_fl + zs_i_gd 
    98                 
    99                ! Salt flux 
    100                sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoi * a_i_1d(ji) * h_i_1d(ji) * ( zs_i_fl + zs_i_gd ) * r1_Dt_ice 
    101             ENDIF 
    102108         END DO 
    103109         ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_zdf.F90

    r12377 r13571  
    8585      INTEGER  ::   ios, ioptio   ! Local integer 
    8686      !! 
    87       NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, rn_kappa_i 
     87      NAMELIST/namthd_zdf/ ln_zdf_BL99, ln_cndi_U64, ln_cndi_P07, rn_cnd_s, & 
     88         &                 rn_kappa_i, rn_kappa_s, rn_kappa_smlt, rn_kappa_sdry, ln_zdf_chkcvg 
    8889      !!------------------------------------------------------------------- 
    8990      ! 
     
    99100         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    100101         WRITE(numout,*) '   Namelist namthd_zdf:' 
    101          WRITE(numout,*) '      Bitz and Lipscomb (1999) formulation                    ln_zdf_BL99  = ', ln_zdf_BL99 
    102          WRITE(numout,*) '      thermal conductivity in the ice (Untersteiner 1964)     ln_cndi_U64  = ', ln_cndi_U64 
    103          WRITE(numout,*) '      thermal conductivity in the ice (Pringle et al 2007)    ln_cndi_P07  = ', ln_cndi_P07 
    104          WRITE(numout,*) '      thermal conductivity in the snow                        rn_cnd_s     = ', rn_cnd_s 
    105          WRITE(numout,*) '      extinction radiation parameter in sea ice               rn_kappa_i   = ', rn_kappa_i 
     102         WRITE(numout,*) '      Bitz and Lipscomb (1999) formulation                      ln_zdf_BL99   = ', ln_zdf_BL99 
     103         WRITE(numout,*) '      thermal conductivity in the ice (Untersteiner 1964)       ln_cndi_U64   = ', ln_cndi_U64 
     104         WRITE(numout,*) '      thermal conductivity in the ice (Pringle et al 2007)      ln_cndi_P07   = ', ln_cndi_P07 
     105         WRITE(numout,*) '      thermal conductivity in the snow                          rn_cnd_s      = ', rn_cnd_s 
     106         WRITE(numout,*) '      extinction radiation parameter in sea ice                 rn_kappa_i    = ', rn_kappa_i 
     107         WRITE(numout,*) '      extinction radiation parameter in snw      (nn_qtrice=0)  rn_kappa_s    = ', rn_kappa_s 
     108         WRITE(numout,*) '      extinction radiation parameter in melt snw (nn_qtrice=1)  rn_kappa_smlt = ', rn_kappa_smlt 
     109         WRITE(numout,*) '      extinction radiation parameter in dry  snw (nn_qtrice=1)  rn_kappa_sdry = ', rn_kappa_sdry 
     110         WRITE(numout,*) '      check convergence of heat diffusion scheme                ln_zdf_chkcvg = ', ln_zdf_chkcvg 
    106111      ENDIF 
    107112      ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icethd_zdf_bl99.F90

    r12489 r13571  
    8585 
    8686      LOGICAL, DIMENSION(jpij) ::   l_T_converged   ! true when T converges (per grid point) 
    87 ! 
     87      ! 
    8888      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    8989      REAL(wp) ::   zg1       =  2._wp        ! 
    9090      REAL(wp) ::   zgamma    =  18009._wp    ! for specific heat 
    9191      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
    92       REAL(wp) ::   zraext_s  =  10._wp       ! extinction coefficient of radiation in the snow 
    9392      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
    9493      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered at 0C  
    9594      REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature  
    96       REAL(wp) ::   zhs_min   =  0.01_wp      ! minimum snow thickness for conductivity calculation  
     95      REAL(wp) ::   zhs_ssl   =  0.03_wp      ! surface scattering layer in the snow  
     96      REAL(wp) ::   zhi_ssl   =  0.10_wp      ! surface scattering layer in the ice 
     97      REAL(wp) ::   zh_min    =  1.e-3_wp     ! minimum ice/snow thickness for conduction 
    9798      REAL(wp) ::   ztmelts                   ! ice melting temperature 
    9899      REAL(wp) ::   zdti_max                  ! current maximal error on temperature  
    99100      REAL(wp) ::   zcpi                      ! Ice specific heat 
    100101      REAL(wp) ::   zhfx_err, zdq             ! diag errors on heat 
    101       REAL(wp) ::   zfac                      ! dummy factor 
    102       ! 
    103       REAL(wp), DIMENSION(jpij) ::   isnow        ! switch for presence (1) or absence (0) of snow 
     102      ! 
     103      REAL(wp), DIMENSION(jpij) ::   zraext_s     ! extinction coefficient of radiation in the snow 
    104104      REAL(wp), DIMENSION(jpij) ::   ztsub        ! surface temperature at previous iteration 
    105105      REAL(wp), DIMENSION(jpij) ::   zh_i, z1_h_i ! ice layer thickness 
     
    124124      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zkappa_s    ! Kappa factor in the snow 
    125125      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeta_s      ! Eta factor in the snow 
     126      REAL(wp), DIMENSION(jpij)            ::   zkappa_comb ! Combined snow and ice surface conductivity 
    126127      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindterm    ! 'Ind'ependent term 
    127128      REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindtbis    ! Temporary 'ind'ependent term 
     
    130131      REAL(wp), DIMENSION(jpij)            ::   zq_ini      ! diag errors on heat 
    131132      REAL(wp), DIMENSION(jpij)            ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat 
     133      REAL(wp), DIMENSION(jpij)            ::   za_s_fra    ! ice fraction covered by snow  
     134      REAL(wp), DIMENSION(jpij)            ::   isnow       ! snow presence (1) or not (0)  
     135      REAL(wp), DIMENSION(jpij)            ::   isnow_comb  ! snow presence for met-office  
    132136      ! 
    133137      ! Mono-category 
     
    143147      END DO 
    144148 
     149      ! calculate ice fraction covered by snow for radiation 
     150      CALL ice_var_snwfra( h_s_1d(1:npti), za_s_fra(1:npti) ) 
     151       
    145152      !------------------ 
    146153      ! 1) Initialization 
    147154      !------------------ 
     155      ! 
     156      ! extinction radiation in the snow 
     157      IF    ( nn_qtrice == 0 ) THEN   ! constant  
     158         zraext_s(1:npti) = rn_kappa_s 
     159      ELSEIF( nn_qtrice == 1 ) THEN   ! depends on melting/freezing conditions 
     160         WHERE( t_su_1d(1:npti) < rt0 )   ;   zraext_s(1:npti) = rn_kappa_sdry   ! no surface melting 
     161         ELSEWHERE                        ;   zraext_s(1:npti) = rn_kappa_smlt   !    surface melting 
     162         END WHERE 
     163      ENDIF 
     164      ! 
     165      ! thicknesses 
    148166      DO ji = 1, npti 
    149          isnow(ji) = 1._wp - MAX( 0._wp , SIGN(1._wp, - h_s_1d(ji) ) )  ! is there snow or not 
    150          ! layer thickness 
    151          zh_i(ji) = h_i_1d(ji) * r1_nlay_i 
    152          zh_s(ji) = h_s_1d(ji) * r1_nlay_s 
     167         ! ice thickness 
     168         IF( h_i_1d(ji) > 0._wp ) THEN  
     169            zh_i  (ji) = MAX( zh_min , h_i_1d(ji) ) * r1_nlay_i ! set a minimum thickness for conduction 
     170            z1_h_i(ji) = 1._wp / zh_i(ji)                       !       it must be very small 
     171         ELSE 
     172            zh_i  (ji) = 0._wp 
     173            z1_h_i(ji) = 0._wp 
     174         ENDIF 
     175         ! snow thickness 
     176         IF( h_s_1d(ji) > 0._wp ) THEN 
     177            zh_s  (ji) = MAX( zh_min , h_s_1d(ji) ) * r1_nlay_s ! set a minimum thickness for conduction 
     178            z1_h_s(ji) = 1._wp / zh_s(ji)                       !       it must be very small 
     179            isnow (ji) = 1._wp 
     180         ELSE 
     181            zh_s  (ji) = 0._wp 
     182            z1_h_s(ji) = 0._wp 
     183            isnow (ji) = 0._wp 
     184         ENDIF 
     185         ! for Met-Office 
     186         IF( h_s_1d(ji) < zh_min ) THEN 
     187            isnow_comb(ji) = h_s_1d(ji) / zh_min 
     188         ELSE 
     189            isnow_comb(ji) = 1._wp 
     190         ENDIF 
    153191      END DO 
    154       ! 
    155       WHERE( zh_i(1:npti) >= epsi10 )   ;   z1_h_i(1:npti) = 1._wp / zh_i(1:npti) 
    156       ELSEWHERE                         ;   z1_h_i(1:npti) = 0._wp 
    157       END WHERE 
    158       ! 
    159       WHERE( zh_s(1:npti) > 0._wp   )       zh_s(1:npti) = MAX( zhs_min * r1_nlay_s, zh_s(1:npti) ) 
    160       ! 
    161       WHERE( zh_s(1:npti) > 0._wp   )   ;   z1_h_s(1:npti) = 1._wp / zh_s(1:npti) 
    162       ELSEWHERE                         ;   z1_h_s(1:npti) = 0._wp 
    163       END WHERE 
     192      ! clem: we should apply correction on snow thickness to take into account snow fraction 
     193      !       it must be a distribution, so it is a bit complicated 
    164194      ! 
    165195      ! Store initial temperatures and non solar heat fluxes 
    166196      IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_EMU ) THEN 
    167          ! 
    168197         ztsub      (1:npti) = t_su_1d(1:npti)                          ! surface temperature at iteration n-1 
    169198         ztsuold    (1:npti) = t_su_1d(1:npti)                          ! surface temperature initial value 
     
    185214         DO ji = 1, npti 
    186215            !                             ! radiation transmitted below the layer-th snow layer 
    187