New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13727 for NEMO/branches/2020/dev_12905_xios_restart/src/ICE – NEMO

Ignore:
Timestamp:
2020-11-05T15:18:53+01:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2462: Upate to trunk rev 13688

Location:
NEMO/branches/2020/dev_12905_xios_restart
Files:
30 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_12905_xios_restart

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/ice.F90

    r12969 r13727  
    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)  
    … …  
    173184   INTEGER, PUBLIC, PARAMETER ::   np_cnd_ON  = 1  !: forcing from conduction flux (SM0L) (compute qcn and qsr_tr via sbcblk.F90 or sbccpl.F90) 
    174185   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) 
    175  
     186   INTEGER, PUBLIC ::   nn_qtrice         !: Solar flux transmitted thru the surface scattering layer: 
     187   !                                      !   = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow)  
     188   !                                      !   = 1  Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 
     189   ! 
    176190   !                                     !!** ice-vertical diffusion namelist (namthd_zdf) ** 
    177191   LOGICAL , PUBLIC ::   ln_cndi_U64      !: thermal conductivity: Untersteiner (1964) 
    178192   LOGICAL , PUBLIC ::   ln_cndi_P07      !: thermal conductivity: Pringle et al (2007) 
    179    REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    180193   REAL(wp), PUBLIC ::   rn_cnd_s         !: thermal conductivity of the snow [W/m/K]    
     194   REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation in sea ice, Grenfell et al. (2006) [1/m] 
     195   REAL(wp), PUBLIC ::   rn_kappa_s       !: coef. for the extinction of radiation in snw (nn_qtrice=0) [1/m] 
     196   REAL(wp), PUBLIC ::   rn_kappa_smlt    !: coef. for the extinction of radiation in melt snw (nn_qtrice=1) [1/m] 
     197   REAL(wp), PUBLIC ::   rn_kappa_sdry    !: coef. for the extinction of radiation in dry  snw (nn_qtrice=1) [1/m] 
     198   LOGICAL , PUBLIC ::   ln_zdf_chkcvg    !: check convergence of heat diffusion scheme 
    181199 
    182200   !                                     !!** ice-salinity namelist (namthd_sal) ** 
    … …  
    191209   !                                     !!** ice-ponds namelist (namthd_pnd) 
    192210   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    193    LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012 
     211   LOGICAL , PUBLIC ::   ln_pnd_LEV       !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 
     212   REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum ice fraction that contributes to melt ponds 
     213   REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum ice fraction that contributes to melt ponds 
    194214   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    195215   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    196216   REAL(wp), PUBLIC ::   rn_hpnd          !: prescribed pond depth    (0<rn_hpnd<1) 
     217   LOGICAL,  PUBLIC ::   ln_pnd_lids      !: Allow ponds to have frozen lids 
    197218   LOGICAL , PUBLIC ::   ln_pnd_alb       !: melt ponds affect albedo 
    198219 
    … …  
    219240 
    220241   !                                     !!** define arrays 
    221    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce,v_oce !: surface ocean velocity used in ice dynamics 
    222    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_i_new    !: ice collection thickness accreted in leads 
    223    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
    224    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
    225    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i     !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
    226    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i      !: Divergence of the velocity field             [s-1] 
    227    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i     !: Shear of the velocity field                  [s-1] 
    228    ! 
    229    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    230    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
    231    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsb_ice_bot !: net downward heat flux from the ice to the ocean 
    232    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
    233  
    234    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: mass flux from snow-ocean mass exchange             [kg.m-2.s-1] 
    235    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sni !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 
    236    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sum !: mass flux from surface melt component of wfx_snw    [kg.m-2.s-1] 
    237    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_pnd     !: mass flux from melt pond-ocean mass exchange        [kg.m-2.s-1] 
    238    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: mass flux from snow precipitation on ice            [kg.m-2.s-1] 
    239    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: mass flux from sublimation of snow/ice              [kg.m-2.s-1] 
    240    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sub !: mass flux from snow sublimation                     [kg.m-2.s-1] 
    241    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice_sub !: mass flux from ice sublimation                      [kg.m-2.s-1] 
    242  
    243    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_dyn !: mass flux from dynamical component of wfx_snw       [kg.m-2.s-1] 
    244  
    245    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: mass flux from ice-ocean mass exchange                   [kg.m-2.s-1] 
    246    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni     !: mass flux from snow ice growth component of wfx_ice      [kg.m-2.s-1] 
    247    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw     !: mass flux from lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
    248    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog     !: mass flux from bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
    249    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn     !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
    250    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom     !: mass flux from bottom melt component of wfx_ice          [kg.m-2.s-1] 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum     !: mass flux from surface melt component of wfx_ice         [kg.m-2.s-1] 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_lam     !: mass flux from lateral melt component of wfx_ice         [kg.m-2.s-1] 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res     !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                        [kg.m-2.s-1] 
    255  
    256    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] 
    257    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] 
    258    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] 
    259    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] 
    260    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] 
    261    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] 
    262    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] 
    263    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] 
    264    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] 
    265    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] 
    266  
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth           [W.m-2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt             [W.m-2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt            [W.m-2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation    [W.m-2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice      [W.m-2] 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                             [W.m-2] 
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping => must be 0   [W.m-2] 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_atm_oi   !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
    276    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_oce_ai   !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
     242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_oce,v_oce     !: surface ocean velocity used in ice dynamics 
     243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht_i_new        !: ice collection thickness accreted in leads 
     244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   strength        !: ice strength 
     245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
     246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   delta_i         !: ice rheology elta factor (Flato & Hibler 95) [s-1] 
     247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   divu_i          !: Divergence of the velocity field             [s-1] 
     248   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   shear_i         !: Shear of the velocity field                  [s-1] 
     249   ! 
     250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   t_bo            !: Sea-Ice bottom temperature [Kelvin]      
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qlead           !: heat balance of the lead (or of the open ocean) 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qsb_ice_bot     !: net downward heat flux from the ice to the ocean 
     253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fhld            !: heat flux from the lead used for bottom melting 
     254 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw         !: mass flux from snow-ocean mass exchange             [kg.m-2.s-1] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sni     !: mass flux from snow ice growth component of wfx_snw [kg.m-2.s-1] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sum     !: mass flux from surface melt component of wfx_snw    [kg.m-2.s-1] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_pnd         !: mass flux from melt pond-ocean mass exchange        [kg.m-2.s-1] 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_spr         !: mass flux from snow precipitation on ice            [kg.m-2.s-1] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sub         !: mass flux from sublimation of snow/ice              [kg.m-2.s-1] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_sub     !: mass flux from snow sublimation                     [kg.m-2.s-1] 
     262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_ice_sub     !: mass flux from ice sublimation                      [kg.m-2.s-1] 
     263 
     264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_snw_dyn     !: mass flux from dynamical component of wfx_snw       [kg.m-2.s-1] 
     265 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_ice         !: mass flux from ice-ocean mass exchange                   [kg.m-2.s-1] 
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sni         !: mass flux from snow ice growth component of wfx_ice      [kg.m-2.s-1] 
     268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_opw         !: mass flux from lateral ice growth component of wfx_ice   [kg.m-2.s-1] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_bog         !: mass flux from bottom ice growth component of wfx_ice    [kg.m-2.s-1] 
     270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_dyn         !: mass flux from dynamical ice growth component of wfx_ice [kg.m-2.s-1] 
     271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_bom         !: mass flux from bottom melt component of wfx_ice          [kg.m-2.s-1] 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_sum         !: mass flux from surface melt component of wfx_ice         [kg.m-2.s-1] 
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_lam         !: mass flux from lateral melt component of wfx_ice         [kg.m-2.s-1] 
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_res         !: mass flux from residual component of wfx_ice             [kg.m-2.s-1] 
     275   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wfx_err_sub     !: mass flux error after sublimation                        [kg.m-2.s-1] 
     276 
     277   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] 
     278   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] 
     279   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] 
     280   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] 
     281   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] 
     282   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] 
     283   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] 
     284   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] 
     285   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] 
     286   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] 
     287 
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_bog         !: total heat flux causing bottom ice growth           [W.m-2] 
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_bom         !: total heat flux causing bottom ice melt             [W.m-2] 
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sum         !: total heat flux causing surface ice melt            [W.m-2] 
     291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_opw         !: total heat flux causing open water ice formation    [W.m-2] 
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_dif         !: total heat flux causing Temp change in the ice      [W.m-2] 
     293   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_snw         !: heat flux for snow melt                             [W.m-2] 
     294   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_err_dif     !: heat flux remaining due to change in non-solar flux [W.m-2] 
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_atm_oi       !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
     296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qt_oce_ai       !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
    277297    
    278298   ! heat flux associated with ice-atmosphere mass exchange 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation            [W.m-2] 
    280    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  [W.m-2] 
     299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_sub         !: heat flux for sublimation            [W.m-2] 
     300   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_spr         !: heat flux of the snow precipitation  [W.m-2] 
    281301 
    282302   ! heat flux associated with ice-ocean mass exchange 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
    284    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from ridging                      [W.m-2] 
    285    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: heat flux due to correction on ice thick. (residual)  [W.m-2] 
    286  
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot    !: transmitted solar radiation under ice 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice         !: temperature of the first layer                (ln_cndflx=T) [K] 
    290    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice        !: effective conductivity at the top of ice/snow (ln_cndflx=T) [W.m-2.K-1] 
     303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_thd         !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
     304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_dyn         !: ice-ocean heat flux from ridging                      [W.m-2] 
     305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hfx_res         !: heat flux due to correction on ice thick. (residual)  [W.m-2] 
     306 
     307   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d      !: maximum ice concentration 2d array 
     308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_ice_bot     !: transmitted solar radiation under ice 
     309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t1_ice          !: temperature of the first layer          (ln_cndflx=T) [K] 
     310   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   cnd_ice         !: effective conductivity of the 1st layer (ln_cndflx=T) [W.m-2.K-1] 
    291311 
    292312   !!---------------------------------------------------------------------- 
    … …  
    294314   !!---------------------------------------------------------------------- 
    295315   !! Variables defined for each ice category 
    296    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness                           (m) 
    297    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
    298    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area                (m) 
    299    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area               (m) 
    300    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_s       !: Snow thickness                          (m) 
    301    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature             (K) 
    302    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   s_i       !: Sea-Ice Bulk salinity                   (pss) 
    303    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sv_i      !: Sea-Ice Bulk salinity * volume per area (pss.m) 
    304    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age                             (s) 
    305    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area              (s) 
    306    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume 
     316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_i           !: Ice thickness                           (m) 
     317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i           !: Ice fractional areas (concentration) 
     318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_i           !: Ice volume per unit area                (m) 
     319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s           !: Snow volume per unit area               (m) 
     320   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_s           !: Snow thickness                          (m) 
     321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   t_su          !: Sea-Ice Surface Temperature             (K) 
     322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   s_i           !: Sea-Ice Bulk salinity                   (pss) 
     323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sv_i          !: Sea-Ice Bulk salinity * volume per area (pss.m) 
     324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   o_i           !: Sea-Ice Age                             (s) 
     325   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   oa_i          !: Sea-Ice Age times ice area              (s) 
     326   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   bv_i          !: brine volume 
    307327 
    308328   !! Variables summed over all categories, or associated to all the ice in a single grid cell 
    309    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity                          (m/s) 
    310    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area                 (m) 
    311    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   st_i         !: Total ice salinity content                              (pss.m) 
    312    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
    313    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
    314    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s  !: ice and snow total heat content                         (J/m2) 
    315    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories                (K) 
    316    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_s         !: mean snw temperature over all categories                (K) 
    317    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories 
    318    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sm_i         !: mean sea ice salinity averaged over all categories      (pss) 
    319    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories            (K) 
    320    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_i         !: mean ice  thickness over all categories                 (m) 
    321    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_s         !: mean snow thickness over all categories                 (m) 
    322    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories                        (s) 
    323    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction on ocean bottom (landfast param activated) 
    324  
    325    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures     [K] 
    326    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow enthalpy         [J/m2] 
    327    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures      [K] 
    328    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice enthalpy          [J/m2] 
    329    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i     !: ice salinity          [PSS] 
    330  
    331    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond concentration 
    332    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area      [m] 
    333    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond fraction (a_ip/a_i) 
    334    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond depth                          [m] 
    335  
    336    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond concentration 
    337    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_ip      !: mean melt pond depth                     [m] 
    338    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per gridcell area [m] 
    339  
    340    !!---------------------------------------------------------------------- 
    341    !! * Old values of global variables 
    342    !!---------------------------------------------------------------------- 
    343    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 
    344    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b, oa_i_b                 !: 
    345    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                                 !: snow heat content 
    346    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                                 !: ice temperatures 
    347    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b                      !: ice velocity 
    348    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                                !: ice concentration (total) 
     329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice, v_ice  !: components of the ice velocity                          (m/s) 
     330   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_i , vt_s   !: ice and snow total volume per unit area                 (m) 
     331   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   st_i          !: Total ice salinity content                              (pss.m) 
     332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i          !: ice total fractional area (ice concentration) 
     333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   ato_i         !: =1-at_i ; total open water fractional area 
     334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   et_i , et_s   !: ice and snow total heat content                         (J/m2) 
     335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_i          !: mean ice temperature over all categories                (K) 
     336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_s          !: mean snw temperature over all categories                (K) 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   bvm_i         !: brine volume averaged over all categories 
     338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sm_i          !: mean sea ice salinity averaged over all categories      (pss) 
     339   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_su         !: mean surface temperature over all categories            (K) 
     340   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_i          !: mean ice  thickness over all categories                 (m) 
     341   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_s          !: mean snow thickness over all categories                 (m) 
     342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   om_i          !: mean ice age over all categories                        (s) 
     343   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tau_icebfr    !: ice friction on ocean bottom (landfast param activated) 
     344 
     345   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s           !: Snow temperatures     [K] 
     346   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s           !: Snow enthalpy         [J/m2] 
     347   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i           !: ice temperatures      [K] 
     348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i           !: ice enthalpy          [J/m2] 
     349   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i          !: ice salinity          [PSS] 
     350 
     351   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip          !: melt pond concentration 
     352   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_ip          !: melt pond volume per grid cell area      [m] 
     353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip_frac     !: melt pond fraction (a_ip/a_i) 
     354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_ip_eff      !: melt pond effective fraction (not covered up by lid) (a_ip/a_i) 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_ip          !: melt pond depth                          [m] 
     356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_il          !: melt pond lid volume                     [m] 
     357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   h_il          !: melt pond lid thickness                  [m] 
     358 
     359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_ip         !: total melt pond concentration 
     360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_ip         !: mean melt pond depth                     [m] 
     361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_ip         !: total melt pond volume per gridcell area [m] 
     362   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   hm_il         !: mean melt pond lid depth                     [m] 
     363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_il         !: total melt pond lid volume per gridcell area [m] 
     364 
     365   !!---------------------------------------------------------------------- 
     366   !! * Global variables at before time step 
     367   !!---------------------------------------------------------------------- 
     368   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 
     369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b              !: 
     370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
     371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
     372   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
     373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total) 
    349374             
    350375   !!---------------------------------------------------------------------- 
    351376   !! * Ice thickness distribution variables 
    352377   !!---------------------------------------------------------------------- 
    353    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    354    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hi_mean        !: Mean ice thickness in catgories  
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max            !: Boundary of ice thickness categories in thickness space 
     379   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean           !: Mean ice thickness in catgories  
    355380   ! 
    356381   !!---------------------------------------------------------------------- 
    357382   !! * Ice diagnostics 
    358383   !!---------------------------------------------------------------------- 
    359    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi   !: transport of ice volume 
    360    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs   !: transport of snw volume 
    361    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_ei   !: transport of ice enthalpy [W/m2] 
    362    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_es   !: transport of snw enthalpy [W/m2] 
    363    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv   !: transport of salt content 
    364    ! 
    365    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice     !: ice salt content variation   []  
    367    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice     !: ice volume variation   [m/s]  
    368    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw     !: snw volume variation   [m/s]  
    369  
     384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vi       !: transport of ice volume 
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_vs       !: transport of snw volume 
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_ei       !: transport of ice enthalpy [W/m2] 
     387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_es       !: transport of snw enthalpy [W/m2] 
     388   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_trp_sv       !: transport of salt content 
     389   ! 
     390   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_heat         !: snw/ice heat content variation   [W/m2]  
     391   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_sice         !: ice salt content variation   []  
     392   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vice         !: ice volume variation   [m/s]  
     393   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s]  
     394   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_aice         !: ice conc.  variation   [s-1]  
     395   ! 
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_adv_mass     !: advection of mass (kg/m2/s) 
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_adv_salt     !: advection of salt (g/m2/s) 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_adv_heat     !: advection of heat (W/m2) 
     399   ! 
    370400   !!---------------------------------------------------------------------- 
    371401   !! * Ice conservation 
    372402   !!---------------------------------------------------------------------- 
    373    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v        !: conservation of ice volume 
    374    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s        !: conservation of ice salt 
    375    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t        !: conservation of ice heat 
    376    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv       !: conservation of ice volume 
    377    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs       !: conservation of ice salt 
    378    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft       !: conservation of ice heat 
     403   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_v            !: conservation of ice volume 
     404   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_s            !: conservation of ice salt 
     405   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_t            !: conservation of ice heat 
     406   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fv           !: conservation of ice volume 
     407   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_fs           !: conservation of ice salt 
     408   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_ft           !: conservation of ice heat 
    379409   ! 
    380410   !!---------------------------------------------------------------------- 
    … …  
    382412   !!---------------------------------------------------------------------- 
    383413   ! Extra sea ice diagnostics to address the data request 
    384    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si          !: Temperature at Snow-ice interface (K)  
    385    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si         !: mean temperature at the snow-ice interface (K)  
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot   !: Bottom  conduction flux (W/m2) 
    387    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top   !: Surface conduction flux (W/m2) 
    388  
     414   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_si            !: Temperature at Snow-ice interface (K)  
     415   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tm_si           !: mean temperature at the snow-ice interface (K)  
     416   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_bot     !: Bottom  conduction flux (W/m2) 
     417   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top     !: Surface conduction flux (W/m2) 
    389418   ! 
    390419   !!---------------------------------------------------------------------- 
    … …  
    425454         &      hfx_sum    (jpi,jpj) , hfx_bom   (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
    426455         &      hfx_opw    (jpi,jpj) , hfx_thd   (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
    427          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)             , STAT=ierr(ii) ) 
     456         &      hfx_err_dif(jpi,jpj) , wfx_err_sub(jpi,jpj)                   , STAT=ierr(ii) ) 
    428457 
    429458      ! * Ice global state variables 
    … …  
    449478 
    450479      ii = ii + 1 
    451       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) ) 
    452  
    453       ii = ii + 1 
    454       ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
     480      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl),  & 
     481         &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 
     482 
     483      ii = ii + 1 
     484      ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) ) 
    455485 
    456486      ! * Old values of global variables 
    457487      ii = ii + 1 
    458       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),  & 
    459          &      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) ,               & 
    460          &      oa_i_b(jpi,jpj,jpl)                                                   , STAT=ierr(ii) ) 
     488      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),         & 
     489         &      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) , & 
     490         &      STAT=ierr(ii) ) 
    461491 
    462492      ii = ii + 1 
    … …  
    469499      ! * Ice diagnostics 
    470500      ii = ii + 1 
    471       ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),   &  
    472          &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),   & 
    473          &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
     501      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),                      &  
     502         &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),                      & 
     503         &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), diag_aice(jpi,jpj),  & 
     504         &      diag_adv_mass(jpi,jpj), diag_adv_salt(jpi,jpj), diag_adv_heat(jpi,jpj), STAT=ierr(ii) ) 
    474505 
    475506      ! * Ice conservation 
    … …  
    485516      IF( ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) 
    486517      ! 
     518 
    487519   END FUNCTION ice_alloc 
    488520 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/ice1d.F90

    r10786 r13727  
    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 
    … …  
    145145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sst_1d 
    146146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sss_1d 
    147  
     147   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frq_m_1d 
     148 
     149   ! convergence check 
     150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tice_cvgerr_1d   !: convergence of ice/snow temp (dT)          [K] 
     151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tice_cvgstp_1d   !: convergence of ice/snow temp (subtimestep) [-] 
    148152   !  
    149153   !!---------------------- 
    … …  
    157161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ip_2d 
    158162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_ip_2d  
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_il_2d  
    159164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_su_2d  
    160165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_2d 
    … …  
    175180      !!---------------------------------------------------------------------! 
    176181      INTEGER ::   ice1D_alloc   ! return value 
    177       INTEGER ::   ierr(7), ii 
     182      INTEGER ::   ierr(8), ii 
    178183      !!---------------------------------------------------------------------! 
    179184      ierr(:) = 0 
    … …  
    189194         &      hfx_thd_1d(jpij) , hfx_spr_1d    (jpij) ,                      & 
    190195         &      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) ) 
     196         &      hfx_res_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
    192197      ! 
    193198      ii = ii + 1 
    … …  
    208213         &      dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm  (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) ,  &     
    209214         &      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) ,                                                   & 
     215         &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) , v_il_1d (jpij) ,  & 
     216         &      h_il_1d (jpij) , h_ip_1d (jpij) ,                                                       & 
    212217         &      sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d    (jpij) , STAT=ierr(ii) ) 
    213218      ! 
    … …  
    221226      ! 
    222227      ii = ii + 1 
    223       ALLOCATE( sst_1d(jpij) , sss_1d(jpij) , STAT=ierr(ii) ) 
     228      ALLOCATE( sst_1d(jpij) , sss_1d(jpij) , frq_m_1d(jpij) , STAT=ierr(ii) ) 
     229      ! 
     230      ii = ii + 1 
     231      ALLOCATE( tice_cvgerr_1d(jpij) , tice_cvgstp_1d(jpij) , STAT=ierr(ii) ) 
    224232      ! 
    225233      ii = ii + 1 
    226234      ALLOCATE( a_i_2d (jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d (jpij,jpl) , h_ib_2d(jpij,jpl) ,  & 
    227235         &      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) ,                      & 
     236         &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , v_il_2d(jpij,jpl) ,  & 
    229237         &      STAT=ierr(ii) ) 
    230238 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icealb.F90

    r12377 r13727  
    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 
    121          DO_2D_11_11 
    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 
     126         DO_2D( 1, 1, 1, 1 ) 
     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_12905_xios_restart/src/ICE/icecor.F90

    r12489 r13727  
    5555      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    5656      REAL(wp) ::   zsal, zzc 
    57       REAL(wp), DIMENSION(jpi,jpj) ::   zafx   ! concentration trends diag 
    5857      !!---------------------------------------------------------------------- 
    5958      ! controls 
    … …  
    8180      DO jl = 1, jpl 
    8281         WHERE( at_i(:,:) > rn_amax_2d(:,:) )   a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) 
    83       END DO 
    84      
     82      END DO     
     83      !                             !----------------------------------------------------- 
     84      !                             !  Rebin categories with thickness out of bounds     ! 
     85      !                             !----------------------------------------------------- 
     86      IF ( jpl > 1 )   CALL ice_itd_reb( kt ) 
     87      ! 
    8588      !                             !----------------------------------------------------- 
    8689      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
    … …  
    8891         zzc = rhoi * r1_Dt_ice 
    8992         DO jl = 1, jpl 
    90             DO_2D_11_11 
     93            DO_2D( 1, 1, 1, 1 ) 
    9194               zsal = sv_i(ji,jj,jl) 
    9295               sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  ) 
    93                sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux 
     96               IF( kn /= 0 ) & ! no ice-ocean exchanges if kn=0 (for bdy for instance) otherwise conservation diags will fail 
     97                  &   sfx_res(ji,jj) = sfx_res(ji,jj) - ( sv_i(ji,jj,jl) - zsal ) * zzc   ! associated salt flux 
    9498            END_2D 
    9599         END DO 
    96100      ENDIF 
    97       !                             !----------------------------------------------------- 
    98       !                             !  Rebin categories with thickness out of bounds     ! 
    99       !                             !----------------------------------------------------- 
    100       IF ( jpl > 1 )   CALL ice_itd_reb( kt ) 
    101101 
    102       !                             !----------------------------------------------------- 
    103       CALL ice_var_zapsmall         !  Zap small values                                  ! 
    104       !                             !----------------------------------------------------- 
    105  
     102      IF( kn /= 0 ) THEN   ! no zapsmall if kn=0 (for bdy for instance) because we do not want ice-ocean exchanges (wfx,sfx,hfx) 
     103         !                                                              otherwise conservation diags will fail 
     104         !                          !----------------------------------------------------- 
     105         CALL ice_var_zapsmall      !  Zap small values                                  ! 
     106         !                          !----------------------------------------------------- 
     107      ENDIF 
    106108      !                             !----------------------------------------------------- 
    107109      IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values ! 
    108          DO_2D_00_00 
     110         DO_2D( 0, 0, 0, 0 )        !----------------------------------------------------- 
    109111            IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice 
    110112               IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 
    … …  
    114116            ENDIF 
    115117         END_2D 
    116          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     118         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
    117119      ENDIF 
    118  
    119       !                             !----------------------------------------------------- 
    120       SELECT CASE( kn )             !  Diagnostics                                       ! 
    121       !                             !----------------------------------------------------- 
    122       CASE( 1 )                        !--- dyn trend diagnostics 
    123          ! 
    124          IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
    125             diag_heat(:,:) = - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice &      ! W.m-2 
    126                &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice 
    127             diag_sice(:,:) =   SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi 
    128             diag_vice(:,:) =   SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi 
    129             diag_vsnw(:,:) =   SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos 
    130          ENDIF 
    131          !                       ! concentration tendency (dynamics) 
    132          IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
    133             zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice  
    134             CALL iom_put( 'afxdyn' , zafx ) 
    135          ENDIF 
    136          ! 
    137       CASE( 2 )                        !--- thermo trend diagnostics & ice aging 
    138          ! 
    139          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice   ! ice natural aging incrementation 
    140          ! 
    141          IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
    142             diag_heat(:,:) = diag_heat(:,:) & 
    143                &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice & 
    144                &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice 
    145             diag_sice(:,:) = diag_sice(:,:) & 
    146                &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi 
    147             diag_vice(:,:) = diag_vice(:,:) & 
    148                &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi 
    149             diag_vsnw(:,:) = diag_vsnw(:,:) & 
    150                &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos 
    151             CALL iom_put ( 'hfxdhc' , diag_heat )  
    152          ENDIF 
    153          !                       ! concentration tendency (total + thermo) 
    154          IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
    155             zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 
    156             CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice ) 
    157             CALL iom_put( 'afxtot' , zafx ) 
    158          ENDIF 
    159          ! 
    160       END SELECT 
    161120      ! 
    162121      ! controls 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icectl.F90

    r12649 r13727  
    4343   PUBLIC   ice_prt 
    4444   PUBLIC   ice_prt3D 
     45   PUBLIC   ice_drift_wri 
     46   PUBLIC   ice_drift_init 
    4547 
    4648   ! thresold rates for conservation 
    … …  
    4951   REAL(wp), PARAMETER ::   zchk_s   = 2.5e-6   ! g/m2/s  <=> 1e-6 m of ice per hour spuriously gained/lost (considering s=10g/kg) 
    5052   REAL(wp), PARAMETER ::   zchk_t   = 7.5e-2   ! W/m2    <=> 1e-6 m of ice per hour spuriously gained/lost (considering Lf=3e5J/kg) 
     53 
     54   ! for drift outputs 
     55   CHARACTER(LEN=50)   ::   clname="icedrift_diagnostics.ascii"   ! ascii filename 
     56   INTEGER             ::   numicedrift                           ! outfile unit 
     57   REAL(wp)            ::   rdiag_icemass, rdiag_icesalt, rdiag_iceheat  
     58   REAL(wp)            ::   rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat  
    5159    
    5260   !! * Substitutions 
    … …  
    132140 
    133141         ! -- advection scheme is conservative? -- ! 
    134          zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 (only for Prather) 
    135          zetrp = glob_sum( 'icectl', ( diag_trp_ei        + diag_trp_es        ) * e1e2t ) ! must be close to 0 (only for Prather) 
     142         zvtrp = glob_sum( 'icectl', diag_adv_mass * e1e2t ) 
     143         zetrp = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
    136144 
    137145         ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    … …  
    156164               &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_amax 
    157165            ! check if advection scheme is conservative 
    158             !    only check for Prather because Ultimate-Macho uses corrective fluxes (wfx etc) 
    159             !    so the formulation for conservation is different (and not coded)  
    160             !    it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now 
    161             !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    162             !   &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 
     166            IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
     167               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 
     168            IF( ABS(zetrp) > zchk_t * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
     169               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rdt_ice 
    163170         ENDIF 
    164171         ! 
    … …  
    186193      ! water flux 
    187194      ! -- mass diag -- ! 
    188       zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) 
     195      zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
     196         &                              + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) 
    189197 
    190198      ! -- salt diag -- ! 
    191       zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t ) 
     199      zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) 
    192200 
    193201      ! -- heat diag -- ! 
    194       ! clem: not the good formulation 
    195       !!zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr  & 
    196       !!   &                              ) * e1e2t ) 
     202      zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     203      ! equivalent to this: 
     204      !!zdiag_heat = glob_sum( 'icectl', ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 
     205      !!   &                                          - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr & 
     206      !!   &                                          ) * e1e2t ) 
    197207 
    198208      ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
    … …  
    204214         IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
    205215            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rDt_ice 
    206          !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
     216         IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 
     217            &                   WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
    207218      ENDIF 
    208219      ! 
    … …  
    350361      !!                   ***  ROUTINE ice_ctl ***  
    351362      !!                  
    352       !! ** Purpose :   Alerts in case of model crash 
     363      !! ** Purpose :   control checks 
    353364      !!------------------------------------------------------------------- 
    354365      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 
     366      INTEGER  ::   ja, ji, jj, jk, jl ! dummy loop indices 
     367      INTEGER  ::   ialert_id          ! number of the current alert 
     368      REAL(wp) ::   ztmelts            ! ice layer melting point 
    359369      CHARACTER (len=30), DIMENSION(20) ::   cl_alname   ! name of alert 
    360370      INTEGER           , DIMENSION(20) ::   inb_alp     ! number of alerts positive 
    361371      !!------------------------------------------------------------------- 
    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 
     372      inb_alp(:) = 0 
     373      ialert_id = 0 
     374       
     375      ! Alert if very high salinity 
     376      ialert_id = ialert_id + 1 ! reference number of this alert 
     377      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    369378      DO jl = 1, jpl 
    370          DO_2D_11_11 
    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 
     379         DO_2D( 1, 1, 1, 1 ) 
     380            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     381               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
     382                  WRITE(numout,*) ' ALERTE :   Very high salinity ',sv_i(ji,jj,jl)/v_i(ji,jj,jl) 
     383                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     384                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     385               ENDIF 
    374386            ENDIF 
    375387         END_2D 
    376388      END DO 
    377389 
    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_11_11 
    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_11_11 
    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_11_11 
    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_11_11 
    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 
     390      ! Alert if very low salinity 
     391      ialert_id = ialert_id + 1 ! reference number of this alert 
     392      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    428393      DO jl = 1, jpl 
    429          DO_2D_11_11 
    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 
     394         DO_2D( 1, 1, 1, 1 ) 
     395            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
     396               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
     397                  WRITE(numout,*) ' ALERTE :   Very low salinity ',sv_i(ji,jj,jl),v_i(ji,jj,jl) 
     398                  WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     399                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     400               ENDIF 
    434401            ENDIF 
    435402         END_2D 
    436403      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_11_11 
    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 
     404 
     405      ! Alert if very cold ice 
     406      ialert_id = ialert_id + 1 ! reference number of this alert 
     407      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    455408      DO jl = 1, jpl 
    456          DO_2D_11_11 
    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 
    471       DO jl = 1, jpl 
    472          DO_3D_11_11( 1, nlay_i ) 
     409         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    473410            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' 
     411            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     412               WRITE(numout,*) ' ALERTE :   Very cold ice ',(t_i(ji,jj,jk,jl)-rt0) 
     413               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
    477414              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    478415            ENDIF 
    479416         END_3D 
    480417      END DO 
     418   
     419      ! Alert if very warm ice 
     420      ialert_id = ialert_id + 1 ! reference number of this alert 
     421      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
     422      DO jl = 1, jpl 
     423         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     424            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
     425            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
     426               WRITE(numout,*) ' ALERTE :   Very warm ice',(t_i(ji,jj,jk,jl)-rt0) 
     427               WRITE(numout,*) ' at i,j,k,l = ',ji,jj,jk,jl 
     428              inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     429            ENDIF 
     430         END_3D 
     431      END DO 
     432       
     433      ! Alerte if very thick ice 
     434      ialert_id = ialert_id + 1 ! reference number of this alert 
     435      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
     436      jl = jpl  
     437      DO_2D( 1, 1, 1, 1 ) 
     438         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
     439            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
     440            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     441            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     442         ENDIF 
     443      END_2D 
     444 
     445      ! Alerte if very thin ice 
     446      ialert_id = ialert_id + 1 ! reference number of this alert 
     447      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
     448      jl = 1  
     449      DO_2D( 1, 1, 1, 1 ) 
     450         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
     451            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
     452            WRITE(numout,*) ' at i,j,l = ',ji,jj,jl 
     453            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     454         ENDIF 
     455      END_2D 
     456 
     457      ! Alert if very fast ice 
     458      ialert_id = ialert_id + 1 ! reference number of this alert 
     459      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
     460      DO_2D( 1, 1, 1, 1 ) 
     461         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
     462            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(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 there is ice on continents 
     469      ialert_id = ialert_id + 1 ! reference number of this alert 
     470      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
     471      DO_2D( 1, 1, 1, 1 ) 
     472         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
     473            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
     474            WRITE(numout,*) ' at i,j = ',ji,jj 
     475            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     476         ENDIF 
     477      END_2D 
     478 
     479      ! Alert if incompatible ice concentration and volume 
     480      ialert_id = ialert_id + 1 ! reference number of this alert 
     481      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
     482      DO_2D( 1, 1, 1, 1 ) 
     483         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
     484            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
     485            WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
     486            WRITE(numout,*) ' at i,j = ',ji,jj 
     487            inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
     488         ENDIF 
     489      END_2D 
    481490 
    482491      ! sum of the alerts on all processors 
    483492      IF( lk_mpp ) THEN 
    484          DO ialert_id = 1, inb_altests 
    485             CALL mpp_sum('icectl', inb_alp(ialert_id)) 
     493         DO ja = 1, ialert_id 
     494            CALL mpp_sum('icectl', inb_alp(ja)) 
    486495         END DO 
    487496      ENDIF 
    … …  
    489498      ! print alerts 
    490499      IF( lwp ) THEN 
    491          ialert_id = 1                                 ! reference number of this alert 
    492          cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert 
    493500         WRITE(numout,*) ' time step ',kt 
    494501         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 ! ' 
     502         DO ja = 1, ialert_id 
     503            WRITE(numout,*) ja, cl_alname(ja)//' : ', inb_alp(ja), ' times ! ' 
    497504         END DO 
    498505      ENDIF 
    … …  
    543550               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    544551               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    545                WRITE(numout,*) 
    546552               WRITE(numout,*) ' - Cell values ' 
    547553               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    … …  
    552558               DO jl = 1, jpl 
    553559                  WRITE(numout,*) ' - Category (', jl,')' 
     560                  WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    554561                  WRITE(numout,*) ' a_i           : ', a_i(ji,jj,jl) 
    555562                  WRITE(numout,*) ' h_i           : ', h_i(ji,jj,jl) 
    … …  
    588595               WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ji,jj) 
    589596               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)   
    591597               WRITE(numout,*) 
    592598                
    … …  
    605611                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    606612                  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) 
    608613               END DO !jl 
    609614                
    … …  
    702707      DO jl = 1, jpl 
    703708         CALL prt_ctl_info(' ') 
    704          CALL prt_ctl_info(' - Category : ', ivar1=jl) 
     709         CALL prt_ctl_info(' - Category : ', ivar=jl) 
    705710         CALL prt_ctl_info('   ~~~~~~~~~~') 
    706711         CALL prt_ctl(tab2d_1=h_i        (:,:,jl)        , clinfo1= ' h_i         : ') 
    … …  
    713718         CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' v_i         : ') 
    714719         CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' v_s         : ') 
    715          CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)      , clinfo1= ' e_i1        : ') 
    716720         CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' e_snow      : ') 
    717721         CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ') 
    … …  
    719723          
    720724         DO jk = 1, nlay_i 
    721             CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
     725            CALL prt_ctl_info(' - Layer : ', ivar=jk) 
    722726            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
     727            CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' e_i       : ') 
    723728         END DO 
    724729      END DO 
    … …  
    731736       
    732737   END SUBROUTINE ice_prt3D 
     738 
     739 
     740   SUBROUTINE ice_drift_wri( kt ) 
     741      !!------------------------------------------------------------------- 
     742      !!                     ***  ROUTINE ice_drift_wri *** 
     743      !! 
     744      !! ** Purpose : conservation of mass, salt and heat 
     745      !!              write the drift in a ascii file at each time step 
     746      !!              and the total run drifts 
     747      !!------------------------------------------------------------------- 
     748      INTEGER, INTENT(in) ::   kt   ! ice time-step index 
     749      ! 
     750      INTEGER  ::   ji, jj 
     751      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 
     752      REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass2D, zdiag_salt2D, zdiag_heat2D 
     753      !!------------------------------------------------------------------- 
     754      ! 
     755      IF( kt == nit000 .AND. lwp ) THEN 
     756         WRITE(numout,*) 
     757         WRITE(numout,*) 'ice_drift_wri: sea-ice drifts' 
     758         WRITE(numout,*) '~~~~~~~~~~~~~' 
     759      ENDIF 
     760      ! 
     761      ! 2D budgets (must be close to 0) 
     762      IF( iom_use('icedrift_mass') .OR. iom_use('icedrift_salt') .OR. iom_use('icedrift_heat') ) THEN 
     763         DO_2D( 1, 1, 1, 1 ) 
     764            zdiag_mass2D(ji,jj) =   wfx_ice(ji,jj)   + wfx_snw(ji,jj)   + wfx_spr(ji,jj) + wfx_sub(ji,jj) & 
     765               &                  + diag_vice(ji,jj) + diag_vsnw(ji,jj) - diag_adv_mass(ji,jj) 
     766            zdiag_salt2D(ji,jj) = sfx(ji,jj) + diag_sice(ji,jj) - diag_adv_salt(ji,jj) 
     767            zdiag_heat2D(ji,jj) = qt_oce_ai(ji,jj) - qt_atm_oi(ji,jj) + diag_heat(ji,jj) - diag_adv_heat(ji,jj) 
     768         END_2D 
     769         ! 
     770         ! write outputs 
     771         CALL iom_put( 'icedrift_mass', zdiag_mass2D ) 
     772         CALL iom_put( 'icedrift_salt', zdiag_salt2D ) 
     773         CALL iom_put( 'icedrift_heat', zdiag_heat2D ) 
     774      ENDIF 
     775 
     776      ! -- mass diag -- ! 
     777      zdiag_mass     = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
     778         &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rdt_ice 
     779      zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rDt_ice 
     780 
     781      ! -- salt diag -- ! 
     782      zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rdt_ice * 1.e-3 
     783      zdiag_adv_salt = glob_sum( 'icectl', diag_adv_salt * e1e2t ) * rDt_ice * 1.e-3 
     784 
     785      ! -- heat diag -- ! 
     786      zdiag_heat     = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     787      zdiag_adv_heat = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
     788 
     789      !                    ! write out to file 
     790      IF( lwp ) THEN 
     791         ! check global drift (must be close to 0) 
     792         WRITE(numicedrift,FMT='(2x,i6,3x,a19,4x,f25.5)') kt, 'mass drift     [kg]', zdiag_mass 
     793         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift     [kg]', zdiag_salt 
     794         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift     [W] ', zdiag_heat 
     795         ! check drift from advection scheme (can be /=0 with bdy but not sure why) 
     796         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'mass drift adv [kg]', zdiag_adv_mass 
     797         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift adv [kg]', zdiag_adv_salt 
     798         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift adv [W] ', zdiag_adv_heat 
     799      ENDIF 
     800      !                    ! drifts 
     801      rdiag_icemass = rdiag_icemass + zdiag_mass 
     802      rdiag_icesalt = rdiag_icesalt + zdiag_salt 
     803      rdiag_iceheat = rdiag_iceheat + zdiag_heat 
     804      rdiag_adv_icemass = rdiag_adv_icemass + zdiag_adv_mass 
     805      rdiag_adv_icesalt = rdiag_adv_icesalt + zdiag_adv_salt 
     806      rdiag_adv_iceheat = rdiag_adv_iceheat + zdiag_adv_heat 
     807      ! 
     808      !                    ! output drifts and close ascii file 
     809      IF( kt == nitend - nn_fsbc + 1 .AND. lwp ) THEN 
     810         ! to ascii file 
     811         WRITE(numicedrift,*) '******************************************' 
     812         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run mass drift     [kg]', rdiag_icemass 
     813         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run mass drift adv [kg]', rdiag_adv_icemass 
     814         WRITE(numicedrift,*) '******************************************' 
     815         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run salt drift     [kg]', rdiag_icesalt 
     816         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run salt drift adv [kg]', rdiag_adv_icesalt 
     817         WRITE(numicedrift,*) '******************************************' 
     818         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run heat drift     [W] ', rdiag_iceheat 
     819         WRITE(numicedrift,FMT='(3x,a23,6x,E10.2)') 'Run heat drift adv [W] ', rdiag_adv_iceheat 
     820         CLOSE( numicedrift ) 
     821         ! 
     822         ! to ocean output 
     823         WRITE(numout,*) 
     824         WRITE(numout,*) 'ice_drift_wri: ice drifts information for the run ' 
     825         WRITE(numout,*) '~~~~~~~~~~~~~' 
     826         ! check global drift (must be close to 0) 
     827         WRITE(numout,*) '   sea-ice mass drift     [kg] = ', rdiag_icemass 
     828         WRITE(numout,*) '   sea-ice salt drift     [kg] = ', rdiag_icesalt 
     829         WRITE(numout,*) '   sea-ice heat drift     [W]  = ', rdiag_iceheat 
     830         ! check drift from advection scheme (can be /=0 with bdy but not sure why) 
     831         WRITE(numout,*) '   sea-ice mass drift adv [kg] = ', rdiag_adv_icemass 
     832         WRITE(numout,*) '   sea-ice salt drift adv [kg] = ', rdiag_adv_icesalt 
     833         WRITE(numout,*) '   sea-ice heat drift adv [W]  = ', rdiag_adv_iceheat 
     834      ENDIF 
     835      ! 
     836   END SUBROUTINE ice_drift_wri 
     837 
     838   SUBROUTINE ice_drift_init 
     839      !!---------------------------------------------------------------------- 
     840      !!                  ***  ROUTINE ice_drift_init  *** 
     841      !!                    
     842      !! ** Purpose :   create output file, initialise arrays 
     843      !!---------------------------------------------------------------------- 
     844      ! 
     845      IF( .NOT.ln_icediachk ) RETURN ! exit 
     846      ! 
     847      IF(lwp) THEN 
     848         WRITE(numout,*) 
     849         WRITE(numout,*) 'ice_drift_init: Output ice drifts to ',TRIM(clname), ' file' 
     850         WRITE(numout,*) '~~~~~~~~~~~~~' 
     851         WRITE(numout,*) 
     852         ! 
     853         ! create output ascii file 
     854         CALL ctl_opn( numicedrift, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 
     855         WRITE(numicedrift,*) 'Timestep  Drifts' 
     856         WRITE(numicedrift,*) '******************************************' 
     857      ENDIF 
     858      ! 
     859      rdiag_icemass = 0._wp 
     860      rdiag_icesalt = 0._wp 
     861      rdiag_iceheat = 0._wp 
     862      rdiag_adv_icemass = 0._wp 
     863      rdiag_adv_icesalt = 0._wp 
     864      rdiag_adv_iceheat = 0._wp 
     865      ! 
     866   END SUBROUTINE ice_drift_init 
    733867       
    734868#else 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icedia.F90

    r12969 r13727  
    230230            CALL iom_get( numrir, 'frc_temtop' , frc_temtop, ldxios = lrixios  ) 
    231231            CALL iom_get( numrir, 'frc_tembot' , frc_tembot, ldxios = lrixios  ) 
    232             CALL iom_get( numrir, 'frc_sal'    , frc_sal, ldxios = lrixios     ) 
    233             CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini, ldxios = lrixios ) 
    234             CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini, ldxios = lrixios ) 
    235             CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini, ldxios = lrixios ) 
     232            CALL iom_get( numrir, 'frc_sal'    , frc_sal,    ldxios = lrixios  ) 
     233            CALL iom_get( numrir, jpdom_auto, 'vol_loc_ini', vol_loc_ini, ldxios = lrixios ) 
     234            CALL iom_get( numrir, jpdom_auto, 'tem_loc_ini', tem_loc_ini, ldxios = lrixios ) 
     235            CALL iom_get( numrir, jpdom_auto, 'sal_loc_ini', sal_loc_ini, ldxios = lrixios ) 
    236236            IF(lrixios) CALL iom_swap(cxios_context) 
    237237         ELSE 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icedyn.F90

    r12377 r13727  
    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      ! 
    … …  
    126128         ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 
    127129         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s  
    128          DO_2D_11_11 
    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., zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 
    132             v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1., zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 
     130         DO_2D( 1, 1, 1, 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         ! --- 
    … …  
    155157 
    156158            ALLOCATE( zdivu_i(jpi,jpj) ) 
    157             DO_2D_00_00 
     159            DO_2D( 0, 0, 0, 0 ) 
    158160               zdivu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    159161                  &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 
    160162            END_2D 
    161             CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 
     163            CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1.0_wp ) 
    162164            ! output 
    163165            CALL iom_put( 'icediv' , zdivu_i ) 
    … …  
    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_12905_xios_restart/src/ICE/icedyn_adv.F90

    r12489 r13727  
    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_12905_xios_restart/src/ICE/icedyn_adv_pra.F90

    r12969 r13727  
    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 
    88       REAL(wp) ::   zdt                     !   -      - 
     90      REAL(wp) ::   zdt, z1_dt              !   -      - 
    8991      REAL(wp), DIMENSION(1)                  ::   zcflprv, zcflnow   ! for global communication 
    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 
     102      !! diagnostics 
     103      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat       
    98104      !!---------------------------------------------------------------------- 
    99105      ! 
    100106      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 
    101107      ! 
    102       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
    103       DO jl = 1, jpl 
    104          DO_2D_00_00 
    105             zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
    106                &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
    107                &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
    108                &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
    109             zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
    110                &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
    111                &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
    112                &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
    113             zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
    114                &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
    115                &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    116                &                                               ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 
    117          END_2D 
     108      ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 
     109      ! thickness and salinity 
     110      WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 
     111      ELSEWHERE                      ; zs_i(:,:,:) = 0._wp 
     112      END WHERE 
     113      CALL icemax3D( ph_i , zhi_max ) 
     114      CALL icemax3D( ph_s , zhs_max ) 
     115      CALL icemax3D( ph_ip, zhip_max) 
     116      CALL icemax3D( zs_i , zsi_max ) 
     117      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 ) 
     118      ! 
     119      ! enthalpies 
     120      DO jk = 1, nlay_i 
     121         WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 
     122         ELSEWHERE                      ; ze_i(:,:,jk,:) = 0._wp 
     123         END WHERE 
    118124      END DO 
    119       CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
     125      DO jk = 1, nlay_s 
     126         WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 
     127         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
     128         END WHERE 
     129      END DO    
     130      CALL icemax4D( ze_i , zei_max ) 
     131      CALL icemax4D( ze_s , zes_max ) 
     132      CALL lbc_lnk( 'icedyn_adv_pra', zei_max, 'T', 1._wp ) 
     133      CALL lbc_lnk( 'icedyn_adv_pra', zes_max, 'T', 1._wp ) 
     134      ! 
    120135      ! 
    121136      ! --- If ice drift is too fast, use  subtime steps for advection (CFL test for stability) --- ! 
    … …  
    132147      ENDIF 
    133148      zdt = rDt_ice / REAL(icycle) 
     149      z1_dt = 1._wp / zdt 
    134150       
    135151      ! --- transport --- ! 
    … …  
    138154 
    139155      DO jt = 1, icycle 
     156 
     157         ! diagnostics 
     158         zdiag_adv_mass(:,:) =   SUM(  pv_i(:,:,:) , dim=3 ) * rhoi + SUM(  pv_s(:,:,:) , dim=3 ) * rhos 
     159         zdiag_adv_salt(:,:) =   SUM( psv_i(:,:,:) , dim=3 ) * rhoi 
     160         zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
     161            &                  - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 ) 
    140162 
    141163         ! record at_i before advection (for open water) 
    … …  
    156178               z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    157179            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 
     180            IF ( ln_pnd_LEV ) THEN 
     181               z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond fraction 
     182               z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond volume 
     183               IF ( ln_pnd_lids ) THEN 
     184                  z0vl(:,:,jl) = pv_il(:,:,jl) * e1e2t(:,:)   ! Melt pond lid volume 
     185               ENDIF 
    161186            ENDIF 
    162187         END DO 
    … …  
    189214            END DO 
    190215            ! 
    191             IF ( ln_pnd_H12 ) THEN 
     216            IF ( ln_pnd_LEV ) THEN 
    192217               CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    193218               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )  
    194219               CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    195220               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )  
     221               IF ( ln_pnd_lids ) THEN 
     222                  CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     223                  CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     224               ENDIF 
    196225            ENDIF 
    197226            !                                                               !--------------------------------------------! 
    … …  
    220249                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
    221250            END DO 
    222             IF ( ln_pnd_H12 ) THEN 
     251            IF ( ln_pnd_LEV ) THEN 
    223252               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    224253               CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
    225254               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    226255               CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
     256               IF ( ln_pnd_lids ) THEN 
     257                  CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     258                  CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     259               ENDIF 
    227260            ENDIF 
    228261            ! 
     262         ENDIF 
     263          
     264         ! --- Lateral boundary conditions --- ! 
     265         !     caution: for gradients (sx and sy) the sign changes 
     266         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ice , 'T', 1._wp, sxice , 'T', -1._wp, syice , 'T', -1._wp  & ! ice volume 
     267            &                                , sxxice, 'T', 1._wp, syyice, 'T',  1._wp, sxyice, 'T',  1._wp  & 
     268            &                                , z0snw , 'T', 1._wp, sxsn  , 'T', -1._wp, sysn  , 'T', -1._wp  & ! snw volume 
     269            &                                , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  ) 
     270         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
     271            &                                , sxxsal, 'T', 1._wp, syysal, 'T',  1._wp, sxysal, 'T',  1._wp  & 
     272            &                                , z0ai  , 'T', 1._wp, sxa   , 'T', -1._wp, sya   , 'T', -1._wp  & ! ice concentration 
     273            &                                , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  ) 
     274         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
     275            &                                , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  ) 
     276         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
     277            &                                , sxxc0 , 'T', 1._wp, syyc0 , 'T',  1._wp, sxyc0 , 'T',  1._wp  )  
     278         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
     279            &                                , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
     280         IF ( ln_pnd_LEV ) THEN 
     281            CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     282               &                                , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     283               &                                , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     284               &                                , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  )  
     285            IF ( ln_pnd_lids ) THEN 
     286               CALL lbc_lnk_multi( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume 
     287                  &                                , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  )  
     288            ENDIF 
    229289         ENDIF 
    230290 
    … …  
    242302               pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    243303            END DO 
    244             IF ( ln_pnd_H12 ) THEN 
     304            IF ( ln_pnd_LEV ) THEN 
    245305               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    246306               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     307               IF ( ln_pnd_lids ) THEN 
     308                  pv_il(:,:,jl) = z0vl(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     309               ENDIF 
    247310            ENDIF 
    248311         END DO 
    … …  
    250313         ! derive open water from ice concentration 
    251314         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    252          DO_2D_00_00 
     315         DO_2D( 0, 0, 0, 0 ) 
    253316            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &                        !--- open water 
    254317               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    255318         END_2D 
    256          CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1. ) 
     319         CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T',  1.0_wp ) 
     320         ! 
     321         ! --- diagnostics --- ! 
     322         diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 
     323            &                                        - zdiag_adv_mass(:,:) ) * z1_dt 
     324         diag_adv_salt(:,:) = diag_adv_salt(:,:) + (   SUM( psv_i(:,:,:) , dim=3 ) * rhoi & 
     325            &                                        - zdiag_adv_salt(:,:) ) * z1_dt 
     326         diag_adv_heat(:,:) = diag_adv_heat(:,:) + ( - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
     327            &                                        - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 ) & 
     328            &                                        - zdiag_adv_heat(:,:) ) * z1_dt 
    257329         ! 
    258330         ! --- Ensure non-negative fields --- ! 
    259331         !     Remove negative values (conservation is ensured) 
    260332         !     (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 ) 
     333         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 ) 
    262334         ! 
    263335         ! --- Make sure ice thickness is not too big --- ! 
    264336         !     (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 ) 
     337         CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, zsi_max, zes_max, zei_max, & 
     338            &            pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    266339         ! 
    267340         ! --- Ensure snow load is not too big --- ! 
    … …  
    292365      !!  
    293366      INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices 
     367      INTEGER  ::   jj0                                  ! dummy loop indices 
    294368      REAL(wp) ::   zs1max, zslpmax, ztemp               ! local scalars 
    295369      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !   -      - 
    296370      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !   -      - 
     371      REAL(wp) ::   zpsm, zps0 
     372      REAL(wp) ::   zpsx, zpsy, zpsxx, zpsyy, zpsxy 
    297373      REAL(wp), DIMENSION(jpi,jpj) ::   zf0 , zfx  , zfy   , zbet   ! 2D workspace 
    298374      REAL(wp), DIMENSION(jpi,jpj) ::   zfm , zfxx , zfyy  , zfxy   !  -      - 
    299375      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q         !  -      - 
    300376      !----------------------------------------------------------------------- 
     377      ! in order to avoid lbc_lnk (communications): 
     378      !    jj loop must be 1:jpj   if adv_x is called first 
     379      !                and 2:jpj-1 if adv_x is called second 
     380      jj0 = NINT(pcrh) 
    301381      ! 
    302382      jcat = SIZE( ps0 , 3 )   ! size of input arrays 
    … …  
    305385         ! 
    306386         ! Limitation of moments.                                            
    307          DO_2D_00_11 
    308             !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
    309             psm (ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 
    310             ! 
    311             zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
    312             zs1max  = 1.5 * zslpmax 
    313             zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 
    314             zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    315                &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) )  ) 
    316             rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    317  
    318             ps0 (ji,jj,jl) = zslpmax   
    319             psx (ji,jj,jl) = zs1new         * rswitch 
    320             psxx(ji,jj,jl) = zs2new         * rswitch 
    321             psy (ji,jj,jl) = psy (ji,jj,jl) * rswitch 
    322             psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 
    323             psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
    324          END_2D 
    325  
    326          !  Calculate fluxes and moments between boxes i<-->i+1               
    327          DO_2D_00_11 
    328             zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
    329             zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) 
    330             zalfq        =  zalf * zalf 
    331             zalf1        =  1.0 - zalf 
    332             zalf1q       =  zalf1 * zalf1 
    333             ! 
    334             zfm (ji,jj)  =  zalf  *   psm (ji,jj,jl) 
    335             zf0 (ji,jj)  =  zalf  * ( ps0 (ji,jj,jl) + zalf1 * ( psx(ji,jj,jl) + (zalf1 - zalf) * psxx(ji,jj,jl) ) ) 
    336             zfx (ji,jj)  =  zalfq * ( psx (ji,jj,jl) + 3.0 * zalf1 * psxx(ji,jj,jl) ) 
    337             zfxx(ji,jj)  =  zalf  *   psxx(ji,jj,jl) * zalfq 
    338             zfy (ji,jj)  =  zalf  * ( psy (ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
    339             zfxy(ji,jj)  =  zalfq *   psxy(ji,jj,jl) 
    340             zfyy(ji,jj)  =  zalf  *   psyy(ji,jj,jl) 
    341  
    342             !  Readjust moments remaining in the box. 
    343             psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
    344             ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
    345             psx (ji,jj,jl)  =  zalf1q * ( psx(ji,jj,jl) - 3.0 * zalf * psxx(ji,jj,jl) ) 
    346             psxx(ji,jj,jl)  =  zalf1  * zalf1q * psxx(ji,jj,jl) 
    347             psy (ji,jj,jl)  =  psy (ji,jj,jl) - zfy(ji,jj) 
    348             psyy(ji,jj,jl)  =  psyy(ji,jj,jl) - zfyy(ji,jj) 
    349             psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
    350          END_2D 
    351  
    352          DO_2D_00_10 
    353             zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
    354             zalg  (ji,jj) = zalf 
    355             zalfq         = zalf * zalf 
    356             zalf1         = 1.0 - zalf 
    357             zalg1 (ji,jj) = zalf1 
    358             zalf1q        = zalf1 * zalf1 
    359             zalg1q(ji,jj) = zalf1q 
    360             ! 
    361             zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl) 
    362             zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) & 
    363                &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 
    364             zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 
    365             zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq 
    366             zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 
    367             zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl) 
    368             zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl) 
    369          END_2D 
    370  
    371          DO_2D_00_00 
    372             zbt  =       zbet(ji-1,jj) 
    373             zbt1 = 1.0 - zbet(ji-1,jj) 
    374             ! 
    375             psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 
    376             ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) 
    377             psx (ji,jj,jl) = zalg1q(ji-1,jj) * ( psx(ji,jj,jl) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj,jl) ) 
    378             psxx(ji,jj,jl) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj,jl) 
    379             psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) - zfy (ji-1,jj) ) 
    380             psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 
    381             psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 
    382          END_2D 
    383  
    384          !   Put the temporary moments into appropriate neighboring boxes.     
    385          DO_2D_00_00 
    386             zbt  =       zbet(ji-1,jj) 
    387             zbt1 = 1.0 - zbet(ji-1,jj) 
    388             psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj,jl) 
    389             zalf          = zbt * zfm(ji-1,jj) / psm(ji,jj,jl) 
    390             zalf1         = 1.0 - zalf 
    391             ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji-1,jj) 
    392             ! 
    393             ps0 (ji,jj,jl) =  zbt  * ( ps0(ji,jj,jl) + zf0(ji-1,jj) ) + zbt1 * ps0(ji,jj,jl) 
    394             psx (ji,jj,jl) =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) + zbt1 * psx(ji,jj,jl) 
    395             psxx(ji,jj,jl) =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj,jl)                             & 
    396                &                     + 5.0 * ( zalf * zalf1 * ( psx (ji,jj,jl) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  ) & 
    397                &            + zbt1 * psxx(ji,jj,jl) 
    398             psxy(ji,jj,jl) =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj,jl)             & 
    399                &                     + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj,jl) ) )   & 
    400                &            + zbt1 * psxy(ji,jj,jl) 
    401             psy (ji,jj,jl) =  zbt  * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 
    402             psyy(ji,jj,jl) =  zbt  * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 
    403          END_2D 
    404  
    405          DO_2D_00_00 
    406             zbt  =       zbet(ji,jj) 
    407             zbt1 = 1.0 - zbet(ji,jj) 
    408             psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
    409             zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
    410             zalf1         = 1.0 - zalf 
    411             ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
    412             ! 
    413             ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) + zf0(ji,jj) ) 
    414             psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj,jl) + 3.0 * ztemp ) 
    415             psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * psxx(ji,jj,jl) & 
    416                &                                           + 5.0 * ( zalf * zalf1 * ( - psx(ji,jj,jl) + zfx(ji,jj) )    & 
    417                &                                           + ( zalf1 - zalf ) * ztemp ) ) 
    418             psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
    419                &                                           + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj,jl) ) ) 
    420             psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * ( psy (ji,jj,jl) + zfy (ji,jj) ) 
    421             psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 
    422          END_2D 
    423  
     387         DO jj = Njs0 - jj0, Nje0 + jj0 
     388             
     389            DO ji = Nis0 - 1, Nie0 + 1 
     390 
     391               zpsm  = psm (ji,jj,jl) ! optimization 
     392               zps0  = ps0 (ji,jj,jl) 
     393               zpsx  = psx (ji,jj,jl) 
     394               zpsxx = psxx(ji,jj,jl) 
     395               zpsy  = psy (ji,jj,jl) 
     396               zpsyy = psyy(ji,jj,jl) 
     397               zpsxy = psxy(ji,jj,jl) 
     398 
     399               !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                      
     400               zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * zpsm , epsi20 ) 
     401               ! 
     402               zslpmax = MAX( 0._wp, zps0 ) 
     403               zs1max  = 1.5 * zslpmax 
     404               zs1new  = MIN( zs1max, MAX( -zs1max, zpsx ) ) 
     405               zs2new  = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, zpsxx ) ) 
     406               rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
     407 
     408               zps0  = zslpmax   
     409               zpsx  = zs1new  * rswitch 
     410               zpsxx = zs2new  * rswitch 
     411               zpsy  = zpsy    * rswitch 
     412               zpsyy = zpsyy   * rswitch 
     413               zpsxy = MIN( zslpmax, MAX( -zslpmax, zpsxy ) ) * rswitch 
     414 
     415               !  Calculate fluxes and moments between boxes i<-->i+1               
     416               !                                !  Flux from i to i+1 WHEN u GT 0  
     417               zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     418               zalf         =  MAX( 0._wp, put(ji,jj) ) * pdt / zpsm 
     419               zalfq        =  zalf * zalf 
     420               zalf1        =  1.0 - zalf 
     421               zalf1q       =  zalf1 * zalf1 
     422               ! 
     423               zfm (ji,jj)  =  zalf  *   zpsm  
     424               zf0 (ji,jj)  =  zalf  * ( zps0  + zalf1 * ( zpsx + (zalf1 - zalf) * zpsxx ) ) 
     425               zfx (ji,jj)  =  zalfq * ( zpsx  + 3.0 * zalf1 * zpsxx ) 
     426               zfxx(ji,jj)  =  zalf  *   zpsxx * zalfq 
     427               zfy (ji,jj)  =  zalf  * ( zpsy  + zalf1 * zpsxy ) 
     428               zfxy(ji,jj)  =  zalfq *   zpsxy 
     429               zfyy(ji,jj)  =  zalf  *   zpsyy 
     430 
     431               !                                !  Readjust moments remaining in the box. 
     432               zpsm  =  zpsm  - zfm(ji,jj) 
     433               zps0  =  zps0  - zf0(ji,jj) 
     434               zpsx  =  zalf1q * ( zpsx - 3.0 * zalf * zpsxx ) 
     435               zpsxx =  zalf1  * zalf1q * zpsxx 
     436               zpsy  =  zpsy  - zfy (ji,jj) 
     437               zpsyy =  zpsyy - zfyy(ji,jj) 
     438               zpsxy =  zalf1q * zpsxy 
     439               ! 
     440               psm (ji,jj,jl) = zpsm ! optimization 
     441               ps0 (ji,jj,jl) = zps0  
     442               psx (ji,jj,jl) = zpsx  
     443               psxx(ji,jj,jl) = zpsxx 
     444               psy (ji,jj,jl) = zpsy  
     445               psyy(ji,jj,jl) = zpsyy 
     446               psxy(ji,jj,jl) = zpsxy 
     447               ! 
     448            END DO 
     449             
     450            DO ji = Nis0 - 1, Nie0 
     451               !                                !  Flux from i+1 to i when u LT 0. 
     452               zalf          = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl)  
     453               zalg  (ji,jj) = zalf 
     454               zalfq         = zalf * zalf 
     455               zalf1         = 1.0 - zalf 
     456               zalg1 (ji,jj) = zalf1 
     457               zalf1q        = zalf1 * zalf1 
     458               zalg1q(ji,jj) = zalf1q 
     459               ! 
     460               zfm   (ji,jj) = zfm (ji,jj) + zalf  *    psm (ji+1,jj,jl) 
     461               zf0   (ji,jj) = zf0 (ji,jj) + zalf  * (  ps0 (ji+1,jj,jl) & 
     462                  &                                   - zalf1 * ( psx(ji+1,jj,jl) - (zalf1 - zalf ) * psxx(ji+1,jj,jl) ) ) 
     463               zfx   (ji,jj) = zfx (ji,jj) + zalfq * (  psx (ji+1,jj,jl) - 3.0 * zalf1 * psxx(ji+1,jj,jl) ) 
     464               zfxx  (ji,jj) = zfxx(ji,jj) + zalf  *    psxx(ji+1,jj,jl) * zalfq 
     465               zfy   (ji,jj) = zfy (ji,jj) + zalf  * (  psy (ji+1,jj,jl) - zalf1 * psxy(ji+1,jj,jl) ) 
     466               zfxy  (ji,jj) = zfxy(ji,jj) + zalfq *    psxy(ji+1,jj,jl) 
     467               zfyy  (ji,jj) = zfyy(ji,jj) + zalf  *    psyy(ji+1,jj,jl) 
     468            END DO 
     469 
     470            DO ji = Nis0, Nie0 
     471               ! 
     472               zpsm  = psm (ji,jj,jl) ! optimization 
     473               zps0  = ps0 (ji,jj,jl) 
     474               zpsx  = psx (ji,jj,jl) 
     475               zpsxx = psxx(ji,jj,jl) 
     476               zpsy  = psy (ji,jj,jl) 
     477               zpsyy = psyy(ji,jj,jl) 
     478               zpsxy = psxy(ji,jj,jl) 
     479               !                                !  Readjust moments remaining in the box. 
     480               zbt  =       zbet(ji-1,jj) 
     481               zbt1 = 1.0 - zbet(ji-1,jj) 
     482               ! 
     483               zpsm  = zbt * zpsm + zbt1 * ( zpsm - zfm(ji-1,jj) ) 
     484               zps0  = zbt * zps0 + zbt1 * ( zps0 - zf0(ji-1,jj) ) 
     485               zpsx  = zalg1q(ji-1,jj) * ( zpsx + 3.0 * zalg(ji-1,jj) * zpsxx ) 
     486               zpsxx = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * zpsxx 
     487               zpsy  = zbt * zpsy  + zbt1 * ( zpsy  - zfy (ji-1,jj) ) 
     488               zpsyy = zbt * zpsyy + zbt1 * ( zpsyy - zfyy(ji-1,jj) ) 
     489               zpsxy = zalg1q(ji-1,jj) * zpsxy 
     490 
     491               !   Put the temporary moments into appropriate neighboring boxes.     
     492               !                                !   Flux from i to i+1 IF u GT 0. 
     493               zbt   =       zbet(ji-1,jj) 
     494               zbt1  = 1.0 - zbet(ji-1,jj) 
     495               zpsm  = zbt * ( zpsm + zfm(ji-1,jj) ) + zbt1 * zpsm 
     496               zalf  = zbt * zfm(ji-1,jj) / zpsm 
     497               zalf1 = 1.0 - zalf 
     498               ztemp = zalf * zps0 - zalf1 * zf0(ji-1,jj) 
     499               ! 
     500               zps0  =  zbt  * ( zps0 + zf0(ji-1,jj) ) + zbt1 * zps0 
     501               zpsx  =  zbt  * ( zalf * zfx(ji-1,jj) + zalf1 * zpsx + 3.0 * ztemp ) + zbt1 * zpsx 
     502               zpsxx =  zbt  * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * zpsxx                            & 
     503                  &            + 5.0 * ( zalf * zalf1 * ( zpsx  - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp ) ) & 
     504                  &            + zbt1 * zpsxx 
     505               zpsxy =  zbt  * ( zalf * zfxy(ji-1,jj) + zalf1 * zpsxy            & 
     506                  &            + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * zpsy ) )  & 
     507                  &            + zbt1 * zpsxy 
     508               zpsy  =  zbt  * ( zpsy  + zfy (ji-1,jj) ) + zbt1 * zpsy  
     509               zpsyy =  zbt  * ( zpsyy + zfyy(ji-1,jj) ) + zbt1 * zpsyy 
     510 
     511               !                                !  Flux from i+1 to i IF u LT 0. 
     512               zbt   =       zbet(ji,jj) 
     513               zbt1  = 1.0 - zbet(ji,jj) 
     514               zpsm  = zbt * zpsm + zbt1 * ( zpsm + zfm(ji,jj) ) 
     515               zalf  = zbt1 * zfm(ji,jj) / zpsm 
     516               zalf1 = 1.0 - zalf 
     517               ztemp = - zalf * zps0 + zalf1 * zf0(ji,jj) 
     518               ! 
     519               zps0  = zbt * zps0  + zbt1 * ( zps0 + zf0(ji,jj) ) 
     520               zpsx  = zbt * zpsx  + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * zpsx + 3.0 * ztemp ) 
     521               zpsxx = zbt * zpsxx + zbt1 * ( zalf * zalf * zfxx(ji,jj) + zalf1 * zalf1 * zpsxx & 
     522                  &                         + 5.0 * ( zalf * zalf1 * ( - zpsx + zfx(ji,jj) )    & 
     523                  &                         + ( zalf1 - zalf ) * ztemp ) ) 
     524               zpsxy = zbt * zpsxy + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * zpsxy  & 
     525                  &                         + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * zpsy ) ) 
     526               zpsy  = zbt * zpsy  + zbt1 * ( zpsy  + zfy (ji,jj) ) 
     527               zpsyy = zbt * zpsyy + zbt1 * ( zpsyy + zfyy(ji,jj) ) 
     528               ! 
     529               psm (ji,jj,jl) = zpsm  ! optimization 
     530               ps0 (ji,jj,jl) = zps0  
     531               psx (ji,jj,jl) = zpsx  
     532               psxx(ji,jj,jl) = zpsxx 
     533               psy (ji,jj,jl) = zpsy  
     534               psyy(ji,jj,jl) = zpsyy 
     535               psxy(ji,jj,jl) = zpsxy 
     536            END DO 
     537            ! 
     538         END DO 
     539         ! 
    424540      END DO 
    425  
    426       !-- Lateral boundary conditions 
    427       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
    428          &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    429          &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
    430       ! 
     541      !       
    431542   END SUBROUTINE adv_x 
    432543 
    … …  
    449560      !! 
    450561      INTEGER  ::   ji, jj, jl, jcat                     ! dummy loop indices 
     562      INTEGER  ::   ji0                                  ! dummy loop indices 
    451563      REAL(wp) ::   zs1max, zslpmax, ztemp               ! temporary scalars 
    452564      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    453565      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
     566      REAL(wp) ::   zpsm, zps0 
     567      REAL(wp) ::   zpsx, zpsy, zpsxx, zpsyy, zpsxy 
    454568      REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace 
    455569      REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      - 
    456570      REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    457571      !--------------------------------------------------------------------- 
     572      ! in order to avoid lbc_lnk (communications): 
     573      !    ji loop must be 1:jpi   if adv_y is called first 
     574      !                and 2:jpi-1 if adv_y is called second 
     575      ji0 = NINT(pcrh) 
    458576      ! 
    459577      jcat = SIZE( ps0 , 3 )   ! size of input arrays 
    … …  
    462580         ! 
    463581         ! Limitation of moments. 
    464          DO_2D_11_00 
    465             !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 
    466             psm(ji,jj,jl) = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20  ) 
    467             ! 
    468             zslpmax = MAX( 0._wp, ps0(ji,jj,jl) ) 
     582         DO_2D( 1, 1, ji0, ji0 ) 
     583            ! 
     584            zpsm  = psm (ji,jj,jl) ! optimization 
     585            zps0  = ps0 (ji,jj,jl) 
     586            zpsx  = psx (ji,jj,jl) 
     587            zpsxx = psxx(ji,jj,jl) 
     588            zpsy  = psy (ji,jj,jl) 
     589            zpsyy = psyy(ji,jj,jl) 
     590            zpsxy = psxy(ji,jj,jl) 
     591            ! 
     592            !  Initialize volumes of boxes (=area if adv_y first called, =psm otherwise) 
     593            zpsm = MAX(  pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * zpsm , epsi20  ) 
     594            ! 
     595            zslpmax = MAX( 0._wp, zps0 ) 
    469596            zs1max  = 1.5 * zslpmax 
    470             zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 
    471             zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    472                &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) )  ) 
     597            zs1new  = MIN( zs1max, MAX( -zs1max, zpsy ) ) 
     598            zs2new  = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), MAX( ABS( zs1new )-zslpmax, zpsyy ) ) 
    473599            rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1)   ! Case of empty boxes & Apply mask 
    474600            ! 
    475             ps0 (ji,jj,jl) = zslpmax   
    476             psx (ji,jj,jl) = psx (ji,jj,jl) * rswitch 
    477             psxx(ji,jj,jl) = psxx(ji,jj,jl) * rswitch 
    478             psy (ji,jj,jl) = zs1new         * rswitch 
    479             psyy(ji,jj,jl) = zs2new         * rswitch 
    480             psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 
    481          END_2D 
    482   
    483          !  Calculate fluxes and moments between boxes j<-->j+1               
    484          DO_2D_11_00 
     601            zps0  = zslpmax   
     602            zpsx  = zpsx  * rswitch 
     603            zpsxx = zpsxx * rswitch 
     604            zpsy  = zs1new         * rswitch 
     605            zpsyy = zs2new         * rswitch 
     606            zpsxy = MIN( zslpmax, MAX( -zslpmax, zpsxy ) ) * rswitch 
     607 
     608            !  Calculate fluxes and moments between boxes j<-->j+1               
     609            !                                !  Flux from j to j+1 WHEN v GT 0    
    485610            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
    486             zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) 
     611            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * pdt / zpsm 
    487612            zalfq        =  zalf * zalf 
    488613            zalf1        =  1.0 - zalf 
    489614            zalf1q       =  zalf1 * zalf1 
    490615            ! 
    491             zfm (ji,jj)  =  zalf  * psm(ji,jj,jl) 
    492             zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj,jl) + zalf1 * ( psy(ji,jj,jl)  + (zalf1-zalf) * psyy(ji,jj,jl) ) )  
    493             zfy (ji,jj)  =  zalfq *( psy(ji,jj,jl) + 3.0*zalf1*psyy(ji,jj,jl) ) 
    494             zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj,jl) 
    495             zfx (ji,jj)  =  zalf  * ( psx(ji,jj,jl) + zalf1 * psxy(ji,jj,jl) ) 
    496             zfxy(ji,jj)  =  zalfq * psxy(ji,jj,jl) 
    497             zfxx(ji,jj)  =  zalf  * psxx(ji,jj,jl) 
    498             ! 
    499             !  Readjust moments remaining in the box. 
    500             psm (ji,jj,jl)  =  psm (ji,jj,jl) - zfm(ji,jj) 
    501             ps0 (ji,jj,jl)  =  ps0 (ji,jj,jl) - zf0(ji,jj) 
    502             psy (ji,jj,jl)  =  zalf1q * ( psy(ji,jj,jl) -3.0 * zalf * psyy(ji,jj,jl) ) 
    503             psyy(ji,jj,jl)  =  zalf1 * zalf1q * psyy(ji,jj,jl) 
    504             psx (ji,jj,jl)  =  psx (ji,jj,jl) - zfx(ji,jj) 
    505             psxx(ji,jj,jl)  =  psxx(ji,jj,jl) - zfxx(ji,jj) 
    506             psxy(ji,jj,jl)  =  zalf1q * psxy(ji,jj,jl) 
     616            zfm (ji,jj)  =  zalf  * zpsm 
     617            zf0 (ji,jj)  =  zalf  * ( zps0 + zalf1 * ( zpsy  + (zalf1-zalf) * zpsyy ) )  
     618            zfy (ji,jj)  =  zalfq *( zpsy + 3.0*zalf1*zpsyy ) 
     619            zfyy(ji,jj)  =  zalf  * zalfq * zpsyy 
     620            zfx (ji,jj)  =  zalf  * ( zpsx + zalf1 * zpsxy ) 
     621            zfxy(ji,jj)  =  zalfq * zpsxy 
     622            zfxx(ji,jj)  =  zalf  * zpsxx 
     623            ! 
     624            !                                !  Readjust moments remaining in the box. 
     625            zpsm   =  zpsm  - zfm(ji,jj) 
     626            zps0   =  zps0  - zf0(ji,jj) 
     627            zpsy   =  zalf1q * ( zpsy -3.0 * zalf * zpsyy ) 
     628            zpsyy  =  zalf1 * zalf1q * zpsyy 
     629            zpsx   =  zpsx  - zfx(ji,jj) 
     630            zpsxx  =  zpsxx - zfxx(ji,jj) 
     631            zpsxy  =  zalf1q * zpsxy 
     632            ! 
     633            psm (ji,jj,jl) = zpsm ! optimization 
     634            ps0 (ji,jj,jl) = zps0  
     635            psx (ji,jj,jl) = zpsx  
     636            psxx(ji,jj,jl) = zpsxx 
     637            psy (ji,jj,jl) = zpsy  
     638            psyy(ji,jj,jl) = zpsyy 
     639            psxy(ji,jj,jl) = zpsxy 
    507640         END_2D 
    508641         ! 
    509          DO_2D_10_00 
     642         DO_2D( 1, 0, ji0, ji0 ) 
     643            !                                !  Flux from j+1 to j when v LT 0. 
    510644            zalf          = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl)  
    511645            zalg  (ji,jj) = zalf 
    … …  
    526660         END_2D 
    527661 
    528          !  Readjust moments remaining in the box.  
    529          DO_2D_00_00 
     662         DO_2D( 0, 0, ji0, ji0 ) 
     663            !                                !  Readjust moments remaining in the box. 
    530664            zbt  =         zbet(ji,jj-1) 
    531665            zbt1 = ( 1.0 - zbet(ji,jj-1) ) 
    532666            ! 
    533             psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji,jj-1) ) 
    534             ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji,jj-1) ) 
    535             psy (ji,jj,jl) = zalg1q(ji,jj-1) * ( psy(ji,jj,jl) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj,jl) ) 
    536             psyy(ji,jj,jl) = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * psyy(ji,jj,jl) 
    537             psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) - zfx (ji,jj-1) ) 
    538             psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 
    539             psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 
     667            zpsm  = psm (ji,jj,jl) ! optimization 
     668            zps0  = ps0 (ji,jj,jl) 
     669            zpsx  = psx (ji,jj,jl) 
     670            zpsxx = psxx(ji,jj,jl) 
     671            zpsy  = psy (ji,jj,jl) 
     672            zpsyy = psyy(ji,jj,jl) 
     673            zpsxy = psxy(ji,jj,jl) 
     674            ! 
     675            zpsm  = zbt * zpsm + zbt1 * ( zpsm - zfm(ji,jj-1) ) 
     676            zps0  = zbt * zps0 + zbt1 * ( zps0 - zf0(ji,jj-1) ) 
     677            zpsy  = zalg1q(ji,jj-1) * ( zpsy + 3.0 * zalg(ji,jj-1) * zpsyy ) 
     678            zpsyy = zalg1 (ji,jj-1) * zalg1q(ji,jj-1) * zpsyy 
     679            zpsx  = zbt * zpsx  + zbt1 * ( zpsx  - zfx (ji,jj-1) ) 
     680            zpsxx = zbt * zpsxx + zbt1 * ( zpsxx - zfxx(ji,jj-1) ) 
     681            zpsxy = zalg1q(ji,jj-1) * zpsxy 
     682 
     683            !   Put the temporary moments into appropriate neighboring boxes.     
     684            !                                !   Flux from j to j+1 IF v GT 0. 
     685            zbt   =       zbet(ji,jj-1) 
     686            zbt1  = 1.0 - zbet(ji,jj-1) 
     687            zpsm  = zbt * ( zpsm + zfm(ji,jj-1) ) + zbt1 * zpsm  
     688            zalf  = zbt * zfm(ji,jj-1) / zpsm  
     689            zalf1 = 1.0 - zalf 
     690            ztemp = zalf * zps0 - zalf1 * zf0(ji,jj-1) 
     691            ! 
     692            zps0  =   zbt  * ( zps0 + zf0(ji,jj-1) ) + zbt1 * zps0 
     693            zpsy  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * zpsy + 3.0 * ztemp )  & 
     694               &             + zbt1 * zpsy   
     695            zpsyy =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * zpsyy                           & 
     696               &             + 5.0 * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) &  
     697               &             + zbt1 * zpsyy 
     698            zpsxy =   zbt  * ( zalf * zfxy(ji,jj-1) + zalf1 * zpsxy             & 
     699               &             + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * zpsx ) )  & 
     700               &             + zbt1 * zpsxy 
     701            zpsx  =   zbt * ( zpsx  + zfx (ji,jj-1) ) + zbt1 * zpsx  
     702            zpsxx =   zbt * ( zpsxx + zfxx(ji,jj-1) ) + zbt1 * zpsxx 
     703 
     704            !                                !  Flux from j+1 to j IF v LT 0. 
     705            zbt   =       zbet(ji,jj) 
     706            zbt1  = 1.0 - zbet(ji,jj) 
     707            zpsm  = zbt * zpsm + zbt1 * ( zpsm + zfm(ji,jj) ) 
     708            zalf  = zbt1 * zfm(ji,jj) / zpsm 
     709            zalf1 = 1.0 - zalf 
     710            ztemp = - zalf * zps0 + zalf1 * zf0(ji,jj) 
     711            ! 
     712            zps0  = zbt * zps0  + zbt1 * (  zps0 + zf0(ji,jj) ) 
     713            zpsy  = zbt * zpsy  + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * zpsy + 3.0 * ztemp ) 
     714            zpsyy = zbt * zpsyy + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * zpsyy & 
     715               &                         + 5.0 * ( zalf * zalf1 * ( - zpsy + zfy(ji,jj) )     & 
     716               &                         + ( zalf1 - zalf ) * ztemp ) ) 
     717            zpsxy = zbt * zpsxy + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * zpsxy  & 
     718               &                         + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * zpsx ) ) 
     719            zpsx  = zbt * zpsx  + zbt1 * ( zpsx  + zfx (ji,jj) ) 
     720            zpsxx = zbt * zpsxx + zbt1 * ( zpsxx + zfxx(ji,jj) ) 
     721            ! 
     722            psm (ji,jj,jl) = zpsm ! optimization 
     723            ps0 (ji,jj,jl) = zps0  
     724            psx (ji,jj,jl) = zpsx  
     725            psxx(ji,jj,jl) = zpsxx 
     726            psy (ji,jj,jl) = zpsy  
     727            psyy(ji,jj,jl) = zpsyy 
     728            psxy(ji,jj,jl) = zpsxy 
    540729         END_2D 
    541  
    542          !   Put the temporary moments into appropriate neighboring boxes.     
    543          DO_2D_00_00 
    544             zbt  =       zbet(ji,jj-1) 
    545             zbt1 = 1.0 - zbet(ji,jj-1) 
    546             psm(ji,jj,jl) = zbt * ( psm(ji,jj,jl) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj,jl)  
    547             zalf          = zbt * zfm(ji,jj-1) / psm(ji,jj,jl)  
    548             zalf1         = 1.0 - zalf 
    549             ztemp         = zalf * ps0(ji,jj,jl) - zalf1 * zf0(ji,jj-1) 
    550             ! 
    551             ps0(ji,jj,jl)  =   zbt  * ( ps0(ji,jj,jl) + zf0(ji,jj-1) ) + zbt1 * ps0(ji,jj,jl) 
    552             psy(ji,jj,jl)  =   zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp )  & 
    553                &             + zbt1 * psy(ji,jj,jl)   
    554             psyy(ji,jj,jl) =   zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj,jl)                           & 
    555                &                      + 5.0 * ( zalf * zalf1 * ( psy(ji,jj,jl) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) &  
    556                &             + zbt1 * psyy(ji,jj,jl) 
    557             psxy(ji,jj,jl) =   zbt  * (  zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj,jl)            & 
    558                &                      + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj,jl) ) )  & 
    559                &             + zbt1 * psxy(ji,jj,jl) 
    560             psx (ji,jj,jl) =   zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 
    561             psxx(ji,jj,jl) =   zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 
    562          END_2D 
    563  
    564          DO_2D_00_00 
    565             zbt  =       zbet(ji,jj) 
    566             zbt1 = 1.0 - zbet(ji,jj) 
    567             psm(ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) + zfm(ji,jj) ) 
    568             zalf          = zbt1 * zfm(ji,jj) / psm(ji,jj,jl) 
    569             zalf1         = 1.0 - zalf 
    570             ztemp         = - zalf * ps0(ji,jj,jl) + zalf1 * zf0(ji,jj) 
    571             ! 
    572             ps0 (ji,jj,jl) = zbt * ps0 (ji,jj,jl) + zbt1 * (  ps0(ji,jj,jl) + zf0(ji,jj) ) 
    573             psy (ji,jj,jl) = zbt * psy (ji,jj,jl) + zbt1 * (  zalf * zfy(ji,jj) + zalf1 * psy(ji,jj,jl) + 3.0 * ztemp ) 
    574             psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * (  zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj,jl) & 
    575                &                                            + 5.0 * ( zalf * zalf1 * ( - psy(ji,jj,jl) + zfy(ji,jj) )    & 
    576                &                                            + ( zalf1 - zalf ) * ztemp ) ) 
    577             psxy(ji,jj,jl) = zbt * psxy(ji,jj,jl) + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj,jl)  & 
    578                &                                            + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj,jl) ) ) 
    579             psx (ji,jj,jl) = zbt * psx (ji,jj,jl) + zbt1 * ( psx (ji,jj,jl) + zfx (ji,jj) ) 
    580             psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) + zfxx(ji,jj) ) 
    581          END_2D 
    582  
     730         ! 
    583731      END DO 
    584  
    585       !-- Lateral boundary conditions 
    586       CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T',  1., ps0 , 'T',  1.   & 
    587          &                                , psx             , 'T', -1., psy , 'T', -1.   &   ! caution gradient ==> the sign changes 
    588          &                                , psxx            , 'T',  1., psyy, 'T',  1. , psxy, 'T',  1. ) 
    589732      ! 
    590733   END SUBROUTINE adv_y 
    591734 
    592735 
    593    SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     736   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 
     737      &                  pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    594738      !!------------------------------------------------------------------- 
    595739      !!                  ***  ROUTINE Hbig  *** 
    … …  
    605749      !! ** input   : Max thickness of the surrounding 9-points 
    606750      !!------------------------------------------------------------------- 
    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 
     751      REAL(wp)                    , INTENT(in   ) ::   pdt                                   ! tracer time-step 
     752      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max, psi_max   ! max ice thick from surrounding 9-pts 
     753      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pes_max 
     754      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pei_max 
     755      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 
    610756      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 
     757      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i 
     758      ! 
     759      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
     760      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 
    614761      !!------------------------------------------------------------------- 
    615762      ! 
    … …  
    617764      ! 
    618765      DO jl = 1, jpl 
    619  
    620          DO_2D_11_11 
     766         DO_2D( 1, 1, 1, 1 ) 
    621767            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    622768               ! 
    623769               !                               ! -- check h_ip -- ! 
    624770               ! 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 
     771               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    626772                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    627773                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    650796               ENDIF            
    651797               !                   
     798               !                               ! -- check s_i -- ! 
     799               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     800               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     801               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     802                  zfra = psi_max(ji,jj,jl) / zsi 
     803                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     804                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     805               ENDIF 
     806               ! 
    652807            ENDIF 
    653808         END_2D 
    654809      END DO  
     810      ! 
     811      !                                           ! -- check e_i/v_i -- ! 
     812      DO jl = 1, jpl 
     813         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     814            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     815               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     816               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     817               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     818                  zfra = pei_max(ji,jj,jk,jl) / zei 
     819                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     820                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     821               ENDIF 
     822            ENDIF 
     823         END_3D 
     824      END DO 
     825      !                                           ! -- check e_s/v_s -- ! 
     826      DO jl = 1, jpl 
     827         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     828            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     829               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     830               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     831               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     832                  zfra = pes_max(ji,jj,jk,jl) / zes 
     833                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     834                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     835               ENDIF 
     836            ENDIF 
     837         END_3D 
     838      END DO 
    655839      ! 
    656840   END SUBROUTINE Hbig 
    … …  
    684868      ! -- check snow load -- ! 
    685869      DO jl = 1, jpl 
    686          DO_2D_11_11 
     870         DO_2D( 1, 1, 1, 1 ) 
    687871            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    688872               ! 
    … …  
    724908         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   & 
    725909         &      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) ,   & 
     910         &      sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
     911         &      sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     912         &      sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) ,   & 
    728913         ! 
    729914         &      sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & 
    … …  
    773958            ! 
    774959            !                                                        ! ice thickness 
    775             CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice, ldxios = lrixios ) 
    776             CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice, ldxios = lrixios ) 
    777             CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice, ldxios = lrixios ) 
    778             CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice, ldxios = lrixios ) 
    779             CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice, ldxios = lrixios ) 
     960            CALL iom_get( numrir, jpdom_auto, 'sxice' , sxice , psgn = -1._wp, ldxios = lrixios ) 
     961            CALL iom_get( numrir, jpdom_auto, 'syice' , syice , psgn = -1._wp, ldxios = lrixios ) 
     962            CALL iom_get( numrir, jpdom_auto, 'sxxice', sxxice, ldxios = lrixios ) 
     963            CALL iom_get( numrir, jpdom_auto, 'syyice', syyice, ldxios = lrixios ) 
     964            CALL iom_get( numrir, jpdom_auto, 'sxyice', sxyice, ldxios = lrixios ) 
    780965            !                                                        ! snow thickness 
    781             CALL iom_get( numrir, jpdom_autoglo, 'sxsn'  , sxsn, ldxios = lrixios  ) 
    782             CALL iom_get( numrir, jpdom_autoglo, 'sysn'  , sysn, ldxios = lrixios  ) 
    783             CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn, ldxios = lrixios  ) 
    784             CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn, ldxios = lrixios  ) 
    785             CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn, ldxios = lrixios  ) 
     966            CALL iom_get( numrir, jpdom_auto, 'sxsn'  , sxsn  , psgn = -1._wp, ldxios = lrixios ) 
     967            CALL iom_get( numrir, jpdom_auto, 'sysn'  , sysn  , psgn = -1._wp, ldxios = lrixios ) 
     968            CALL iom_get( numrir, jpdom_auto, 'sxxsn' , sxxsn, ldxios = lrixios  ) 
     969            CALL iom_get( numrir, jpdom_auto, 'syysn' , syysn, ldxios = lrixios  ) 
     970            CALL iom_get( numrir, jpdom_auto, 'sxysn' , sxysn, ldxios = lrixios  ) 
    786971            !                                                        ! ice concentration 
    787             CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa, ldxios = lrixios    ) 
    788             CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya, ldxios = lrixios    ) 
    789             CALL iom_get( numrir, jpdom_autoglo, 'sxxa'  , sxxa, ldxios = lrixios   ) 
    790             CALL iom_get( numrir, jpdom_autoglo, 'syya'  , syya, ldxios = lrixios   ) 
    791             CALL iom_get( numrir, jpdom_autoglo, 'sxya'  , sxya, ldxios = lrixios   ) 
     972            CALL iom_get( numrir, jpdom_auto, 'sxa'   , sxa   , psgn = -1._wp, ldxios = lrixios ) 
     973            CALL iom_get( numrir, jpdom_auto, 'sya'   , sya   , psgn = -1._wp, ldxios = lrixios ) 
     974            CALL iom_get( numrir, jpdom_auto, 'sxxa'  , sxxa, ldxios = lrixios   ) 
     975            CALL iom_get( numrir, jpdom_auto, 'syya'  , syya, ldxios = lrixios   ) 
     976            CALL iom_get( numrir, jpdom_auto, 'sxya'  , sxya, ldxios = lrixios   ) 
    792977            !                                                        ! ice salinity 
    793             CALL iom_get( numrir, jpdom_autoglo, 'sxsal' , sxsal, ldxios = lrixios ) 
    794             CALL iom_get( numrir, jpdom_autoglo, 'sysal' , sysal, ldxios = lrixios ) 
    795             CALL iom_get( numrir, jpdom_autoglo, 'sxxsal', sxxsal, ldxios = lrixios ) 
    796             CALL iom_get( numrir, jpdom_autoglo, 'syysal', syysal, ldxios = lrixios ) 
    797             CALL iom_get( numrir, jpdom_autoglo, 'sxysal', sxysal, ldxios = lrixios ) 
     978            CALL iom_get( numrir, jpdom_auto, 'sxsal' , sxsal , psgn = -1._wp, ldxios = lrixios ) 
     979            CALL iom_get( numrir, jpdom_auto, 'sysal' , sysal , psgn = -1._wp, ldxios = lrixios ) 
     980            CALL iom_get( numrir, jpdom_auto, 'sxxsal', sxxsal, ldxios = lrixios ) 
     981            CALL iom_get( numrir, jpdom_auto, 'syysal', syysal, ldxios = lrixios ) 
     982            CALL iom_get( numrir, jpdom_auto, 'sxysal', sxysal, ldxios = lrixios ) 
    798983            !                                                        ! ice age 
    799             CALL iom_get( numrir, jpdom_autoglo, 'sxage' , sxage, ldxios = lrixios ) 
    800             CALL iom_get( numrir, jpdom_autoglo, 'syage' , syage, ldxios = lrixios ) 
    801             CALL iom_get( numrir, jpdom_autoglo, 'sxxage', sxxage, ldxios = lrixios ) 
    802             CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage, ldxios = lrixios ) 
    803             CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage, ldxios = lrixios ) 
     984            CALL iom_get( numrir, jpdom_auto, 'sxage' , sxage , psgn = -1._wp, ldxios = lrixios ) 
     985            CALL iom_get( numrir, jpdom_auto, 'syage' , syage , psgn = -1._wp, ldxios = lrixios ) 
     986            CALL iom_get( numrir, jpdom_auto, 'sxxage', sxxage, ldxios = lrixios ) 
     987            CALL iom_get( numrir, jpdom_auto, 'syyage', syyage, ldxios = lrixios ) 
     988            CALL iom_get( numrir, jpdom_auto, 'sxyage', sxyage, ldxios = lrixios ) 
    804989            !                                                        ! snow layers heat content 
    805990            DO jk = 1, nlay_s 
    806991               WRITE(zchar1,'(I2.2)') jk 
    807992               znam = 'sxc0'//'_l'//zchar1   
    808                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sxc0 (:,:,jk,:) = z3d(:,:,:) 
     993               CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp, ldxios = lrixios )   ;   sxc0 (:,:,jk,:) = z3d(:,:,:) 
    809994               znam = 'syc0'//'_l'//zchar1   
    810                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   syc0 (:,:,jk,:) = z3d(:,:,:) 
     995               CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp, ldxios = lrixios )   ;   syc0 (:,:,jk,:) = z3d(:,:,:) 
    811996               znam = 'sxxc0'//'_l'//zchar1  
    812                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sxxc0(:,:,jk,:) = z3d(:,:,:) 
     997               CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios )   ;   sxxc0(:,:,jk,:) = z3d(:,:,:) 
    813998               znam = 'syyc0'//'_l'//zchar1  
    814                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   syyc0(:,:,jk,:) = z3d(:,:,:) 
     999               CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios )   ;   syyc0(:,:,jk,:) = z3d(:,:,:) 
    8151000               znam = 'sxyc0'//'_l'//zchar1  
    816                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sxyc0(:,:,jk,:) = z3d(:,:,:) 
     1001               CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios )   ;   sxyc0(:,:,jk,:) = z3d(:,:,:) 
    8171002            END DO 
    8181003            !                                                        ! ice layers heat content 
    … …  
    8201005               WRITE(zchar1,'(I2.2)') jk 
    8211006               znam = 'sxe'//'_l'//zchar1    
    822                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sxe (:,:,jk,:) = z3d(:,:,:) 
     1007               CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp, ldxios = lrixios )   ;   sxe (:,:,jk,:) = z3d(:,:,:) 
    8231008               znam = 'sye'//'_l'//zchar1    
    824                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sye (:,:,jk,:) = z3d(:,:,:) 
     1009               CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp, ldxios = lrixios )   ;   sye (:,:,jk,:) = z3d(:,:,:) 
    8251010               znam = 'sxxe'//'_l'//zchar1   
    826                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sxxe(:,:,jk,:) = z3d(:,:,:) 
     1011               CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios )   ;   sxxe(:,:,jk,:) = z3d(:,:,:) 
    8271012               znam = 'syye'//'_l'//zchar1   
    828                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   syye(:,:,jk,:) = z3d(:,:,:) 
     1013               CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios )   ;   syye(:,:,jk,:) = z3d(:,:,:) 
    8291014               znam = 'sxye'//'_l'//zchar1   
    830                CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios )   ;   sxye(:,:,jk,:) = z3d(:,:,:) 
    831             END DO 
    832             ! 
    833             IF( ln_pnd_H12 ) THEN                                    ! melt pond fraction 
    834                CALL iom_get( numrir, jpdom_autoglo, 'sxap' , sxap,  ldxios = lrixios ) 
    835                CALL iom_get( numrir, jpdom_autoglo, 'syap' , syap,  ldxios = lrixios ) 
    836                CALL iom_get( numrir, jpdom_autoglo, 'sxxap', sxxap, ldxios = lrixios ) 
    837                CALL iom_get( numrir, jpdom_autoglo, 'syyap', syyap, ldxios = lrixios ) 
    838                CALL iom_get( numrir, jpdom_autoglo, 'sxyap', sxyap, ldxios = lrixios ) 
    839                !                                                     ! melt pond volume 
    840                CALL iom_get( numrir, jpdom_autoglo, 'sxvp' , sxvp,  ldxios = lrixios ) 
    841                CALL iom_get( numrir, jpdom_autoglo, 'syvp' , syvp,  ldxios = lrixios ) 
    842                CALL iom_get( numrir, jpdom_autoglo, 'sxxvp', sxxvp, ldxios = lrixios ) 
    843                CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp, ldxios = lrixios ) 
    844                CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp, ldxios = lrixios ) 
     1015               CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios )   ;   sxye(:,:,jk,:) = z3d(:,:,:) 
     1016            END DO 
     1017            ! 
     1018            IF( ln_pnd_LEV ) THEN                                    ! melt pond fraction 
     1019               IF( iom_varid( numrir, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 
     1020                  CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap , psgn = -1._wp, ldxios = lrixios ) 
     1021                  CALL iom_get( numrir, jpdom_auto, 'syap' , syap , psgn = -1._wp, ldxios = lrixios ) 
     1022                  CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap, ldxios = lrixios ) 
     1023                  CALL iom_get( numrir, jpdom_auto, 'syyap', syyap, ldxios = lrixios ) 
     1024                  CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap, ldxios = lrixios ) 
     1025                  !                                                     ! melt pond volume 
     1026                  CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp , psgn = -1._wp, ldxios = lrixios ) 
     1027                  CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp , psgn = -1._wp, ldxios = lrixios ) 
     1028                  CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp, ldxios = lrixios ) 
     1029                  CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp, ldxios = lrixios ) 
     1030                  CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp, ldxios = lrixios ) 
     1031               ELSE 
     1032                  sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp   ! melt pond fraction 
     1033                  sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp   ! melt pond volume 
     1034               ENDIF 
     1035                  ! 
     1036               IF ( ln_pnd_lids ) THEN                               ! melt pond lid volume 
     1037                  IF( iom_varid( numrir, 'sxvl', ldstop = .FALSE. ) > 0 ) THEN 
     1038                     CALL iom_get( numrir, jpdom_auto, 'sxvl' , sxvl , psgn = -1._wp, ldxios = lrixios ) 
     1039                     CALL iom_get( numrir, jpdom_auto, 'syvl' , syvl , psgn = -1._wp, ldxios = lrixios ) 
     1040                     CALL iom_get( numrir, jpdom_auto, 'sxxvl', sxxvl, ldxios = lrixios ) 
     1041                     CALL iom_get( numrir, jpdom_auto, 'syyvl', syyvl, ldxios = lrixios ) 
     1042                     CALL iom_get( numrir, jpdom_auto, 'sxyvl', sxyvl, ldxios = lrixios ) 
     1043                  ELSE 
     1044                     sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp   ! melt pond lid volume 
     1045                  ENDIF 
     1046               ENDIF 
    8451047            ENDIF 
    8461048            IF(lrixios) CALL iom_swap(cxios_context) 
    … …  
    8571059            sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow layers heat content 
    8581060            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
    859             IF( ln_pnd_H12 ) THEN 
    860                sxap  = 0._wp   ;   syap  = 0._wp   ;   sxxap  = 0._wp   ;   syyap  = 0._wp   ;   sxyap  = 0._wp   ! melt pond fraction 
    861                sxvp  = 0._wp   ;   syvp  = 0._wp   ;   sxxvp  = 0._wp   ;   syyvp  = 0._wp   ;   sxyvp  = 0._wp   ! melt pond volume 
     1061            IF( ln_pnd_LEV ) THEN 
     1062               sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp       ! melt pond fraction 
     1063               sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp       ! melt pond volume 
     1064               IF ( ln_pnd_lids ) THEN 
     1065                  sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp       ! melt pond lid volume 
     1066               ENDIF 
    8621067            ENDIF 
    8631068         ENDIF 
    … …  
    9331138         END DO 
    9341139         ! 
    935          IF( ln_pnd_H12 ) THEN                                       ! melt pond fraction 
    936             CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap,  ldxios = lwxios) 
    937             CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap,  ldxios = lwxios) 
    938             CALL iom_rstput( iter, nitrst, numriw, 'sxxap', sxxap, ldxios = lwxios) 
    939             CALL iom_rstput( iter, nitrst, numriw, 'syyap', syyap, ldxios = lwxios) 
    940             CALL iom_rstput( iter, nitrst, numriw, 'sxyap', sxyap, ldxios = lwxios) 
     1140         IF( ln_pnd_LEV ) THEN                                       ! melt pond fraction 
     1141            CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap , ldxios = lwxios ) 
     1142            CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap , ldxios = lwxios ) 
     1143            CALL iom_rstput( iter, nitrst, numriw, 'sxxap', sxxap, ldxios = lwxios ) 
     1144            CALL iom_rstput( iter, nitrst, numriw, 'syyap', syyap, ldxios = lwxios ) 
     1145            CALL iom_rstput( iter, nitrst, numriw, 'sxyap', sxyap, ldxios = lwxios ) 
    9411146            !                                                        ! melt pond volume 
    942             CALL iom_rstput( iter, nitrst, numriw, 'sxvp' , sxvp,  ldxios = lwxios) 
    943             CALL iom_rstput( iter, nitrst, numriw, 'syvp' , syvp,  ldxios = lwxios) 
    944             CALL iom_rstput( iter, nitrst, numriw, 'sxxvp', sxxvp, ldxios = lwxios) 
    945             CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp, ldxios = lwxios) 
    946             CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp, ldxios = lwxios) 
     1147            CALL iom_rstput( iter, nitrst, numriw, 'sxvp' , sxvp , ldxios = lwxios ) 
     1148            CALL iom_rstput( iter, nitrst, numriw, 'syvp' , syvp , ldxios = lwxios ) 
     1149            CALL iom_rstput( iter, nitrst, numriw, 'sxxvp', sxxvp, ldxios = lwxios ) 
     1150            CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp, ldxios = lwxios ) 
     1151            CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp, ldxios = lwxios ) 
     1152            ! 
     1153            IF ( ln_pnd_lids ) THEN                                  ! melt pond lid volume 
     1154               CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl , ldxios = lwxios ) 
     1155               CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl , ldxios = lwxios ) 
     1156               CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl, ldxios = lwxios ) 
     1157               CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl, ldxios = lwxios ) 
     1158               CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl, ldxios = lwxios ) 
     1159            ENDIF 
    9471160         ENDIF 
    9481161         IF( lwxios ) CALL iom_swap(      cxios_context         ) 
    … …  
    9511164      ! 
    9521165   END SUBROUTINE adv_pra_rst 
     1166 
     1167   SUBROUTINE icemax3D( pice , pmax ) 
     1168      !!--------------------------------------------------------------------- 
     1169      !!                   ***  ROUTINE icemax3D ***                      
     1170      !! ** Purpose :  compute the max of the 9 points around 
     1171      !!---------------------------------------------------------------------- 
     1172      REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input 
     1173      REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output 
     1174      REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1175      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     1176      !!---------------------------------------------------------------------- 
     1177      DO jl = 1, jpl 
     1178         DO jj = Njs0-1, Nje0+1     
     1179            DO ji = Nis0, Nie0 
     1180               zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 
     1181            END DO 
     1182         END DO 
     1183         DO jj = Njs0, Nje0     
     1184            DO ji = Nis0, Nie0 
     1185               pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
     1186            END DO 
     1187         END DO 
     1188      END DO 
     1189   END SUBROUTINE icemax3D 
     1190 
     1191   SUBROUTINE icemax4D( pice , pmax ) 
     1192      !!--------------------------------------------------------------------- 
     1193      !!                   ***  ROUTINE icemax4D ***                      
     1194      !! ** Purpose :  compute the max of the 9 points around 
     1195      !!---------------------------------------------------------------------- 
     1196      REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input 
     1197      REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output 
     1198      REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1199      INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices 
     1200      !!---------------------------------------------------------------------- 
     1201      jlay = SIZE( pice , 3 )   ! size of input arrays 
     1202      DO jl = 1, jpl 
     1203         DO jk = 1, jlay 
     1204            DO jj = Njs0-1, Nje0+1     
     1205               DO ji = Nis0, Nie0 
     1206                  zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 
     1207               END DO 
     1208            END DO 
     1209            DO jj = Njs0, Nje0     
     1210               DO ji = Nis0, Nie0 
     1211                  pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
     1212               END DO 
     1213            END DO 
     1214         END DO 
     1215      END DO 
     1216   END SUBROUTINE icemax4D 
    9531217 
    9541218#else 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icedyn_adv_umx.F90

    r12489 r13727  
    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 
    … …  
    9192      INTEGER  ::   icycle                  ! number of sub-timestep for the advection 
    9293      REAL(wp) ::   zamsk                   ! 1 if advection of concentration, 0 if advection of other tracers 
    93       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 
     94      REAL(wp) ::   zdt, z1_dt, zvi_cen 
     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  
     106      !! diagnostics 
     107      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat       
    103108      !!---------------------------------------------------------------------- 
    104109      ! 
    105110      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 
    106111      ! 
    107       ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 
    108       DO jl = 1, jpl 
    109          DO_2D_00_00 
    110             zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj  ,jl), ph_ip(ji  ,jj+1,jl), & 
    111                &                                               ph_ip(ji-1,jj  ,jl), ph_ip(ji  ,jj-1,jl), & 
    112                &                                               ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 
    113                &                                               ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 
    114             zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj  ,jl), ph_i (ji  ,jj+1,jl), & 
    115                &                                               ph_i (ji-1,jj  ,jl), ph_i (ji  ,jj-1,jl), & 
    116                &                                               ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 
    117                &                                               ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 
    118             zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj  ,jl), ph_s (ji  ,jj+1,jl), & 
    119                &                                               ph_s (ji-1,jj  ,jl), ph_s (ji  ,jj-1,jl), & 
    120                &                                               ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 
    121                &                                               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., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 
     112      ! --- Record max of the surrounding 9-pts (for call Hbig) --- ! 
     113      ! thickness and salinity 
     114      WHERE( pv_i(:,:,:) >= epsi10 ) ; zs_i(:,:,:) = psv_i(:,:,:) / pv_i(:,:,:) 
     115      ELSEWHERE                      ; zs_i(:,:,:) = 0._wp 
     116      END WHERE 
     117      CALL icemax3D( ph_i , zhi_max ) 
     118      CALL icemax3D( ph_s , zhs_max ) 
     119      CALL icemax3D( ph_ip, zhip_max) 
     120      CALL icemax3D( zs_i , zsi_max ) 
     121      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 ) 
     122      ! 
     123      ! enthalpies 
     124      DO jk = 1, nlay_i 
     125         WHERE( pv_i(:,:,:) >= epsi10 ) ; ze_i(:,:,jk,:) = pe_i(:,:,jk,:) / pv_i(:,:,:) 
     126         ELSEWHERE                      ; ze_i(:,:,jk,:) = 0._wp 
     127         END WHERE 
     128      END DO 
     129      DO jk = 1, nlay_s 
     130         WHERE( pv_s(:,:,:) >= epsi10 ) ; ze_s(:,:,jk,:) = pe_s(:,:,jk,:) / pv_s(:,:,:) 
     131         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
     132         END WHERE 
     133      END DO    
     134      CALL icemax4D( ze_i , zei_max ) 
     135      CALL icemax4D( ze_s , zes_max ) 
     136      CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1._wp ) 
     137      CALL lbc_lnk( 'icedyn_adv_umx', zes_max, 'T', 1._wp ) 
    125138      ! 
    126139      ! 
    … …  
    138151      ENDIF 
    139152      zdt = rDt_ice / REAL(icycle) 
     153      z1_dt = 1._wp / zdt 
    140154 
    141155      ! --- transport --- ! 
    … …  
    150164      ! 
    151165      ! --- define velocity for advection: u*grad(H) --- ! 
    152       DO_2D_00_00 
     166      DO_2D( 0, 0, 0, 0 ) 
    153167         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
    154168         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj) 
    … …  
    166180      !---------------! 
    167181      DO jt = 1, icycle 
     182 
     183         ! diagnostics 
     184         zdiag_adv_mass(:,:) =   SUM(  pv_i(:,:,:) , dim=3 ) * rhoi + SUM(  pv_s(:,:,:) , dim=3 ) * rhos 
     185         zdiag_adv_salt(:,:) =   SUM( psv_i(:,:,:) , dim=3 ) * rhoi 
     186         zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
     187            &                  - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 ) 
    168188 
    169189         ! record at_i before advection (for open water) 
    … …  
    183203            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) )  
    184204            DO jl = 1, jpl 
    185                DO_2D_10_10 
     205               DO_2D( 1, 0, 1, 0 ) 
    186206                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 
    187207                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0 
    … …  
    318338         ! 
    319339         !== melt ponds ==! 
    320          IF ( ln_pnd_H12 ) THEN 
     340         IF ( ln_pnd_LEV ) THEN 
    321341            ! concentration 
    322342            zamsk = 1._wp 
    … …  
    328348            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
    329349               &                                      zhvar, pv_ip, zua_ups, zva_ups ) 
     350            ! lid 
     351            IF ( ln_pnd_lids ) THEN 
     352               zamsk = 0._wp 
     353               zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) 
     354               CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
     355                  &                                      zhvar, pv_il, zua_ups, zva_ups ) 
     356            ENDIF 
    330357         ENDIF 
     358 
     359         ! --- Lateral boundary conditions --- ! 
     360         IF    ( ln_pnd_LEV .AND. ln_pnd_lids ) THEN 
     361            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
     362               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 
     363         ELSEIF( ln_pnd_LEV .AND. .NOT.ln_pnd_lids ) THEN 
     364            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
     365               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 
     366         ELSE 
     367            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp ) 
     368         ENDIF 
     369         CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp ) 
     370         CALL lbc_lnk( 'icedyn_adv_umx', pe_s, 'T', 1._wp ) 
    331371         ! 
    332372         !== Open water area ==! 
    333373         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    334          DO_2D_00_00 
     374         DO_2D( 0, 0, 0, 0 ) 
    335375            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &  
    336376               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    337377         END_2D 
    338          CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1. ) 
    339          ! 
     378         CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T',  1._wp ) 
     379         ! 
     380         ! --- diagnostics --- ! 
     381         diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 
     382            &                                        - zdiag_adv_mass(:,:) ) * z1_dt 
     383         diag_adv_salt(:,:) = diag_adv_salt(:,:) + (   SUM( psv_i(:,:,:) , dim=3 ) * rhoi & 
     384            &                                        - zdiag_adv_salt(:,:) ) * z1_dt 
     385         diag_adv_heat(:,:) = diag_adv_heat(:,:) + ( - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
     386            &                                        - SUM(SUM( pe_s(:,:,1:nlay_s,:) , dim=4 ), dim=3 ) & 
     387            &                                        - zdiag_adv_heat(:,:) ) * z1_dt 
    340388         ! 
    341389         ! --- Ensure non-negative fields and in-bound thicknesses --- ! 
    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 --- ! 
    … …  
    396445      !!             work on H (and not V). It is partly related to the multi-category approach 
    397446      !!             Therefore, after advection we limit the thickness to the largest value of the 9-points around (only if ice 
    398       !!             concentration is small). Since we do not limit S and T, large values can occur at the edge but it does not really matter 
    399       !!             since sv_i and e_i are still good. 
     447      !!             concentration is small). We also limit S and T. 
    400448      !!---------------------------------------------------------------------- 
    401449      REAL(wp)                        , INTENT(in   )           ::   pamsk            ! advection of concentration (1) or other tracers (0) 
    … …  
    441489      IF( pamsk == 0._wp ) THEN 
    442490         DO jl = 1, jpl 
    443             DO_2D_10_10 
     491            DO_2D( 0, 0, 1, 0 ) 
    444492               IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 
    445493                  zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc    (ji,jj,jl) / pu(ji,jj) 
    … …  
    450498               ENDIF 
    451499               ! 
     500            END_2D 
     501            DO_2D( 1, 0, 0, 0 ) 
    452502               IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 
    453503                  zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc    (ji,jj,jl) / pv(ji,jj) 
    … …  
    463513         ! thus we calculate the upstream solution and apply a limiter again 
    464514         DO jl = 1, jpl 
    465             DO_2D_00_00 
     515            DO_2D( 0, 0, 0, 0 ) 
    466516               ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 
    467517               ! 
    … …  
    469519            END_2D 
    470520         END DO 
    471          CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1. ) 
     521         CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T',  1.0_wp ) 
    472522         ! 
    473523         IF    ( np_limiter == 1 ) THEN 
    … …  
    484534      IF( PRESENT( pua_ho ) ) THEN 
    485535         DO jl = 1, jpl 
    486             DO_2D_10_10 
    487                pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
    488                pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
     536            DO_2D( 0, 0, 1, 0 ) 
     537               pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) 
     538               pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) 
     539            END_2D 
     540            DO_2D( 1, 0, 0, 0 ) 
     541               pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 
     542               pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 
    489543            END_2D 
    490544         END DO 
    … …  
    494548      ! --------------------------------- 
    495549      DO jl = 1, jpl 
    496          DO_2D_00_00 
     550         DO_2D( 0, 0, 0, 0 ) 
    497551            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )   
    498552            ! 
    … …  
    500554         END_2D 
    501555      END DO 
    502       CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T',  1. ) 
    503556      ! 
    504557   END SUBROUTINE adv_umx 
    … …  
    528581         ! 
    529582         DO jl = 1, jpl 
    530             DO_2D_10_10 
     583            DO_2D( 1, 0, 1, 0 ) 
    531584               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    532585               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    … …  
    539592            ! 
    540593            DO jl = 1, jpl              !-- flux in x-direction 
    541                DO_2D_10_10 
     594               DO_2D( 1, 1, 1, 0 ) 
    542595                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    543596               END_2D 
    … …  
    545598            ! 
    546599            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    547                DO_2D_00_00 
     600               DO_2D( 1, 1, 0, 0 ) 
    548601                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
    549602                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    552605               END_2D 
    553606            END DO 
    554             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    555607            ! 
    556608            DO jl = 1, jpl              !-- flux in y-direction 
    557                DO_2D_10_10 
     609               DO_2D( 1, 0, 0, 0 ) 
    558610                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
    559611               END_2D 
    … …  
    563615            ! 
    564616            DO jl = 1, jpl              !-- flux in y-direction 
    565                DO_2D_10_10 
     617               DO_2D( 1, 0, 1, 1 ) 
    566618                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    567619               END_2D 
    … …  
    569621            ! 
    570622            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    571                DO_2D_00_00 
     623               DO_2D( 0, 0, 1, 1 ) 
    572624                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
    573625                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    576628               END_2D 
    577629            END DO 
    578             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    579630            ! 
    580631            DO jl = 1, jpl              !-- flux in x-direction 
    581                DO_2D_10_10 
     632               DO_2D( 0, 0, 1, 0 ) 
    582633                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
    583634               END_2D 
    … …  
    589640      ! 
    590641      DO jl = 1, jpl                    !-- after tracer with upstream scheme 
    591          DO_2D_00_00 
     642         DO_2D( 0, 0, 0, 0 ) 
    592643            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   & 
    593644               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) & 
    … …  
    598649         END_2D 
    599650      END DO 
    600       CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. ) 
     651      CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 
    601652 
    602653   END SUBROUTINE upstream 
    … …  
    628679         ! 
    629680         DO jl = 1, jpl 
    630             DO_2D_10_10 
     681            DO_2D( 1, 1, 1, 0 ) 
    631682               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
     683            END_2D 
     684            DO_2D( 1, 0, 1, 1 ) 
    632685               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
    633686            END_2D 
    … …  
    646699            ! 
    647700            DO jl = 1, jpl              !-- flux in x-direction 
    648                DO_2D_10_10 
     701               DO_2D( 1, 1, 1, 0 ) 
    649702                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    650703               END_2D 
    … …  
    653706 
    654707            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    655                DO_2D_00_00 
     708               DO_2D( 1, 1, 0, 0 ) 
    656709                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
    657710                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    660713               END_2D 
    661714            END DO 
    662             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    663715 
    664716            DO jl = 1, jpl              !-- flux in y-direction 
    665                DO_2D_10_10 
     717               DO_2D( 1, 0, 0, 0 ) 
    666718                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    667719               END_2D 
    … …  
    672724            ! 
    673725            DO jl = 1, jpl              !-- flux in y-direction 
    674                DO_2D_10_10 
     726               DO_2D( 1, 0, 1, 1 ) 
    675727                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    676728               END_2D 
    … …  
    679731            ! 
    680732            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    681                DO_2D_00_00 
     733               DO_2D( 0, 0, 1, 1 ) 
    682734                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
    683735                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    686738               END_2D 
    687739            END DO 
    688             CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
    689740            ! 
    690741            DO jl = 1, jpl              !-- flux in x-direction 
    691                DO_2D_10_10 
     742               DO_2D( 0, 0, 1, 0 ) 
    692743                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
    693744               END_2D 
    … …  
    737788         !                                                        !--  advective form update in zpt  --! 
    738789         DO jl = 1, jpl 
    739             DO_2D_00_00 
     790            DO_2D( 0, 0, 0, 0 ) 
    740791               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) & 
    741792                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    744795            END_2D 
    745796         END DO 
    746          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     797         CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    747798         ! 
    748799         !                                                        !--  ultimate interpolation of pt at v-point  --! 
    … …  
    764815         !                                                        !--  advective form update in zpt  --! 
    765816         DO jl = 1, jpl 
    766             DO_2D_00_00 
     817            DO_2D( 0, 0, 0, 0 ) 
    767818               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) & 
    768819                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    771822            END_2D 
    772823         END DO 
    773          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. ) 
     824         CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    774825         ! 
    775826         !                                                        !--  ultimate interpolation of pt at u-point  --! 
    … …  
    824875         END DO 
    825876      END DO 
    826       CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1. ) 
     877      CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 
    827878      ! 
    828879      !                                                     !--  BiLaplacian in i-direction  --! 
    … …  
    838889         END DO 
    839890      END DO 
    840       CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1. ) 
     891      CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 
    841892      ! 
    842893      ! 
    … …  
    846897         !         
    847898         DO jl = 1, jpl 
    848             DO_2D_10_10 
     899            DO_2D( 0, 0, 1, 0 ) 
    849900               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    850901                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    … …  
    855906         ! 
    856907         DO jl = 1, jpl 
    857             DO_2D_10_10 
     908            DO_2D( 0, 0, 1, 0 ) 
    858909               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    859910               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    865916         ! 
    866917         DO jl = 1, jpl 
    867             DO_2D_10_10 
     918            DO_2D( 0, 0, 1, 0 ) 
    868919               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    869920               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    879930         ! 
    880931         DO jl = 1, jpl 
    881             DO_2D_10_10 
     932            DO_2D( 0, 0, 1, 0 ) 
    882933               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    883934               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    893944         ! 
    894945         DO jl = 1, jpl 
    895             DO_2D_10_10 
     946            DO_2D( 0, 0, 1, 0 ) 
    896947               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    897948               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    914965      IF( ll_neg ) THEN 
    915966         DO jl = 1, jpl 
    916             DO_2D_10_10 
     967            DO_2D( 0, 0, 1, 0 ) 
    917968               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    918969                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    924975      !                                                     !-- High order flux in i-direction  --! 
    925976      DO jl = 1, jpl 
    926          DO_2D_10_10 
     977         DO_2D( 0, 0, 1, 0 ) 
    927978            pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 
    928979         END_2D 
    … …  
    9571008      !                                                     !--  Laplacian in j-direction  --! 
    9581009      DO jl = 1, jpl 
    959          DO_2D_10_00 
     1010         DO_2D( 1, 0, 0, 0 )         ! First derivative (gradient) 
    9601011            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    9611012         END_2D 
    962          DO_2D_00_00 
     1013         DO_2D( 0, 0, 0, 0 )         ! Second derivative (Laplacian) 
    9631014            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    9641015         END_2D 
    9651016      END DO 
    966       CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. ) 
     1017      CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 
    9671018      ! 
    9681019      !                                                     !--  BiLaplacian in j-direction  --! 
    9691020      DO jl = 1, jpl 
    970          DO_2D_10_00 
     1021         DO_2D( 1, 0, 0, 0 )         ! First derivative 
    9711022            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    9721023         END_2D 
    973          DO_2D_00_00 
     1024         DO_2D( 0, 0, 0, 0 )         ! Second derivative 
    9741025            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    9751026         END_2D 
    9761027      END DO 
    977       CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. ) 
     1028      CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 
    9781029      ! 
    9791030      ! 
    … …  
    9821033      CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21) 
    9831034         DO jl = 1, jpl 
    984             DO_2D_10_10 
     1035            DO_2D( 1, 0, 0, 0 ) 
    9851036               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    9861037                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    … …  
    9901041      CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23) 
    9911042         DO jl = 1, jpl 
    992             DO_2D_10_10 
     1043            DO_2D( 1, 0, 0, 0 ) 
    9931044               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    9941045               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    … …  
    9991050      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24) 
    10001051         DO jl = 1, jpl 
    1001             DO_2D_10_10 
     1052            DO_2D( 1, 0, 0, 0 ) 
    10021053               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10031054               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10121063      CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27) 
    10131064         DO jl = 1, jpl 
    1014             DO_2D_10_10 
     1065            DO_2D( 1, 0, 0, 0 ) 
    10151066               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10161067               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10251076      CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29) 
    10261077         DO jl = 1, jpl 
    1027             DO_2D_10_10 
     1078            DO_2D( 1, 0, 0, 0 ) 
    10281079               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10291080               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10461097      IF( ll_neg ) THEN 
    10471098         DO jl = 1, jpl 
    1048             DO_2D_10_10 
     1099            DO_2D( 1, 0, 0, 0 ) 
    10491100               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    10501101                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    … …  
    10561107      !                                                     !-- High order flux in j-direction  --! 
    10571108      DO jl = 1, jpl 
    1058          DO_2D_10_10 
     1109         DO_2D( 1, 0, 0, 0 ) 
    10591110            pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 
    10601111         END_2D 
    … …  
    10921143      ! -------------------------------------------------- 
    10931144      DO jl = 1, jpl 
    1094          DO_2D_10_10 
     1145         DO_2D( 0, 0, 1, 0 ) 
    10951146            pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 
     1147         END_2D 
     1148         DO_2D( 1, 0, 0, 0 ) 
    10961149            pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 
    10971150         END_2D 
    … …  
    11091162          
    11101163         DO jl = 1, jpl 
    1111             DO_2D_00_00 
     1164            DO_2D( 0, 0, 0, 0 ) 
    11121165               zti_ups(ji,jj,jl)= pt_ups(ji+1,jj  ,jl) 
    11131166               ztj_ups(ji,jj,jl)= pt_ups(ji  ,jj+1,jl) 
    11141167            END_2D 
    11151168         END DO 
    1116          CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1., ztj_ups, 'T', 1. ) 
    1117  
    1118          DO jl = 1, jpl 
    1119             DO_2D_00_00 
     1169         CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp ) 
     1170 
     1171         DO jl = 1, jpl 
     1172            DO_2D( 0, 0, 0, 0 ) 
    11201173               IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj  ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND.  & 
    11211174                  & pfv_ho(ji,jj,jl) * ( pt_ups(ji  ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN 
    … …  
    11361189            END_2D 
    11371190         END DO 
    1138          CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1., pfv_ho, 'V', -1. )   ! lateral boundary cond. 
     1191         CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp )   ! lateral boundary cond. 
    11391192 
    11401193      ENDIF 
    … …  
    11461199      DO jl = 1, jpl 
    11471200          
    1148          DO_2D_11_11 
     1201         DO_2D( 1, 1, 1, 1 ) 
    11491202            IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
    11501203               zbup(ji,jj) = -zbig 
    … …  
    11621215         END_2D 
    11631216 
    1164          DO_2D_00_00 
     1217         DO_2D( 0, 0, 0, 0 ) 
    11651218            ! 
    11661219            zup  = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) )  ! search max/min in neighbourhood 
    … …  
    11931246         END_2D 
    11941247      END DO 
    1195       CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     1248      CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    11961249 
    11971250       
    … …  
    11991252      ! --------------------------------- 
    12001253      DO jl = 1, jpl 
    1201          DO_2D_10_10 
     1254         DO_2D( 0, 0, 1, 0 ) 
    12021255            zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 
    12031256            zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) 
    … …  
    12101263         END_2D 
    12111264 
    1212          DO_2D_10_10 
     1265         DO_2D( 1, 0, 0, 0 ) 
    12131266            zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 
    12141267            zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) 
    … …  
    12441297      ! 
    12451298      DO jl = 1, jpl 
    1246          DO_2D_00_00 
     1299         DO_2D( 0, 0, 0, 0 ) 
    12471300            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 
    12481301         END_2D 
    12491302      END DO 
    1250       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.)   ! lateral boundary cond. 
     1303      CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
    12511304       
    12521305      DO jl = 1, jpl 
    1253          DO_2D_00_00 
     1306         DO_2D( 0, 0, 0, 0 ) 
    12541307            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
    12551308             
    … …  
    13121365         END_2D 
    13131366      END DO 
    1314       CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.)   ! lateral boundary cond. 
     1367      CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp)   ! lateral boundary cond. 
    13151368      ! 
    13161369   END SUBROUTINE limiter_x 
    … …  
    13351388      ! 
    13361389      DO jl = 1, jpl 
    1337          DO_2D_00_00 
     1390         DO_2D( 0, 0, 0, 0 ) 
    13381391            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 
    13391392         END_2D 
    13401393      END DO 
    1341       CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.)   ! lateral boundary cond. 
    1342  
    1343       DO jl = 1, jpl 
    1344          DO_2D_00_00 
     1394      CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp)   ! lateral boundary cond. 
     1395 
     1396      DO jl = 1, jpl 
     1397         DO_2D( 0, 0, 0, 0 ) 
    13451398            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 
    13461399 
    … …  
    14041457         END_2D 
    14051458      END DO 
    1406       CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.)   ! lateral boundary cond. 
     1459      CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp)   ! lateral boundary cond. 
    14071460      ! 
    14081461   END SUBROUTINE limiter_y 
    14091462 
    14101463 
    1411    SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 
     1464   SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, psi_max, pes_max, pei_max, & 
     1465      &                  pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i, pe_s, pe_i ) 
    14121466      !!------------------------------------------------------------------- 
    14131467      !!                  ***  ROUTINE Hbig  *** 
    … …  
    14231477      !! ** input   : Max thickness of the surrounding 9-points 
    14241478      !!------------------------------------------------------------------- 
    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 
     1479      REAL(wp)                    , INTENT(in   ) ::   pdt                                   ! tracer time-step 
     1480      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   phi_max, phs_max, phip_max, psi_max   ! max ice thick from surrounding 9-pts 
     1481      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pes_max 
     1482      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pei_max 
     1483      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_i, pv_s, pa_i, pa_ip, pv_ip, psv_i 
    14281484      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 
     1485      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i 
     1486      ! 
     1487      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
     1488      REAL(wp) ::   z1_dt, zhip, zhi, zhs, zsi, zes, zei, zfra 
    14321489      !!------------------------------------------------------------------- 
    14331490      ! 
    … …  
    14351492      ! 
    14361493      DO jl = 1, jpl 
    1437  
    1438          DO_2D_11_11 
     1494         DO_2D( 1, 1, 1, 1 ) 
    14391495            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    14401496               ! 
    14411497               !                               ! -- check h_ip -- ! 
    14421498               ! 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 
     1499               IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    14441500                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    14451501                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    14681524               ENDIF            
    14691525               !                   
     1526               !                               ! -- check s_i -- ! 
     1527               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
     1528               zsi = psv_i(ji,jj,jl) / pv_i(ji,jj,jl) 
     1529               IF( zsi > psi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1530                  zfra = psi_max(ji,jj,jl) / zsi 
     1531                  sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * ( 1._wp - zfra ) * rhoi * z1_dt 
     1532                  psv_i(ji,jj,jl) = psv_i(ji,jj,jl) * zfra 
     1533               ENDIF 
     1534               ! 
    14701535            ENDIF 
    14711536         END_2D 
    14721537      END DO  
     1538      ! 
     1539      !                                           ! -- check e_i/v_i -- ! 
     1540      DO jl = 1, jpl 
     1541         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     1542            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
     1543               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1544               zei = pe_i(ji,jj,jk,jl) / pv_i(ji,jj,jl) 
     1545               IF( zei > pei_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1546                  zfra = pei_max(ji,jj,jk,jl) / zei 
     1547                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1548                  pe_i(ji,jj,jk,jl) = pe_i(ji,jj,jk,jl) * zfra 
     1549               ENDIF 
     1550            ENDIF 
     1551         END_3D 
     1552      END DO 
     1553      !                                           ! -- check e_s/v_s -- ! 
     1554      DO jl = 1, jpl 
     1555         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     1556            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
     1557               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
     1558               zes = pe_s(ji,jj,jk,jl) / pv_s(ji,jj,jl) 
     1559               IF( zes > pes_max(ji,jj,jk,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 
     1560                  zfra = pes_max(ji,jj,jk,jl) / zes 
     1561                  hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 
     1562                  pe_s(ji,jj,jk,jl) = pe_s(ji,jj,jk,jl) * zfra 
     1563               ENDIF 
     1564            ENDIF 
     1565         END_3D 
     1566      END DO 
    14731567      ! 
    14741568   END SUBROUTINE Hbig 
    … …  
    15021596      ! -- check snow load -- ! 
    15031597      DO jl = 1, jpl 
    1504          DO_2D_11_11 
     1598         DO_2D( 1, 1, 1, 1 ) 
    15051599            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    15061600               ! 
    … …  
    15261620   END SUBROUTINE Hsnow 
    15271621 
     1622   SUBROUTINE icemax3D( pice , pmax ) 
     1623      !!--------------------------------------------------------------------- 
     1624      !!                   ***  ROUTINE icemax3D ***                      
     1625      !! ** Purpose :  compute the max of the 9 points around 
     1626      !!---------------------------------------------------------------------- 
     1627      REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input 
     1628      REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output 
     1629      REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1630      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
     1631      !!---------------------------------------------------------------------- 
     1632      DO jl = 1, jpl 
     1633         DO jj = Njs0-1, Nje0+1     
     1634            DO ji = Nis0, Nie0 
     1635               zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 
     1636            END DO 
     1637         END DO 
     1638         DO jj = Njs0, Nje0     
     1639            DO ji = Nis0, Nie0 
     1640               pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
     1641            END DO 
     1642         END DO 
     1643      END DO 
     1644   END SUBROUTINE icemax3D 
     1645 
     1646   SUBROUTINE icemax4D( pice , pmax ) 
     1647      !!--------------------------------------------------------------------- 
     1648      !!                   ***  ROUTINE icemax4D ***                      
     1649      !! ** Purpose :  compute the max of the 9 points around 
     1650      !!---------------------------------------------------------------------- 
     1651      REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input 
     1652      REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output 
     1653      REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1654      INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices 
     1655      !!---------------------------------------------------------------------- 
     1656      jlay = SIZE( pice , 3 )   ! size of input arrays 
     1657      DO jl = 1, jpl 
     1658         DO jk = 1, jlay 
     1659            DO jj = Njs0-1, Nje0+1     
     1660               DO ji = Nis0, Nie0 
     1661                  zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 
     1662               END DO 
     1663            END DO 
     1664            DO jj = Njs0, Nje0     
     1665               DO ji = Nis0, Nie0 
     1666                  pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
     1667               END DO 
     1668            END DO 
     1669         END DO 
     1670      END DO 
     1671   END SUBROUTINE icemax4D 
    15281672 
    15291673#else 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icedyn_rdgrft.F90

    r12489 r13727  
    161161      npti = 0   ;   nptidx(:) = 0 
    162162      ipti = 0   ;   iptidx(:) = 0 
    163       DO_2D_11_11 
     163      DO_2D( 1, 1, 1, 1 ) 
    164164         IF ( at_i(ji,jj) > epsi10 ) THEN 
    165165            npti           = npti + 1 
    … …  
    300300 
    301301      !                       ! Ice thickness needed for rafting 
     302      ! In single precision there were floating point invalids due a sqrt of zhi which happens to have negative values 
     303      ! To solve that an extra check about the value of pv_i was added. 
     304      ! Although adding this condition is safe, the double definition (one for single other for double) has been kept to preserve the results of the sette test. 
     305#if defined key_single 
     306 
     307      WHERE( pa_i(1:npti,:) > epsi10 .and. pv_i(1:npti,:) > epsi10 )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 
     308#else 
    302309      WHERE( pa_i(1:npti,:) > epsi10 )   ;   zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 
     310#endif 
    303311      ELSEWHERE                          ;   zhi(1:npti,:) = 0._wp 
    304312      END WHERE 
    … …  
    341349               ELSEIF( zGsum(ji,jl-1) < rn_gstar ) THEN 
    342350                  apartf(ji,jl) = z1_gstar * ( rn_gstar     - zGsum(ji,jl-1) ) *  & 
    343                      &                       ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar        ) * z1_gstar ) 
     351                     &                       ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar     ) * z1_gstar ) 
    344352               ELSE 
    345353                  apartf(ji,jl) = 0._wp 
    … …  
    494502      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    495503      REAL(wp)                  ::   airft1, oirft1, aprft1 
    496       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg  ! area etc of new ridges 
    497       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 
    498506      ! 
    499507      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
    … …  
    522530      DO jl1 = 1, jpl 
    523531 
    524          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 
    525535 
    526536         DO ji = 1, npti 
    … …  
    565575               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft  
    566576 
    567                IF ( ln_pnd_H12 ) THEN 
     577               IF ( ln_pnd_LEV ) THEN 
    568578                  aprdg1     = a_ip_2d(ji,jl1) * afrdg 
    569579                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
    … …  
    572582                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 
    573583                  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 
    574588               ENDIF 
    575589 
    … …  
    598612               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji) 
    599613               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1 
    600                IF ( ln_pnd_H12 ) THEN 
     614               IF ( ln_pnd_LEV ) THEN 
    601615                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    602616                  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 
    603620               ENDIF 
    604621            ENDIF 
    … …  
    692709                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    693710                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    694                   IF ( ln_pnd_H12 ) THEN 
     711                  IF ( ln_pnd_LEV ) THEN 
    695712                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
    696713                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   ) 
    697714                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &  
    698715                        &                                   + 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 
    699720                  ENDIF 
    700721                   
    … …  
    727748      !---------------- 
    728749      ! In case ridging/rafting lead to very small negative values (sometimes it happens) 
    729       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 ) 
    730751      ! 
    731752   END SUBROUTINE rdgrft_shift 
    … …  
    766787      !                              !--------------------------------------------------! 
    767788      CASE( 1 )               !--- Spatial smoothing 
    768          DO_2D_00_00 
     789         DO_2D( 0, 0, 0, 0 ) 
    769790            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
    770791               zworka(ji,jj) = ( 4.0 * strength(ji,jj)              & 
    … …  
    777798         END_2D 
    778799          
    779          DO_2D_00_00 
     800         DO_2D( 0, 0, 0, 0 ) 
    780801            strength(ji,jj) = zworka(ji,jj) 
    781802         END_2D 
    782          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 
     803         CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 
    783804         ! 
    784805      CASE( 2 )               !--- Temporal smoothing 
    … …  
    788809         ENDIF 
    789810         ! 
    790          DO_2D_00_00 
     811         DO_2D( 0, 0, 0, 0 ) 
    791812            IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN  
    792813               itframe = 1 ! number of time steps for the running mean 
    … …  
    799820            ENDIF 
    800821         END_2D 
    801          CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. ) 
     822         CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 
    802823         ! 
    803824      END SELECT 
    … …  
    833854         CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    834855         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(:,:,:) ) 
    835857         DO jl = 1, jpl 
    836858            DO jk = 1, nlay_s 
    … …  
    859881         CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    860882         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(:,:,:) ) 
    861884         DO jl = 1, jpl 
    862885            DO jk = 1, nlay_s 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icedyn_rhg.F90

    r12377 r13727  
    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_12905_xios_restart/src/ICE/icedyn_rhg_evp.F90

    r12969 r13727  
    4141   USE prtctl         ! Print control 
    4242 
     43   USE netcdf         ! NetCDF library for convergence test 
    4344   IMPLICIT NONE 
    4445   PRIVATE 
    … …  
    4950   !! * Substitutions 
    5051#  include "do_loop_substitute.h90" 
     52#  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 
    5158   !!---------------------------------------------------------------------- 
    5259   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    120127      REAL(wp) ::   ecc2, z1_ecc2                                       ! square of yield ellipse eccenticity 
    121128      REAL(wp) ::   zalph1, z1_alph1, zalph2, z1_alph2                  ! alpha coef from Bouillon 2009 or Kimmritz 2017 
     129      REAl(wp) ::   zbetau, zbetav 
    122130      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV, zvU, zvV             ! ice/snow mass and volume 
    123       REAL(wp) ::   zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2       ! temporary scalars 
     131      REAL(wp) ::   zp_delf, zds2, zdt, zdt2, zdiv, zdiv2               ! temporary scalars 
    124132      REAL(wp) ::   zTauO, zTauB, zRHS, zvel                            ! temporary scalars 
    125133      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice 
    126134      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    127135      ! 
    128       REAL(wp) ::   zresm                                               ! Maximal error on ice velocity 
    129136      REAL(wp) ::   zintb, zintn                                        ! dummy argument 
    130137      REAL(wp) ::   zfac_x, zfac_y 
    131138      REAL(wp) ::   zshear, zdum1, zdum2 
    132139      ! 
    133       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 
    134141      REAL(wp), DIMENSION(jpi,jpj) ::   zbeta                           ! beta coef from Kimmritz 2017 
    135142      ! 
    … …  
    138145      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points 
    139146      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points 
    140       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 
    141148      ! 
    142149      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
     150      REAL(wp), DIMENSION(jpi,jpj) ::   zten_i                          ! tension 
    143151      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components 
    144 !!$      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr           ! check convergence 
    145152      REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope: 
    146153      !                                                                 !    ocean surface (ssh_m) if ice is not embedded 
    … …  
    156163      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    157164      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    158       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask, zwf                     ! mask at F points for the ice 
     165      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    159166 
    160167      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
    161168      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2)  below which ice velocity becomes very small 
    162169      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
     170      !! --- check convergence 
     171      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice 
    163172      !! --- diags 
    164       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
    165       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3 
     173      REAL(wp) ::   zsig1, zsig2, zsig12, zfac, z1_strength 
     174      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig_I, zsig_II, zsig1_p, zsig2_p          
    166175      !! --- SIMIP diags 
    167176      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s) 
    … …  
    175184      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 
    176185      ! 
    177 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     186      ! for diagnostics and convergence tests 
     187      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
     188      DO_2D( 1, 1, 1, 1 ) 
     189         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     190         zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     191      END_2D 
     192      ! 
     193      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    178194      !------------------------------------------------------------------------------! 
    179195      ! 0) mask at F points for the ice 
    180196      !------------------------------------------------------------------------------! 
    181197      ! ocean/land mask 
    182       DO_2D_10_10 
     198      DO_2D( 1, 0, 1, 0 ) 
    183199         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    184200      END_2D 
    … …  
    186202 
    187203      ! Lateral boundary conditions on velocity (modify zfmask) 
    188       zwf(:,:) = zfmask(:,:) 
    189       DO_2D_00_00 
     204      DO_2D( 0, 0, 0, 0 ) 
    190205         IF( zfmask(ji,jj) == 0._wp ) THEN 
    191             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) ) ) 
     206            zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     207               &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
    192208         ENDIF 
    193209      END_2D 
    194210      DO jj = 2, jpjm1 
    195211         IF( zfmask(1,jj) == 0._wp ) THEN 
    196             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     212            zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    197213         ENDIF 
    198214         IF( zfmask(jpi,jj) == 0._wp ) THEN 
    199             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    200          ENDIF 
     215            zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
     216        ENDIF 
    201217      END DO 
    202218      DO ji = 2, jpim1 
    203219         IF( zfmask(ji,1) == 0._wp ) THEN 
    204             zfmask(ji,1  ) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     220            zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    205221         ENDIF 
    206222         IF( zfmask(ji,jpj) == 0._wp ) THEN 
    207             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     223            zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    208224         ENDIF 
    209225      END DO 
    … …  
    219235      z1_ecc2 = 1._wp / ecc2 
    220236 
    221       ! Time step for subcycling 
    222       zdtevp   = rDt_ice / REAL( nn_nevp ) 
    223       z1_dtevp = 1._wp / zdtevp 
    224  
    225237      ! alpha parameters (Bouillon 2009) 
    226238      IF( .NOT. ln_aEVP ) THEN 
    227          zalph1 = ( 2._wp * rn_relast * rDt_ice ) * z1_dtevp 
     239         zdtevp   = rDt_ice / REAL( nn_nevp ) 
     240         zalph1 =   2._wp * rn_relast * REAL( nn_nevp ) 
    228241         zalph2 = zalph1 * z1_ecc2 
    229242 
    230243         z1_alph1 = 1._wp / ( zalph1 + 1._wp ) 
    231244         z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
    232       ENDIF 
     245      ELSE 
     246         zdtevp   = rdt_ice 
     247         ! zalpha parameters set later on adaptatively 
     248      ENDIF 
     249      z1_dtevp = 1._wp / zdtevp 
    233250          
    234251      ! Initialise stress tensor  
    … …  
    241258 
    242259      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 
    243       IF( ln_landfast_L16 ) THEN   ;   zkt = rn_tensile 
     260      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_lf_tensile 
    244261      ELSE                         ;   zkt = 0._wp 
    245262      ENDIF 
    … …  
    253270      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 
    254271 
    255       DO_2D_00_00 
     272      DO_2D( 0, 0, 0, 0 ) 
    256273 
    257274         ! ice fraction at U-V points 
    … …  
    299316 
    300317      END_2D 
    301       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1., zdt_m, 'T', 1. ) 
     318      CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    302319      ! 
    303320      !                                  !== Landfast ice parameterization ==! 
    304321      ! 
    305322      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016 
    306          DO_2D_00_00 
     323         DO_2D( 0, 0, 0, 0 ) 
    307324            ! ice thickness at U-V points 
    308325            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    309326            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) 
    310327            ! ice-bottom stress at U points 
    311             zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm) 
    312             ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
     328            zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 
     329            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    313330            ! ice-bottom stress at V points 
    314             zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm) 
    315             ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
     331            zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 
     332            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    316333            ! ice_bottom stress at T points 
    317             zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj) 
    318             tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
     334            zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 
     335            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    319336         END_2D 
    320          CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 
     337         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 
    321338         ! 
    322339      ELSE                               !-- no landfast 
    323          DO_2D_00_00 
     340         DO_2D( 0, 0, 0, 0 ) 
    324341            ztaux_base(ji,jj) = 0._wp 
    325342            ztauy_base(ji,jj) = 0._wp 
    … …  
    336353         l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
    337354         ! 
    338 !!$         IF(sn_cfctl%l_prtctl) THEN   ! Convergence test 
    339 !!$            DO jj = 1, jpjm1 
    340 !!$               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
    341 !!$               zv_ice(:,jj) = v_ice(:,jj) 
    342 !!$            END DO 
    343 !!$         ENDIF 
     355         ! convergence test 
     356         IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN 
     357            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     358               zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
     359               zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
     360            END_2D 
     361         ENDIF 
    344362 
    345363         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    346          DO_2D_10_10 
     364         DO_2D( 1, 0, 1, 0 ) 
    347365 
    348366            ! shear at F points 
    … …  
    352370 
    353371         END_2D 
    354          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. ) 
    355  
    356          DO_2D_01_01 
     372 
     373         DO_2D( 0, 0, 0, 0 ) 
    357374 
    358375            ! shear**2 at T points (doc eq. A16) 
    … …  
    374391             
    375392            ! delta at T points 
    376             zdelta = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
    377  
    378             ! P/delta at T points 
    379             zp_delt(ji,jj) = strength(ji,jj) / ( zdelta + rn_creepl ) 
    380  
    381             ! alpha & beta for aEVP 
     393            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     394 
     395         END_2D 
     396         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp ) 
     397 
     398         ! P/delta at T points 
     399         DO_2D( 1, 1, 1, 1 ) 
     400            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
     401         END_2D 
     402 
     403         DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
     404 
     405            ! divergence at T points (duplication to avoid communications) 
     406            zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
     407               &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     408               &    ) * r1_e1e2t(ji,jj) 
     409             
     410            ! tension at T points (duplication to avoid communications) 
     411            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)   & 
     412               &   - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     413               &   ) * r1_e1e2t(ji,jj) 
     414             
     415            ! alpha for aEVP 
    382416            !   gamma = 0.5*P/(delta+creepl) * (c*pi)**2/Area * dt/m 
    383417            !   alpha = beta = sqrt(4*gamma) 
    … …  
    387421               zalph2   = zalph1 
    388422               z1_alph2 = z1_alph1 
     423               ! explicit: 
     424               ! z1_alph1 = 1._wp / zalph1 
     425               ! z1_alph2 = 1._wp / zalph1 
     426               ! zalph1 = zalph1 - 1._wp 
     427               ! zalph2 = zalph1 
    389428            ENDIF 
    390429             
    391430            ! stress at T points (zkt/=0 if landfast) 
    392             zs1(ji,jj) = ( zs1(ji,jj) * zalph1 + zp_delt(ji,jj) * ( zdiv * (1._wp + zkt) - zdelta * (1._wp - zkt) ) ) * z1_alph1 
    393             zs2(ji,jj) = ( zs2(ji,jj) * zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
     431            zs1(ji,jj) = ( zs1(ji,jj)*zalph1 + zp_delt(ji,jj) * ( zdiv*(1._wp + zkt) - zdelta(ji,jj)*(1._wp - zkt) ) ) * z1_alph1 
     432            zs2(ji,jj) = ( zs2(ji,jj)*zalph2 + zp_delt(ji,jj) * ( zdt * z1_ecc2 * (1._wp + zkt) ) ) * z1_alph2 
    394433           
    395434         END_2D 
    396          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. ) 
    397  
    398          DO_2D_10_10 
    399  
    400             ! alpha & beta for aEVP 
     435 
     436         ! Save beta at T-points for further computations 
     437         IF( ln_aEVP ) THEN 
     438            DO_2D( 1, 1, 1, 1 ) 
     439               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     440            END_2D 
     441         ENDIF 
     442          
     443         DO_2D( 1, 0, 1, 0 ) 
     444 
     445            ! alpha for aEVP 
    401446            IF( ln_aEVP ) THEN 
    402                zalph2   = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
     447               zalph2   = MAX( zbeta(ji,jj), zbeta(ji+1,jj), zbeta(ji,jj+1), zbeta(ji+1,jj+1) ) 
    403448               z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
    404                zbeta(ji,jj) = zalph2 
     449               ! explicit: 
     450               ! z1_alph2 = 1._wp / zalph2 
     451               ! zalph2 = zalph2 - 1._wp 
    405452            ENDIF 
    406453             
    … …  
    414461 
    415462         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    416          DO_2D_00_00 
     463         DO_2D( 0, 0, 0, 0 ) 
    417464            !                   !--- U points 
    418465            zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
    … …  
    442489         IF( MOD(jter,2) == 0 ) THEN ! even iterations 
    443490            ! 
    444             DO_2D_00_00 
     491            DO_2D( 0, 0, 0, 0 ) 
    445492               !                 !--- tau_io/(v_oce - v_ice) 
    446493               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    … …  
    468515               ! 
    469516               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    470                   v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    471                      &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    472                      &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    473                      &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    474                      &             ) * 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 
     517                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     518                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     519                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     520                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     521                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   &  
     522                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     523                     &                                    ) / ( zbetav + 1._wp )                                              & 
     524                     &             ) * 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 
    475525                     &           )   * zmsk00y(ji,jj) 
    476526               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    477                   v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    478                      &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    479                      &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    480                      &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    481                      &              ) * 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 
    482                      &            )   * zmsk00y(ji,jj) 
     527                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     528                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     529                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     530                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     531                     &             ) * 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 
     532                     &            )  * zmsk00y(ji,jj) 
    483533               ENDIF 
    484534            END_2D 
    485             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 
     535            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    486536            ! 
    487537#if defined key_agrif 
    … …  
    491541            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
    492542            ! 
    493             DO_2D_00_00 
     543            DO_2D( 0, 0, 0, 0 ) 
    494544               !                 !--- tau_io/(u_oce - u_ice) 
    495545               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    … …  
    517567               ! 
    518568               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    519                   u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    520                      &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    521                      &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    522                      &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    523                      &             ) * 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  
     569                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     570                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     571                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     572                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     573                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     574                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     575                     &                                    ) / ( zbetau + 1._wp )                                              & 
     576                     &             ) * 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  
    524577                     &           )   * zmsk00x(ji,jj) 
    525578               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    526                   u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    527                      &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    528                      &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    529                      &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    530                      &              ) * 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  
    531                      &            )   * zmsk00x(ji,jj) 
     579                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     580                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     581                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     582                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     583                     &             ) * 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  
     584                     &           )   * zmsk00x(ji,jj) 
    532585               ENDIF 
    533586            END_2D 
    534             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 
     587            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    535588            ! 
    536589#if defined key_agrif 
    … …  
    542595         ELSE ! odd iterations 
    543596            ! 
    544             DO_2D_00_00 
     597            DO_2D( 0, 0, 0, 0 ) 
    545598               !                 !--- tau_io/(u_oce - u_ice) 
    546599               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    … …  
    568621               ! 
    569622               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    570                   u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    571                      &                                  + zRHS + zTauO * u_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    572                      &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    573                      &               + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    574                      &             ) * 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  
     623                  zbetau = MAX( zbeta(ji,jj), zbeta(ji+1,jj) ) 
     624                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * ( zbetau * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     625                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     626                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) * ( zbetau + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     627                     &            + ( 1._wp - rswitch ) * (  u_ice_b(ji,jj)                                                   & 
     628                     &                                     + u_ice  (ji,jj) * MAX( 0._wp, zbetau - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     629                     &                                    ) / ( zbetau + 1._wp )                                              & 
     630                     &             ) * 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  
    575631                     &           )   * zmsk00x(ji,jj) 
    576632               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    577                   u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
    578                      &                                     + zRHS + zTauO * u_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    579                      &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    580                      &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    581                      &              ) * 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 
    582                      &            )   * zmsk00x(ji,jj) 
     633                  u_ice(ji,jj) = ( (          rswitch   * ( zmU_t(ji,jj) * u_ice(ji,jj)                                       & ! previous velocity 
     634                     &                                    + zRHS + zTauO * u_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     635                     &                                    ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     636                     &            + ( 1._wp - rswitch ) *   u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     637                     &             ) * 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 
     638                     &           )   * zmsk00x(ji,jj) 
    583639               ENDIF 
    584640            END_2D 
    585             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. ) 
     641            CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    586642            ! 
    587643#if defined key_agrif 
    … …  
    591647            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
    592648            ! 
    593             DO_2D_00_00 
     649            DO_2D( 0, 0, 0, 0 ) 
    594650               !                 !--- tau_io/(v_oce - v_ice) 
    595651               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    … …  
    617673               ! 
    618674               IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    619                   v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    620                      &                                  + zRHS + zTauO * v_ice(ji,jj) )                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    621                      &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    622                      &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    623                      &             ) * 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 
     675                  zbetav = MAX( zbeta(ji,jj), zbeta(ji,jj+1) ) 
     676                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * ( zbetav * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     677                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     678                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) * ( zbetav + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     679                     &            + ( 1._wp - rswitch ) * (  v_ice_b(ji,jj)                                                   & 
     680                     &                                     + v_ice  (ji,jj) * MAX( 0._wp, zbetav - zdtevp * rn_lf_relax )     & ! static friction => slow decrease to v=0 
     681                     &                                    ) / ( zbetav + 1._wp )                                              &  
     682                     &             ) * 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 
    624683                     &           )   * zmsk00y(ji,jj) 
    625684               ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    626                   v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
    627                      &                                     + zRHS + zTauO * v_ice(ji,jj) )                                      & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    628                      &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    629                      &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    630                      &              ) * 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 
    631                      &            )   * zmsk00y(ji,jj) 
     685                  v_ice(ji,jj) = ( (          rswitch   * ( zmV_t(ji,jj) * v_ice(ji,jj)                                       & ! previous velocity 
     686                     &                                    + zRHS + zTauO * v_ice(ji,jj)                                       & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     687                     &                                    ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                      & ! m/dt + tau_io(only ice part) + landfast 
     688                     &            + ( 1._wp - rswitch ) *   v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lf_relax )         & ! static friction => slow decrease to v=0 
     689                     &             ) * 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 
     690                     &           )   * zmsk00y(ji,jj) 
    632691               ENDIF 
    633692            END_2D 
    634             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. ) 
     693            CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    635694            ! 
    636695#if defined key_agrif 
    … …  
    642701         ENDIF 
    643702 
    644 !!$         IF(sn_cfctl%l_prtctl) THEN   ! Convergence test 
    645 !!$            DO jj = 2 , jpjm1 
    646 !!$               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    647 !!$            END DO 
    648 !!$            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    649 !!$            CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    650 !!$         ENDIF 
     703         ! convergence test 
     704         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
    651705         ! 
    652706         !                                                ! ==================== ! 
    653707      END DO                                              !  end loop over jter  ! 
    654708      !                                                   ! ==================== ! 
     709      IF( ln_aEVP )   CALL iom_put( 'beta_evp' , zbeta ) 
    655710      ! 
    656711      !------------------------------------------------------------------------------! 
    657712      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)  
    658713      !------------------------------------------------------------------------------! 
    659       DO_2D_10_10 
     714      DO_2D( 1, 0, 1, 0 ) 
    660715 
    661716         ! shear at F points 
    … …  
    666721      END_2D 
    667722       
    668       DO_2D_00_00 
     723      DO_2D( 0, 0, 0, 0 )   ! no vector loop 
    669724          
    670725         ! tension**2 at T points 
    … …  
    673728            &   ) * r1_e1e2t(ji,jj) 
    674729         zdt2 = zdt * zdt 
     730 
     731         zten_i(ji,jj) = zdt 
    675732          
    676733         ! shear**2 at T points (doc eq. A16) 
    … …  
    688745          
    689746         ! delta at T points 
    690          zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
    691          rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
    692          pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
     747         zfac            = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 ) ! delta   
     748         rswitch         = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zfac ) ) ! 0 if delta=0 
     749         pdelta_i(ji,jj) = zfac + rn_creepl * rswitch ! delta+creepl 
    693750 
    694751      END_2D 
    695       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
     752      CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1._wp, pdivu_i, 'T', 1._wp, pdelta_i, 'T', 1._wp, zten_i, 'T', 1._wp, & 
     753         &                                  zs1     , 'T', 1._wp, zs2    , 'T', 1._wp, zs12    , 'F', 1._wp ) 
    696754       
    697755      ! --- Store the stress tensor for the next time step --- ! 
    698       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 
    699756      pstress1_i (:,:) = zs1 (:,:) 
    700757      pstress2_i (:,:) = zs2 (:,:) 
    … …  
    705762      ! 5) diagnostics 
    706763      !------------------------------------------------------------------------------! 
    707       DO_2D_11_11 
    708          zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    709       END_2D 
    710  
    711764      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 
    712765      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 
    713766         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    714767         ! 
    715          CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., & 
    716             &                                  ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
     768         CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
     769            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    717770         ! 
    718771         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
    … …  
    729782      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
    730783 
    731       ! --- stress tensor --- ! 
    732       IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN 
    733          ! 
    734          ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 
     784      ! --- Stress tensor invariants (SIMIP diags) --- ! 
     785      IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN 
     786         ! 
     787         ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    735788         !          
    736          DO_2D_00_00 
    737             zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
    738                &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
    739                &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 
    740  
    741             zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress   
    742  
    743             zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
    744  
    745 !!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) 
    746 !!               zsig2(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) - zshear ) ! principal stress (x-direction, see Hunke & Dukowicz 2002) 
    747 !!               zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) ! quadratic relation linking compressive stress to shear stress 
    748 !!                                                                                                               ! (scheme converges if this value is ~1, see Bouillon et al 2009 (eq. 11)) 
    749             zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) )          ! compressive stress, see Bouillon et al. 2015 
    750             zsig2(ji,jj) = 0.5_wp * zdum2 * ( zshear )                     ! shear stress 
    751             zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 
    752          END_2D 
    753          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 
    754          ! 
    755          CALL iom_put( 'isig1' , zsig1 ) 
    756          CALL iom_put( 'isig2' , zsig2 ) 
    757          CALL iom_put( 'isig3' , zsig3 ) 
    758          ! 
    759          ! Stress tensor invariants (normal and shear stress N/m) 
    760          IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,       ( zs1(:,:) + zs2(:,:) )                       * zmsk00(:,:) ) ! Normal stress 
    761          IF( iom_use('sheastr') )   CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress 
    762  
    763          DEALLOCATE( zsig1 , zsig2 , zsig3 ) 
    764       ENDIF 
    765        
     789         DO_2D( 1, 1, 1, 1 ) 
     790             
     791            ! Ice stresses 
     792            ! sigma1, sigma2, sigma12 are some useful recombination of the stresses (Hunke and Dukowicz MWR 2002, Bouillon et al., OM2013) 
     793            ! These are NOT stress tensor components, neither stress invariants, neither stress principal components 
     794            ! I know, this can be confusing... 
     795            zfac             =   strength(ji,jj) / ( pdelta_i(ji,jj) + rn_creepl )  
     796            zsig1            =   zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) ) 
     797            zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj) 
     798            zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj) 
     799             
     800            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008) 
     801            zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure 
     802            zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress 
     803                
     804         END_2D          
     805         ! 
     806         ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 
     807         IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 
     808         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 
     809          
     810         DEALLOCATE ( zsig_I, zsig_II ) 
     811          
     812      ENDIF 
     813 
     814      ! --- Normalized stress tensor principal components --- ! 
     815      ! This are used to plot the normalized yield curve, see Lemieux & Dupont, 2020 
     816      ! Recommendation 1 : we use ice strength, not replacement pressure 
     817      ! Recommendation 2 : need to use deformations at PREVIOUS iterate for viscosities 
     818      IF( iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN 
     819         ! 
     820         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) )          
     821         !          
     822         DO_2D( 1, 1, 1, 1 ) 
     823             
     824            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates  
     825            !                        and **deformations** at current iterates 
     826            !                        following Lemieux & Dupont (2020) 
     827            zfac             =   zp_delt(ji,jj) 
     828            zsig1            =   zfac * ( pdivu_i(ji,jj) - ( zdelta(ji,jj) + rn_creepl ) ) 
     829            zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj) 
     830            zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj) 
     831             
     832            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point 
     833            zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                            ! 1st stress invariant, aka average normal stress, aka negative pressure 
     834            zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )   ! 2nd  ''       '', aka maximum shear stress 
     835             
     836            ! Normalized  principal stresses (used to display the ellipse) 
     837            z1_strength      =   1._wp / MAX( 1._wp, strength(ji,jj) ) 
     838            zsig1_p(ji,jj)   =   ( zsig_I(ji,jj) + zsig_II(ji,jj) ) * z1_strength 
     839            zsig2_p(ji,jj)   =   ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength 
     840         END_2D               
     841         ! 
     842         CALL iom_put( 'sig1_pnorm' , zsig1_p )  
     843         CALL iom_put( 'sig2_pnorm' , zsig2_p )  
     844 
     845         DEALLOCATE( zsig1_p , zsig2_p , zsig_I, zsig_II ) 
     846          
     847      ENDIF 
     848 
    766849      ! --- SIMIP --- ! 
    767850      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 
    768851         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    769852         ! 
    770          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., & 
    771             &                                  zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. ) 
     853         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     854            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 
    772855 
    773856         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
    … …  
    785868            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 
    786869         ! 
    787          DO_2D_00_00 
     870         DO_2D( 0, 0, 0, 0 ) 
    788871            ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    789872            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
    … …  
    801884         END_2D 
    802885 
    803          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
    804             &                                  zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
    805             &                                  zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. ) 
     886         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     887            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
     888            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 
    806889 
    807890         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s) 
    … …  
    817900      ENDIF 
    818901      ! 
     902      ! --- convergence tests --- ! 
     903      IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2 ) THEN 
     904         IF( iom_use('uice_cvg') ) THEN 
     905            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
     906               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 
     907                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     908            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
     909               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
     910                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     911            ENDIF 
     912         ENDIF 
     913      ENDIF       
     914      ! 
     915      DEALLOCATE( zmsk00, zmsk15 ) 
     916      ! 
    819917   END SUBROUTINE ice_dyn_rhg_evp 
     918 
     919 
     920   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     921      !!---------------------------------------------------------------------- 
     922      !!                    ***  ROUTINE rhg_cvg  *** 
     923      !!                      
     924      !! ** Purpose :   check convergence of oce rheology 
     925      !! 
     926      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity 
     927      !!                during the sub timestepping of rheology so as: 
     928      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 
     929      !!                This routine is called every sub-iteration, so it is cpu expensive 
     930      !! 
     931      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)    
     932      !!---------------------------------------------------------------------- 
     933      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
     934      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     935      !! 
     936      INTEGER           ::   it, idtime, istatus 
     937      INTEGER           ::   ji, jj          ! dummy loop indices 
     938      REAL(wp)          ::   zresm           ! local real  
     939      CHARACTER(len=20) ::   clname 
     940      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
     941      !!---------------------------------------------------------------------- 
     942 
     943      ! create file 
     944      IF( kt == nit000 .AND. kiter == 1 ) THEN 
     945         ! 
     946         IF( lwp ) THEN 
     947            WRITE(numout,*) 
     948            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 
     949            WRITE(numout,*) '~~~~~~~' 
     950         ENDIF 
     951         ! 
     952         IF( lwm ) THEN 
     953            clname = 'ice_cvg.nc' 
     954            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     955            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 
     956            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime ) 
     957            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid ) 
     958            istatus = NF90_ENDDEF(ncvgid) 
     959         ENDIF 
     960         ! 
     961      ENDIF 
     962 
     963      ! time 
     964      it = ( kt - 1 ) * kitermax + kiter 
     965       
     966      ! convergence 
     967      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 
     968         zresm = 0._wp 
     969      ELSE 
     970         DO_2D( 1, 1, 1, 1 ) 
     971            zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     972               &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
     973         END_2D 
     974         zresm = MAXVAL( zres ) 
     975         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
     976      ENDIF 
     977 
     978      IF( lwm ) THEN 
     979         ! write variables 
     980         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 
     981         ! close file 
     982         IF( kt == nitend - nn_fsbc + 1 )   istatus = NF90_CLOSE(ncvgid) 
     983      ENDIF 
     984       
     985   END SUBROUTINE rhg_cvg 
    820986 
    821987 
    … …  
    8451011            ! 
    8461012            IF( MIN( id1, id2, id3 ) > 0 ) THEN      ! fields exist 
    847                CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i, ldxios = lrixios ) 
    848                CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i, ldxios = lrixios ) 
    849                CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i, ldxios = lrixios ) 
     1013               CALL iom_get( numrir, jpdom_auto, 'stress1_i' , stress1_i , cd_type = 'T', ldxios = lrixios ) 
     1014               CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T', ldxios = lrixios ) 
     1015               CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F', ldxios = lrixios ) 
    8501016            ELSE                                     ! start rheology from rest 
    8511017               IF(lwp) WRITE(numout,*) 
    … …  
    8791045   END SUBROUTINE rhg_evp_rst 
    8801046 
     1047    
    8811048#else 
    8821049   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/iceistate.F90

    r12736 r13727  
    3333   USE fldread        ! read input fields 
    3434 
     35# if defined key_agrif 
     36   USE agrif_oce 
     37   USE agrif_ice 
     38   USE agrif_ice_interp  
     39# endif    
     40 
    3541   IMPLICIT NONE 
    3642   PRIVATE 
    … …  
    4147   !                             !! ** namelist (namini) ** 
    4248   LOGICAL, PUBLIC  ::   ln_iceini        !: Ice initialization or not 
    43    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 
    4453   REAL(wp) ::   rn_thres_sst 
    4554   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 
    4655   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 
    47    REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n 
    48    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 
    4958   ! 
    50    !                              ! if ln_iceini_file = T 
    51    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 
    5261   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness    (m) 
    5362   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snw thickness    (m) 
    … …  
    5968   INTEGER , PARAMETER ::   jp_apd = 8           ! index of pnd fraction     (-) 
    6069   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
     70   INTEGER , PARAMETER ::   jp_hld = 10          ! index of pnd lid depth    (m) 
    6171   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    62    !    
     72 
    6373   !! * Substitutions 
    6474#  include "do_loop_substitute.h90" 
    … …  
    8393      !! ** Steps   :   1) Set initial surface and basal temperatures 
    8494      !!                2) Recompute or read sea ice state variables 
    85       !!                3) Fill in the ice thickness distribution using gaussian 
    86       !!                4) Fill in space-dependent arrays for state variables 
    87       !!                5) snow-ice mass computation 
    88       !!                6) store before fields 
     95      !!                3) Fill in space-dependent arrays for state variables 
     96      !!                4) snow-ice mass computation 
    8997      !! 
    9098      !! ** Notes   : o_i, t_su, t_s, t_i, sz_i must be filled everywhere, even 
    … …  
    101109      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, ztm_s_ini            !data from namelist or nc file 
    102110      REAL(wp), DIMENSION(jpi,jpj)     ::   zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    103       REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini                       !data from namelist or nc file 
     111      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini, zhlid_ini            !data from namelist or nc file 
    104112      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
    105113      !! 
    106       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
     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 
    107115      !-------------------------------------------------------------------- 
    108116 
    … …  
    158166      a_ip     (:,:,:) = 0._wp 
    159167      v_ip     (:,:,:) = 0._wp 
    160       a_ip_frac(:,:,:) = 0._wp 
     168      v_il     (:,:,:) = 0._wp 
     169      a_ip_eff (:,:,:) = 0._wp 
    161170      h_ip     (:,:,:) = 0._wp 
     171      h_il     (:,:,:) = 0._wp 
    162172      ! 
    163173      ! ice velocities 
    … …  
    169179      !------------------------------------------------------------------------ 
    170180      IF( ln_iceini ) THEN 
    171          !                             !---------------! 
    172          IF( ln_iceini_file )THEN      ! Read a file   ! 
    173             !                          !---------------! 
    174             WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
    175             ELSEWHERE                     ;   zswitch(:,:) = 0._wp 
    176             END WHERE 
     181         ! 
     182         IF( Agrif_Root() ) THEN 
     183            !                             !---------------! 
     184            IF( nn_iceini_file == 1 )THEN ! Read a file   ! 
     185               !                          !---------------! 
     186               WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
     187               ELSEWHERE                     ;   zswitch(:,:) = 0._wp 
     188               END WHERE 
     189               ! 
     190               CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 
     191               ! 
     192               ! -- mandatory fields -- ! 
     193               zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
     194               zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
     195               zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
     196 
     197               ! -- optional fields -- ! 
     198               !    if fields do not exist then set them to the values present in the namelist (except for temperatures) 
     199               ! 
     200               ! ice salinity 
     201               IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 
     202                  &     si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     203               ! 
     204               ! temperatures 
     205               IF    ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 
     206                  &    TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 
     207                  si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     208                  si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     209                  si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     210               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) 
     223               ! 
     224               ! pond concentration 
     225               IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
     226                  &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
     227                  &                              * si(jp_ati)%fnow(:,:,1)  
     228               ! 
     229               ! pond depth 
     230               IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
     231                  &     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) 
     236               ! 
     237               zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
     238               ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
     239               zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
     240               ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
     241               zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
     242               zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
     243               zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) * tmask(:,:,1) 
     244               ! 
     245               ! change the switch for the following 
     246               WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)  
     247               ELSEWHERE                         ;   zswitch(:,:) = 0._wp 
     248               END WHERE 
     249 
     250               !                          !---------------! 
     251            ELSE                          ! Read namelist ! 
     252               !                          !---------------! 
     253               ! no ice if (sst - Tfreez) >= thresold 
     254               WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp  
     255               ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1) 
     256               END WHERE 
     257               ! 
     258               ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     259               WHERE( ff_t(:,:) >= 0._wp ) 
     260                  zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 
     261                  zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 
     262                  zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 
     263                  zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 
     264                  ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 
     265                  zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
     266                  ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
     267                  zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
     268                  zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     269                  zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 
     270               ELSEWHERE 
     271                  zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
     272                  zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 
     273                  zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 
     274                  zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 
     275                  ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 
     276                  zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 
     277                  ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 
     278                  zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
     279                  zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
     280                  zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:) 
     281               END WHERE 
     282               ! 
     283            ENDIF 
     284 
     285 
     286 
     287            ! make sure ponds = 0 if no ponds scheme 
     288            IF ( .NOT.ln_pnd ) THEN 
     289               zapnd_ini(:,:) = 0._wp 
     290               zhpnd_ini(:,:) = 0._wp 
     291               zhlid_ini(:,:) = 0._wp 
     292            ENDIF 
     293             
     294            IF ( .NOT.ln_pnd_lids ) THEN 
     295               zhlid_ini(:,:) = 0._wp 
     296            ENDIF 
     297             
     298            !----------------! 
     299            ! 3) fill fields ! 
     300            !----------------! 
     301            ! select ice covered grid points 
     302            npti = 0 ; nptidx(:) = 0 
     303            DO_2D( 1, 1, 1, 1 ) 
     304               IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
     305                  npti         = npti  + 1 
     306                  nptidx(npti) = (jj - 1) * jpi + ji 
     307               ENDIF 
     308            END_2D 
     309 
     310            ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
     311            CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti)  , zht_i_ini ) 
     312            CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti)  , zht_s_ini ) 
     313            CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)  , zat_i_ini ) 
     314            CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 
     315            CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 
     316            CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti)  , zt_su_ini ) 
     317            CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti)  , zsm_i_ini ) 
     318            CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
     319            CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
     320            CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini ) 
     321             
     322            ! allocate temporary arrays 
     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 
     327            ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
     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 ) 
     334 
     335            ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
     336            DO jl = 1, jpl 
     337               zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 
     338               zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 
     339            END DO 
     340            CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d   , h_i    ) 
     341            CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d   , h_s    ) 
     342            CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d   , a_i    ) 
     343            CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d   , zti_3d ) 
     344            CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d   , zts_3d ) 
     345            CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d  , t_su   ) 
     346            CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d   , s_i    ) 
     347            CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
     348            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   ) 
     350 
     351            ! deallocate temporary arrays 
     352            DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
     353               &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) 
     354 
     355            ! calculate extensive and intensive variables 
     356            CALL ice_var_salprof ! for sz_i 
     357            DO jl = 1, jpl 
     358               DO_2D( 1, 1, 1, 1 ) 
     359                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
     360                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
     361                  sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
     362               END_2D 
     363            END DO 
    177364            ! 
    178             CALL fld_read( kt, 1, si ) ! input fields provided at the current time-step 
     365            DO jl = 1, jpl 
     366               DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     367                  t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
     368                  e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
     369                     &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
     370               END_3D 
     371            END DO 
    179372            ! 
    180             ! -- mandatory fields -- ! 
    181             zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 
    182             zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 
    183             zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 
    184  
    185             ! -- optional fields -- ! 
    186             !    if fields do not exist then set them to the values present in the namelist (except for snow and surface temperature) 
    187             ! 
    188             ! ice salinity 
    189             IF( TRIM(si(jp_smi)%clrootname) == 'NOT USED' ) & 
    190                &     si(jp_smi)%fnow(:,:,1) = ( rn_smi_ini_n * zswitch + rn_smi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    191             ! 
    192             ! temperatures 
    193             IF    ( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. & 
    194                &    TRIM(si(jp_tms)%clrootname) == 'NOT USED' ) THEN 
    195                si(jp_tmi)%fnow(:,:,1) = ( rn_tmi_ini_n * zswitch + rn_tmi_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    196                si(jp_tsu)%fnow(:,:,1) = ( rn_tsu_ini_n * zswitch + rn_tsu_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    197                si(jp_tms)%fnow(:,:,1) = ( rn_tms_ini_n * zswitch + rn_tms_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    198             ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 
    199                si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tms)%fnow(:,:,1) + 271.15 ) 
    200             ELSEIF( TRIM(si(jp_tmi)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
    201                si(jp_tmi)%fnow(:,:,1) = 0.5_wp * ( si(jp_tsu)%fnow(:,:,1) + 271.15 ) 
    202             ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tms)%clrootname) /= 'NOT USED' ) THEN ! if T_s is read and not T_su, set T_su = T_s 
    203                si(jp_tsu)%fnow(:,:,1) = si(jp_tms)%fnow(:,:,1) 
    204             ELSEIF( TRIM(si(jp_tsu)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_su, set T_su = T_i 
    205                si(jp_tsu)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    206             ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tsu)%clrootname) /= 'NOT USED' ) THEN ! if T_su is read and not T_s, set T_s = T_su 
    207                si(jp_tms)%fnow(:,:,1) = si(jp_tsu)%fnow(:,:,1) 
    208             ELSEIF( TRIM(si(jp_tms)%clrootname) == 'NOT USED' .AND. TRIM(si(jp_tmi)%clrootname) /= 'NOT USED' ) THEN ! if T_i is read and not T_s, set T_s = T_i 
    209                si(jp_tms)%fnow(:,:,1) = si(jp_tmi)%fnow(:,:,1) 
    210             ENDIF 
    211             ! 
    212             ! pond concentration 
    213             IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
    214                &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
    215                &                              * si(jp_ati)%fnow(:,:,1)  
    216             ! 
    217             ! pond depth 
    218             IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
    219                &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    220             ! 
    221             zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 
    222             ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 
    223             zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 
    224             ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 
    225             zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 
    226             zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 
    227             ! 
    228             ! change the switch for the following 
    229             WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)  
    230             ELSEWHERE                         ;   zswitch(:,:) = 0._wp 
    231             END WHERE 
    232             !                          !---------------! 
    233          ELSE                          ! Read namelist ! 
    234             !                          !---------------! 
    235             ! no ice if (sst - Tfreez) >= thresold 
    236             WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp  
    237             ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1) 
    238             END WHERE 
    239             ! 
    240             ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
    241             WHERE( ff_t(:,:) >= 0._wp ) 
    242                zht_i_ini(:,:) = rn_hti_ini_n * zswitch(:,:) 
    243                zht_s_ini(:,:) = rn_hts_ini_n * zswitch(:,:) 
    244                zat_i_ini(:,:) = rn_ati_ini_n * zswitch(:,:) 
    245                zsm_i_ini(:,:) = rn_smi_ini_n * zswitch(:,:) 
    246                ztm_i_ini(:,:) = rn_tmi_ini_n * zswitch(:,:) 
    247                zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
    248                ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
    249                zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    250                zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
    251             ELSEWHERE 
    252                zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
    253                zht_s_ini(:,:) = rn_hts_ini_s * zswitch(:,:) 
    254                zat_i_ini(:,:) = rn_ati_ini_s * zswitch(:,:) 
    255                zsm_i_ini(:,:) = rn_smi_ini_s * zswitch(:,:) 
    256                ztm_i_ini(:,:) = rn_tmi_ini_s * zswitch(:,:) 
    257                zt_su_ini(:,:) = rn_tsu_ini_s * zswitch(:,:) 
    258                ztm_s_ini(:,:) = rn_tms_ini_s * zswitch(:,:) 
    259                zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    260                zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
    261             END WHERE 
    262             ! 
    263          ENDIF 
    264  
    265          ! make sure ponds = 0 if no ponds scheme 
    266          IF ( .NOT.ln_pnd ) THEN 
    267             zapnd_ini(:,:) = 0._wp 
    268             zhpnd_ini(:,:) = 0._wp 
    269          ENDIF 
    270           
    271          !-------------! 
    272          ! fill fields ! 
    273          !-------------! 
    274          ! select ice covered grid points 
    275          npti = 0 ; nptidx(:) = 0 
    276          DO_2D_11_11 
    277             IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
    278                npti         = npti  + 1 
    279                nptidx(npti) = (jj - 1) * jpi + ji 
    280             ENDIF 
    281          END_2D 
    282  
    283          ! move to 1D arrays: (jpi,jpj) -> (jpi*jpj) 
    284          CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d (1:npti)  , zht_i_ini ) 
    285          CALL tab_2d_1d( npti, nptidx(1:npti), h_s_1d (1:npti)  , zht_s_ini ) 
    286          CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d(1:npti)  , zat_i_ini ) 
    287          CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,1), ztm_i_ini ) 
    288          CALL tab_2d_1d( npti, nptidx(1:npti), t_s_1d (1:npti,1), ztm_s_ini ) 
    289          CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d(1:npti)  , zt_su_ini ) 
    290          CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d (1:npti)  , zsm_i_ini ) 
    291          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
    292          CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
    293  
    294          ! allocate temporary arrays 
    295          ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
    296             &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
    297           
    298          ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
    299          CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
    300             &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
    301             &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti), s_i_1d(1:npti), a_ip_1d(1:npti), h_ip_1d(1:npti), & 
    302             &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
    303  
    304          ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
    305          DO jl = 1, jpl 
    306             zti_3d(:,:,jl) = rt0 * tmask(:,:,1) 
    307             zts_3d(:,:,jl) = rt0 * tmask(:,:,1) 
    308          END DO 
    309          CALL tab_2d_3d( npti, nptidx(1:npti), zhi_2d   , h_i    ) 
    310          CALL tab_2d_3d( npti, nptidx(1:npti), zhs_2d   , h_s    ) 
    311          CALL tab_2d_3d( npti, nptidx(1:npti), zai_2d   , a_i    ) 
    312          CALL tab_2d_3d( npti, nptidx(1:npti), zti_2d   , zti_3d ) 
    313          CALL tab_2d_3d( npti, nptidx(1:npti), zts_2d   , zts_3d ) 
    314          CALL tab_2d_3d( npti, nptidx(1:npti), ztsu_2d  , t_su   ) 
    315          CALL tab_2d_3d( npti, nptidx(1:npti), zsi_2d   , s_i    ) 
    316          CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
    317          CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
    318  
    319          ! deallocate temporary arrays 
    320          DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    321             &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
    322  
    323          ! calculate extensive and intensive variables 
    324          CALL ice_var_salprof ! for sz_i 
    325          DO jl = 1, jpl 
    326             DO_2D_11_11 
    327                v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
    328                v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
    329                sv_i(ji,jj,jl) = MIN( MAX( rn_simin , s_i(ji,jj,jl) ) , rn_simax ) * v_i(ji,jj,jl) 
    330             END_2D 
    331          END DO 
    332          ! 
    333          DO jl = 1, jpl 
    334             DO_3D_11_11( 1, nlay_s ) 
    335                t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
    336                e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
    337                   &               rhos * ( rcpi * ( rt0 - t_s(ji,jj,jk,jl) ) + rLfus ) 
    338             END_3D 
    339          END DO 
    340          ! 
    341          DO jl = 1, jpl 
    342             DO_3D_11_11( 1, nlay_i ) 
    343                t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
    344                ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
    345                e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
    346                   &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
    347                   &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
    348                   &                       - rcp   * ( ztmelts - rt0 ) ) 
    349             END_3D 
    350          END DO 
    351  
     373            DO jl = 1, jpl 
     374               DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     375                  t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
     376                  ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
     377                  e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
     378                     &               rhoi * (  rcpi  * ( ztmelts - t_i(ji,jj,jk,jl) ) + & 
     379                     &                         rLfus * ( 1._wp - (ztmelts-rt0) / MIN( (t_i(ji,jj,jk,jl)-rt0), -epsi20 ) ) & 
     380                     &                       - rcp   * ( ztmelts - rt0 ) ) 
     381               END_3D 
     382            END DO 
     383             
     384#if  defined key_agrif 
     385         ELSE 
     386  
     387            Agrif_SpecialValue    = -9999. 
     388            Agrif_UseSpecialValue = .TRUE. 
     389            CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 
     390            use_sign_north = .TRUE. 
     391            sign_north = -1. 
     392            CALL Agrif_init_variable(u_iceini_id  ,procname=interp_u_ice) 
     393            CALL Agrif_init_variable(v_iceini_id  ,procname=interp_v_ice) 
     394            Agrif_SpecialValue    = 0._wp 
     395            use_sign_north = .FALSE. 
     396            Agrif_UseSpecialValue = .FALSE. 
     397        ! lbc ????  
     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 
     399            CALL ice_var_glo2eqv 
     400            CALL ice_var_zapsmall 
     401            CALL ice_var_agg(2) 
     402#endif 
     403         ENDIF ! Agrif_Root 
     404         ! 
    352405         ! Melt ponds 
    353          WHERE( a_i > epsi10 ) 
    354             a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
    355          ELSEWHERE 
    356             a_ip_frac(:,:,:) = 0._wp 
     406         WHERE( a_i > epsi10 )   ;   a_ip_eff(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     407         ELSEWHERE               ;   a_ip_eff(:,:,:) = 0._wp 
    357408         END WHERE 
    358409         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
    359            
     410         v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
     411          
    360412         ! specific temperatures for coupled runs 
    361413         tn_ice(:,:,:) = t_su(:,:,:) 
    362414         t1_ice(:,:,:) = t_i (:,:,1,:) 
    363415         ! 
     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         ! 
    364423      ENDIF ! ln_iceini 
    365424      ! 
    366       at_i(:,:) = SUM( a_i, dim=3 ) 
    367       ! 
    368425      !---------------------------------------------- 
    369       ! 3) Snow-ice mass (case ice is fully embedded) 
     426      ! 4) Snow-ice mass (case ice is fully embedded) 
    370427      !---------------------------------------------- 
    371428      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
    … …  
    377434         ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 
    378435         ! 
    379          IF( .NOT.ln_linssh ) THEN 
    380             ! 
    381             WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 
    382             ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE 
    383             ! 
    384             DO jk = 1,jpkm1                     ! adjust initial vertical scale factors                 
    385                e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 
    386                e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
    387                e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 
    388             END DO 
    389             ! 
    390             ! Reconstruction of all vertical scale factors at now and before time-steps 
    391             ! ========================================================================= 
    392             ! Horizontal scale factor interpolations 
    393             ! -------------------------------------- 
    394             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
    395             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
    396             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
    397             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
    398             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
    399             ! Vertical scale factor interpolations 
    400             ! ------------------------------------ 
    401             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
    402             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
    403             CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
    404             CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    405             CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
    406             ! t- and w- points depth 
    407             ! ---------------------- 
    408             !!gm not sure of that.... 
    409             gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
    410             gdepw(:,:,1,Kmm) = 0.0_wp 
    411             gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    412             DO jk = 2, jpk 
    413                gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk  ,Kmm) 
    414                gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 
    415                gde3w(:,:,jk) = gdept(:,:,jk  ,Kmm) - ssh (:,:,Kmm) 
    416             END DO 
    417          ENDIF 
     436         IF( .NOT.ln_linssh )   CALL dom_vvl_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
     437! !!st 
     438!          IF( .NOT.ln_linssh ) THEN 
     439!             ! 
     440!             WHERE( ht_0(:,:) > 0 )   ;   z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 
     441!             ELSEWHERE                ;   z2d(:,:) = 1._wp   ;   END WHERE 
     442!             ! 
     443!             DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
     444!                e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 
     445!                e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
     446!                e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 
     447!             END DO 
     448!             ! 
     449!             ! Reconstruction of all vertical scale factors at now and before time-steps 
     450!             ! ========================================================================= 
     451!             ! Horizontal scale factor interpolations 
     452!             ! -------------------------------------- 
     453!             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
     454!             CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
     455!             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 
     456!             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 
     457!             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 
     458!             ! Vertical scale factor interpolations 
     459!             ! ------------------------------------ 
     460!             CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W'  ) 
     461!             CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
     462!             CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
     463!             CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
     464!             CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
     465!             ! t- and w- points depth 
     466!             ! ---------------------- 
     467!             !!gm not sure of that.... 
     468!             gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
     469!             gdepw(:,:,1,Kmm) = 0.0_wp 
     470!             gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
     471!             DO jk = 2, jpk 
     472!                gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk  ,Kmm) 
     473!                gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 
     474!                gde3w(:,:,jk) = gdept(:,:,jk  ,Kmm) - ssh (:,:,Kmm) 
     475!             END DO 
     476!          ENDIF 
    418477      ENDIF 
    419        
    420       !------------------------------------ 
    421       ! 4) store fields at before time-step 
    422       !------------------------------------ 
    423       ! it is only necessary for the 1st interpolation by Agrif 
    424       a_i_b  (:,:,:)   = a_i  (:,:,:) 
    425       e_i_b  (:,:,:,:) = e_i  (:,:,:,:) 
    426       v_i_b  (:,:,:)   = v_i  (:,:,:) 
    427       v_s_b  (:,:,:)   = v_s  (:,:,:) 
    428       e_s_b  (:,:,:,:) = e_s  (:,:,:,:) 
    429       sv_i_b (:,:,:)   = sv_i (:,:,:) 
    430       oa_i_b (:,:,:)   = oa_i (:,:,:) 
    431       u_ice_b(:,:)     = u_ice(:,:) 
    432       v_ice_b(:,:)     = v_ice(:,:) 
    433       ! total concentration is needed for Lupkes parameterizations 
    434       at_i_b (:,:)     = at_i (:,:)  
    435  
    436 !!clem: output of initial state should be written here but it is impossible because 
    437 !!      the ocean and ice are in the same file 
    438 !!      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' ) 
    439482      ! 
    440483   END SUBROUTINE ice_istate 
    … …  
    457500      ! 
    458501      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
    459       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 
    460503      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    461504      ! 
    462       NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 
     505      NAMELIST/namini/ ln_iceini, nn_iceini_file, rn_thres_sst, & 
    463506         &             rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 
    464507         &             rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 
    465508         &             rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 
    466          &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 
    467          &             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 
    468511      !!----------------------------------------------------------------------------- 
    469512      ! 
    … …  
    477520      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_smi) = sn_smi 
    478521      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_tsu) = sn_tsu   ;   slf_i(jp_tms) = sn_tms 
    479       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 
    480523      ! 
    481524      IF(lwp) THEN                          ! control print 
    … …  
    485528         WRITE(numout,*) '   Namelist namini:' 
    486529         WRITE(numout,*) '      ice initialization (T) or not (F)                ln_iceini      = ', ln_iceini 
    487          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 
    488531         WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst 
    489          IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 
     532         IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 
    490533            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s  
    491534            WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s 
    … …  
    497540            WRITE(numout,*) '      initial pnd fraction  in the north-south         rn_apd_ini     = ', rn_apd_ini_n,rn_apd_ini_s 
    498541            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 
    499543         ENDIF 
    500544      ENDIF 
    501545      ! 
    502       IF( ln_iceini_file ) THEN                      ! Ice initialization using input file 
     546      IF( nn_iceini_file == 1 ) THEN                      ! Ice initialization using input file 
    503547         ! 
    504548         ! set si structure 
    … …  
    521565         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
    522566         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
    523          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. 
    524573      ENDIF 
    525574      ! 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/iceitd.F90

    r12377 r13727  
    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 
    … …  
    9899      ! 
    99100      npti = 0   ;   nptidx(:) = 0 
    100       DO_2D_11_11 
     101      DO_2D( 1, 1, 1, 1 ) 
    101102         IF ( at_i(ji,jj) > epsi10 ) THEN 
    102103            npti = npti + 1 
    … …  
    148149               !    Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible  
    149150               !          in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     151# if defined key_single 
     152               IF( a_i_2d(ji,jl  ) > epsi10 .AND. h_i_2d(ji,jl  ) > ( zhbnew(ji,jl) - epsi06 ) )   nptidx(ji) = 0 
     153               IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi06 ) )   nptidx(ji) = 0 
     154# else 
    150155               IF( a_i_2d(ji,jl  ) > epsi10 .AND. h_i_2d(ji,jl  ) > ( zhbnew(ji,jl) - epsi10 ) )   nptidx(ji) = 0 
    151156               IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) )   nptidx(ji) = 0 
     157# endif 
    152158               ! 
    153159               ! 2) Hn-1 < Hn* < Hn+1   
    … …  
    170176            !    h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible  
    171177            !    in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
     178# if defined key_single 
     179            IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi06 ) )   nptidx(ji) = 0 
     180            IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi06 ) )   nptidx(ji) = 0 
     181# else 
    172182            IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) )   nptidx(ji) = 0 
    173183            IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) )   nptidx(ji) = 0 
     184# endif 
    174185         END DO 
    175186         ! 
    … …  
    304315            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 
    305316               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin  
    306                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 
    307318               h_i_1d(ji) = rn_himin 
    308319            ENDIF 
    … …  
    410421      CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    411422      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 ) 
    412424      CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    413425      DO jl = 1, jpl 
    … …  
    474486               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans 
    475487               !   
    476                IF ( ln_pnd_H12 ) THEN 
     488               IF ( ln_pnd_LEV ) THEN 
    477489                  ztrans          = a_ip_2d(ji,jl1) * zworka(ji)     ! Pond fraction 
    478490                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 
    … …  
    482494                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    483495                  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 
    484502               ENDIF 
    485503               ! 
    … …  
    526544      ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 
    527545      !       because of truncation error ( i.e. 1. - 1. /= 0 ) 
    528       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 ) 
    529547 
    530548      ! at_i must be <= rn_amax 
    … …  
    538556      ! 4) Update ice thickness and temperature 
    539557      !------------------------------------------------------------------------------- 
     558# if defined key_single 
     559      WHERE( a_i_2d(1:npti,:) >= epsi06 ) 
     560# else 
    540561      WHERE( a_i_2d(1:npti,:) >= epsi20 ) 
     562# endif 
    541563         h_i_2d (1:npti,:)  =  v_i_2d(1:npti,:) / a_i_2d(1:npti,:)  
    542564         t_su_2d(1:npti,:)  =  zaTsfn(1:npti,:) / a_i_2d(1:npti,:)  
    … …  
    554576      CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    555577      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 ) 
    556579      CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    557580      DO jl = 1, jpl 
    … …  
    597620         !                    !--------------------------------------- 
    598621         npti = 0   ;   nptidx(:) = 0 
    599          DO_2D_11_11 
     622         DO_2D( 1, 1, 1, 1 ) 
    600623            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 
    601624               npti = npti + 1 
    … …  
    604627         END_2D 
    605628         ! 
    606 !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 
    607          CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) ) 
    608          CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl) ) 
    609          ! 
    610          DO ji = 1, npti 
    611             jdonor(ji,jl)  = jl  
    612             ! how much of a_i you send in cat sup is somewhat arbitrary 
    613 !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
    614 !!          zdaice(ji,jl)  = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji)   
    615 !!          zdvice(ji,jl)  = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 ) 
    616 !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
    617 !!          zdaice(ji,jl)  = a_i_1d(ji) 
    618 !!          zdvice(ji,jl)  = v_i_1d(ji) 
    619 !!clem: these are from UCL and work ok 
    620             zdaice(ji,jl)  = a_i_1d(ji) * 0.5_wp 
    621             zdvice(ji,jl)  = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 
    622          END DO 
    623          ! 
    624          IF( npti > 0 ) THEN 
     629         IF( npti > 0 ) THEN             
     630            !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 
     631            CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) ) 
     632            CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl) ) 
     633            ! 
     634            DO ji = 1, npti 
     635               jdonor(ji,jl)  = jl  
     636               ! how much of a_i you send in cat sup is somewhat arbitrary 
     637               !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
     638               !!          zdaice(ji,jl)  = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji)   
     639               !!          zdvice(ji,jl)  = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 ) 
     640               !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
     641               !!          zdaice(ji,jl)  = a_i_1d(ji) 
     642               !!          zdvice(ji,jl)  = v_i_1d(ji) 
     643               !!clem: these are from UCL and work ok 
     644               zdaice(ji,jl)  = a_i_1d(ji) * 0.5_wp 
     645               zdvice(ji,jl)  = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 
     646            END DO 
     647            ! 
    625648            CALL itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) )  ! Shift jl=>jl+1 
    626649            ! Reset shift parameters 
    … …  
    636659         !                    !----------------------------------------- 
    637660         npti = 0 ; nptidx(:) = 0 
    638          DO_2D_11_11 
     661         DO_2D( 1, 1, 1, 1 ) 
    639662            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 
    640663               npti = npti + 1 
    … …  
    643666         END_2D 
    644667         ! 
    645          CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok 
    646          CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl+1) ) ! jl+1 is ok 
    647          DO ji = 1, npti 
    648             jdonor(ji,jl) = jl + 1 
    649             zdaice(ji,jl) = a_i_1d(ji)  
    650             zdvice(ji,jl) = v_i_1d(ji) 
    651          END DO 
    652          ! 
    653668         IF( npti > 0 ) THEN 
     669            CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok 
     670            CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl+1) ) ! jl+1 is ok 
     671            DO ji = 1, npti 
     672               jdonor(ji,jl) = jl + 1 
     673               zdaice(ji,jl) = a_i_1d(ji)  
     674               zdvice(ji,jl) = v_i_1d(ji) 
     675            END DO 
     676            ! 
    654677            CALL itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) )  ! Shift jl+1=>jl 
    655678            ! Reset shift parameters 
    … …  
    679702      REAL(wp) ::   zhmax, znum, zden, zalpha   !   -      - 
    680703      ! 
    681       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 
    682705      !!------------------------------------------------------------------ 
    683706      ! 
    … …  
    696719         WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean 
    697720         WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr 
    698          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  
    699723      ENDIF 
    700724      ! 
    … …  
    733757      END DO 
    734758      ! 
    735       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) 
    736760      ! 
    737761      IF(lwp) WRITE(numout,*) 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icerst.F90

    r13033 r13727  
    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 
    … …  
    141145 
    142146      ! Prognostic variables 
    143       CALL iom_rstput( iter, nitrst, numriw, 'v_i'  , v_i,  ldxios = lwxios ) 
    144       CALL iom_rstput( iter, nitrst, numriw, 'v_s'  , v_s,  ldxios = lwxios ) 
    145       CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i, ldxios = lwxios ) 
    146       CALL iom_rstput( iter, nitrst, numriw, 'a_i'  , a_i,  ldxios = lwxios ) 
    147       CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su, ldxios = lwxios ) 
     147      CALL iom_rstput( iter, nitrst, numriw, 'v_i'  , v_i  , ldxios = lwxios ) 
     148      CALL iom_rstput( iter, nitrst, numriw, 'v_s'  , v_s  , ldxios = lwxios ) 
     149      CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i , ldxios = lwxios ) 
     150      CALL iom_rstput( iter, nitrst, numriw, 'a_i'  , a_i  , ldxios = lwxios ) 
     151      CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su , ldxios = lwxios ) 
    148152      CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice, ldxios = lwxios ) 
    149153      CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice, ldxios = lwxios ) 
    150       CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i,  ldxios = lwxios ) 
    151       CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip,  ldxios = lwxios ) 
    152       CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip,  ldxios = lwxios ) 
     154      CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i , ldxios = lwxios ) 
     155      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip , ldxios = lwxios ) 
     156      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip , ldxios = lwxios ) 
     157      CALL iom_rstput( iter, nitrst, numriw, 'v_il' , v_il , ldxios = lwxios ) 
    153158      ! Snow enthalpy 
    154159      DO jk = 1, nlay_s  
    … …  
    196201      INTEGER           ::   jk 
    197202      LOGICAL           ::   llok 
    198       INTEGER           ::   id0, id1, id2, id3, id4   ! local integer 
     203      INTEGER           ::   id0, id1, id2, id3, id4, id5   ! local integer 
    199204      CHARACTER(len=25) ::   znam 
    200205      CHARACTER(len=2)  ::   zchar, zchar1 
    … …  
    250255 
    251256         ! --- mandatory fields --- !  
    252          CALL iom_get( numrir, jpdom_autoglo, 'v_i'  , v_i,  ldxios = lrixios ) 
    253          CALL iom_get( numrir, jpdom_autoglo, 'v_s'  , v_s,  ldxios = lrixios ) 
    254          CALL iom_get( numrir, jpdom_autoglo, 'sv_i' , sv_i, ldxios = lrixios ) 
    255          CALL iom_get( numrir, jpdom_autoglo, 'a_i'  , a_i,  ldxios = lrixios ) 
    256          CALL iom_get( numrir, jpdom_autoglo, 't_su' , t_su, ldxios = lrixios ) 
    257          CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice, ldxios = lrixios ) 
    258          CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice, ldxios = lrixios ) 
     257         CALL iom_get( numrir, jpdom_auto, 'v_i'  , v_i  , ldxios = lrixios ) 
     258         CALL iom_get( numrir, jpdom_auto, 'v_s'  , v_s  , ldxios = lrixios ) 
     259         CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i , ldxios = lrixios ) 
     260         CALL iom_get( numrir, jpdom_auto, 'a_i'  , a_i  , ldxios = lrixios ) 
     261         CALL iom_get( numrir, jpdom_auto, 't_su' , t_su , ldxios = lrixios ) 
     262         CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp, ldxios = lrixios ) 
     263         CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp, ldxios = lrixios ) 
    259264         ! Snow enthalpy 
    260265         DO jk = 1, nlay_s 
    261266            WRITE(zchar1,'(I2.2)') jk 
    262267            znam = 'e_s'//'_l'//zchar1 
    263             CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios ) 
     268            CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios ) 
    264269            e_s(:,:,jk,:) = z3d(:,:,:) 
    265270         END DO 
    … …  
    268273            WRITE(zchar1,'(I2.2)') jk 
    269274            znam = 'e_i'//'_l'//zchar1 
    270             CALL iom_get( numrir, jpdom_autoglo, znam , z3d, ldxios = lrixios ) 
     275            CALL iom_get( numrir, jpdom_auto, znam , z3d, ldxios = lrixios ) 
    271276            e_i(:,:,jk,:) = z3d(:,:,:) 
    272277         END DO 
    … …  
    275280         id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 
    276281         IF( id1 > 0 ) THEN                       ! fields exist 
    277             CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i, ldxios = lrixios ) 
     282            CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i, ldxios = lrixios ) 
    278283         ELSE                                     ! start from rest 
    279284            IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero' 
    … …  
    283288         id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 
    284289         IF( id2 > 0 ) THEN                       ! fields exist 
    285             CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip, ldxios = lrixios ) 
    286             CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip, ldxios = lrixios ) 
     290            CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip, ldxios = lrixios ) 
     291            CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip, ldxios = lrixios ) 
    287292         ELSE                                     ! start from rest 
    288293            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
    … …  
    290295            v_ip(:,:,:) = 0._wp 
    291296         ENDIF 
     297         ! melt pond lids 
     298         id3 = iom_varid( numrir, 'v_il' , ldstop = .FALSE. ) 
     299         IF( id3 > 0 ) THEN 
     300            CALL iom_get( numrir, jpdom_auto, 'v_il', v_il, ldxios = lrixios) 
     301         ELSE 
     302            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds lids output then set it to zero' 
     303            v_il(:,:,:) = 0._wp 
     304         ENDIF 
    292305         ! fields needed for Met Office (Jules) coupling 
    293306         IF( ln_cpl ) THEN 
    294             id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
    295             id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
    296             IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
    297                CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice, ldxios = lrixios ) 
    298                CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice, ldxios = lrixios ) 
     307            id4 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
     308            id5 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
     309            IF( id4 > 0 .AND. id5 > 0 ) THEN         ! fields exist 
     310               CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice, ldxios = lrixios ) 
     311               CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice , ldxios = lrixios ) 
    299312            ELSE                                     ! start from rest 
    300313               IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero' 
    … …  
    309322      ELSE                 ! == case of a simplified restart == ! 
    310323         !                 ! ---------------------------------- ! 
    311          CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 
     324         CALL ctl_warn('ice_rst_read: you are attempting to use an unsuitable ice restart') 
    312325         ! 
    313          CALL ice_istate_init 
     326         IF( .NOT. ln_iceini .OR. nn_iceini_file == 2 ) THEN 
     327            CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and nn_iceini_file=0 or 1') 
     328         ELSE 
     329            CALL ctl_warn('ice_rst_read: using ice_istate to set initial conditions instead') 
     330         ENDIF 
     331         ! 
     332         IF( nn_components == jp_iam_sas ) THEN   ! SAS case: ss[st]_m were not initialized by sbc_ssm_init 
     333            ! 
     334            IF(lwp) WRITE(numout,*) '  SAS: default initialisation of ss[st]_m arrays used in ice_istate' 
     335            IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem, Kmm), ts(:,:,1,jp_sal, Kmm) ) 
     336            ELSE                   ;   sst_m(:,:) = ts(:,:,1,jp_tem, Kmm) 
     337            ENDIF 
     338            sss_m(:,:) = ts(:,:,1,jp_sal, Kmm) 
     339         ENDIF 
     340         ! 
    314341         CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
    315342         ! 
    316          IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
    317             &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
    318          ! 
    319343      ENDIF 
    320344 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icesbc.F90

    r12377 r13727  
    8282      IF( ln_mixcpl) THEN                                                        ! Case of a mixed Bulk/Coupled formulation 
    8383                                   CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    84          DO_2D_00_00 
     84         DO_2D( 0, 0, 0, 0 ) 
    8585            utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8686            vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    8787         END_2D 
    88          CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 
     88         CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 
    8989      ENDIF 
    9090      ! 
    … …  
    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_12905_xios_restart/src/ICE/icestp.F90

    r12969 r13727  
    5555   USE icedyn         ! sea-ice: dynamics 
    5656   USE icethd         ! sea-ice: thermodynamics 
    57    USE icecor         ! sea-ice: corrections 
    5857   USE iceupdate      ! sea-ice: sea surface boundary condition update 
    5958   USE icedia         ! sea-ice: budget diagnostics 
    … …  
    8685   PUBLIC   ice_init   ! called by sbcmod.F90 
    8786 
     87   !! * Substitutions 
     88#  include "do_loop_substitute.h90" 
    8889   !!---------------------------------------------------------------------- 
    8990   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    160161         IF( ln_icedyn .AND. .NOT.lk_c1d )   & 
    161162            &                           CALL ice_dyn( kt, Kmm )       ! -- Ice dynamics 
     163         ! 
     164                                        CALL diag_trends( 1 )         ! record dyn trends 
    162165         ! 
    163166         !                          !==  lateral boundary conditions  ==! 
    … …  
    188191         IF( ln_icethd )                CALL ice_thd( kt )            ! -- Ice thermodynamics       
    189192         ! 
    190                                         CALL ice_cor( kt , 2 )        ! -- Corrections 
    191          ! 
     193                                        CALL diag_trends( 2 )         ! record thermo trends 
    192194                                        CALL ice_var_glo2eqv          ! necessary calls (at least for coupling) 
    193195                                        CALL ice_var_agg( 2 )         ! necessary calls (at least for coupling) 
    … …  
    197199         IF( ln_icediahsb )             CALL ice_dia( kt )            ! -- Diagnostics outputs  
    198200         ! 
     201         IF( ln_icediachk )             CALL ice_drift_wri( kt )      ! -- Diagnostics outputs for conservation  
     202         ! 
    199203                                        CALL ice_wri( kt )            ! -- Ice outputs  
    200204         ! 
    201205         IF( lrst_ice )                 CALL ice_rst_write( kt )      ! -- Ice restart file  
    202206         ! 
    203          IF( ln_icectl )                CALL ice_ctl( kt )            ! -- alerts in case of model crash 
     207         IF( ln_icectl )                CALL ice_ctl( kt )            ! -- Control checks 
    204208         ! 
    205209      ENDIF   ! End sea-ice time step only 
    … …  
    224228      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
    225229      ! 
    226       INTEGER :: ji, jj, ierr 
     230      INTEGER ::   ierr 
    227231      !!---------------------------------------------------------------------- 
    228232      IF(lwp) WRITE(numout,*) 
    … …  
    240244      CALL par_init                ! set some ice run parameters 
    241245      ! 
     246#if defined key_agrif 
     247      CALL Agrif_Declare_Var_ice  !  "      "   "   "      "  Sea ice 
     248#endif 
     249      ! 
    242250      !                                ! Allocate the ice arrays (sbc_ice already allocated in sbc_init) 
    243251      ierr =        ice_alloc        ()      ! ice variables 
    … …  
    248256      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays') 
    249257      ! 
    250       CALL ice_itd_init                ! ice thickness distribution initialization 
    251       ! 
    252       CALL ice_thd_init                ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 
    253       ! 
    254       !                                ! Initial sea-ice state 
    255       IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
    256          CALL ice_istate_init 
    257          CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 
    258       ELSE                                    ! start from a restart file 
    259          CALL ice_rst_read( Kbb, Kmm, Kaa ) 
    260       ENDIF 
    261       CALL ice_var_glo2eqv 
    262       CALL ice_var_agg(1) 
    263       ! 
    264       CALL ice_sbc_init                ! set ice-ocean and ice-atm. coupling parameters 
    265       ! 
    266       CALL ice_dyn_init                ! set ice dynamics parameters 
    267       ! 
    268       CALL ice_update_init             ! ice surface boundary condition 
    269       ! 
    270       CALL ice_alb_init                ! ice surface albedo 
    271       ! 
    272       CALL ice_dia_init                ! initialization for diags 
    273       ! 
    274       fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction 
    275       tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu 
    276       ! 
    277258      !                                ! set max concentration in both hemispheres 
    278259      WHERE( gphit(:,:) > 0._wp )   ;   rn_amax_2d(:,:) = rn_amax_n  ! NH 
    279260      ELSEWHERE                     ;   rn_amax_2d(:,:) = rn_amax_s  ! SH 
    280261      END WHERE 
    281  
     262      ! 
     263      CALL diag_set0                   ! set diag of mass, heat and salt fluxes to 0: needed for Agrif child grids 
     264      ! 
     265      CALL ice_itd_init                ! ice thickness distribution initialization 
     266      ! 
     267      CALL ice_thd_init                ! set ice thermodynics parameters (clem: important to call it first for melt ponds) 
     268      ! 
     269      CALL ice_sbc_init                ! set ice-ocean and ice-atm. coupling parameters 
     270      ! 
     271      CALL ice_istate_init             ! Initial sea-ice state 
     272      IF ( ln_rstart .OR. nn_iceini_file == 2 ) THEN 
     273         CALL ice_rst_read( Kbb, Kmm, Kaa )         ! start from a restart file 
     274      ELSE 
     275         CALL ice_istate( nit000, Kbb, Kmm, Kaa )   ! start from rest or read a file 
     276      ENDIF 
     277      CALL ice_var_glo2eqv 
     278      CALL ice_var_agg(1) 
     279      ! 
     280      CALL ice_dyn_init                ! set ice dynamics parameters 
     281      ! 
     282      CALL ice_update_init             ! ice surface boundary condition 
     283      ! 
     284      CALL ice_alb_init                ! ice surface albedo 
     285      ! 
     286      CALL ice_dia_init                ! initialization for diags 
     287      ! 
     288      CALL ice_drift_init              ! initialization for diags of conservation 
     289      ! 
     290      fr_i  (:,:)   = at_i(:,:)        ! initialisation of sea-ice fraction 
     291      tn_ice(:,:,:) = t_su(:,:,:)      ! initialisation of surface temp for coupled simu 
     292      ! 
    282293      IF( ln_rstart )  THEN 
    283294          CALL iom_close( numrir )  ! close input ice restart file 
    … …  
    339350      ENDIF 
    340351      ! 
    341       IF( ln_bdy .AND. ln_icediachk )   CALL ctl_warn('par_init: online conservation check does not work with BDY') 
    342       ! 
    343352      rDt_ice   = REAL(nn_fsbc) * rn_Dt          !--- sea-ice timestep and its inverse 
    344353      r1_Dt_ice = 1._wp / rDt_ice 
    … …  
    365374      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume 
    366375      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content 
    367       oa_i_b(:,:,:)   = oa_i(:,:,:)     ! areal age content 
    368376      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy 
    369377      e_i_b (:,:,:,:) = e_i (:,:,:,:)   ! ice thermal energy 
    … …  
    375383         h_s_b(:,:,:) = 0._wp 
    376384      END WHERE 
    377        
    378       WHERE( a_ip(:,:,:) >= epsi20 ) 
    379          h_ip_b(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)   ! ice pond thickness 
    380       ELSEWHERE 
    381          h_ip_b(:,:,:) = 0._wp 
    382       END WHERE 
    383385      ! 
    384386      ! ice velocities & total concentration 
    … …  
    397399      !!               of the time step 
    398400      !!---------------------------------------------------------------------- 
    399       INTEGER  ::   ji, jj      ! dummy loop index 
    400       !!---------------------------------------------------------------------- 
    401       sfx    (:,:) = 0._wp   ; 
    402       sfx_bri(:,:) = 0._wp   ;   sfx_lam(:,:) = 0._wp 
    403       sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
    404       sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
    405       sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
    406       sfx_res(:,:) = 0._wp   ;   sfx_sub(:,:) = 0._wp 
    407       ! 
    408       wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
    409       wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
    410       wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
    411       wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
    412       wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
    413       wfx_spr(:,:) = 0._wp   ;   wfx_lam(:,:) = 0._wp   
    414       wfx_snw_dyn(:,:) = 0._wp ; wfx_snw_sum(:,:) = 0._wp 
    415       wfx_snw_sub(:,:) = 0._wp ; wfx_ice_sub(:,:) = 0._wp 
    416       wfx_snw_sni(:,:) = 0._wp  
    417       wfx_pnd(:,:) = 0._wp 
    418  
    419       hfx_thd(:,:) = 0._wp   ; 
    420       hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
    421       hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
    422       hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
    423       hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
    424       hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
    425       hfx_err_rem(:,:) = 0._wp 
    426       hfx_err_dif(:,:) = 0._wp 
    427       wfx_err_sub(:,:) = 0._wp 
    428       ! 
    429       diag_heat(:,:) = 0._wp ;   diag_sice(:,:) = 0._wp 
    430       diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp 
    431  
    432       ! SIMIP diagnostics 
    433       qcn_ice_bot(:,:,:) = 0._wp ; qcn_ice_top(:,:,:) = 0._wp ! conductive fluxes 
    434       t_si       (:,:,:) = rt0   ! temp at the ice-snow interface 
    435  
    436       tau_icebfr (:,:)   = 0._wp   ! landfast ice param only (clem: important to keep the init here) 
    437       cnd_ice    (:,:,:) = 0._wp   ! initialisation: effective conductivity at the top of ice/snow (ln_cndflx=T) 
    438       qcn_ice    (:,:,:) = 0._wp   ! initialisation: conductive flux (ln_cndflx=T & ln_cndemule=T) 
    439       qtr_ice_bot(:,:,:) = 0._wp   ! initialization: part of solar radiation transmitted through the ice needed at least for outputs 
    440       qsb_ice_bot(:,:)   = 0._wp   ! (needed if ln_icethd=F) 
    441       ! 
    442       ! for control checks (ln_icediachk) 
    443       diag_trp_vi(:,:) = 0._wp   ;   diag_trp_vs(:,:) = 0._wp 
    444       diag_trp_ei(:,:) = 0._wp   ;   diag_trp_es(:,:) = 0._wp 
    445       diag_trp_sv(:,:) = 0._wp 
     401      INTEGER  ::   ji, jj, jl      ! dummy loop index 
     402      !!---------------------------------------------------------------------- 
     403 
     404      DO_2D( 1, 1, 1, 1 ) 
     405         sfx    (ji,jj) = 0._wp   ; 
     406         sfx_bri(ji,jj) = 0._wp   ;   sfx_lam(ji,jj) = 0._wp 
     407         sfx_sni(ji,jj) = 0._wp   ;   sfx_opw(ji,jj) = 0._wp 
     408         sfx_bog(ji,jj) = 0._wp   ;   sfx_dyn(ji,jj) = 0._wp 
     409         sfx_bom(ji,jj) = 0._wp   ;   sfx_sum(ji,jj) = 0._wp 
     410         sfx_res(ji,jj) = 0._wp   ;   sfx_sub(ji,jj) = 0._wp 
     411         ! 
     412         wfx_snw(ji,jj) = 0._wp   ;   wfx_ice(ji,jj) = 0._wp 
     413         wfx_sni(ji,jj) = 0._wp   ;   wfx_opw(ji,jj) = 0._wp 
     414         wfx_bog(ji,jj) = 0._wp   ;   wfx_dyn(ji,jj) = 0._wp 
     415         wfx_bom(ji,jj) = 0._wp   ;   wfx_sum(ji,jj) = 0._wp 
     416         wfx_res(ji,jj) = 0._wp   ;   wfx_sub(ji,jj) = 0._wp 
     417         wfx_spr(ji,jj) = 0._wp   ;   wfx_lam(ji,jj) = 0._wp   
     418         wfx_snw_dyn(ji,jj) = 0._wp ; wfx_snw_sum(ji,jj) = 0._wp 
     419         wfx_snw_sub(ji,jj) = 0._wp ; wfx_ice_sub(ji,jj) = 0._wp 
     420         wfx_snw_sni(ji,jj) = 0._wp  
     421         wfx_pnd(ji,jj) = 0._wp 
     422 
     423         hfx_thd(ji,jj) = 0._wp   ; 
     424         hfx_snw(ji,jj) = 0._wp   ;   hfx_opw(ji,jj) = 0._wp 
     425         hfx_bog(ji,jj) = 0._wp   ;   hfx_dyn(ji,jj) = 0._wp 
     426         hfx_bom(ji,jj) = 0._wp   ;   hfx_sum(ji,jj) = 0._wp 
     427         hfx_res(ji,jj) = 0._wp   ;   hfx_sub(ji,jj) = 0._wp 
     428         hfx_spr(ji,jj) = 0._wp   ;   hfx_dif(ji,jj) = 0._wp 
     429         hfx_err_dif(ji,jj) = 0._wp 
     430         wfx_err_sub(ji,jj) = 0._wp 
     431         ! 
     432         diag_heat(ji,jj) = 0._wp ;   diag_sice(ji,jj) = 0._wp 
     433         diag_vice(ji,jj) = 0._wp ;   diag_vsnw(ji,jj) = 0._wp 
     434 
     435         tau_icebfr (ji,jj) = 0._wp   ! landfast ice param only (clem: important to keep the init here) 
     436         qsb_ice_bot(ji,jj) = 0._wp   ! (needed if ln_icethd=F) 
     437 
     438         fhld(ji,jj) = 0._wp   ! needed if ln_icethd=F 
     439 
     440         ! for control checks (ln_icediachk) 
     441         diag_trp_vi(ji,jj) = 0._wp   ;   diag_trp_vs(ji,jj) = 0._wp 
     442         diag_trp_ei(ji,jj) = 0._wp   ;   diag_trp_es(ji,jj) = 0._wp 
     443         diag_trp_sv(ji,jj) = 0._wp 
     444         ! 
     445         diag_adv_mass(ji,jj) = 0._wp 
     446         diag_adv_salt(ji,jj) = 0._wp 
     447         diag_adv_heat(ji,jj) = 0._wp 
     448      END_2D 
     449 
     450      DO jl = 1, jpl 
     451         DO_2D( 1, 1, 1, 1 ) 
     452            ! SIMIP diagnostics 
     453            t_si       (ji,jj,jl) = rt0     ! temp at the ice-snow interface 
     454            qcn_ice_bot(ji,jj,jl) = 0._wp 
     455            qcn_ice_top(ji,jj,jl) = 0._wp   ! conductive fluxes 
     456            cnd_ice    (ji,jj,jl) = 0._wp   ! effective conductivity at the top of ice/snow (ln_cndflx=T) 
     457            qcn_ice    (ji,jj,jl) = 0._wp   ! conductive flux (ln_cndflx=T & ln_cndemule=T) 
     458            qtr_ice_bot(ji,jj,jl) = 0._wp   ! part of solar radiation transmitted through the ice needed at least for outputs 
     459         END_2D 
     460      ENDDO 
    446461 
    447462   END SUBROUTINE diag_set0 
     463 
     464 
     465   SUBROUTINE diag_trends( kn ) 
     466      !!---------------------------------------------------------------------- 
     467      !!                  ***  ROUTINE diag_trends  *** 
     468      !! 
     469      !! ** purpose : diagnostics of the trends. Used for conservation purposes 
     470      !!              and outputs 
     471      !!---------------------------------------------------------------------- 
     472      INTEGER, INTENT(in) ::   kn    ! 1 = after dyn ; 2 = after thermo 
     473      !!---------------------------------------------------------------------- 
     474      ! 
     475      ! --- trends of heat, salt, mass (used for conservation controls) 
     476      IF( ln_icediachk .OR. iom_use('hfxdhc') ) THEN 
     477         ! 
     478         diag_heat(:,:) = diag_heat(:,:) & 
     479            &             - SUM(SUM( e_i (:,:,1:nlay_i,:) - e_i_b (:,:,1:nlay_i,:), dim=4 ), dim=3 ) * r1_Dt_ice & 
     480            &             - SUM(SUM( e_s (:,:,1:nlay_s,:) - e_s_b (:,:,1:nlay_s,:), dim=4 ), dim=3 ) * r1_Dt_ice 
     481         diag_sice(:,:) = diag_sice(:,:) & 
     482            &             + SUM(     sv_i(:,:,:)          - sv_i_b(:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi 
     483         diag_vice(:,:) = diag_vice(:,:) & 
     484            &             + SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhoi 
     485         diag_vsnw(:,:) = diag_vsnw(:,:) & 
     486            &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos 
     487         ! 
     488         IF( kn == 2 )    CALL iom_put ( 'hfxdhc' , diag_heat )   ! output of heat trend 
     489         ! 
     490      ENDIF 
     491      ! 
     492      ! --- trends of concentration (used for simip outputs) 
     493      IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 
     494         ! 
     495         diag_aice(:,:) = diag_aice(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice 
     496         ! 
     497         IF( kn == 1 )   CALL iom_put( 'afxdyn' , diag_aice )                                           ! dyn trend 
     498         IF( kn == 2 )   CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_Dt_ice ) ! thermo trend 
     499         IF( kn == 2 )   CALL iom_put( 'afxtot' , diag_aice )                                           ! total trend 
     500         ! 
     501      ENDIF 
     502      ! 
     503   END SUBROUTINE diag_trends 
    448504 
    449505#else 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icethd.F90

    r12489 r13727  
    1818   USE ice            ! sea-ice: variables 
    1919!!gm list trop longue ==>>> why not passage en argument d'appel ? 
    20    USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl 
     20   USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, sprecip, ln_cpl 
    2121   USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, & 
    2222      &                 qml_ice, qcn_ice, qtr_ice_top 
    … …  
    3030   USE icethd_pnd     ! sea-ice: melt ponds 
    3131   USE iceitd         ! sea-ice: remapping thickness distribution 
     32   USE icecor         ! sea-ice: corrections 
    3233   USE icetab         ! sea-ice: 1D <==> 2D transformation 
    3334   USE icevar         ! sea-ice: operations 
    … …  
    3536   ! 
    3637   USE in_out_manager ! I/O manager 
     38   USE iom            ! I/O manager library 
    3739   USE lib_mpp        ! MPP library 
    3840   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    … …  
    5153   LOGICAL ::   ln_icedO         ! activate ice growth in open-water (T) or not (F) 
    5254   LOGICAL ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F) 
     55   LOGICAL ::   ln_leadhfx       ! heat in the leads is used to melt sea-ice before warming the ocean 
     56 
     57   !! for convergence tests 
     58   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztice_cvgerr, ztice_cvgstp 
    5359 
    5460   !! * Substitutions 
    … …  
    8692      ! 
    8793      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    88       REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg 
    89       REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
    90       REAL(wp), PARAMETER :: zch        = 0.0057_wp       ! heat transfer coefficient 
    91       REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io, zfric   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
     94      REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg, zqfr_pos 
     95      REAL(wp), PARAMETER :: zfric_umin = 0._wp       ! lower bound for the friction velocity (cice value=5.e-04) 
     96      REAL(wp), PARAMETER :: zch        = 0.0057_wp   ! heat transfer coefficient 
     97      REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io, zfric, zvel   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
    9298      ! 
    9399      !!------------------------------------------------------------------- 
    … …  
    101107         WRITE(numout,*) 'ice_thd: sea-ice thermodynamics' 
    102108         WRITE(numout,*) '~~~~~~~' 
     109      ENDIF 
     110 
     111      ! convergence tests 
     112      IF( ln_zdf_chkcvg ) THEN 
     113         ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) ) 
     114         ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 
    103115      ENDIF 
    104116       
    … …  
    109121         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    110122         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    111          DO_2D_00_00 
     123         DO_2D( 0, 0, 0, 0 ) 
    112124            zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
    113125               &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    114126               &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
     127            zvel(ji,jj) = 0.5_wp * SQRT( ( u_ice(ji-1,jj) + u_ice(ji,jj) ) * ( u_ice(ji-1,jj) + u_ice(ji,jj) ) + & 
     128               &                         ( v_ice(ji,jj-1) + v_ice(ji,jj) ) * ( v_ice(ji,jj-1) + v_ice(ji,jj) ) ) 
    115129         END_2D 
    116130      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
    117          DO_2D_00_00 
     131         DO_2D( 0, 0, 0, 0 ) 
    118132            zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp *  & 
    119133               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    120134               &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     135            zvel(ji,jj) = 0._wp 
    121136         END_2D 
    122137      ENDIF 
    123       CALL lbc_lnk( 'icethd', zfric, 'T',  1. ) 
     138      CALL lbc_lnk_multi( 'icethd', zfric, 'T',  1.0_wp, zvel, 'T', 1.0_wp ) 
    124139      ! 
    125140      !--------------------------------------------------------------------! 
    126141      ! Partial computation of forcing for the thermodynamic sea ice model 
    127142      !--------------------------------------------------------------------! 
    128       DO_2D_11_11 
     143      DO_2D( 1, 1, 1, 1 ) 
    129144         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    130          ! 
    131          !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    132          !           !  practically no "direct lateral ablation" 
    133          !            
    134          !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    135          !           !  temperature and turbulent mixing (McPhee, 1992) 
    136145         ! 
    137146         ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
    … …  
    140149            &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    141150 
    142          ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 
     151         ! --- Energy needed to bring ocean surface layer until its freezing, zqfr is defined everywhere (J.m-2) --- ! 
     152         !     (mostly<0 but >0 if supercooling) 
    143153         zqfr     = rho0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 
    144154         zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
    145  
    146          ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 
     155         zqfr_pos = MAX( zqfr , 0._wp )                                                                    ! only > 0 
     156 
     157         ! --- Sensible ocean-to-ice heat flux (W/m2) --- ! 
     158         !     (mostly>0 but <0 if supercooling) 
    147159         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    148          qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
    149  
    150          qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
     160         qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 
     161          
    151162         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
    152163         !                              the freezing point, so that we do not have SST < T_freeze 
    153          !                              This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    154  
    155          !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 
    156          qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rDt_ice ) - zqfr ) 
    157  
    158          ! If there is ice and leads are warming => transfer energy from the lead budget and use it for bottom melting  
    159          ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
    160          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 
     164         !                              This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg 
     165         !                              The following formulation is ok for both normal conditions and supercooling 
     166         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
     167 
     168         ! --- Energy Budget of the leads (qlead, J.m-2) --- ! 
     169         !     qlead is the energy received from the atm. in the leads. 
     170         !     If warming (zqld >= 0), then the energy in the leads is used to melt ice (bottom melting) => fhld  (W/m2) 
     171         !     If cooling (zqld <  0), then the energy in the leads is used to grow ice in open water    => qlead (J.m-2) 
     172         IF( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
     173            ! upper bound for fhld: fhld should be equal to zqld 
     174            !                        but we have to make sure that this heat will not make the sst drop below the freezing point 
     175            !                        so the max heat that can be pulled out of the ocean is zqld - qsb - zqfr_pos 
     176            !                        The following formulation is ok for both normal conditions and supercooling 
     177            fhld (ji,jj) = rswitch * MAX( 0._wp, ( zqld - zqfr_pos ) * 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 
     178               &                                 - qsb_ice_bot(ji,jj) ) 
    162179            qlead(ji,jj) = 0._wp 
    163180         ELSE 
    164181            fhld (ji,jj) = 0._wp 
     182            ! upper bound for qlead: qlead should be equal to zqld 
     183            !                        but before using this heat for ice formation, we suppose that the ocean cools down till the freezing point. 
     184            !                        The energy for this cooling down is zqfr. Also some heat will be removed from the ocean from turbulent fluxes (qsb) 
     185            !                        and freezing point is reached if zqfr = zqld - qsb*a/dt 
     186            !                        so the max heat that can be pulled out of the ocean is zqld - qsb - zqfr 
     187            !                        The following formulation is ok for both normal conditions and supercooling 
     188            qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rDt_ice ) - zqfr ) 
    165189         ENDIF 
    166190         ! 
    167          ! Net heat flux on top of the ice-ocean [W.m-2] 
    168          ! --------------------------------------------- 
    169          qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)  
     191         ! If ice is landfast and ice concentration reaches its max 
     192         ! => stop ice formation in open water 
     193         IF(  zvel(ji,jj) <= 5.e-04_wp .AND. at_i(ji,jj) >= rn_amax_2d(ji,jj)-epsi06 )   qlead(ji,jj) = 0._wp 
     194         ! 
     195         ! If the grid cell is almost fully covered by ice (no leads) 
     196         ! => stop ice formation in open water 
     197         IF( at_i(ji,jj) >= (1._wp - epsi10) )   qlead(ji,jj) = 0._wp 
     198         ! 
     199         ! If ln_leadhfx is false 
     200         ! => do not use energy of the leads to melt sea-ice 
     201         IF( .NOT.ln_leadhfx )   fhld(ji,jj) = 0._wp 
     202         ! 
    170203      END_2D 
    171204       
    … …  
    178211      ENDIF 
    179212 
    180       ! --------------------------------------------------------------------- 
    181       ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 
    182       ! --------------------------------------------------------------------- 
    183       !     First  step here              :  non solar + precip - qlead - qsensible 
    184       !     Second step in icethd_dh      :  heat remaining if total melt (zq_rema)  
    185       !     Third  step in iceupdate.F90  :  heat from ice-ocean mass exchange (zf_mass) + solar 
    186       qt_oce_ai(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:)  &  ! Non solar heat flux received by the ocean                
    187          &             - qlead(:,:) * r1_Dt_ice                                &  ! heat flux taken from the ocean where there is open water ice formation 
    188          &             - at_i (:,:) * qsb_ice_bot(:,:)                         &  ! heat flux taken by sensible flux 
    189          &             - at_i (:,:) * fhld       (:,:)                            ! heat flux taken during bottom growth/melt  
    190       !                                                                           !    (fhld should be 0 while bott growth) 
    191213      !-------------------------------------------------------------------------------------------! 
    192214      ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories 
    … …  
    196218         ! select ice covered grid points 
    197219         npti = 0 ; nptidx(:) = 0 
    198          DO_2D_11_11 
     220         DO_2D( 1, 1, 1, 1 ) 
    199221            IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
    200222               npti         = npti  + 1 
    … …  
    208230            !                                                       ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 
    209231            ! 
    210             s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp  ! --- some init --- !  (important to have them here)  
     232            s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here)  
    211233            dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp  
    212234            dh_i_sub  (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 
    … …  
    242264      IF( ln_icedO )          CALL ice_thd_do                       ! --- Frazil ice growth in leads --- ! 
    243265      ! 
     266                              CALL ice_cor( kt , 2 )                ! --- Corrections --- ! 
     267      ! 
     268      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice              ! ice natural aging incrementation      
     269      ! 
     270      ! convergence tests 
     271      IF( ln_zdf_chkcvg ) THEN 
     272         CALL iom_put( 'tice_cvgerr', ztice_cvgerr ) ; DEALLOCATE( ztice_cvgerr ) 
     273         CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) 
     274      ENDIF 
     275      ! 
    244276      ! controls 
    245277      IF( ln_icectl )   CALL ice_prt    (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints 
    … …  
    347379         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    348380         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) ) 
     381         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    350382         ! 
    351383         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
    … …  
    399431         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res       ) 
    400432         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   ) 
    402          CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai     ) 
    403433         ! 
    404434         ! ocean surface fields 
    405435         CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m ) 
    406436         CALL tab_2d_1d( npti, nptidx(1:npti), sss_1d(1:npti), sss_m ) 
     437         CALL tab_2d_1d( npti, nptidx(1:npti), frq_m_1d(1:npti), frq_m ) 
    407438         ! 
    408439         ! to update ice age 
    … …  
    434465         sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 
    435466         v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 
     467         v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 
    436468         oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 
    437469          
    … …  
    453485         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    454486         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) ) 
     487         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    456488         ! 
    457489         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
    … …  
    491523         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res     ) 
    492524         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 ) 
    494          CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai   ) 
    495525         ! 
    496526         CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d    (1:npti), qns_ice    (:,:,kl) ) 
    … …  
    508538         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    509539         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
     540         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    510541         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
     542         ! check convergence of heat diffusion scheme 
     543         IF( ln_zdf_chkcvg ) THEN 
     544            CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) 
     545            CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) 
     546         ENDIF 
    511547         ! 
    512548      END SELECT 
    … …  
    529565      INTEGER  ::   ios   ! Local integer output status for namelist read 
    530566      !! 
    531       NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 
     567      NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 
    532568      !!------------------------------------------------------------------- 
    533569      ! 
    … …  
    543579         WRITE(numout,*) '~~~~~~~~~~~~' 
    544580         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 
     581         WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)                ln_icedH   = ', ln_icedH 
     582         WRITE(numout,*) '      activate lateral melting (T) or not (F)                              ln_icedA   = ', ln_icedA 
     583         WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)                     ln_icedO   = ', ln_icedO 
     584         WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)                ln_icedS   = ', ln_icedS 
     585         WRITE(numout,*) '      heat in the leads is used to melt sea-ice before warming the ocean   ln_leadhfx = ', ln_leadhfx 
    549586     ENDIF 
    550587      ! 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icethd_dh.F90

    r12489 r13727  
    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   !!---------------------------------------------------------------------- 
    … …  
    144139      ! 
    145140      DO ji = 1, npti 
    146          zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji)  
     141         zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji)  
    147142         zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rDt_ice ) 
    148143      END DO 
    … …  
    186181      ! Snow precipitation 
    187182      !------------------- 
    188       CALL ice_thd_snwblow( 1. - 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 
    … …  
    442437                
    443438               zEi           = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
    444                   &            - rLfus * ( 1.0 - ztmelts / ( zt_i_new - rt0 ) ) + rcp  * ztmelts 
     439                  &            - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp  * ztmelts 
    445440 
    446441               zEw           = rcp  * ( t_bo_1d(ji) - rt0 )                                           ! Specific enthalpy of seawater (J/kg, < 0) 
    … …  
    561556         !     
    562557         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
    563          qt_oce_ai_1d(ji) = qt_oce_ai_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 
     558         !!hfx_res_1d(ji) = hfx_res_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 
    564559 
    565560         IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
    … …  
    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_12905_xios_restart/src/ICE/icethd_do.F90

    r12489 r13727  
    131131 
    132132      ! Default new ice thickness 
    133       WHERE( qlead(:,:) < 0._wp  .AND. tau_icebfr(:,:) == 0._wp )   ;   ht_i_new(:,:) = rn_hinew ! if cooling and no landfast 
    134       ELSEWHERE                                                     ;   ht_i_new(:,:) = 0._wp 
     133      WHERE( qlead(:,:) < 0._wp ) ! cooling 
     134         ht_i_new(:,:) = rn_hinew 
     135      ELSEWHERE 
     136         ht_i_new(:,:) = 0._wp 
    135137      END WHERE 
    136138 
    … …  
    145147         zgamafr = 0.03 
    146148         ! 
    147          DO_2D_00_00 
    148             IF ( qlead(ji,jj) < 0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN ! activated if cooling and no landfast 
     149         DO_2D( 0, 0, 0, 0 ) 
     150            IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling 
    149151               ! -- Wind stress -- ! 
    150152               ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   & 
    … …  
    191193         END_2D 
    192194         !  
    193          CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1., ht_i_new, 'T', 1.  ) 
     195         CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp  ) 
    194196 
    195197      ENDIF 
    … …  
    198200      ! 2) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
    199201      !------------------------------------------------------------------------------! 
    200       ! This occurs if open water energy budget is negative (cooling) and there is no landfast ice 
     202      ! it occurs if cooling 
    201203 
    202204      ! Identify grid points where new ice forms 
    203205      npti = 0   ;   nptidx(:) = 0 
    204       DO_2D_11_11 
    205          IF ( qlead(ji,jj)  <  0._wp .AND. tau_icebfr(ji,jj) == 0._wp ) THEN 
     206      DO_2D( 1, 1, 1, 1 ) 
     207         IF ( qlead(ji,jj)  <  0._wp ) THEN 
    206208            npti = npti + 1 
    207209            nptidx( npti ) = (jj - 1) * jpi + ji 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icethd_ent.F90

    r12489 r13727  
    128128      ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do),  
    129129      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
    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 
     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 
    134134       
    135135   END SUBROUTINE ice_thd_ent 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icethd_pnd.F90

    r12489 r13727  
    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_12905_xios_restart/src/ICE/icethd_sal.F90

    r12489 r13727  
    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_12905_xios_restart/src/ICE/icethd_zdf.F90

    r12377 r13727  
    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_12905_xios_restart/src/ICE/icethd_zdf_bl99.F90

    r12489 r13727  
    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             zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * h_s_1d(ji) * r1_nlay_s * REAL(jk) ) 
     216            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s(ji) * MAX( 0._wp, zh_s(ji) * REAL(jk) - zhs_ssl ) ) 
    188217            !                             ! radiation absorbed by the layer-th snow layer 
    189218            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) 
    … …  
    191220      END DO 
    192221      ! 
    193       zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 
     222      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * za_s_fra(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - za_s_fra(1:npti) ) 
    194223      DO jk = 1, nlay_i  
    195224         DO ji = 1, npti 
    196225            !                             ! radiation transmitted below the layer-th ice layer 
    197             zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - rn_kappa_i * zh_i(ji) * REAL(jk) ) 
     226            zradtr_i(ji,jk) =           za_s_fra(ji)   * zradtr_s(ji,nlay_s)                       &   ! part covered by snow 
     227               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zh_min  ) ) & 
     228               &            + ( 1._wp - za_s_fra(ji) ) * qtr_ice_top_1d(ji)                        &   ! part snow free 
     229               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) )             
    198230            !                             ! radiation absorbed by the layer-th ice layer 
    199231            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    … …  
    203235      qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i)   ! record radiation transmitted below the ice 
    204236      ! 
    205       iconv    = 0          ! number of iterations 
     237      iconv = 0          ! number of iterations 
    206238      ! 
    207239      l_T_converged(:) = .FALSE. 
    … …  
    230262               DO ji = 1, npti 
    231263                  ztcond_i_cp(ji,jk) = rcnd_i + zbeta * 0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /  & 
    232                      &                         MIN( -epsi10, 0.5_wp * (t_i_1d(ji,jk) + t_i_1d(ji,jk+1)) - rt0 ) 
     264                     &                    MIN( -epsi10, 0.5_wp * (  t_i_1d(ji,jk) +  t_i_1d(ji,jk+1) ) - rt0 ) 
    233265               END DO 
    234266            END DO 
    … …  
    238270            DO ji = 1, npti 
    239271               ztcond_i_cp(ji,0)      = rcnd_i + 0.09_wp  *  sz_i_1d(ji,1)      / MIN( -epsi10, t_i_1d(ji,1) - rt0 )  & 
    240                   &                           - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 
     272                  &                            - 0.011_wp * ( t_i_1d(ji,1) - rt0 ) 
    241273               ztcond_i_cp(ji,nlay_i) = rcnd_i + 0.09_wp  *  sz_i_1d(ji,nlay_i) / MIN( -epsi10, t_bo_1d(ji)  - rt0 )  & 
    242                   &                           - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 
     274                  &                            - 0.011_wp * ( t_bo_1d(ji) - rt0 ) 
    243275            END DO 
    244276            DO jk = 1, nlay_i-1 
    245277               DO ji = 1, npti 
    246                   ztcond_i_cp(ji,jk) = rcnd_i + 0.09_wp  *   0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /        & 
    247                      &                        MIN( -epsi10, 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 ) & 
    248                      &                       - 0.011_wp * ( 0.5_wp * ( t_i_1d (ji,jk) + t_i_1d (ji,jk+1) ) - rt0 ) 
     278                  ztcond_i_cp(ji,jk) = rcnd_i + 0.09_wp  *   0.5_wp * ( sz_i_1d(ji,jk) + sz_i_1d(ji,jk+1) ) /       & 
     279                     &                         MIN( -epsi10, 0.5_wp * (  t_i_1d(ji,jk) +  t_i_1d(ji,jk+1) ) - rt0 ) & 
     280                     &                        - 0.011_wp * ( 0.5_wp * (  t_i_1d(ji,jk) +  t_i_1d(ji,jk+1) ) - rt0 ) 
    249281               END DO 
    250282            END DO 
    … …  
    290322         END DO 
    291323         DO ji = 1, npti   ! Snow-ice interface 
    292             IF ( .NOT. l_T_converged(ji) ) THEN 
    293                zfac = 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) ) 
    294                IF( zfac > epsi10 ) THEN 
    295                   zkappa_s(ji,nlay_s) = zghe(ji) * rn_cnd_s * ztcond_i(ji,0) / zfac 
    296                ELSE 
    297                   zkappa_s(ji,nlay_s) = 0._wp 
    298                ENDIF 
    299             ENDIF 
     324            IF ( .NOT. l_T_converged(ji) ) & 
     325               zkappa_s(ji,nlay_s) = isnow(ji) * zghe(ji) * rn_cnd_s * ztcond_i(ji,0) & 
     326                  &                            / ( 0.5_wp * ( ztcond_i(ji,0) * zh_s(ji) + rn_cnd_s * zh_i(ji) ) ) 
    300327         END DO 
    301328 
    … …  
    310337         END DO 
    311338         DO ji = 1, npti   ! Snow-ice interface 
    312             IF ( .NOT. l_T_converged(ji) ) & 
    313                zkappa_i(ji,0) = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 
     339            IF ( .NOT. l_T_converged(ji) ) THEN 
     340               ! Calculate combined surface snow and ice conductivity to pass through the coupler (met-office) 
     341               zkappa_comb(ji) = isnow_comb(ji) * zkappa_s(ji,0) + ( 1._wp - isnow_comb(ji) ) * zkappa_i(ji,0) 
     342               ! If there is snow then use the same snow-ice interface conductivity for the top layer of ice 
     343               IF( h_s_1d(ji) > 0._wp )   zkappa_i(ji,0) = zkappa_s(ji,nlay_s) 
     344           ENDIF 
    314345         END DO 
    315346         ! 
    … …  
    320351            DO ji = 1, npti 
    321352               zcpi = rcpi + zgamma * sz_i_1d(ji,jk) / MAX( ( t_i_1d(ji,jk) - rt0 ) * ( ztiold(ji,jk) - rt0 ), epsi10 ) 
    322                zeta_i(ji,jk) = rDt_ice * r1_rhoi * z1_h_i(ji) / MAX( epsi10, zcpi )  
     353               zeta_i(ji,jk) = rDt_ice * r1_rhoi * z1_h_i(ji) / zcpi 
    323354            END DO 
    324355         END DO 
    … …  
    544575                  ztsub(ji) = t_su_1d(ji) 
    545576                  IF( t_su_1d(ji) < rt0 ) THEN 
    546                      t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
    547                         &          ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
     577                     t_su_1d(ji) = (  zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
     578                        &           ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
    548579                  ENDIF 
    549580               ENDIF 
    550581            END DO 
     582            !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 
    551583            ! 
    552584            !-------------------------------------------------------------- 
    … …  
    561593 
    562594               IF ( .NOT. l_T_converged(ji) ) THEN 
     595 
    563596                  t_su_1d(ji) = MAX( MIN( t_su_1d(ji) , rt0 ) , rt0 - 100._wp ) 
    564597                  zdti_max    = MAX( zdti_max, ABS( t_su_1d(ji) - ztsub(ji) ) ) 
    565598 
    566                   t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 
    567                   zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
     599                  IF( h_s_1d(ji) > 0._wp ) THEN 
     600                     DO jk = 1, nlay_s 
     601                        t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp ) 
     602                        zdti_max      = MAX ( zdti_max , ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) ) 
     603                     END DO 
     604                  ENDIF 
    568605 
    569606                  DO jk = 1, nlay_i 
    … …  
    572609                     zdti_max      =  MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
    573610                  END DO 
    574  
    575                   IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 
     611                   
     612                  ! convergence test 
     613                  IF( ln_zdf_chkcvg ) THEN 
     614                     tice_cvgerr_1d(ji) = zdti_max 
     615                     tice_cvgstp_1d(ji) = REAL(iconv) 
     616                  ENDIF 
     617 
     618                  IF( zdti_max < zdti_bnd )   l_T_converged(ji) = .TRUE. 
    576619 
    577620               ENDIF 
    … …  
    726769               ENDIF 
    727770            END DO 
     771            !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 
    728772            ! 
    729773            !-------------------------------------------------------------- 
    … …  
    738782 
    739783               IF ( .NOT. l_T_converged(ji) ) THEN 
    740                   ! t_s 
    741                   t_s_1d(ji,1:nlay_s) = MAX( MIN( t_s_1d(ji,1:nlay_s), rt0 ), rt0 - 100._wp ) 
    742                   zdti_max = MAX ( zdti_max , MAXVAL( ABS( t_s_1d(ji,1:nlay_s) - ztsb(ji,1:nlay_s) ) ) ) 
    743                   ! t_i 
     784 
     785                  IF( h_s_1d(ji) > 0._wp ) THEN 
     786                     DO jk = 1, nlay_s 
     787                        t_s_1d(ji,jk) = MAX( MIN( t_s_1d(ji,jk), rt0 ), rt0 - 100._wp ) 
     788                        zdti_max      = MAX ( zdti_max , ABS( t_s_1d(ji,jk) - ztsb(ji,jk) ) ) 
     789                     END DO 
     790                  ENDIF 
     791 
    744792                  DO jk = 1, nlay_i 
    745793                     ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0  
    … …  
    748796                  END DO 
    749797 
    750                   IF ( zdti_max < zdti_bnd ) l_T_converged(ji) = .TRUE. 
     798                  ! convergence test 
     799                  IF( ln_zdf_chkcvg ) THEN 
     800                     tice_cvgerr_1d(ji) = zdti_max 
     801                     tice_cvgstp_1d(ji) = REAL(iconv) 
     802                  ENDIF 
     803 
     804                  IF( zdti_max < zdti_bnd )   l_T_converged(ji) = .TRUE. 
    751805 
    752806               ENDIF 
    … …  
    755809 
    756810         ENDIF ! k_cnd 
    757           
     811 
    758812      END DO  ! End of the do while iterative procedure 
    759        
    760       IF( ln_icectl .AND. lwp ) THEN 
    761          WRITE(numout,*) ' zdti_max : ', zdti_max 
    762          WRITE(numout,*) ' iconv    : ', iconv 
    763       ENDIF 
    764        
    765813      ! 
    766814      !----------------------------- 
    … …  
    771819      !     bottom ice conduction flux 
    772820      DO ji = 1, npti 
    773          qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1  * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
     821         qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 
    774822      END DO 
    775823      !     surface ice conduction flux 
    … …  
    777825         ! 
    778826         DO ji = 1, npti 
    779             qcn_ice_top_1d(ji) =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 
    780                &                  - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
     827            qcn_ice_top_1d(ji) = -           isnow(ji)   * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 
     828               &                 - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * ( t_i_1d(ji,1) - t_su_1d(ji) ) 
    781829         END DO 
    782830         ! 
    … …  
    792840         ! 
    793841         DO ji = 1, npti 
    794             t_su_1d(ji) = (  qcn_ice_top_1d(ji) &            ! calculate surface temperature 
    795                &           +           isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) & 
    796                &           + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) & 
    797                &          ) / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 
     842            t_su_1d(ji) = ( qcn_ice_top_1d(ji) +          isnow(ji)   * zkappa_s(ji,0) * zg1s * t_s_1d(ji,1) + & 
     843               &                                ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * t_i_1d(ji,1) ) & 
     844               &          / MAX( epsi10, isnow(ji) * zkappa_s(ji,0) * zg1s + ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 ) 
    798845            t_su_1d(ji) = MAX( MIN( t_su_1d(ji), rt0 ), rt0 - 100._wp )  ! cap t_su 
    799846         END DO 
    … …  
    853900      !-------------------------------------------------------------------- 
    854901      ! effective conductivity and 1st layer temperature (needed by Met Office) 
     902      ! this is a conductivity at mid-layer, hence the factor 2 
    855903      DO ji = 1, npti 
    856          IF( h_s_1d(ji) > 0.1_wp ) THEN  
    857             cnd_ice_1d(ji) = 2._wp * zkappa_s(ji,0) 
     904         IF( h_i_1d(ji) >= zhi_ssl ) THEN 
     905            cnd_ice_1d(ji) = 2._wp * zkappa_comb(ji) 
     906            !!cnd_ice_1d(ji) = 2._wp * zkappa_i(ji,0) 
    858907         ELSE 
    859             IF( h_i_1d(ji) > 0.1_wp ) THEN 
    860                cnd_ice_1d(ji) = 2._wp * zkappa_i(ji,0) 
    861             ELSE 
    862                cnd_ice_1d(ji) = 2._wp * ztcond_i(ji,0) * 10._wp 
    863             ENDIF 
     908            cnd_ice_1d(ji) = 2._wp * ztcond_i(ji,0) / zhi_ssl ! cnd_ice is capped by: cond_i/zhi_ssl 
    864909         ENDIF 
    865910         t1_ice_1d(ji) = isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) 
    … …  
    877922      DO ji = 1, npti          
    878923         !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
    879          zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) 
    880          IF( h_s_1d(ji) >= zhs_min ) THEN 
    881             t_si_1d(ji) = ( rn_cnd_s       * zh_i(ji) * t_s_1d(ji,1) +   & 
    882                &            ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac ) 
     924         IF( h_s_1d(ji) >= zhs_ssl ) THEN 
     925            t_si_1d(ji) = (   rn_cnd_s       * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,1)   & 
     926               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1) ) & 
     927               &          / ( rn_cnd_s       * h_i_1d(ji) * r1_nlay_i & 
     928               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s ) 
    883929         ELSE 
    884930            t_si_1d(ji) = t_su_1d(ji) 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/iceupdate.F90

    r12969 r13727  
    2424   USE traqsr         ! add penetration of solar flux in the calculation of heat budget 
    2525   USE icectl         ! sea-ice: control prints 
    26    USE bdy_oce , ONLY : ln_bdy 
     26   USE zdfdrg  , ONLY : ln_drgice_imp 
    2727   ! 
    2828   USE in_out_manager ! I/O manager 
    … …  
    9191      ! 
    9292      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices 
    93       REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    9493      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
    95       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  ! 2D workspace 
    96       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace 
     94      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
    9795      !!--------------------------------------------------------------------- 
    9896      IF( ln_timing )   CALL timing_start('ice_update') 
    … …  
    103101         WRITE(numout,*)'~~~~~~~~~~~~~~' 
    104102      ENDIF 
     103 
     104      ! Net heat flux on top of the ice-ocean (W.m-2) 
     105      !---------------------------------------------- 
     106      qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:)  
    105107 
    106108      ! --- case we bypass ice thermodynamics --- ! 
    … …  
    113115      ENDIF 
    114116       
    115       DO_2D_11_11 
    116  
    117          ! Solar heat flux reaching the ocean = zqsr (W.m-2)  
     117      DO_2D( 1, 1, 1, 1 ) 
     118 
     119         ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2)  
    118120         !--------------------------------------------------- 
    119121         zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
    … …  
    121123         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)  
    122124         !--------------------------------------------------- 
    123          zqmass           = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
    124          qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 
    125  
    126          ! Add the residual from heat diffusion equation and sublimation (W.m-2) 
    127          !---------------------------------------------------------------------- 
    128          qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) +   & 
    129             &             ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 
    130  
     125         qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 
     126            &                                - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 
     127            &                                + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 
     128            &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj)                  
     129          
    131130         ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    132131         !---------------------------------------------------------------------------- 
    133          qsr(ji,jj) = zqsr                                       
     132         ! if warming and some ice remains, then we suppose that the whole solar flux has been consumed to melt the ice 
     133         ! else ( cooling or no ice left ), then we suppose that     no    solar flux has been consumed 
     134         ! 
     135         IF( fhld(ji,jj) > 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN   !-- warming and some ice remains 
     136            !                                        solar flux transmitted thru the 1st level of the ocean (i.e. not used by sea-ice) 
     137            qsr(ji,jj) = ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * ( 1._wp - frq_m(ji,jj) ) & 
     138               !                                   + solar flux transmitted thru ice and the 1st ocean level (also not used by sea-ice) 
     139               &             + SUM( a_i_b(ji,jj,:) * qtr_ice_bot(ji,jj,:) ) * ( 1._wp - frq_m(ji,jj) ) 
     140            ! 
     141         ELSE                                                       !-- cooling or no ice left 
     142            qsr(ji,jj) = zqsr 
     143         ENDIF 
     144         ! 
     145         ! the non-solar is simply derived from the solar flux 
    134146         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr               
    135  
     147          
    136148         ! Mass flux at the atm. surface        
    137149         !----------------------------------- 
    … …  
    140152         ! Mass flux at the ocean surface       
    141153         !------------------------------------ 
    142          !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    143          !  -------------------------------------------------------------------------------------  
    144          !  The idea of this approach is that the system that we consider is the ICE-OCEAN system 
    145          !  Thus  FW  flux  =  External ( E-P+snow melt) 
    146          !       Salt flux  =  Exchanges in the ice-ocean system then converted into FW 
    147          !                     Associated to Ice formation AND Ice melting 
    148          !                     Even if i see Ice melting as a FW and SALT flux 
    149          !         
    150          ! mass flux from ice/ocean 
     154         ! ice-ocean  mass flux 
    151155         wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    152156            &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 
    153  
    154          ! add the snow melt water to snow mass flux to the ocean 
     157          
     158         ! snw-ocean mass flux 
    155159         wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 
    156  
    157          ! mass flux at the ocean/ice interface 
    158          fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) + wfx_err_sub(ji,jj) )              ! F/M mass flux save at least for biogeochemical model 
    159          emp(ji,jj)    = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    160  
     160          
     161         ! total mass flux at the ocean/ice interface 
     162         fmmflx(ji,jj) =                - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! ice-ocean mass flux saved at least for biogeochemical model 
     163         emp   (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! atm-ocean + ice-ocean mass flux 
    161164 
    162165         ! Salt flux at the ocean surface       
    … …  
    182185      ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 
    183186      !------------------------------------------------------------------ 
    184       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    185       ! 
    186       alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     187      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo 
     188 
    187189      ! 
    188190      IF( lrst_ice ) THEN                       !* write snwice_mass fields in the restart file 
    … …  
    263265      CALL iom_put ('hfxdif'     , hfx_dif     )   ! heat flux used for ice temperature change 
    264266      CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt  
    265       CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion (included in qt_oce_ai) 
     267      CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion 
    266268 
    267269      ! heat fluxes associated with mass exchange (freeze/melt/precip...) 
    … …  
    280282      !--------- 
    281283#if ! defined key_agrif 
    282       IF( ln_icediachk .AND. .NOT. ln_bdy)   CALL ice_cons_final('iceupdate')                                       ! conservation 
     284      IF( ln_icediachk      )   CALL ice_cons_final('iceupdate')                                       ! conservation 
    283285#endif 
    284       IF( ln_icectl                      )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints 
    285       IF( sn_cfctl%l_prtctl              )   CALL ice_prt3D     ('iceupdate')                                       ! prints 
    286       IF( ln_timing                      )   CALL timing_stop   ('ice_update')                                      ! timing 
     286      IF( ln_icectl         )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints 
     287      IF( sn_cfctl%l_prtctl )   CALL ice_prt3D     ('iceupdate')                                       ! prints 
     288      IF( ln_timing         )   CALL timing_stop   ('ice_update')                                      ! timing 
    287289      ! 
    288290   END SUBROUTINE ice_update_flx 
    … …  
    320322      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar 
    321323      REAL(wp) ::   zat_v, zvtau_ice, zv_t, zrhoco  !   -      - 
     324      REAL(wp) ::   zflagi                          !   -      - 
    322325      !!--------------------------------------------------------------------- 
    323326      IF( ln_timing )   CALL timing_start('ice_update_tau') 
    … …  
    332335      ! 
    333336      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    334          DO_2D_00_00 
     337         DO_2D( 0, 0, 0, 0 )                          !* update the modulus of stress at ocean surface (T-point) 
    335338            !                                               ! 2*(U_ice-U_oce) at T-point 
    336339            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)    
    … …  
    342345            tmod_io(ji,jj) = zrhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point 
    343346         END_2D 
    344          CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1., tmod_io, 'T', 1. ) 
     347         CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp ) 
    345348         ! 
    346349         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
    … …  
    350353      ! 
    351354      !                                      !==  every ocean time-step  ==! 
    352       ! 
    353       DO_2D_00_00 
     355      IF ( ln_drgice_imp ) THEN 
     356         ! Save drag with right sign to update top drag in the ocean implicit friction  
     357         rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1)  
     358         zflagi = 0._wp 
     359      ELSE 
     360         zflagi = 1._wp 
     361      ENDIF 
     362      ! 
     363      DO_2D( 0, 0, 0, 0 )                             !* update the stress WITHOUT an ice-ocean rotation angle 
    354364         ! ice area at u and v-points  
    355365         zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  & 
    … …  
    364374         vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 
    365375      END_2D 
    366       CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1., vtau, 'V', -1. )   ! lateral boundary condition 
     376      CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp )   ! lateral boundary condition 
    367377      ! 
    368378      IF( ln_timing )   CALL timing_stop('ice_update_tau') 
    … …  
    417427            ! 
    418428            IF( id1 > 0 ) THEN                       ! fields exist 
    419                IF(lrixios) CALL iom_swap(crixios_context)  
    420                CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass,  ldxios = lrixios ) 
    421                CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b, ldxios = lrixios ) 
     429               IF(lrixios) CALL iom_swap(crixios_context) 
     430               CALL iom_get( numrir, jpdom_auto, 'snwice_mass'  , snwice_mass  , ldxios = lrixios ) 
     431               CALL iom_get( numrir, jpdom_auto, 'snwice_mass_b', snwice_mass_b, ldxios = lrixios ) 
    422432               IF(lrixios) CALL iom_swap(cxios_context) 
    423433            ELSE                                     ! start from rest 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icevar.F90

    r12489 r13727  
    5151   !!   ice_var_sshdyn    : compute equivalent ssh in lead 
    5252   !!   ice_var_itd       : convert N-cat to M-cat 
     53   !!   ice_var_snwfra    : fraction of ice covered by snow 
     54   !!   ice_var_snwblow   : distribute snow fall between ice and ocean 
    5355   !!---------------------------------------------------------------------- 
    5456   USE dom_oce        ! ocean space and time domain 
    … …  
    7779   PUBLIC   ice_var_sshdyn 
    7880   PUBLIC   ice_var_itd 
     81   PUBLIC   ice_var_snwfra 
     82   PUBLIC   ice_var_snwblow 
    7983 
    8084   INTERFACE ice_var_itd 
    … …  
    8488   !! * Substitutions 
    8589#  include "do_loop_substitute.h90" 
     90 
     91   INTERFACE ice_var_snwfra 
     92      MODULE PROCEDURE ice_var_snwfra_1d, ice_var_snwfra_2d, ice_var_snwfra_3d 
     93   END INTERFACE 
     94 
     95   INTERFACE ice_var_snwblow 
     96      MODULE PROCEDURE ice_var_snwblow_1d, ice_var_snwblow_2d 
     97   END INTERFACE 
     98 
    8699   !!---------------------------------------------------------------------- 
    87100   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    115128      at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 
    116129      vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) 
     130      vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 
    117131      ! 
    118132      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
    … …  
    166180         ! 
    167181         !                           ! mean melt pond depth 
    168          WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 
    169          ELSEWHERE                      ;   hm_ip(:,:) = 0._wp 
     182         WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:)   ;   hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 
     183         ELSEWHERE                      ;   hm_ip(:,:) = 0._wp                     ;   hm_il(:,:) = 0._wp 
    170184         END WHERE          
    171185         ! 
    … …  
    191205      REAL(wp) ::   zhmax, z1_zhmax                 !   -      - 
    192206      REAL(wp) ::   zlay_i, zlay_s                  !   -      - 
    193       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i 
     207      REAL(wp), PARAMETER ::   zhl_max =  0.015_wp  ! pond lid thickness above which the ponds disappear from the albedo calculation 
     208      REAL(wp), PARAMETER ::   zhl_min =  0.005_wp  ! pond lid thickness below which the full pond area is used in the albedo calculation 
     209      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i, z1_a_ip, za_s_fra 
    194210      !!------------------------------------------------------------------- 
    195211 
    … …  
    210226      ELSEWHERE                      ;   z1_v_i(:,:,:) = 0._wp 
    211227      END WHERE 
     228      ! 
     229      WHERE( a_ip(:,:,:) > epsi20 )  ;   z1_a_ip(:,:,:) = 1._wp / a_ip(:,:,:) 
     230      ELSEWHERE                      ;   z1_a_ip(:,:,:) = 0._wp 
     231      END WHERE 
    212232      !                                           !--- ice thickness 
    213233      h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:) 
    … …  
    224244      !                                           !--- ice age       
    225245      o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 
    226       !                                           !--- pond fraction and thickness       
     246      !                                           !--- pond and lid thickness       
     247      h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 
     248      h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) 
     249      !                                           !--- melt pond effective area (used for albedo) 
    227250      a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:) 
    228       WHERE( a_ip_frac(:,:,:) > epsi20 )   ;   h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 
    229       ELSEWHERE                            ;   h_ip(:,:,:) = 0._wp 
    230       END WHERE 
     251      WHERE    ( h_il(:,:,:) <= zhl_min )  ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:)       ! lid is very thin.  Expose all the pond 
     252      ELSEWHERE( h_il(:,:,:) >= zhl_max )  ;   a_ip_eff(:,:,:) = 0._wp                  ! lid is very thick. Cover all the pond up with ice and snow 
     253      ELSEWHERE                            ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * &   ! lid is in between. Expose part of the pond 
     254         &                                                       ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 
     255      END WHERE 
     256      ! 
     257      CALL ice_var_snwfra( h_s, za_s_fra )           ! calculate ice fraction covered by snow 
     258      a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra )   ! make sure (a_ip_eff + a_s_fra) <= 1 
    231259      ! 
    232260      !                                           !---  salinity (with a minimum value imposed everywhere)      
    … …  
    243271      zlay_i   = REAL( nlay_i , wp )    ! number of layers 
    244272      DO jl = 1, jpl 
    245          DO_3D_11_11( 1, nlay_i ) 
     273         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    246274            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
    247275               ! 
    … …  
    292320      sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 
    293321      v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     322      v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    294323      ! 
    295324   END SUBROUTINE ice_var_eqv2glo 
    … …  
    347376         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    348377         DO jl = 1, jpl 
    349             DO_2D_11_11 
     378            DO_2D( 1, 1, 1, 1 ) 
    350379               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    351380               !                             ! force a constant profile when SSS too low (Baltic Sea) 
    … …  
    356385         ! Computation of the profile 
    357386         DO jl = 1, jpl 
    358             DO_3D_11_11( 1, nlay_i ) 
     387            DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    359388               !                          ! linear profile with 0 surface value 
    360389               zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
    … …  
    486515         ! Zap ice energy and use ocean heat to melt ice 
    487516         !----------------------------------------------------------------- 
    488          DO_3D_11_11( 1, nlay_i ) 
     517         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    489518            ! update exchanges with ocean 
    490519            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0 
    … …  
    493522         END_3D 
    494523         ! 
    495          DO_3D_11_11( 1, nlay_s ) 
     524         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    496525            ! update exchanges with ocean 
    497526            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0 
    … …  
    503532         ! zap ice and snow volume, add water and salt to ocean 
    504533         !----------------------------------------------------------------- 
    505          DO_2D_11_11 
     534         DO_2D( 1, 1, 1, 1 ) 
    506535            ! update exchanges with ocean 
    507536            sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
    … …  
    521550            a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
    522551            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
     552            v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 
    523553            ! 
    524554         END_2D 
    … …  
    542572 
    543573 
    544    SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     574   SUBROUTINE ice_var_zapneg( pdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    545575      !!------------------------------------------------------------------- 
    546576      !!                   ***  ROUTINE ice_var_zapneg *** 
    … …  
    557587      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    558588      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     589      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    559590      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    560591      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    574605         ! zap ice energy and send it to the ocean 
    575606         !---------------------------------------- 
    576          DO_3D_11_11( 1, nlay_i ) 
     607         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    577608            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    578609               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
    … …  
    581612         END_3D 
    582613         ! 
    583          DO_3D_11_11( 1, nlay_s ) 
     614         DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
    584615            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    585616               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
    … …  
    591622         ! zap ice and snow volume, add water and salt to ocean 
    592623         !----------------------------------------------------- 
    593          DO_2D_11_11 
     624         DO_2D( 1, 1, 1, 1 ) 
    594625            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    595626               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 
    … …  
    613644      WHERE( pa_ip (:,:,:) < 0._wp )   pa_ip (:,:,:) = 0._wp 
    614645      WHERE( pv_ip (:,:,:) < 0._wp )   pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 
    615       !                                                        but it does not change conservation, so keep it this way is ok 
     646      WHERE( pv_il (:,:,:) < 0._wp )   pv_il (:,:,:) = 0._wp !    but it does not change conservation, so keep it this way is ok 
    616647      ! 
    617648   END SUBROUTINE ice_var_zapneg 
    618649 
    619650 
    620    SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     651   SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    621652      !!------------------------------------------------------------------- 
    622653      !!                   ***  ROUTINE ice_var_roundoff *** 
    … …  
    631662      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    632663      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     664      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    633665      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    634666      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    635667      !!------------------------------------------------------------------- 
    636668      ! 
    637       WHERE( pa_i (1:npti,:)   < 0._wp .AND. pa_i (1:npti,:)   > -epsi10 )   pa_i (1:npti,:)   = 0._wp   !  a_i must be >= 0 
    638       WHERE( pv_i (1:npti,:)   < 0._wp .AND. pv_i (1:npti,:)   > -epsi10 )   pv_i (1:npti,:)   = 0._wp   !  v_i must be >= 0 
    639       WHERE( pv_s (1:npti,:)   < 0._wp .AND. pv_s (1:npti,:)   > -epsi10 )   pv_s (1:npti,:)   = 0._wp   !  v_s must be >= 0 
    640       WHERE( psv_i(1:npti,:)   < 0._wp .AND. psv_i(1:npti,:)   > -epsi10 )   psv_i(1:npti,:)   = 0._wp   ! sv_i must be >= 0 
    641       WHERE( poa_i(1:npti,:)   < 0._wp .AND. poa_i(1:npti,:)   > -epsi10 )   poa_i(1:npti,:)   = 0._wp   ! oa_i must be >= 0 
    642       WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
    643       WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
    644       IF( ln_pnd_H12 ) THEN 
    645          WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    646          WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     669 
     670      WHERE( pa_i (1:npti,:)   < 0._wp )   pa_i (1:npti,:)   = 0._wp   !  a_i must be >= 0 
     671      WHERE( pv_i (1:npti,:)   < 0._wp )   pv_i (1:npti,:)   = 0._wp   !  v_i must be >= 0 
     672      WHERE( pv_s (1:npti,:)   < 0._wp )   pv_s (1:npti,:)   = 0._wp   !  v_s must be >= 0 
     673      WHERE( psv_i(1:npti,:)   < 0._wp )   psv_i(1:npti,:)   = 0._wp   ! sv_i must be >= 0 
     674      WHERE( poa_i(1:npti,:)   < 0._wp )   poa_i(1:npti,:)   = 0._wp   ! oa_i must be >= 0 
     675      WHERE( pe_i (1:npti,:,:) < 0._wp )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
     676      WHERE( pe_s (1:npti,:,:) < 0._wp )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
     677      IF( ln_pnd_LEV ) THEN 
     678         WHERE( pa_ip(1:npti,:) < 0._wp )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
     679         WHERE( pv_ip(1:npti,:) < 0._wp )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     680         IF( ln_pnd_lids ) THEN 
     681            WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:)   = 0._wp   ! v_il must be >= 0 
     682         ENDIF 
    647683      ENDIF 
    648684      ! 
    … …  
    763799   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    764800   !!------------------------------------------------------------------- 
    765    SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    766       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     801   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     802      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    767803      !!------------------------------------------------------------------- 
    768804      !! ** Purpose :  converting 1-cat ice to 1 ice category 
    … …  
    770806      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    771807      REAL(wp), DIMENSION(:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    772       REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    773       REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     808      REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     809      REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    774810      !!------------------------------------------------------------------- 
    775811      ! == thickness and concentration == ! 
    … …  
    785821      pa_ip(:) = patip(:) 
    786822      ph_ip(:) = phtip(:) 
     823      ph_il(:) = phtil(:) 
    787824       
    788825   END SUBROUTINE ice_var_itd_1c1c 
    789826 
    790    SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    791       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     827   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     828      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    792829      !!------------------------------------------------------------------- 
    793830      !! ** Purpose :  converting N-cat ice to 1 ice category 
    … …  
    795832      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    796833      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    797       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    798       REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     834      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     835      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    799836      ! 
    800837      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
    … …  
    831868      ! == ponds == ! 
    832869      pa_ip(:) = SUM( patip(:,:), dim=2 ) 
    833       WHERE( pa_ip(:) /= 0._wp )   ;   ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
    834       ELSEWHERE                    ;   ph_ip(:) = 0._wp 
     870      WHERE( pa_ip(:) /= 0._wp ) 
     871         ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     872         ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     873      ELSEWHERE 
     874         ph_ip(:) = 0._wp 
     875         ph_il(:) = 0._wp 
    835876      END WHERE 
    836877      ! 
    … …  
    839880   END SUBROUTINE ice_var_itd_Nc1c 
    840881    
    841    SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    842       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     882   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     883      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    843884      !!------------------------------------------------------------------- 
    844885      !! 
    … …  
    862903      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    863904      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    864       REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    865       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     905      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     906      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    866907      ! 
    867908      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra, z1_hti 
    … …  
    953994         pt_su(:,jl) = ptmsu(:) 
    954995         ps_i (:,jl) = psmi (:) 
    955          ps_i (:,jl) = psmi (:)          
    956996      END DO 
    957997      ! 
    … …  
    9741014         END WHERE 
    9751015      END DO 
     1016      ! keep the same v_il/v_i ratio for each category 
     1017      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     1018      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     1019      END WHERE 
     1020      DO jl = 1, jpl 
     1021         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1022         ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1023         END WHERE 
     1024      END DO 
    9761025      DEALLOCATE( zfra ) 
    9771026      ! 
    9781027   END SUBROUTINE ice_var_itd_1cMc 
    9791028 
    980    SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    981       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     1029   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     1030      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    9821031      !!------------------------------------------------------------------- 
    9831032      !! 
    … …  
    9941043      !! 
    9951044      !!               2) Expand the filling to the cat jlmin-1 and jlmax+1 
    996        !!                   by removing 25% ice area from jlmin and jlmax (resp.)  
     1045      !!                   by removing 25% ice area from jlmin and jlmax (resp.)  
    9971046      !!               
    9981047      !!               3) Expand the filling to the empty cat between jlmin and jlmax  
    … …  
    10101059      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    10111060      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    1012       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    1013       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     1061      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     1062      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il    ! output ice/snow temp & sal & ponds 
    10141063      ! 
    10151064      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
    … …  
    10401089         pa_ip(:,:) = patip(:,:) 
    10411090         ph_ip(:,:) = phtip(:,:) 
     1091         ph_il(:,:) = phtil(:,:) 
    10421092         !                              ! ---------------------- ! 
    10431093      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    … …  
    10451095         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
    10461096            &                    ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
    1047             &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 
    1048             &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:)  ) 
     1097            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 
     1098            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:)  ) 
    10491099         !                              ! ---------------------- ! 
    10501100      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    … …  
    10521102         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
    10531103            &                    ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
    1054             &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 
    1055             &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1)  ) 
     1104            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 
     1105            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1)  ) 
    10561106         !                              ! ----------------------- ! 
    10571107      ELSE                              ! input cat /= output cat ! 
    … …  
    11951245            END WHERE 
    11961246         END DO 
     1247         ! keep the same v_il/v_i ratio for each category 
     1248         WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 
     1249            zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 
     1250         ELSEWHERE 
     1251            zfra(:) = 0._wp 
     1252         END WHERE 
     1253         DO jl = 1, jpl 
     1254            WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1255            ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1256            END WHERE 
     1257         END DO 
    11971258         DEALLOCATE( zfra ) 
    11981259         ! 
    … …  
    12001261      ! 
    12011262   END SUBROUTINE ice_var_itd_NcMc 
     1263 
     1264   !!------------------------------------------------------------------- 
     1265   !! INTERFACE ice_var_snwfra 
     1266   !! 
     1267   !! ** Purpose :  fraction of ice covered by snow 
     1268   !! 
     1269   !! ** Method  :  In absence of proper snow model on top of sea ice, 
     1270   !!               we argue that snow does not cover the whole ice because 
     1271   !!               of wind blowing... 
     1272   !!                 
     1273   !! ** Arguments : ph_s: snow thickness 
     1274   !!                 
     1275   !! ** Output    : pa_s_fra: fraction of ice covered by snow 
     1276   !! 
     1277   !!------------------------------------------------------------------- 
     1278   SUBROUTINE ice_var_snwfra_3d( ph_s, pa_s_fra ) 
     1279      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ph_s        ! snow thickness 
     1280      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pa_s_fra    ! ice fraction covered by snow 
     1281      IF    ( nn_snwfra == 0 ) THEN   ! basic 0 or 1 snow cover 
     1282         WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 
     1283         ELSEWHERE             ; pa_s_fra = 0._wp 
     1284         END WHERE 
     1285      ELSEIF( nn_snwfra == 1 ) THEN   ! snow cover depends on hsnow (met-office style) 
     1286         pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 
     1287      ELSEIF( nn_snwfra == 2 ) THEN   ! snow cover depends on hsnow (cice style) 
     1288         pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 
     1289      ENDIF 
     1290   END SUBROUTINE ice_var_snwfra_3d 
     1291 
     1292   SUBROUTINE ice_var_snwfra_2d( ph_s, pa_s_fra ) 
     1293      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   ph_s        ! snow thickness 
     1294      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pa_s_fra    ! ice fraction covered by snow 
     1295      IF    ( nn_snwfra == 0 ) THEN   ! basic 0 or 1 snow cover 
     1296         WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 
     1297         ELSEWHERE             ; pa_s_fra = 0._wp 
     1298         END WHERE 
     1299      ELSEIF( nn_snwfra == 1 ) THEN   ! snow cover depends on hsnow (met-office style) 
     1300         pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 
     1301      ELSEIF( nn_snwfra == 2 ) THEN   ! snow cover depends on hsnow (cice style) 
     1302         pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 
     1303      ENDIF 
     1304   END SUBROUTINE ice_var_snwfra_2d 
     1305 
     1306   SUBROUTINE ice_var_snwfra_1d( ph_s, pa_s_fra ) 
     1307      REAL(wp), DIMENSION(:), INTENT(in   ) ::   ph_s        ! snow thickness 
     1308      REAL(wp), DIMENSION(:), INTENT(  out) ::   pa_s_fra    ! ice fraction covered by snow 
     1309      IF    ( nn_snwfra == 0 ) THEN   ! basic 0 or 1 snow cover 
     1310         WHERE( ph_s > 0._wp ) ; pa_s_fra = 1._wp 
     1311         ELSEWHERE             ; pa_s_fra = 0._wp 
     1312         END WHERE 
     1313      ELSEIF( nn_snwfra == 1 ) THEN   ! snow cover depends on hsnow (met-office style) 
     1314         pa_s_fra = 1._wp - EXP( -0.2_wp * rhos * ph_s ) 
     1315      ELSEIF( nn_snwfra == 2 ) THEN   ! snow cover depends on hsnow (cice style) 
     1316         pa_s_fra = ph_s / ( ph_s + 0.02_wp ) 
     1317      ENDIF 
     1318   END SUBROUTINE ice_var_snwfra_1d 
     1319    
     1320   !!-------------------------------------------------------------------------- 
     1321   !! INTERFACE ice_var_snwblow 
     1322   !! 
     1323   !! ** Purpose :   Compute distribution of precip over the ice 
     1324   !! 
     1325   !!                Snow accumulation in one thermodynamic time step 
     1326   !!                snowfall is partitionned between leads and ice. 
     1327   !!                If snow fall was uniform, a fraction (1-at_i) would fall into leads 
     1328   !!                but because of the winds, more snow falls on leads than on sea ice 
     1329   !!                and a greater fraction (1-at_i)^beta of the total mass of snow  
     1330   !!                (beta < 1) falls in leads. 
     1331   !!                In reality, beta depends on wind speed,  
     1332   !!                and should decrease with increasing wind speed but here, it is  
     1333   !!                considered as a constant. an average value is 0.66 
     1334   !!-------------------------------------------------------------------------- 
     1335!!gm  I think it can be usefull to set this as a FUNCTION, not a SUBROUTINE.... 
     1336   SUBROUTINE ice_var_snwblow_2d( pin, pout ) 
     1337      REAL(wp), DIMENSION(:,:), INTENT(in   ) :: pin   ! previous fraction lead ( 1. - a_i_b ) 
     1338      REAL(wp), DIMENSION(:,:), INTENT(inout) :: pout 
     1339      pout = ( 1._wp - ( pin )**rn_snwblow ) 
     1340   END SUBROUTINE ice_var_snwblow_2d 
     1341 
     1342   SUBROUTINE ice_var_snwblow_1d( pin, pout ) 
     1343      REAL(wp), DIMENSION(:), INTENT(in   ) :: pin 
     1344      REAL(wp), DIMENSION(:), INTENT(inout) :: pout 
     1345      pout = ( 1._wp - ( pin )**rn_snwblow ) 
     1346   END SUBROUTINE ice_var_snwblow_1d 
    12021347 
    12031348#else 

  • NEMO/branches/2020/dev_12905_xios_restart/src/ICE/icewri.F90

    r12489 r13727  
    7171 
    7272      ! tresholds for outputs 
    73       DO_2D_11_11 
     73      DO_2D( 1, 1, 1, 1 ) 
    7474         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    7575         zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less 
    … …  
    7878      END_2D 
    7979      DO jl = 1, jpl 
    80          DO_2D_11_11 
     80         DO_2D( 1, 1, 1, 1 ) 
    8181            zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    8282            zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) 
    … …  
    114114      IF( iom_use('icehpnd' ) )   CALL iom_put( 'icehpnd', hm_ip  * zmsk00      )                                           ! melt pond depth 
    115115      IF( iom_use('icevpnd' ) )   CALL iom_put( 'icevpnd', vt_ip  * zmsk00      )                                           ! melt pond total volume per unit area 
     116      IF( iom_use('icehlid' ) )   CALL iom_put( 'icehlid', hm_il  * zmsk00      )                                           ! melt pond lid depth 
     117      IF( iom_use('icevlid' ) )   CALL iom_put( 'icevlid', vt_il  * zmsk00      )                                           ! melt pond lid total volume per unit area 
    116118      ! salt 
    117119      IF( iom_use('icesalt' ) )   CALL iom_put( 'icesalt', sm_i                 * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity 
    … …  
    130132      ! 
    131133      IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity 
    132          DO_2D_00_00 
     134         DO_2D( 0, 0, 0, 0 ) 
    133135            z2da  = u_ice(ji,jj) + u_ice(ji-1,jj) 
    134136            z2db  = v_ice(ji,jj) + v_ice(ji,jj-1) 
    135137            z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 
    136138         END_2D 
    137          CALL lbc_lnk( 'icewri', z2d, 'T', 1. ) 
     139         CALL lbc_lnk( 'icewri', z2d, 'T', 1.0_wp ) 
    138140         CALL iom_put( 'icevel', z2d ) 
    139141 
    … …  
    158160      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    159161      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories 
    160       IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 
     162      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 
     163      IF( iom_use('icehlid_cat' ) )   CALL iom_put( 'icehlid_cat' ,   h_il         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 
    161164      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
     165      IF( iom_use('iceaepnd_cat') )   CALL iom_put( 'iceaepnd_cat',   a_ip_eff     * zmsk00l                                   ) ! melt pond effective frac for categories 
    162166      IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 
    163167 
    … …  
    173177      IF( iom_use('dmisum') )   CALL iom_put( 'dmisum', - wfx_sum                                                             ) ! Sea-ice mass change through surface melting 
    174178      IF( iom_use('dmibom') )   CALL iom_put( 'dmibom', - wfx_bom                                                             ) ! Sea-ice mass change through bottom melting 
     179      IF( iom_use('dmilam') )   CALL iom_put( 'dmilam', - wfx_lam                                                             ) ! Sea-ice mass change through lateral melting 
    175180      IF( iom_use('dmtsub') )   CALL iom_put( 'dmtsub', - wfx_sub                                                             ) ! Sea-ice mass change through evaporation and sublimation 
    176181      IF( iom_use('dmssub') )   CALL iom_put( 'dmssub', - wfx_snw_sub                                                         ) ! Snow mass change through sublimation 
Note: See TracChangeset for help on using the changeset viewer.