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

Changeset 12720


Ignore:
Timestamp:
2020-04-08T18:54:44+02:00 (5 years ago)
Author:
clem
Message:

implementation of ice pond lids (before debugging)

Location:
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl
Files:
27 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/cfgs/SHARED/field_def_nemo-ice.xml

    r12337 r12720  
    4949          <field id="icehpnd"      long_name="melt pond depth"                                         standard_name="sea_ice_meltpond_depth"                    unit="m" />  
    5050          <field id="icevpnd"      long_name="melt pond volume"                                        standard_name="sea_ice_meltpond_volume"                   unit="m" />  
     51          <field id="icehlid"      long_name="melt pond lid depth"                                     standard_name="sea_ice_meltpondlid_depth"                 unit="m" />  
     52          <field id="icevlid"      long_name="melt pond lid volume"                                    standard_name="sea_ice_meltpondlid_volume"                unit="m" />  
    5153      
    5254     <!-- heat --> 
    … …  
    287289          <field id="iceapnd_cat"  long_name="Ice melt pond concentration per category"          unit=""        />  
    288290          <field id="icehpnd_cat"  long_name="Ice melt pond thickness per category"              unit="m"       detect_missing_value="true" />  
     291          <field id="icehlid_cat"  long_name="Ice melt pond lid thickness per category"          unit="m"       detect_missing_value="true" />  
    289292          <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category"               unit=""        />  
     293          <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category"     unit=""        />  
    290294          <field id="icemask_cat"  long_name="Fraction of time step with sea ice (per category)" unit=""        /> 
    291295          <field id="iceage_cat"   long_name="Ice age per category"                              unit="days"    detect_missing_value="true" /> 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/cfgs/SHARED/namelist_ice_ref

    r12121 r12720  
    176176!------------------------------------------------------------------------------ 
    177177   ln_pnd           = .false.         !  activate melt ponds or not 
    178      ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Holland et al 2012) 
     178     ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 
     179       ln_pnd_lids  = .true.          !  ponds with frozen lids 
     180       ln_pnd_flush = .true.          !  ponds flushing trhu the ice   
     181       rn_apnd_min  =   0.15          !  minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 
     182       rn_apnd_max  =   0.85          !  maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 
    179183     ln_pnd_CST     = .false.         !  activate constant  melt ponds 
    180184       rn_apnd      =   0.2           !     prescribed pond fraction, at Tsu=0 degC 
    … …  
    206210   rn_hpd_ini_n     =   0.05          !  initial pond depth          (m), North 
    207211   rn_hpd_ini_s     =   0.05          !        "            "             South 
     212   rn_hld_ini_n     =   0.0           !  initial pond lid depth      (m), North 
     213   rn_hld_ini_s     =   0.0           !        "            "             South 
    208214   ! -- for ln_iceini_file = T 
    209215   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    … …  
    217223   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    218224   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     225   sn_hld = 'NOT USED'              , -12 ,'hld'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    219226   cn_dir='./' 
    220227/ 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/cfgs/SHARED/namelist_ref

    r12288 r12720  
    643643   bn_aip      = 'NOT USED'              ,         24.       , 'siapnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    644644   bn_hip      = 'NOT USED'              ,         24.       , 'sihpnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
     645   bn_hil      = 'NOT USED'              ,         24.       , 'sihlid'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    645646   ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 
    646647   rn_ice_tem  = 270.         !  arbitrary temperature               of incoming sea ice 
    … …  
    649650   rn_ice_apnd = 0.2          !       --   pond fraction = a_ip/a_i            -- 
    650651   rn_ice_hpnd = 0.05         !       --   pond depth                          -- 
     652   rn_ice_hlid = 0.0          !       --   pond lid depth                      -- 
    651653/ 
    652654!----------------------------------------------------------------------- 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/doc/namelists/nambdy_dta

    r11703 r12720  
    2929   bn_aip      = 'NOT USED'              ,         24.       , 'siapnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    3030   bn_hip      = 'NOT USED'              ,         24.       , 'sihpnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
     31   bn_hil      = 'NOT USED'              ,         24.       , 'sihlid'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    3132   ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 
    3233   rn_ice_tem  = 270.         !  arbitrary temperature               of incoming sea ice 
    … …  
    3536   rn_ice_apnd = 0.2          !       --   pond fraction = a_ip/a_i            -- 
    3637   rn_ice_hpnd = 0.05         !       --   pond depth                          -- 
     38   rn_ice_hlid = 0.0          !       --   pond lid depth                      -- 
    3739/ 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/doc/namelists/namini

    r11703 r12720  
    2323   rn_hpd_ini_n     =   0.05          !  initial pond depth          (m), North 
    2424   rn_hpd_ini_s     =   0.05          !        "            "             South 
     25   rn_hld_ini_n     =   0.0           !  initial pond lid depth      (m), North 
     26   rn_hld_ini_s     =   0.0           !        "            "             South 
    2527   ! -- for ln_iceini_file = T 
    2628   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    … …  
    3436   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    3537   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     38   sn_hld = 'NOT USED'              , -12 ,'hld'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    3639   cn_dir='./' 
    3740/ 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/doc/namelists/namthd_pnd

    r11536 r12720  
    33!------------------------------------------------------------------------------ 
    44   ln_pnd           = .false.         !  activate melt ponds or not 
    5      ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Holland et al 2012) 
     5     ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 
     6       ln_pnd_lids  = .true.          !  ponds with frozen lids 
     7       ln_pnd_flush = .true.          !  ponds flushing trhu the ice   
     8       rn_apnd_min  =   0.15          !  minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 
     9       rn_apnd_max  =   0.85          !  maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 
    610     ln_pnd_CST     = .false.         !  activate constant  melt ponds 
    711       rn_apnd      =   0.2           !     prescribed pond fraction, at Tsu=0 degC 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/ice.F90

    r11627 r12720  
    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 
    … …  
    190194   !                                     !!** ice-ponds namelist (namthd_pnd) 
    191195   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    192    LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012 
     196   LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 
     197   LOGICAL,  PUBLIC ::   ln_pnd_lids      !: Allow ponds to have frozen lids 
     198   LOGICAL,  PUBLIC ::   ln_pnd_flush     !: Allow ponds to flush thru the ice 
     199   REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum ice fraction that contributes to melt ponds 
     200   REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum ice fraction that contributes to melt ponds 
    193201   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    194202   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    … …  
    331339   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area      [m] 
    332340   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond fraction (a_ip/a_i) 
     341   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_eff   !: melt pond effective fraction (not covered up by lid) (a_ip/a_i) 
    333342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond depth                          [m] 
     343   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_il       !: melt pond lid volume                     [m] 
     344   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_il       !: melt pond lid thickness                  [m] 
    334345 
    335346   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond concentration 
    336347   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_ip      !: mean melt pond depth                     [m] 
    337348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per gridcell area [m] 
     349   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hm_il      !: mean melt pond lid depth                     [m] 
     350   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_il      !: total melt pond lid volume per gridcell area [m] 
    338351 
    339352   !!---------------------------------------------------------------------- 
    … …  
    448461 
    449462      ii = ii + 1 
    450       ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    451  
    452       ii = ii + 1 
    453       ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
     463      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl),  & 
     464         &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 
     465 
     466      ii = ii + 1 
     467      ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) ) 
    454468 
    455469      ! * Old values of global variables 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/ice1d.F90

    r10786 r12720  
    124124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oa_i_1d       !: 
    125125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_1d        !: 
    126    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: ice ponds 
    127127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !: 
    128128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ip_1d       !: 
    129129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_frac_1d  !: 
     130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_eff_1d   !: 
     131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_il_1d       !: Ice pond lid 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_il_1d       !: 
    130133 
    131134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d      !: corresponding to the 2D var  t_s 
    … …  
    157160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ip_2d 
    158161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_ip_2d  
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_il_2d  
    159163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_su_2d  
    160164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_2d 
    … …  
    208212         &      dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm  (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) ,  &     
    209213         &      dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , s_i_1d  (jpij) , s_i_new (jpij) ,  & 
    210          &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) ,                   & 
    211          &      h_ip_1d (jpij) , a_ip_frac_1d(jpij) ,                                                   & 
     214         &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) , v_il_1d (jpij) , h_il_1d(jpij) , & 
     215         &      h_ip_1d (jpij) , a_ip_frac_1d(jpij) , a_ip_eff_1d(jpij) ,                               & 
    212216         &      sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d    (jpij) , STAT=ierr(ii) ) 
    213217      ! 
    … …  
    226230      ALLOCATE( a_i_2d (jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d (jpij,jpl) , h_ib_2d(jpij,jpl) ,  & 
    227231         &      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) ,                      & 
     232         &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , v_il_2d(jpij,jpl) ,  & 
    229233         &      STAT=ierr(ii) ) 
    230234 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icealb.F90

    r11536 r12720  
    9696      LOGICAL , INTENT(in   )                   ::   ld_pnd_alb   !  effect of melt ponds on albedo 
    9797      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pafrac_pnd   !  melt pond relative fraction (per unit ice area) 
     98                                                                  !  This is the effective fraction not covered up by a pond lid 
    9899      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_pnd       !  melt pond depth 
    99100      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_cs      !  albedo of ice under clear    sky 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icedyn.F90

    r11536 r12720  
    9999      WHERE( a_ip(:,:,:) >= epsi20 ) 
    100100         h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 
     101         h_il(:,:,:) = v_il(:,:,:) / a_ip(:,:,:) 
    101102      ELSEWHERE 
    102103         h_ip(:,:,:) = 0._wp 
     104         h_il(:,:,:) = 0._wp 
    103105      END WHERE 
    104106      ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icedyn_adv.F90

    r12197 r12720  
    8484         !                             !-----------------------! 
    8585         CALL ice_dyn_adv_umx( nn_UMx, kt, u_ice, v_ice, h_i, h_s, h_ip, & 
    86             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     86            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 
    8787         !                             !-----------------------! 
    8888      CASE( np_advPRA )                ! PRATHER scheme        ! 
    8989         !                             !-----------------------! 
    9090         CALL ice_dyn_adv_pra(         kt, u_ice, v_ice, h_i, h_s, h_ip, & 
    91             &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 
     91            &                          ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, v_il, e_s, e_i ) 
    9292      END SELECT 
    9393 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icedyn_adv_pra.F90

    r12197 r12720  
    4444   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxap , syap , sxxap , syyap , sxyap    ! melt pond fraction 
    4545   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvp , syvp , sxxvp , syyvp , sxyvp    ! melt pond volume 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxvl , syvl , sxxvl , syyvl , sxyvl    ! melt pond lid volume 
    4647 
    4748   !! * Substitutions 
    … …  
    5556 
    5657   SUBROUTINE ice_dyn_adv_pra(         kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip,  & 
    57       &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     58      &                        pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    5859      !!---------------------------------------------------------------------- 
    5960      !!                **  routine ice_dyn_adv_pra  ** 
    … …  
    8182      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    8283      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     84      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il     ! melt pond lid thickness 
    8385      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    8486      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    8587      ! 
    86       INTEGER  ::   ji,jj, jk, jl, jt       ! dummy loop indices 
     88      INTEGER  ::   ji, jj, jk, jl, jt      ! dummy loop indices 
    8789      INTEGER  ::   icycle                  ! number of sub-timestep for the advection 
    8890      REAL(wp) ::   zdt                     !   -      - 
    … …  
    9395      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   zarea 
    9496      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi 
    95       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp 
     97      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp, z0vl 
    9698      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   z0es 
    9799      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   z0ei 
    … …  
    159161            END DO 
    160162            IF ( ln_pnd_H12 ) THEN 
    161                z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction 
    162                z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume 
     163               z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond fraction 
     164               z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond volume 
     165               z0vl(:,:,jl) = pv_il(:,:,jl) * e1e2t(:,:)      ! Melt pond lid volume 
    163166            ENDIF 
    164167         END DO 
    … …  
    196199               CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    197200               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )  
     201               CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )    !--- melt pond lid volume 
     202               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
    198203            ENDIF 
    199204            !                                                               !--------------------------------------------! 
    … …  
    227232               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    228233               CALL adv_x( zdt , zudy , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
    229             ENDIF 
     234               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 
     235               CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )    !--- melt pond lid volume  
     236           ENDIF 
    230237            ! 
    231238         ENDIF 
    … …  
    247254               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    248255               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     256               pv_il(:,:,jl) = z0vl(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    249257            ENDIF 
    250258         END DO 
    … …  
    263271         !     Remove negative values (conservation is ensured) 
    264272         !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    265          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 ) 
     273         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 ) 
    266274         ! 
    267275         ! --- Make sure ice thickness is not too big --- ! 
    … …  
    756764         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   & 
    757765         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   & 
    758          &      sxap(jpi,jpj,jpl)  , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
    759          &      sxvp(jpi,jpj,jpl)  , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     766         &      sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
     767         &      sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     768         &      sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) ,   & 
    760769         ! 
    761770         &      sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & 
    … …  
    864873               CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 
    865874               CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 
     875               !                                                     ! melt pond lid volume 
     876               CALL iom_get( numrir, jpdom_autoglo, 'sxvl' , sxvl  ) 
     877               CALL iom_get( numrir, jpdom_autoglo, 'syvl' , syvl  ) 
     878               CALL iom_get( numrir, jpdom_autoglo, 'sxxvl', sxxvl ) 
     879               CALL iom_get( numrir, jpdom_autoglo, 'syyvl', syyvl ) 
     880               CALL iom_get( numrir, jpdom_autoglo, 'sxyvl', sxyvl ) 
    866881            ENDIF 
    867882            ! 
    … …  
    880895               sxap  = 0._wp   ;   syap  = 0._wp   ;   sxxap  = 0._wp   ;   syyap  = 0._wp   ;   sxyap  = 0._wp   ! melt pond fraction 
    881896               sxvp  = 0._wp   ;   syvp  = 0._wp   ;   sxxvp  = 0._wp   ;   syyvp  = 0._wp   ;   sxyvp  = 0._wp   ! melt pond volume 
     897               sxvl  = 0._wp   ;   syvl  = 0._wp   ;   sxxvl  = 0._wp   ;   syyvl  = 0._wp   ;   sxyvl  = 0._wp   ! melt pond lid volume 
    882898            ENDIF 
    883899         ENDIF 
    … …  
    954970            CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 
    955971            CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 
     972            !                                                        ! melt pond lid volume 
     973            CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl  ) 
     974            CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl  ) 
     975            CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) 
     976            CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) 
     977            CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) 
    956978         ENDIF 
    957979         ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icedyn_adv_umx.F90

    r12197 r12720  
    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 
    … …  
    334335            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
    335336               &                                      zhvar, pv_ip, zua_ups, zva_ups ) 
     337            ! lid 
     338            zamsk = 0._wp 
     339            zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) 
     340            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
     341               &                                      zhvar, pv_il, zua_ups, zva_ups )             
    336342         ENDIF 
    337343         ! 
    … …  
    350356         ! Remove negative values (conservation is ensured) 
    351357         !    (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    352          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 ) 
     358         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 ) 
    353359         ! 
    354360         ! --- Make sure ice thickness is not too big --- ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icedyn_rdgrft.F90

    r11732 r12720  
    494494      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    495495      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 
     496      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
     497      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
    498498      ! 
    499499      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
    … …  
    569569                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
    570570                  vprdg (ji) = v_ip_2d(ji,jl1) * afrdg 
     571                  vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 
    571572                  aprft1     = a_ip_2d(ji,jl1) * afrft 
    572573                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 
    573574                  vprft (ji) = v_ip_2d(ji,jl1) * afrft 
     575                  vlrft (ji) = v_il_2d(ji,jl1) * afrft 
    574576               ENDIF 
    575577 
    … …  
    601603                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    602604                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
     605                  v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 
    603606               ENDIF 
    604607            ENDIF 
    … …  
    697700                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &  
    698701                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   ) 
     702                     v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + (   vlrdg (ji) * rn_fpndrdg * fvol   (ji)   & 
     703                        &                                   + vlrft (ji) * rn_fpndrft * zswitch(ji)   ) 
    699704                  ENDIF 
    700705                   
    … …  
    727732      !---------------- 
    728733      ! 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 ) 
     734      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 ) 
    730735      ! 
    731736   END SUBROUTINE rdgrft_shift 
    … …  
    839844         CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    840845         CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     846         CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    841847         DO jl = 1, jpl 
    842848            DO jk = 1, nlay_s 
    … …  
    865871         CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    866872         CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     873         CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    867874         DO jl = 1, jpl 
    868875            DO jk = 1, nlay_s 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/iceistate.F90

    r12398 r12720  
    4545   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 
    4646   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 
     47   REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n, rn_hld_ini_n 
     48   REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s, rn_hld_ini_s 
    4949   ! 
    5050   !                              ! if ln_iceini_file = T 
    51    INTEGER , PARAMETER ::   jpfldi = 9           ! maximum number of files to read 
     51   INTEGER , PARAMETER ::   jpfldi = 10          ! maximum number of files to read 
    5252   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness    (m) 
    5353   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snw thickness    (m) 
    … …  
    5959   INTEGER , PARAMETER ::   jp_apd = 8           ! index of pnd fraction     (-) 
    6060   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
     61   INTEGER , PARAMETER ::   jp_hld = 10          ! index of pnd lid depth    (m) 
    6162   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6263   !    
    … …  
    9899      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, ztm_s_ini            !data from namelist or nc file 
    99100      REAL(wp), DIMENSION(jpi,jpj)     ::   zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    100       REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini                       !data from namelist or nc file 
     101      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini, zhlid_ini            !data from namelist or nc file 
    101102      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
    102103      !! 
    103       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
     104      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d 
    104105      !-------------------------------------------------------------------- 
    105106 
    … …  
    155156      a_ip     (:,:,:) = 0._wp 
    156157      v_ip     (:,:,:) = 0._wp 
     158      v_il     (:,:,:) = 0._wp 
    157159      a_ip_frac(:,:,:) = 0._wp 
     160      a_ip_eff (:,:,:) = 0._wp 
    158161      h_ip     (:,:,:) = 0._wp 
     162      h_il     (:,:,:) = 0._wp 
    159163      ! 
    160164      ! ice velocities 
    … …  
    216220               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
    217221            ! 
     222            ! pond lid depth 
     223            IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) & 
     224               &     si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zswitch + rn_hld_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     225            ! 
    218226            zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 
    219227            ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 
    … …  
    222230            zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 
    223231            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 
     232            zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) 
    224233            ! 
    225234            ! change the switch for the following 
    … …  
    246255               zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    247256               zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     257               zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 
    248258            ELSEWHERE 
    249259               zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
    … …  
    256266               zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    257267               zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
     268               zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:) 
    258269            END WHERE 
    259270            ! 
    … …  
    264275            zapnd_ini(:,:) = 0._wp 
    265276            zhpnd_ini(:,:) = 0._wp 
     277            zhlid_ini(:,:) = 0._wp 
    266278         ENDIF 
    267279          
    … …  
    290302         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
    291303         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
     304         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini ) 
    292305 
    293306         ! allocate temporary arrays 
    294          ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
    295             &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
     307         ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & 
     308            &      zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), & 
     309            &      zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) ) 
    296310          
    297311         ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
    298          CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
    299             &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
    300             &              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), & 
    301             &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
     312         CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                  & 
     313            &              zhi_2d          , zhs_2d          , zai_2d         ,                  & 
     314            &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti),                  & 
     315            &              s_i_1d(1:npti)  , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), & 
     316            &              zti_2d          , zts_2d          , ztsu_2d        ,                  & 
     317            &              zsi_2d          , zaip_2d         , zhip_2d        , zhil_2d ) 
    302318 
    303319         ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
    … …  
    315331         CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
    316332         CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
     333         CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d  , h_il   ) 
    317334 
    318335         ! deallocate temporary arrays 
    319336         DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    320             &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     337            &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) 
    321338 
    322339         ! calculate extensive and intensive variables 
    … …  
    365382            a_ip_frac(:,:,:) = 0._wp 
    366383         END WHERE 
     384         a_ip_eff(:,:,:) = a_ip_frac(:,:,:) 
    367385         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     386         v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    368387           
    369388         ! specific temperatures for coupled runs 
    … …  
    466485      ! 
    467486      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
    468       TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd 
     487      TYPE(FLD_N)                    ::   sn_hti, sn_hts, sn_ati, sn_smi, sn_tmi, sn_tsu, sn_tms, sn_apd, sn_hpd, sn_hld 
    469488      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    470489      ! 
    … …  
    473492         &             rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 
    474493         &             rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 
    475          &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 
    476          &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, cn_dir 
     494         &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, rn_hld_ini_n, rn_hld_ini_s, & 
     495         &             sn_hti, sn_hts, sn_ati, sn_tsu, sn_tmi, sn_smi, sn_tms, sn_apd, sn_hpd, sn_hld, cn_dir 
    477496      !!----------------------------------------------------------------------------- 
    478497      ! 
    … …  
    488507      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_smi) = sn_smi 
    489508      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_tsu) = sn_tsu   ;   slf_i(jp_tms) = sn_tms 
    490       slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd 
     509      slf_i(jp_apd) = sn_apd  ;  slf_i(jp_hpd) = sn_hpd   ;   slf_i(jp_hld) = sn_hld 
    491510      ! 
    492511      IF(lwp) THEN                          ! control print 
    … …  
    508527            WRITE(numout,*) '      initial pnd fraction  in the north-south         rn_apd_ini     = ', rn_apd_ini_n,rn_apd_ini_s 
    509528            WRITE(numout,*) '      initial pnd depth     in the north-south         rn_hpd_ini     = ', rn_hpd_ini_n,rn_hpd_ini_s 
     529            WRITE(numout,*) '      initial pnd lid depth in the north-south         rn_hld_ini     = ', rn_hld_ini_n,rn_hld_ini_s 
    510530         ENDIF 
    511531      ENDIF 
    … …  
    532552         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
    533553         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
    534          CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 when no ponds' ) 
     554         rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 
     555         CALL ctl_warn( 'rn_apd_ini & rn_hpd_ini = 0 & rn_hld_ini = 0 when no ponds' ) 
    535556      ENDIF 
    536557      ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/iceitd.F90

    r11732 r12720  
    410410      CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    411411      CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     412      CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    412413      CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    413414      DO jl = 1, jpl 
    … …  
    482483                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    483484                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
     485                  !                                               
     486                  ztrans          = v_il_2d(ji,jl1) * zworka(ji)     ! Pond lid volume 
     487                  v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 
     488                  v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 
    484489               ENDIF 
    485490               ! 
    … …  
    526531      ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 
    527532      !       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 ) 
     533      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 ) 
    529534 
    530535      ! at_i must be <= rn_amax 
    … …  
    554559      CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    555560      CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     561      CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    556562      CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    557563      DO jl = 1, jpl 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icerst.F90

    r11536 r12720  
    132132      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip  ) 
    133133      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip  ) 
     134      CALL iom_rstput( iter, nitrst, numriw, 'v_il' , v_il  ) 
    134135      ! Snow enthalpy 
    135136      DO jk = 1, nlay_s  
    … …  
    171172      INTEGER           ::   jk 
    172173      LOGICAL           ::   llok 
    173       INTEGER           ::   id0, id1, id2, id3, id4   ! local integer 
     174      INTEGER           ::   id0, id1, id2, id3, id4, id5   ! local integer 
    174175      CHARACTER(len=25) ::   znam 
    175176      CHARACTER(len=2)  ::   zchar, zchar1 
    … …  
    250251            v_ip(:,:,:) = 0._wp 
    251252         ENDIF 
     253         a_ip_eff(:,:,:) = a_ip(:,:,:) 
     254         ! melt pond lids 
     255         id5 = iom_varid( numrir, 'v_il' , ldstop = .FALSE. ) 
     256         IF( id5 > 0 ) THEN 
     257            CALL iom_get( numrir, jpdom_autoglo, 'v_il', v_il) 
     258         ELSE 
     259            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds lids output then set it to zero' 
     260            v_il(:,:,:) = 0._wp 
     261         ENDIF 
    252262         ! fields needed for Met Office (Jules) coupling 
    253263         IF( ln_cpl ) THEN 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icesbc.F90

    r11575 r12720  
    132132 
    133133      ! --- cloud-sky and overcast-sky ice albedos --- ! 
    134       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) 
     134      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, zalb_cs, zalb_os ) 
    135135 
    136136      ! albedo depends on cloud fraction because of non-linear spectral effects 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icethd.F90

    r11536 r12720  
    355355         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    356356         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     357         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_eff_1d (1:npti), a_ip_eff (:,:,kl) ) 
     358         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    357359         ! 
    358360         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
    … …  
    441443         sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 
    442444         v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 
     445         v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 
    443446         oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 
    444447          
    … …  
    461464         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    462465         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     466         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_eff_1d (1:npti), a_ip_eff (:,:,kl) ) 
     467         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    463468         ! 
    464469         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
    … …  
    515520         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    516521         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
     522         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    517523         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
    518524         ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icethd_pnd.F90

    r11536 r12720  
    8989         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    9090            a_ip_frac_1d(ji) = rn_apnd 
     91            a_ip_eff_1d(ji)  = rn_apnd 
    9192            h_ip_1d(ji)      = rn_hpnd     
    9293            a_ip_1d(ji)      = a_ip_frac_1d(ji) * a_i_1d(ji) 
     94            h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
    9395         ELSE 
    9496            a_ip_frac_1d(ji) = 0._wp 
     97            a_ip_eff_1d(ji)  = 0._wp 
    9598            h_ip_1d(ji)      = 0._wp     
    9699            a_ip_1d(ji)      = 0._wp 
     100            h_il_1d(ji)      = 0._wp 
    97101         ENDIF 
    98102         ! 
    … …  
    106110      !!                ***  ROUTINE pnd_H12  *** 
    107111      !! 
    108       !! ** Purpose    : Compute melt pond evolution 
    109       !! 
    110       !! ** Method     : Empirical method. A fraction of meltwater is accumulated in ponds  
    111       !!                 and sent to ocean when surface is freezing 
    112       !! 
    113       !!                 pond growth:      Vp = Vp + dVmelt 
    114       !!                    with dVmelt = R/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
    115       !!                 pond contraction: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp) 
    116       !!                    with Tp = -2degC 
    117       !!   
    118       !! ** Tunable parameters : (no real expertise yet, ideas?) 
     112      !! ** Purpose : Compute melt pond evolution 
     113      !! 
     114      !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 
     115      !!              We  work with volumes and then redistribute changes into thickness and concentration 
     116      !!              assuming linear relationship between the two.  
     117      !! 
     118      !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 --- 
     119      !!                                     dVmelt = (1-r)/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
     120      !!                                        dh_i  = meltwater from ice surface melt 
     121      !!                                        dh_s  = meltwater from snow melt 
     122      !!                                        (1-r) = fraction of melt water that is not flushed 
     123      !! 
     124      !!              - limtations:       a_ip must not exceed (1-r)*a_i 
     125      !!                                  h_ip must not exceed 0.5*h_i 
     126      !! 
     127      !!              - pond shrinking: 
     128      !!                       if lids:   Vp = Vp -dH * a_ip 
     129      !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 --- 
     130      !! 
     131      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H  
     132      !!                                                                      H = lid thickness 
     133      !!                                                                      Lf = latent heat of fusion 
     134      !!                                                                      Tp = -2C 
     135      !! 
     136      !!                                                                And solved implicitely as: 
     137      !!                                                                   H(t+dt)**2 -H(t) * H(t+dt) -ki * (Tp-Tsu) * dt / (rhoi*Lf) = 0 
     138      !! 
     139      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 --- 
     140      !! 
     141      !!              - Overflow:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 --- 
     142      !!                                     perm = permability of sea-ice 
     143      !!                                     visc = water viscosity 
     144      !!                                     Hp   = height of top of the pond above sea-level 
     145      !!                                     Hi   = ice thickness thru which there is flushing 
     146      !! 
     147      !! 
     148      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness 
     149      !! 
     150      !!              - effective pond area: to be used for albedo  
     151      !! 
     152      !!              - pond thickness and area is retrieved from pond volume assuming a linear relationship between h_ip and a_ip: 
     153      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect 
     154      !! 
     155      !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 
    119156      !!  
    120       !! ** Note       : Stolen from CICE for quick test of the melt pond 
    121       !!                 radiation and freshwater interfaces 
    122       !!                 Coupling can be radiative AND freshwater 
    123       !!                 Advection, ridging, rafting are called 
    124       !! 
    125       !! ** References : Holland, M. M. et al (J Clim 2012) 
    126       !!------------------------------------------------------------------- 
    127       REAL(wp), PARAMETER ::   zrmin       = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding 
    128       REAL(wp), PARAMETER ::   zrmax       = 0.70_wp  ! maximum     -           -         -         -            - 
    129       REAL(wp), PARAMETER ::   zpnd_aspect = 0.8_wp   ! pond aspect ratio 
    130       REAL(wp), PARAMETER ::   zTp         = -2._wp   ! reference temperature 
    131       ! 
    132       REAL(wp) ::   zfr_mlt          ! fraction of available meltwater retained for melt ponding 
    133       REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding 
    134       REAL(wp) ::   z1_Tp            ! inverse reference temperature 
    135       REAL(wp) ::   z1_rhow          ! inverse freshwater density 
    136       REAL(wp) ::   z1_zpnd_aspect   ! inverse pond aspect ratio 
    137       REAL(wp) ::   zfac, zdum 
    138       ! 
    139       INTEGER  ::   ji   ! loop indices 
    140       !!------------------------------------------------------------------- 
    141       z1_rhow        = 1._wp / rhow  
    142       z1_zpnd_aspect = 1._wp / zpnd_aspect 
    143       z1_Tp          = 1._wp / zTp  
     157      !! ** Note       :   mostly stolen from CICE 
     158      !! 
     159      !! ** References :   Flocco and Feltham (JGR, 2007) 
     160      !!                   Flocco et al       (JGR, 2010) 
     161      !!                   Holland et al      (J. Clim, 2012) 
     162      !!------------------------------------------------------------------- 
     163      REAL(wp), DIMENSION(nlay_i) ::   zperm          ! Permeability of sea ice 
     164      !! 
     165      REAL(wp), PARAMETER ::   zaspect =  0.8_wp      ! pond aspect ratio 
     166      REAL(wp), PARAMETER ::   zTp     = -2._wp       ! reference temperature 
     167      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity 
     168      REAL(wp), PARAMETER ::   zhl_max =  0.015_wp    ! pond lid thickness above which the ponds disappear from the albedo calculation 
     169      REAL(wp), PARAMETER ::   zhl_min =  0.005_wp    ! pond lid thickness below which the full pond area is used in the albedo calculation 
     170      !! 
     171      REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding 
     172      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes 
     173      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh 
     174      REAL(wp) ::   v_ip_max                          ! max pond volume allowed 
     175      REAL(wp) ::   zdT                               ! zTp-t_su 
     176      REAL(wp) ::   zsbr                              ! Brine salinity 
     177      REAL(wp) ::   zfac, zdum                        ! temporary arrays 
     178      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse 
     179      !! 
     180      INTEGER  ::   ji, jk                            ! loop indices 
     181      !!------------------------------------------------------------------- 
     182      z1_rhow   = 1._wp / rhow  
     183      z1_aspect = 1._wp / zaspect 
     184      z1_Tp     = 1._wp / zTp  
    144185 
    145186      DO ji = 1, npti 
    146          !                                                        !--------------------------------! 
    147          IF( h_i_1d(ji) < rn_himin) THEN                          ! Case ice thickness < rn_himin ! 
    148             !                                                     !--------------------------------! 
    149             !--- Remove ponds on thin ice 
     187         !                                                            !----------------------------------------------------! 
     188         IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction ! 
     189            !                                                         !----------------------------------------------------! 
     190            !--- Remove ponds on thin ice or tiny ice fractions 
    150191            a_ip_1d(ji)      = 0._wp 
    151192            a_ip_frac_1d(ji) = 0._wp 
    152193            h_ip_1d(ji)      = 0._wp 
    153             !                                                     !--------------------------------! 
    154          ELSE                                                     ! Case ice thickness >= rn_himin ! 
    155             !                                                     !--------------------------------! 
    156             v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! record pond volume at previous time step 
    157             ! 
    158             ! available meltwater for melt ponding [m, >0] and fraction 
    159             zdv_mlt = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
    160             zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  ! from CICE doc 
    161             !zfr_mlt = zrmin + zrmax * a_i_1d(ji)             ! from Holland paper  
    162             ! 
    163             !--- Pond gowth ---! 
    164             ! v_ip should never be negative, otherwise code crashes 
    165             v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt ) 
    166             ! 
    167             ! melt pond mass flux (<0) 
     194            h_il_1d(ji)      = 0._wp 
     195            ! 
     196            ! clem: problem with conservation or not ? 
     197            !                                                         !--------------------------------! 
     198         ELSE                                                         ! Case ice thickness >= rn_himin ! 
     199            !                                                         !--------------------------------! 
     200            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     201            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     202            ! 
     203            !------------------! 
     204            ! case ice melting ! 
     205            !------------------! 
     206            ! 
     207            !--- available meltwater for melt ponding ---! 
     208            zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
     209            zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) in H12 = fraction of melt water that is not flushed 
     210            zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors?  
     211            ! 
     212            !--- overflow ---! 
     213            ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
     214            !    a_ip_max = zfr_mlt * a_i 
     215            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     216            v_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
     217            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, v_ip_max - v_ip_1d(ji) ) ) 
     218 
     219            ! If pond depth exceeds half the ice thickness then reduce the pond volume 
     220            !    h_ip_max = 0.5 * h_i 
     221            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     222            v_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
     223            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, v_ip_max - v_ip_1d(ji) ) ) 
     224             
     225            !--- Pond growing ---! 
     226            v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
     227            ! 
     228            !--- Lid melting ---! 
     229            IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
     230            ! 
     231            !--- mass flux ---! 
    168232            IF( zdv_mlt > 0._wp ) THEN 
    169                zfac = zfr_mlt * zdv_mlt * rhow * r1_rdtice 
     233               zfac = zdv_mlt * rhow * r1_rdtice                        ! melt pond mass flux < 0 [kg.m-2.s-1] 
    170234               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    171235               ! 
    172                ! adjust ice/snow melting flux to balance melt pond flux (>0) 
    173                zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) 
     236               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux 
    174237               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 
    175238               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    176239            ENDIF 
     240 
     241            !-------------------! 
     242            ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
     243            !-------------------! 
     244            ! 
     245            zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
    177246            ! 
    178247            !--- Pond contraction (due to refreezing) ---! 
    179             v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp ) 
    180             ! 
    181             ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac 
    182             !    h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i 
    183             a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_zpnd_aspect * a_i_1d(ji) ) 
     248            IF( ln_pnd_lids ) THEN 
     249               ! 
     250               !--- Lid growing and subsequent pond shrinking ---!  
     251               zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
     252                  &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
     253                
     254               ! Lid growing 
     255               v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 
     256                
     257               ! Pond shrinking 
     258               v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 
     259 
     260            ELSE 
     261               ! Pond shrinking 
     262               v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 
     263            ENDIF 
     264            ! 
     265            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     266            ! v_ip     = h_ip * a_ip 
     267            ! 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) 
     268            a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) 
    184269            a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 
    185             h_ip_1d(ji)      = zpnd_aspect * a_ip_frac_1d(ji) 
     270            h_ip_1d(ji)      = zaspect * a_ip_frac_1d(ji) 
     271 
     272            !---------------!             
     273            ! Pond flushing ! 
     274            !---------------! 
     275            IF( ln_pnd_flush ) THEN 
     276               ! height of top of the pond above sea-level 
     277               zhp = ( h_i_1d(ji) * ( rau0 - rhoi ) + h_ip_1d(ji) * ( rau0 - rhow * a_ip_frac_1d(ji) ) ) * r1_rau0 
     278 
     279               ! Calculate the permeability of the ice (Assur 1958) 
     280               DO jk = 1, nlay_i 
     281                  zsbr = - 1.2_wp                                  & 
     282                     &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
     283                     &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
     284                     &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 ! clem: error here the factor was 0.01878 instead of 0.0178 (cf Flocco 2010) 
     285                  zperm(jk) = MAX( 0._wp, 3.e-08_wp * (sz_i_1d(ji,jk) / zsbr)**3 ) 
     286               END DO 
     287 
     288               ! Do the drainage using Darcy's law 
     289               zdv_flush   = -MINVAL(zperm(:)) * rau0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 
     290               zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) 
     291               v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
     292                
     293               !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     294               a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) 
     295               a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji) 
     296               h_ip_1d(ji)      = zaspect * a_ip_frac_1d(ji) 
     297 
     298            ENDIF 
     299 
     300            !--- Corrections and lid thickness ---! 
     301            IF( ln_pnd_lids ) THEN 
     302               !--- remove ponds if lids are much larger than ponds ---! 
     303               IF ( v_il_1d(ji) > v_ip_1d(ji) * 10._wp ) THEN 
     304                  a_ip_1d(ji)      = 0._wp 
     305                  a_ip_frac_1d(ji) = 0._wp 
     306                  h_ip_1d(ji)      = 0._wp 
     307                  v_il_1d(ji)      = 0._wp 
     308               ENDIF 
     309               !--- retrieve lid thickness from volume ---! 
     310               IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
     311               ELSE                              ;   h_il_1d(ji) = 0._wp ; 
     312               ENDIF 
     313            ENDIF 
    186314            ! 
    187315         ENDIF 
     316          
    188317      END DO 
     318 
     319      !-------------------------------------------------!             
     320      ! How much melt pond is exposed to the atmosphere ! 
     321      !-------------------------------------------------!             
     322      ! Calculate the melt pond effective area (used for albedo) 
     323      WHERE    ( h_il_1d(1:npti) <= zhl_min )   ;   a_ip_eff_1d(1:npti) = a_ip_frac_1d(1:npti)       ! lid is very thin.  Expose all the pond 
     324      ELSEWHERE( h_il_1d(1:npti) >= zhl_max )   ;   a_ip_eff_1d(1:npti) = 0._wp                      ! lid is very thick. Cover all the pond up with ice and snow 
     325      ELSEWHERE                                 ;   a_ip_eff_1d(1:npti) = a_ip_frac_1d(1:npti) * &   ! lid is in between. Expose part of the pond 
     326         &                                                                ( h_il_1d(1:npti) - zhl_min ) / ( zhl_max - zhl_min ) 
     327      END WHERE 
    189328      ! 
    190329   END SUBROUTINE pnd_H12 
    … …  
    205344      INTEGER  ::   ios, ioptio   ! Local integer 
    206345      !! 
    207       NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
     346      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_lids, ln_pnd_flush, rn_apnd_min, rn_apnd_max, & 
     347         &                          ln_pnd_CST, rn_apnd, rn_hpnd, & 
     348         &                          ln_pnd_alb 
    208349      !!------------------------------------------------------------------- 
    209350      ! 
    … …  
    221362         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    222363         WRITE(numout,*) '   Namelist namicethd_pnd:' 
    223          WRITE(numout,*) '      Melt ponds activated or not                                     ln_pnd     = ', ln_pnd 
    224          WRITE(numout,*) '         Evolutive  melt pond fraction and depth (Holland et al 2012) ln_pnd_H12 = ', ln_pnd_H12 
    225          WRITE(numout,*) '         Prescribed melt pond fraction and depth                      ln_pnd_CST = ', ln_pnd_CST 
    226          WRITE(numout,*) '            Prescribed pond fraction                                  rn_apnd    = ', rn_apnd 
    227          WRITE(numout,*) '            Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd 
    228          WRITE(numout,*) '         Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb 
     364         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd 
     365         WRITE(numout,*) '         Evolutive  melt pond fraction and depth                  ln_pnd_H12   = ', ln_pnd_H12 
     366         WRITE(numout,*) '            Melt ponds can have frozen lids                       ln_pnd_lids  = ', ln_pnd_lids 
     367         WRITE(numout,*) '            Allow ponds to flush thru the ice                     ln_pnd_flush = ', ln_pnd_flush 
     368         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min 
     369         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max 
     370         WRITE(numout,*) '         Prescribed melt pond fraction and depth                  ln_pnd_CST   = ', ln_pnd_CST 
     371         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd 
     372         WRITE(numout,*) '            Prescribed pond depth                                 rn_hpnd      = ', rn_hpnd 
     373         WRITE(numout,*) '         Melt ponds affect albedo or not                          ln_pnd_alb   = ', ln_pnd_alb 
    229374      ENDIF 
    230375      ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/iceupdate.F90

    r11536 r12720  
    185185      ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 
    186186      !------------------------------------------------------------------ 
    187       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 
     187      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    188188      ! 
    189189      alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icevar.F90

    r11732 r12720  
    113113      at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 
    114114      vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) 
     115      vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 
    115116      ! 
    116117      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
    … …  
    161162         ! 
    162163         !                           ! mean melt pond depth 
    163          WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:) 
    164          ELSEWHERE                      ;   hm_ip(:,:) = 0._wp 
     164         WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:)   ;   hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 
     165         ELSEWHERE                      ;   hm_ip(:,:) = 0._wp                     ;   hm_il(:,:) = 0._wp 
    165166         END WHERE          
    166167         ! 
    … …  
    221222      WHERE( a_ip_frac(:,:,:) > epsi20 )   ;   h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 
    222223      ELSEWHERE                            ;   h_ip(:,:,:) = 0._wp 
     224      END WHERE 
     225      !                                           !--- pond lid thickness       
     226      WHERE( a_ip_frac(:,:,:) > epsi20 )   ;   h_il(:,:,:) = v_il(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 
     227      ELSEWHERE                            ;   h_il(:,:,:) = 0._wp 
    223228      END WHERE 
    224229      ! 
    … …  
    289294      sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 
    290295      v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     296      v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    291297      ! 
    292298   END SUBROUTINE ice_var_eqv2glo 
    … …  
    533539               a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
    534540               v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
     541               v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 
    535542               ! 
    536543            END DO 
    … …  
    555562 
    556563 
    557    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 ) 
     564   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 ) 
    558565      !!------------------------------------------------------------------- 
    559566      !!                   ***  ROUTINE ice_var_zapneg *** 
    … …  
    570577      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    571578      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     579      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    572580      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    573581      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    636644      WHERE( pa_ip (:,:,:) < 0._wp )   pa_ip (:,:,:) = 0._wp 
    637645      WHERE( pv_ip (:,:,:) < 0._wp )   pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 
    638       !                                                        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 
    639647      ! 
    640648   END SUBROUTINE ice_var_zapneg 
    641649 
    642650 
    643    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 ) 
    644652      !!------------------------------------------------------------------- 
    645653      !!                   ***  ROUTINE ice_var_roundoff *** 
    … …  
    654662      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    655663      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     664      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    656665      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    657666      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    668677         WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    669678         WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     679         WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 )    pv_il(1:npti,:)   = 0._wp   ! v_il must be >= 0 
    670680      ENDIF 
    671681      ! 
    … …  
    786796   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    787797   !!------------------------------------------------------------------- 
    788    SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    789       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     798   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     799      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    790800      !!------------------------------------------------------------------- 
    791801      !! ** Purpose :  converting 1-cat ice to 1 ice category 
    … …  
    793803      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    794804      REAL(wp), DIMENSION(:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    795       REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    796       REAL(wp), DIMENSION(:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     805      REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     806      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 
    797807      !!------------------------------------------------------------------- 
    798808      ! == thickness and concentration == ! 
    … …  
    808818      pa_ip(:) = patip(:) 
    809819      ph_ip(:) = phtip(:) 
     820      ph_il(:) = phtil(:) 
    810821       
    811822   END SUBROUTINE ice_var_itd_1c1c 
    812823 
    813    SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    814       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     824   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     825      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    815826      !!------------------------------------------------------------------- 
    816827      !! ** Purpose :  converting N-cat ice to 1 ice category 
    … …  
    818829      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    819830      REAL(wp), DIMENSION(:)  , INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    820       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    821       REAL(wp), DIMENSION(:)  , INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     831      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     832      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 
    822833      ! 
    823834      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
    … …  
    854865      ! == ponds == ! 
    855866      pa_ip(:) = SUM( patip(:,:), dim=2 ) 
    856       WHERE( pa_ip(:) /= 0._wp )   ;   ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
    857       ELSEWHERE                    ;   ph_ip(:) = 0._wp 
     867      WHERE( pa_ip(:) /= 0._wp ) 
     868         ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     869         ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     870      ELSEWHERE 
     871         ph_ip(:) = 0._wp 
     872         ph_il(:) = 0._wp 
    858873      END WHERE 
    859874      ! 
    … …  
    862877   END SUBROUTINE ice_var_itd_Nc1c 
    863878    
    864    SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    865       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     879   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     880      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    866881      !!------------------------------------------------------------------- 
    867882      !! 
    … …  
    885900      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    886901      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    887       REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    888       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     902      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     903      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 
    889904      ! 
    890905      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra, z1_hti 
    … …  
    9971012         END WHERE 
    9981013      END DO 
     1014      ! keep the same v_il/v_i ratio for each category 
     1015      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     1016      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     1017      END WHERE 
     1018      DO jl = 1, jpl 
     1019         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1020         ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1021         END WHERE 
     1022      END DO 
    9991023      DEALLOCATE( zfra ) 
    10001024      ! 
    10011025   END SUBROUTINE ice_var_itd_1cMc 
    10021026 
    1003    SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                       ph_i, ph_s, pa_i, & 
    1004       &                         ptmi, ptms, ptmsu, psmi, patip, phtip,   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip ) 
     1027   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     1028      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    10051029      !!------------------------------------------------------------------- 
    10061030      !! 
    … …  
    10331057      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    10341058      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   ph_i, ph_s, pa_i    ! output ice/snow variables 
    1035       REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip    ! input  ice/snow temp & sal & ponds 
    1036       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip    ! output ice/snow temp & sal & ponds 
     1059      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     1060      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 
    10371061      ! 
    10381062      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
    … …  
    10631087         pa_ip(:,:) = patip(:,:) 
    10641088         ph_ip(:,:) = phtip(:,:) 
     1089         ph_il(:,:) = phtil(:,:) 
    10651090         !                              ! ---------------------- ! 
    10661091      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    … …  
    10681093         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
    10691094            &                    ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
    1070             &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), & 
    1071             &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:)  ) 
     1095            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 
     1096            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:)  ) 
    10721097         !                              ! ---------------------- ! 
    10731098      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    … …  
    10751100         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
    10761101            &                    ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
    1077             &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), & 
    1078             &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1)  ) 
     1102            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 
     1103            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1)  ) 
    10791104         !                              ! ----------------------- ! 
    10801105      ELSE                              ! input cat /= output cat ! 
    … …  
    12181243            END WHERE 
    12191244         END DO 
     1245         ! keep the same v_il/v_i ratio for each category 
     1246         WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 
     1247            zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 
     1248         ELSEWHERE 
     1249            zfra(:) = 0._wp 
     1250         END WHERE 
     1251         DO jl = 1, jpl 
     1252            WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1253            ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1254            END WHERE 
     1255         END DO 
    12201256         DEALLOCATE( zfra ) 
    12211257         ! 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icewri.F90

    r11575 r12720  
    116116      IF( iom_use('icehpnd' ) )   CALL iom_put( 'icehpnd', hm_ip  * zmsk00      )                                           ! melt pond depth 
    117117      IF( iom_use('icevpnd' ) )   CALL iom_put( 'icevpnd', vt_ip  * zmsk00      )                                           ! melt pond total volume per unit area 
     118      IF( iom_use('icehlid' ) )   CALL iom_put( 'icehlid', hm_il  * zmsk00      )                                           ! melt pond lid depth 
     119      IF( iom_use('icevlid' ) )   CALL iom_put( 'icevlid', vt_il  * zmsk00      )                                           ! melt pond lid total volume per unit area 
    118120      ! salt 
    119121      IF( iom_use('icesalt' ) )   CALL iom_put( 'icesalt', sm_i                 * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity 
    … …  
    162164      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    163165      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories 
    164       IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 
     166      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 
     167      IF( iom_use('icehlid_cat' ) )   CALL iom_put( 'icehlid_cat' ,   h_il         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 
    165168      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
     169      IF( iom_use('iceaepnd_cat') )   CALL iom_put( 'iceaepnd_cat',   a_ip_eff     * zmsk00l                                   ) ! melt pond effective frac for categories 
    166170      IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 
    167171 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/BDY/bdy_oce.F90

    r11536 r12720  
    6363      REAL(wp), POINTER, DIMENSION(:,:) ::  aip    !: now ice  pond concentration 
    6464      REAL(wp), POINTER, DIMENSION(:,:) ::  hip    !: now ice  pond depth 
     65      REAL(wp), POINTER, DIMENSION(:,:) ::  hil    !: now ice  pond lid depth 
    6566#if defined key_top 
    6667      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply 
    … …  
    115116   REAL(wp), DIMENSION(jp_bdy) ::   rice_apnd               !: pond conc.  of incoming sea ice 
    116117   REAL(wp), DIMENSION(jp_bdy) ::   rice_hpnd               !: pond thick. of incoming sea ice 
     118   REAL(wp), DIMENSION(jp_bdy) ::   rice_hlid               !: pond lid thick. of incoming sea ice 
    117119   ! 
    118120   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/BDY/bdydta.F90

    r12639 r12720  
    4343   PUBLIC   bdy_dta_init     ! routine called by nemogcm.F90 
    4444 
    45    INTEGER , PARAMETER ::   jpbdyfld  = 16    ! maximum number of files to read  
     45   INTEGER , PARAMETER ::   jpbdyfld  = 17    ! maximum number of files to read  
    4646   INTEGER , PARAMETER ::   jp_bdyssh = 1     !  
    4747   INTEGER , PARAMETER ::   jp_bdyu2d = 2     !  
    … …  
    6060   INTEGER , PARAMETER ::   jp_bdyaip = 15    !  
    6161   INTEGER , PARAMETER ::   jp_bdyhip = 16    !  
     62   INTEGER , PARAMETER ::   jp_bdyhil = 17    !  
    6263#if ! defined key_si3 
    6364   INTEGER , PARAMETER ::   jpl = 1 
    … …  
    189190                        dta_bdy(jbdy)%aip(ib,jl) =  a_ip(ii,ij,jl) * tmask(ii,ij,1)  
    190191                        dta_bdy(jbdy)%hip(ib,jl) =  h_ip(ii,ij,jl) * tmask(ii,ij,1)  
     192                        dta_bdy(jbdy)%hil(ib,jl) =  h_il(ii,ij,jl) * tmask(ii,ij,1)  
    191193                     END DO 
    192194                  END DO 
    … …  
    294296               &                                                                         bf_alias(jp_bdya_i)%fnow(:,1,:)     !   ( a_ip = rice_apnd * a_i ) 
    295297            IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 
     298            IF( TRIM(bf_alias(jp_bdyhil)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhil)%fnow(:,1,:) = rice_hlid(jbdy) 
    296299 
    297300            ! if T_i is read and not T_su, set T_su = T_i 
    … …  
    318321               bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 
    319322               bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 
     323               bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 
    320324            ENDIF 
    321325             
    … …  
    323327            ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)             
    324328            IF( ipl /= jpl ) THEN      ! ice: convert N-cat fields (input) into jpl-cat (output) 
    325                CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 
    326                   &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & 
    327                   &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 
    328                   &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 
    329                   &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), & 
    330                   &              dta_alias%t_i                  , dta_alias%t_s                  , & 
    331                   &              dta_alias%tsu                  , dta_alias%s_i                  , & 
    332                   &              dta_alias%aip                  , dta_alias%hip ) 
     329               CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & ! in 
     330                  &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & ! out 
     331                  &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), &                                  ! in (optional) 
     332                  &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), &                                  ! in     - 
     333                  &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), bf_alias(jp_bdyhil)%fnow(:,1,:), & ! in     - 
     334                  &              dta_alias%t_i                  , dta_alias%t_s                  , &                                  ! out    - 
     335                  &              dta_alias%tsu                  , dta_alias%s_i                  , &                                  ! out    - 
     336                  &              dta_alias%aip                  , dta_alias%hip                  , dta_alias%hil )                    ! out    - 
    333337            ENDIF 
    334338         ENDIF 
    … …  
    377381      !                                                         ! =F => baroclinic velocities in 3D boundary data 
    378382      LOGICAL                                ::   ln_zinterp    ! =T => requires a vertical interpolation of the bdydta 
    379       REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd  
     383      REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 
    380384      INTEGER                                ::   ipk,ipl       ! 
    381385      INTEGER                                ::   idvar         ! variable ID 
    … …  
    389393      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
    390394      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    391       TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip        
     395      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil        
    392396      TYPE(FLD_N), DIMENSION(:), POINTER ::   bn_alias                        ! must be an array to be used with fld_fill 
    393397      TYPE(FLD  ), DIMENSION(:), POINTER ::   bf_alias 
    394398      ! 
    395399      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
    396       NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip 
    397       NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 
     400      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil 
     401      NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 
    398402      NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp 
    399403      !!--------------------------------------------------------------------------- 
    … …  
    452456#if defined key_si3 
    453457         IF( .NOT.ln_pnd ) THEN 
    454             rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 
    455             CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 
     458            rn_ice_apnd = 0. ; rn_ice_hpnd = 0. ; rn_ice_hlid = 0. 
     459            CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 & rn_ice_hlid = 0 when no ponds' ) 
    456460         ENDIF 
    457461#endif 
    … …  
    463467         rice_apnd(jbdy) = rn_ice_apnd 
    464468         rice_hpnd(jbdy) = rn_ice_hpnd 
    465           
     469         rice_hlid(jbdy) = rn_ice_hlid 
     470 
    466471          
    467472         DO jfld = 1, jpbdyfld 
    … …  
    562567            IF(  jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 
    563568               & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 
    564                & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip     ) THEN 
     569               & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip .OR. jfld == jp_bdyhil ) THEN 
    565570               igrd = 1                                                    ! T point 
    566571               ipk = ipl                                                   ! jpl-cat data 
    … …  
    613618               bf_alias => bf(jp_bdyhip,jbdy:jbdy)                         ! alias for hip structure of bdy number jbdy 
    614619               bn_alias => bn_hip                                          ! alias for hip structure of nambdy_dta  
     620            ENDIF 
     621            IF( jfld == jp_bdyhil ) THEN 
     622               cl3 = 'hil' 
     623               bf_alias => bf(jp_bdyhil,jbdy:jbdy)                         ! alias for hil structure of bdy number jbdy 
     624               bn_alias => bn_hil                                          ! alias for hil structure of nambdy_dta  
    615625            ENDIF 
    616626 
    … …  
    682692                  ENDIF 
    683693               ENDIF 
     694               IF( jfld == jp_bdyhil ) THEN 
     695                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%hil => bf_alias(1)%fnow(:,1,:) 
     696                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%hil(iszdim,jpl) ) 
     697                  ENDIF 
     698               ENDIF 
    684699            ENDIF 
    685700 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/BDY/bdyice.F90

    r12520 r12720  
    9494         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    9595            ! exchange 3d arrays 
    96             CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. & 
    97                  &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. & 
    98                  &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                & 
    99                  &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      ) 
     96            CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1.                 & 
     97               &                        , s_i , 'T', 1., t_su, 'T', 1., v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1. & 
     98               &                        , a_ip, 'T', 1., v_ip, 'T', 1., v_il, 'T', 1.                                & 
     99               &                        , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    100100            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
    101101            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    … …  
    163163            a_ip(ji,jj,  jl) = ( a_ip(ji,jj,  jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond concentration 
    164164            h_ip(ji,jj,  jl) = ( h_ip(ji,jj,  jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond depth 
     165            h_il(ji,jj,  jl) = ( h_il(ji,jj,  jl) * zwgt1 + dta%hil(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice  pond lid depth 
    165166            ! 
    166167            sz_i(ji,jj,:,jl) = s_i(ji,jj,jl) 
    … …  
    170171               a_ip(ji,jj,jl) = 0._wp 
    171172               h_ip(ji,jj,jl) = 0._wp 
     173               h_il(ji,jj,jl) = 0._wp 
    172174            ENDIF 
    173175            ! 
    … …  
    231233               a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) 
    232234               h_ip(ji,jj,  jl) = h_ip(ib,jb,  jl) 
     235               h_il(ji,jj,  jl) = h_il(ib,jb,  jl) 
    233236               ! 
    234237               sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) 
    … …  
    274277               ENDIF 
    275278               v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 
     279               v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) 
    276280               ! 
    277281            ELSE   ! no ice at the boundary 
    … …  
    281285               h_s (ji,jj,  jl) = 0._wp 
    282286               oa_i(ji,jj,  jl) = 0._wp 
    283                a_ip(ji,jj,  jl) = 0._wp 
    284                v_ip(ji,jj,  jl) = 0._wp 
    285287               t_su(ji,jj,  jl) = rt0 
    286288               t_s (ji,jj,:,jl) = rt0 
    … …  
    288290 
    289291               a_ip_frac(ji,jj,jl) = 0._wp 
     292               a_ip     (ji,jj,jl) = 0._wp 
    290293               h_ip     (ji,jj,jl) = 0._wp 
    291                a_ip     (ji,jj,jl) = 0._wp 
    292                v_ip     (ji,jj,jl) = 0._wp 
     294               h_il     (ji,jj,jl) = 0._wp 
    293295                
    294296               IF( nn_icesal == 1 ) THEN     ! if constant salinity 
    … …  
    306308               e_s (ji,jj,:,jl) = 0._wp 
    307309               e_i (ji,jj,:,jl) = 0._wp 
     310               v_ip(ji,jj,  jl) = 0._wp 
     311               v_il(ji,jj,  jl) = 0._wp 
    308312 
    309313            ENDIF 

  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r11536 r12720  
    1515#endif 
    1616 
    17    SUBROUTINE ROUTINE_MULTI( cdname                                                                             & 
    18       &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   & 
    19       &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    20       &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
     17   SUBROUTINE ROUTINE_MULTI( cdname                                                                               & 
     18      &                    , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4   & 
     19      &                    , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8   & 
     20      &                    , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12  & 
     21      &                    , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  & 
    2122      &                    , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
    2223      !!--------------------------------------------------------------------- 
    23       CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
    24       ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) :: pt1     ! arrays on which the lbc is applied 
    25       ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , pt10  , pt11 
    26       CHARACTER(len=1)                     , INTENT(in   ) :: cdna1   ! nature of pt2D. array grid-points 
    27       CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 
    28       REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold 
    29       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 
    30       INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant) 
    31       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
    32       LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
    33       INTEGER            , OPTIONAL        , INTENT(in   ) :: ihlcom         ! number of ranks and rows to be communicated 
     24      CHARACTER(len=*)     ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine 
     25      ARRAY_TYPE(:,:,:,:)            , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied 
     26      ARRAY_TYPE(:,:,:,:)  , OPTIONAL, TARGET, INTENT(inout) ::   pt2   , pt3   , pt4   , pt5   , pt6   , pt7   , pt8   , pt9  , & 
     27         &                                                        pt10  , pt11  , pt12  , pt13  , pt14  , pt15  , pt16 
     28      CHARACTER(len=1)                       , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points 
     29      CHARACTER(len=1)     , OPTIONAL        , INTENT(in   ) ::   cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, & 
     30         &                                                        cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16 
     31      REAL(wp)                               , INTENT(in   ) ::   psgn1   ! sign used across the north fold 
     32      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, & 
     33         &                                                        psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16 
     34      INTEGER              , OPTIONAL        , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
     35      REAL(wp)             , OPTIONAL        , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
     36      LOGICAL, DIMENSION(4), OPTIONAL        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out 
     37      INTEGER              , OPTIONAL        , INTENT(in   ) ::   ihlcom         ! number of ranks and rows to be communicated 
    3438      !! 
    3539      INTEGER                          ::   kfld        ! number of elements that will be attributed 
    36       PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array 
    37       CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
    38       REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary 
     40      PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array 
     41      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
     42      REAL(wp)         , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary 
    3943      !!--------------------------------------------------------------------- 
    4044      ! 
    … …  
    5559      IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5660      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     61      IF( PRESENT(psgn12) )   CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     62      IF( PRESENT(psgn13) )   CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     63      IF( PRESENT(psgn14) )   CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     64      IF( PRESENT(psgn15) )   CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     65      IF( PRESENT(psgn16) )   CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5766      ! 
    58       CALL lbc_lnk_ptr    ( cdname,              ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     67      CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
    5968      ! 
    6069   END SUBROUTINE ROUTINE_MULTI 
Note: See TracChangeset for help on using the changeset viewer.