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 12937 for NEMO/branches/UKMO – NEMO

Changeset 12937 for NEMO/branches/UKMO


Ignore:
Timestamp:
2020-05-15T18:15:25+02:00 (4 years ago)
Author:
dancopsey
Message:

Merge in Clem's branch. It was originally here:

​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/UKMO/NEMO_4.0.1_dan_test_clems_branch

Location:
NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2
Files:
54 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/cfgs/SHARED/field_def_nemo-ice.xml

    r11575 r12937  
    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 --> 
    … …  
    171173          <field id="frq_m"    unit="-"    /> 
    172174 
     175          <!-- rheology convergence tests --> 
     176          <field id="uice_cvg"   long_name="sea ice velocity convergence"   standard_name="sea_ice_velocity_convergence"   unit="m/s" /> 
     177 
    173178     <!-- ================= --> 
    174179          <!-- Add-ons for SIMIP --> 
    … …  
    252257          <field id="iceapnd_cat"  long_name="Ice melt pond concentration per category"          unit=""        />  
    253258          <field id="icehpnd_cat"  long_name="Ice melt pond thickness per category"              unit="m"       detect_missing_value="true" />  
     259          <field id="icehlid_cat"  long_name="Ice melt pond lid thickness per category"          unit="m"       detect_missing_value="true" />  
    254260          <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category"               unit=""        />  
     261          <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category"     unit=""        />  
    255262          <field id="icemask_cat"  long_name="Fraction of time step with sea ice (per category)" unit=""        /> 
    256263          <field id="iceage_cat"   long_name="Ice age per category"                              unit="days"    detect_missing_value="true" /> 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/cfgs/SHARED/field_def_nemo-oce.xml

    r11536 r12937  
    2727        <field id="soce"         long_name="salinity"                            standard_name="sea_water_practical_salinity"      unit="1e-3"     grid_ref="grid_T_3D"/> 
    2828        <field id="soce_e3t"     long_name="salinity    (thickness weighted)"                                                      unit="1e-3"     grid_ref="grid_T_3D" > soce * e3t </field > 
     29 
     30   <!--- additions to diawri.F90 ---> 
     31        <field id="socegrad"    long_name="module of salinity gradient"              unit="psu/m"   grid_ref="grid_T_3D"/> 
     32        <field id="socegrad2"   long_name="square of module of salinity gradient"    unit="psu2/m2" grid_ref="grid_T_3D"/> 
     33        <field id="eken_int"    long_name="vertical integration of kinetic energy"   unit="m3/s2"   /> 
     34        <field id="relvor"      long_name="relative vorticity"                       unit="s-1"    grid_ref="grid_T_3D"/> 
     35        <field id="absvor"      long_name="absolute vorticity"                       unit="s-1"    grid_ref="grid_T_3D"/> 
     36        <field id="potvor"      long_name="potential vorticity"                      unit="s-1"    grid_ref="grid_T_3D"/> 
     37        <field id="salt2c"      long_name="Salt content vertically integrated"       unit="1e-3*kg/m2" /> 
    2938 
    3039        <!-- t-eddy viscosity coefficients (ldfdyn) --> 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/cfgs/SHARED/namelist_ice_ref

    r11649 r12937  
    9797      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    9898                                      !        advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
     99   ln_rhg_chkcvg    = .false.         !  check convergence of rheology (outputs: file ice_cvg.nc & variable uice_cvg) 
    99100/ 
    100101!------------------------------------------------------------------------------ 
    … …  
    126127   ln_icedO         = .true.          !  activate ice growth in open-water (T) or not (F) 
    127128   ln_icedS         = .true.          !  activate brine drainage (T) or not (F) 
     129   ! 
     130   ln_leadhfx       = .true.          !  heat in the leads is used to melt sea-ice before warming the ocean 
    128131/ 
    129132!------------------------------------------------------------------------------ 
    … …  
    176179!------------------------------------------------------------------------------ 
    177180   ln_pnd           = .false.         !  activate melt ponds or not 
    178      ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Holland et al 2012) 
     181     ln_pnd_H12     = .false.         !  activate evolutive melt ponds (from Flocco et al 2007,2010 & Holland et al 2012) 
     182       ln_pnd_lids  = .true.          !  ponds with frozen lids 
     183       ln_pnd_flush = .true.          !  ponds flushing trhu the ice   
     184       rn_apnd_min  =   0.15          !  minimum ice fraction that contributes to melt pond. range: 0.0 -- 0.15 ?? 
     185       rn_apnd_max  =   0.85          !  maximum ice fraction that contributes to melt pond. range: 0.7 -- 0.85 ?? 
    179186     ln_pnd_CST     = .false.         !  activate constant  melt ponds 
    180187       rn_apnd      =   0.2           !     prescribed pond fraction, at Tsu=0 degC 
    … …  
    186193!------------------------------------------------------------------------------ 
    187194   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    188    ln_iceini_file   = .false.         !  netcdf file provided for initialization (T) or not (F) 
     195   nn_iceini_file   =   0             !     0 = Initialise sea ice based on SSTs 
     196                                      !     1 = Initialise sea ice from single category netcdf file 
     197                                      !     2 = Initialise sea ice from multi category restart file 
    189198   rn_thres_sst     =   2.0           !  max temp. above Tfreeze with initial ice = (sst - tfreeze) 
    190199   rn_hti_ini_n     =   3.0           !  initial ice thickness       (m), North 
    … …  
    206215   rn_hpd_ini_n     =   0.05          !  initial pond depth          (m), North 
    207216   rn_hpd_ini_s     =   0.05          !        "            "             South 
    208    ! -- for ln_iceini_file = T 
     217   rn_hld_ini_n     =   0.0           !  initial pond lid depth      (m), North 
     218   rn_hld_ini_s     =   0.0           !        "            "             South 
     219   ! -- for nn_iceini_file = 1 
    209220   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    210221   sn_hts = 'Ice_initialization'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    … …  
    217228   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    218229   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     230   sn_hld = 'NOT USED'              , -12 ,'hld'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    219231   cn_dir='./' 
    220232/ 
    … …  
    238250   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F) 
    239251   ln_icectl        = .false.         !  ice points output for debug (T or F) 
    240    iiceprt          =  10             !  i-index for debug 
    241    jiceprt          =  10             !  j-index for debug 
    242 / 
     252      iiceprt       =  10             !     i-index for debug 
     253      jiceprt       =  10             !     j-index for debug 
     254/ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/cfgs/SHARED/namelist_ref

    r11715 r12937  
    281281   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    282282   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     283   sn_cc       = 'NOT USED'                   ,   24         , 'CC'      ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    283284   sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    284285/ 
    … …  
    286287&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    287288!----------------------------------------------------------------------- 
    288    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
    289    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models 
    290    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    291    nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
     289   nn_cplmodel       =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
     290   ln_usecplmask     = .false. !  use a coupling mask file to merge data received from several models 
     291   !                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     292   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     293   nn_cats_cpl       =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    292294 
    293295   !_____________!__________________________!____________!_____________!______________________!________! 
    … …  
    641643   bn_aip      = 'NOT USED'              ,         24.       , 'siapnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    642644   bn_hip      = 'NOT USED'              ,         24.       , 'sihpnd'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
     645   bn_hil      = 'NOT USED'              ,         24.       , 'sihlid'  ,    .true.   , .false.,  'daily'  ,    ''            ,   ''     ,     '' 
    643646   ! if bn_t_i etc are "not used", then define arbitrary temperatures and salinity and ponds 
    644647   rn_ice_tem  = 270.         !  arbitrary temperature               of incoming sea ice 
    … …  
    647650   rn_ice_apnd = 0.2          !       --   pond fraction = a_ip/a_i            -- 
    648651   rn_ice_hpnd = 0.05         !       --   pond depth                          -- 
     652   rn_ice_hlid = 0.0          !       --   pond lid depth                      -- 
    649653/ 
    650654!----------------------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/nambdy_dta

    r11699 r12937  
    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/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namdia

    r11699 r12937  
    88   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F) 
    99   ln_icectl        = .false.         !  ice points output for debug (T or F) 
    10    iiceprt          =  10             !  i-index for debug 
    11    jiceprt          =  10             !  j-index for debug 
     10      iiceprt       =  10             !     i-index for debug 
     11      jiceprt       =  10             !     j-index for debug 
    1212/ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namdyn_rhg

    r11025 r12937  
    99      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    1010                                      !        advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
     11   ln_rhg_chkcvg    = .false.         !  check convergence of rheology (outputs: file ice_cvg.nc & variable uice_cvg) 
    1112/ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namini

    r11699 r12937  
    33!------------------------------------------------------------------------------ 
    44   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    5    ln_iceini_file   = .false.         !  netcdf file provided for initialization (T) or not (F) 
     5   nn_iceini_file   =   0             !     0 = Initialise sea ice based on SSTs 
     6                                      !     1 = Initialise sea ice from single category netcdf file 
     7                                      !     2 = Initialise sea ice from multi category restart file 
    68   rn_thres_sst     =   2.0           !  max temp. above Tfreeze with initial ice = (sst - tfreeze) 
    79   rn_hti_ini_n     =   3.0           !  initial ice thickness       (m), North 
    … …  
    2325   rn_hpd_ini_n     =   0.05          !  initial pond depth          (m), North 
    2426   rn_hpd_ini_s     =   0.05          !        "            "             South 
    25    ! -- for ln_iceini_file = T 
     27   rn_hld_ini_n     =   0.0           !  initial pond lid depth      (m), North 
     28   rn_hld_ini_s     =   0.0           !        "            "             South 
     29   ! -- for nn_iceini_file = 1 
    2630   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    2731   sn_hts = 'Ice_initialization'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    … …  
    3438   sn_apd = 'NOT USED'              , -12 ,'apd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    3539   sn_hpd = 'NOT USED'              , -12 ,'hpd'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     40   sn_hld = 'NOT USED'              , -12 ,'hld'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
    3641   cn_dir='./' 
    3742/ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namsbc_blk

    r11699 r12937  
    3131   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3232   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     33   sn_cc       = 'NOT USED'                   ,   24         , 'CC'      ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3334   sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3435/ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namsbc_cpl

    r10075 r12937  
    22&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    33!----------------------------------------------------------------------- 
    4    nn_cplmodel   =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
    5    ln_usecplmask = .false. !  use a coupling mask file to merge data received from several models 
    6    !                       !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    7    nn_cats_cpl   =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    8  
     4   nn_cplmodel       =     1   !  Maximum number of models to/from which NEMO is potentially sending/receiving data 
     5   ln_usecplmask     = .false. !  use a coupling mask file to merge data received from several models 
     6   !                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     7   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
     8   nn_cats_cpl       =     5   !  Number of sea ice categories over which coupling is to be carried out (if not 1) 
    99   !_____________!__________________________!____________!_____________!______________________!________! 
    1010   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namthd

    r11025 r12937  
    66   ln_icedO         = .true.          !  activate ice growth in open-water (T) or not (F) 
    77   ln_icedS         = .true.          !  activate brine drainage (T) or not (F) 
     8   !                                    
     9   ln_leadhfx       = .true.          !  heat in the leads is used to melt sea-ice before warming the ocean 
    810/ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/doc/namelists/namthd_pnd

    r11536 r12937  
    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/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/ice.F90

    r11715 r12937  
    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 
    … …  
    151155   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
    152156   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     157   LOGICAL , PUBLIC ::   ln_rhg_chkcvg    !: check ice rheology convergence  
    153158   ! 
    154159   !                                     !!** ice-advection namelist (namdyn_adv) ** 
    … …  
    190195   !                                     !!** ice-ponds namelist (namthd_pnd) 
    191196   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    192    LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al 2012 
     197   LOGICAL , PUBLIC ::   ln_pnd_H12       !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 
     198   LOGICAL,  PUBLIC ::   ln_pnd_lids      !: Allow ponds to have frozen lids 
     199   LOGICAL,  PUBLIC ::   ln_pnd_flush     !: Allow ponds to flush thru the ice 
     200   REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum ice fraction that contributes to melt ponds 
     201   REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum ice fraction that contributes to melt ponds 
    193202   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    194203   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    … …  
    271280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                             [W.m-2] 
    272281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping => must be 0   [W.m-2] 
    274282   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_atm_oi   !: heat flux at the interface atm-[oce+ice]            [W.m-2] 
    275283   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_oce_ai   !: heat flux at the interface oce-[atm+ice]            [W.m-2] 
    … …  
    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   !!---------------------------------------------------------------------- 
    340353   !! * Old values of global variables 
    341354   !!---------------------------------------------------------------------- 
    342    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b, h_ip_b    !: snow and ice volumes/thickness 
    343    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b, oa_i_b                 !: 
    344    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                                 !: snow heat content 
    345    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                                 !: ice temperatures 
    346    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b                      !: ice velocity 
    347    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                                !: ice concentration (total) 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b     !: snow and ice volumes/thickness 
     356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b                  !: 
     357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                          !: snow heat content 
     358   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                          !: ice temperatures 
     359   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b               !: ice velocity 
     360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                         !: ice concentration (total) 
    348361             
    349362   !!---------------------------------------------------------------------- 
    … …  
    386399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qcn_ice_top   !: Surface conduction flux (W/m2) 
    387400 
     401   !!---------------------------------------------------------------------- 
     402   !! * Only for atmospheric coupling 
     403   !!---------------------------------------------------------------------- 
     404   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i_last_couple !: Ice fractional area at last coupling time 
    388405   ! 
    389406   !!---------------------------------------------------------------------- 
    … …  
    400417      INTEGER :: ice_alloc 
    401418      ! 
    402       INTEGER :: ierr(16), ii 
     419      INTEGER :: ierr(17), ii 
    403420      !!----------------------------------------------------------------- 
    404421      ierr(:) = 0 
    … …  
    424441         &      hfx_sum    (jpi,jpj) , hfx_bom   (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
    425442         &      hfx_opw    (jpi,jpj) , hfx_thd   (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,     & 
    426          &      hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj)             , STAT=ierr(ii) ) 
     443         &      hfx_err_dif(jpi,jpj) , wfx_err_sub(jpi,jpj)                   , STAT=ierr(ii) ) 
    427444 
    428445      ! * Ice global state variables 
    … …  
    448465 
    449466      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) ) 
     467      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl),  & 
     468         &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 
     469 
     470      ii = ii + 1 
     471      ALLOCATE( at_ip(jpi,jpj) , hm_ip(jpi,jpj) , vt_ip(jpi,jpj) , hm_il(jpi,jpj) , vt_il(jpi,jpj) , STAT = ierr(ii) ) 
    454472 
    455473      ! * Old values of global variables 
    456474      ii = ii + 1 
    457       ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl)        , h_i_b(jpi,jpj,jpl), h_ip_b(jpi,jpj,jpl),  & 
    458          &      a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,               & 
    459          &      oa_i_b(jpi,jpj,jpl)                                                   , STAT=ierr(ii) ) 
     475      ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl)        , h_i_b(jpi,jpj,jpl),         & 
     476         &      a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 
     477         &      STAT=ierr(ii) ) 
    460478 
    461479      ii = ii + 1 
    … …  
    481499      ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    482500 
     501      ! * For atmospheric coupling 
     502      ii = ii + 1 
     503      ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(ii) ) 
     504 
    483505      ice_alloc = MAXVAL( ierr(:) ) 
    484506      IF( ice_alloc /= 0 )   CALL ctl_stop( 'STOP', 'ice_alloc: failed to allocate arrays.' ) 
    485507      ! 
     508 
    486509   END FUNCTION ice_alloc 
    487510 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/ice1d.F90

    r11715 r12937  
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
    5252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dyn_1d 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
    5453   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_dif_1d 
    5554   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qt_oce_ai_1d 
    … …  
    124123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oa_i_1d       !: 
    125124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_1d        !: 
    126    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_1d       !: ice ponds 
    127126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_ip_1d       !: 
    128127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_ip_1d       !: 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_ip_frac_1d  !: 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   v_il_1d       !: Ice pond lid 
     129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   h_il_1d       !: 
    130130 
    131131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d      !: corresponding to the 2D var  t_s 
    … …  
    157157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   a_ip_2d 
    158158   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_ip_2d  
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   v_il_2d  
    159160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_su_2d  
    160161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_2d 
    … …  
    189190         &      hfx_thd_1d(jpij) , hfx_spr_1d    (jpij) ,                      & 
    190191         &      hfx_snw_1d(jpij) , hfx_sub_1d    (jpij) ,                      & 
    191          &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
     192         &      hfx_res_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 
    192193      ! 
    193194      ii = ii + 1 
    … …  
    208209         &      dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm  (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) ,  &     
    209210         &      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) ,                                                   & 
     211         &      a_ip_1d (jpij) , v_ip_1d (jpij) , v_i_1d    (jpij) , v_s_1d  (jpij) , v_il_1d (jpij) ,  & 
     212         &      h_il_1d (jpij) , h_ip_1d (jpij) ,                                                       & 
    212213         &      sv_i_1d (jpij) , oa_i_1d (jpij) , o_i_1d    (jpij) , STAT=ierr(ii) ) 
    213214      ! 
    … …  
    226227      ALLOCATE( a_i_2d (jpij,jpl) , a_ib_2d(jpij,jpl) , h_i_2d (jpij,jpl) , h_ib_2d(jpij,jpl) ,  & 
    227228         &      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) ,                      & 
     229         &      a_ip_2d(jpij,jpl) , v_ip_2d(jpij,jpl) , t_su_2d(jpij,jpl) , v_il_2d(jpij,jpl) ,  & 
    229230         &      STAT=ierr(ii) ) 
    230231 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icealb.F90

    r11715 r12937  
    4545CONTAINS 
    4646 
    47    SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, palb_cs, palb_os ) 
     47   SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice ) 
    4848      !!---------------------------------------------------------------------- 
    4949      !!               ***  ROUTINE ice_alb  *** 
    … …  
    9797      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pafrac_pnd   !  melt pond relative fraction (per unit ice area) 
    9898      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_pnd       !  melt pond depth 
    99       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_cs      !  albedo of ice under clear    sky 
    100       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_os      !  albedo of ice under overcast sky 
     99      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   pcloud_fra   !  cloud fraction 
     100      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_ice     !  albedo of ice 
    101101      ! 
    102102      INTEGER  ::   ji, jj, jl                ! dummy loop indices 
    … …  
    106106      REAL(wp) ::   zalb_ice, zafrac_ice      ! bare sea ice albedo & relative ice fraction 
    107107      REAL(wp) ::   zalb_snw, zafrac_snw      ! snow-covered sea ice albedo & relative snow fraction 
     108      REAL(wp) ::   zalb_cs, zalb_os          ! albedo of ice under clear/overcast sky 
    108109      !!--------------------------------------------------------------------- 
    109110      ! 
    … …  
    119120         DO jj = 1, jpj 
    120121            DO ji = 1, jpi 
    121                !                       !--- Specific snow, ice and pond fractions (for now, we prevent melt ponds and snow at the same time) 
    122                IF( ph_snw(ji,jj,jl) == 0._wp ) THEN 
     122               !---------------------------------------------! 
     123               !--- Specific snow, ice and pond fractions ---! 
     124               !---------------------------------------------!                
     125               IF( ph_snw(ji,jj,jl) == 0._wp ) THEN   !--- no snow : we prevent melt ponds and snow at the same time (for now) 
    123126                  zafrac_snw = 0._wp 
    124127                  IF( ld_pnd_alb ) THEN 
    … …  
    129132                  zafrac_ice = 1._wp - zafrac_pnd 
    130133               ELSE 
    131                   zafrac_snw = 1._wp      ! Snow fully "shades" melt ponds and ice 
     134                  zafrac_snw = 1._wp                  !--- snow : fully "shades" melt ponds and ice 
    132135                  zafrac_pnd = 0._wp 
    133136                  zafrac_ice = 0._wp 
    134137               ENDIF 
    135138               ! 
     139               !---------------! 
     140               !--- Albedos ---! 
     141               !---------------!                
    136142               !                       !--- Bare ice albedo (for hi > 150cm) 
    137143               IF( ld_pnd_alb ) THEN 
    … …  
    161167               ENDIF 
    162168               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    163                palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
    164                ! 
    165                palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  & 
    166                   &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  & 
    167                   &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 
    168                ! 
     169               zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     170               ! 
     171               zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
     172                  &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
     173               ! 
     174               ! albedo depends on cloud fraction because of non-linear spectral effects 
     175               palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 
     176 
    169177            END DO 
    170178         END DO 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icectl.F90

    r11715 r12937  
    625625                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    626626                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)    
    627                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    628627               END DO !jl 
    629628                

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn.F90

    r11715 r12937  
    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/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn_adv.F90

    r11715 r12937  
    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, & 
    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/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn_adv_pra.F90

    r11715 r12937  
    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,  & 
    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  ** 
    … …  
    7879      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    7980      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     81      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il     ! melt pond lid thickness 
    8082      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    8183      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    8890      REAL(wp), DIMENSION(jpi,jpj,1)          ::   z0opw 
    8991      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ice, z0snw, z0ai, z0smi, z0oi 
    90       REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp 
     92      REAL(wp), DIMENSION(jpi,jpj,jpl)        ::   z0ap , z0vp, z0vl 
    9193      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   z0es 
    9294      REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) ::   z0ei 
    … …  
    129131            z0ap(:,:,jl)  = pa_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond fraction 
    130132            z0vp(:,:,jl)  = pv_ip(:,:,jl) * e1e2t(:,:)     ! Melt pond volume 
     133            IF ( ln_pnd_lids ) THEN 
     134               z0vl(:,:,jl) = pv_il(:,:,jl) * e1e2t(:,:)   ! Melt pond lid volume 
     135            ENDIF 
    131136         ENDIF 
    132137      END DO 
    … …  
    167172               CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    168173               CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )  
     174               IF ( ln_pnd_lids ) THEN 
     175                  CALL adv_x( zdt , pu_ice , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     176                  CALL adv_y( zdt , pv_ice , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     177               ENDIF 
    169178            ENDIF 
    170179         END DO 
    … …  
    202211               CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp )    !--- melt pond volume 
    203212               CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 
     213               IF ( ln_pnd_lids ) THEN 
     214                  CALL adv_y( zdt , pv_ice , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 
     215                  CALL adv_x( zdt , pu_ice , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl )  
     216               ENDIF 
    204217            ENDIF 
    205218         END DO 
    … …  
    225238            pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    226239            pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     240            IF ( ln_pnd_lids ) THEN 
     241               pv_il(:,:,jl) = z0vl(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
     242            ENDIF 
    227243         ENDIF 
    228244      END DO 
    … …  
    231247      !     Remove negative values (conservation is ensured) 
    232248      !     (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 
    233       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 ) 
     249      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 ) 
    234250      ! 
    235251      ! --- Ensure snow load is not too big --- ! 
    … …  
    651667         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   & 
    652668         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   & 
    653          &      sxap(jpi,jpj,jpl)  , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
    654          &      sxvp(jpi,jpj,jpl)  , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     669         &      sxap (jpi,jpj,jpl) , syap (jpi,jpj,jpl) , sxxap (jpi,jpj,jpl) , syyap (jpi,jpj,jpl) , sxyap (jpi,jpj,jpl) ,   & 
     670         &      sxvp (jpi,jpj,jpl) , syvp (jpi,jpj,jpl) , sxxvp (jpi,jpj,jpl) , syyvp (jpi,jpj,jpl) , sxyvp (jpi,jpj,jpl) ,   & 
     671         &      sxvl (jpi,jpj,jpl) , syvl (jpi,jpj,jpl) , sxxvl (jpi,jpj,jpl) , syyvl (jpi,jpj,jpl) , sxyvl (jpi,jpj,jpl) ,   & 
    655672         ! 
    656673         &      sxc0 (jpi,jpj,nlay_s,jpl) , syc0 (jpi,jpj,nlay_s,jpl) , sxxc0(jpi,jpj,nlay_s,jpl) , & 
    … …  
    765782               CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 
    766783               CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 
     784               ! 
     785               IF ( ln_pnd_lids ) THEN                               ! melt pond lid volume 
     786                  CALL iom_get( numrir, jpdom_autoglo, 'sxvl' , sxvl  ) 
     787                  CALL iom_get( numrir, jpdom_autoglo, 'syvl' , syvl  ) 
     788                  CALL iom_get( numrir, jpdom_autoglo, 'sxxvl', sxxvl ) 
     789                  CALL iom_get( numrir, jpdom_autoglo, 'syyvl', syyvl ) 
     790                  CALL iom_get( numrir, jpdom_autoglo, 'sxyvl', sxyvl ) 
     791               ENDIF 
    767792            ENDIF 
    768793            ! 
    … …  
    780805            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
    781806            IF( ln_pnd_H12 ) THEN 
    782                sxap  = 0._wp   ;   syap  = 0._wp   ;   sxxap  = 0._wp   ;   syyap  = 0._wp   ;   sxyap  = 0._wp   ! melt pond fraction 
    783                sxvp  = 0._wp   ;   syvp  = 0._wp   ;   sxxvp  = 0._wp   ;   syyvp  = 0._wp   ;   sxyvp  = 0._wp   ! melt pond volume 
     807               sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp       ! melt pond fraction 
     808               sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp       ! melt pond volume 
     809               IF ( ln_pnd_lids ) THEN 
     810                  sxvl = 0._wp; syvl = 0._wp    ;   sxxvl = 0._wp    ;   syyvl = 0._wp    ;   sxyvl = 0._wp       ! melt pond lid volume 
     811               ENDIF 
    784812            ENDIF 
    785813         ENDIF 
    … …  
    862890            CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 
    863891            CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 
     892            ! 
     893            IF ( ln_pnd_lids ) THEN                                  ! melt pond lid volume 
     894               CALL iom_rstput( iter, nitrst, numriw, 'sxvl' , sxvl  ) 
     895               CALL iom_rstput( iter, nitrst, numriw, 'syvl' , syvl  ) 
     896               CALL iom_rstput( iter, nitrst, numriw, 'sxxvl', sxxvl ) 
     897               CALL iom_rstput( iter, nitrst, numriw, 'syyvl', syyvl ) 
     898               CALL iom_rstput( iter, nitrst, numriw, 'sxyvl', sxyvl ) 
     899            ENDIF 
    864900         ENDIF 
    865901         ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn_adv_umx.F90

    r11715 r12937  
    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            IF ( ln_pnd_lids ) THEN 
     339               zamsk = 0._wp 
     340               zhvar(:,:,:) = pv_il(:,:,:) * z1_aip(:,:,:) 
     341               CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 
     342                  &                                      zhvar, pv_il, zua_ups, zva_ups ) 
     343            ENDIF 
    336344         ENDIF 
    337345         ! 
    … …  
    350358         ! Remove negative values (conservation is ensured) 
    351359         !    (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 ) 
     360         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 ) 
    353361         ! 
    354362         ! Make sure ice thickness is not too big 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn_rdgrft.F90

    r11715 r12937  
    503503      REAL(wp)                  ::   airdg1, oirdg1, aprdg1, virdg1, sirdg1 
    504504      REAL(wp)                  ::   airft1, oirft1, aprft1 
    505       REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg  ! area etc of new ridges 
    506       REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft  ! area etc of rafted ice 
     505      REAL(wp), DIMENSION(jpij) ::   airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg  ! area etc of new ridges 
     506      REAL(wp), DIMENSION(jpij) ::   airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft  ! area etc of rafted ice 
    507507      ! 
    508508      REAL(wp), DIMENSION(jpij) ::   ersw             ! enth of water trapped into ridges 
    … …  
    581581                  aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 
    582582                  vprft (ji) = v_ip_2d(ji,jl1) * afrft 
     583                  IF ( ln_pnd_lids ) THEN 
     584                     vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 
     585                     vlrft (ji) = v_il_2d(ji,jl1) * afrft 
     586                  ENDIF 
    583587               ENDIF 
    584588 
    … …  
    610614                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    611615                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
     616                  IF ( ln_pnd_lids ) THEN 
     617                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 
     618                  ENDIF 
    612619               ENDIF 
    613620            ENDIF 
    … …  
    706713                     a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + (   aprdg2(ji) * rn_fpndrdg * farea         &  
    707714                        &                                   + aprft2(ji) * rn_fpndrft * zswitch(ji)   ) 
     715                     IF ( ln_pnd_lids ) THEN 
     716                        v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + (   vlrdg (ji) * rn_fpndrdg * fvol   (ji)   & 
     717                           &                                   + vlrft (ji) * rn_fpndrft * zswitch(ji)   ) 
     718                     ENDIF 
    708719                  ENDIF 
    709720                   
    … …  
    736747      !---------------- 
    737748      ! In case ridging/rafting lead to very small negative values (sometimes it happens) 
    738       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 ) 
     749      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 ) 
    739750      ! 
    740751   END SUBROUTINE rdgrft_shift 
    … …  
    848859         CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    849860         CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     861         CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    850862         DO jl = 1, jpl 
    851863            DO jk = 1, nlay_s 
    … …  
    874886         CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 
    875887         CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 
     888         CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 
    876889         DO jl = 1, jpl 
    877890            DO jk = 1, nlay_s 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn_rhg.F90

    r11715 r12937  
    110110      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
    111111      !! 
    112       NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast 
     112      NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, rn_creepl, rn_ecc , nn_nevp, rn_relast, ln_rhg_chkcvg 
    113113      !!------------------------------------------------------------------- 
    114114      ! 
    … …  
    126126         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    127127         WRITE(numout,*) '   Namelist : namdyn_rhg:' 
    128          WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP = ', ln_rhg_EVP 
    129          WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP    = ', ln_aEVP 
    130          WRITE(numout,*) '         creep limit                                       rn_creepl  = ', rn_creepl 
    131          WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc     = ', rn_ecc 
    132          WRITE(numout,*) '         number of iterations for subcycling               nn_nevp    = ', nn_nevp 
    133          WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast  = ', rn_relast 
     128         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP    = ', ln_rhg_EVP 
     129         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP       = ', ln_aEVP 
     130         WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl 
     131         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc 
     132         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp       = ', nn_nevp 
     133         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast     = ', rn_relast 
     134         WRITE(numout,*) '      check convergence of rheology                        ln_rhg_chkcvg = ', ln_rhg_chkcvg 
    134135      ENDIF 
    135136      ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icedyn_rhg_evp.F90

    r11715 r12937  
    4141   USE prtctl         ! Print control 
    4242 
     43   USE netcdf         ! NetCDF library for convergence test 
    4344   IMPLICIT NONE 
    4445   PRIVATE 
    … …  
    4950   !! * Substitutions 
    5051#  include "vectopt_loop_substitute.h90" 
     52 
     53   !! for convergence tests 
     54   INTEGER ::   ncvgid   ! netcdf file id 
     55   INTEGER ::   nvarid   ! netcdf variable id 
     56   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
    5157   !!---------------------------------------------------------------------- 
    5258   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    125131      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    126132      ! 
    127       REAL(wp) ::   zresm                                               ! Maximal error on ice velocity 
    128133      REAL(wp) ::   zintb, zintn                                        ! dummy argument 
    129134      REAL(wp) ::   zfac_x, zfac_y 
    … …  
    141146      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
    142147      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12                  ! stress tensor components 
    143 !!$      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr           ! check convergence 
    144148      REAL(wp), DIMENSION(jpi,jpj) ::   zsshdyn                         ! array used for the calculation of ice surface slope: 
    145149      !                                                                 !    ocean surface (ssh_m) if ice is not embedded 
    … …  
    160164      REAL(wp), PARAMETER          ::   zmmin  = 1._wp                  ! ice mass (kg/m2)  below which ice velocity becomes very small 
    161165      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
     166      !! --- check convergence 
     167      REAL(wp), DIMENSION(jpi,jpj) ::   zu_ice, zv_ice 
    162168      !! --- diags 
    163       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
    164169      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3 
    165170      !! --- SIMIP diags 
    … …  
    174179      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_evp: EVP sea-ice rheology' 
    175180      ! 
    176 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     181      ! for diagnostics and convergence tests 
     182      ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
     183      DO jj = 1, jpj 
     184         DO ji = 1, jpi 
     185            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     186            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     187         END DO 
     188      END DO 
     189      ! 
     190      !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    177191      !------------------------------------------------------------------------------! 
    178192      ! 0) mask at F points for the ice 
    … …  
    345359         l_full_nf_update = jter == nn_nevp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
    346360         ! 
    347 !!$         IF(ln_ctl) THEN   ! Convergence test 
    348 !!$            DO jj = 1, jpjm1 
    349 !!$               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
    350 !!$               zv_ice(:,jj) = v_ice(:,jj) 
    351 !!$            END DO 
    352 !!$         ENDIF 
     361         ! convergence test 
     362         IF(ln_rhg_chkcvg) THEN 
     363            DO jj = 1, jpj 
     364               DO ji = 1, jpi 
     365                  zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step 
     366                  zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
     367               END DO 
     368            END DO 
     369         ENDIF 
    353370 
    354371         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    … …  
    667684         ENDIF 
    668685 
    669 !!$         IF(ln_ctl) THEN   ! Convergence test 
    670 !!$            DO jj = 2 , jpjm1 
    671 !!$               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    672 !!$            END DO 
    673 !!$            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    674 !!$            CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    675 !!$         ENDIF 
     686         ! convergence test 
     687         IF(ln_rhg_chkcvg) THEN 
     688            CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
     689         ENDIF 
    676690         ! 
    677691         !                                                ! ==================== ! 
    … …  
    734748      ! 5) diagnostics 
    735749      !------------------------------------------------------------------------------! 
    736       DO jj = 1, jpj 
    737          DO ji = 1, jpi 
    738             zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    739          END DO 
    740       END DO 
    741  
    742750      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 
    743751      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 
    … …  
    796804         DEALLOCATE( zsig1 , zsig2 , zsig3 ) 
    797805      ENDIF 
    798        
     806 
    799807      ! --- SIMIP --- ! 
    800808      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 
    … …  
    852860      ENDIF 
    853861      ! 
     862      ! --- convergence tests --- ! 
     863      IF( ln_rhg_chkcvg ) THEN 
     864         IF( iom_use('uice_cvg') ) THEN  ! output: u(t=nn_nevp) - u(t=nn_nevp-1) 
     865            CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
     866               &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
     867         ENDIF 
     868      ENDIF       
     869      ! 
     870      DEALLOCATE( zmsk00, zmsk15 ) 
     871      ! 
    854872   END SUBROUTINE ice_dyn_rhg_evp 
     873 
     874 
     875   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     876      !!---------------------------------------------------------------------- 
     877      !!                    ***  ROUTINE rhg_cvg  *** 
     878      !!                      
     879      !! ** Purpose :   check convergence of oce rheology 
     880      !! 
     881      !! ** Method  :   create a file ice_cvg.nc containing the convergence of ice velocity 
     882      !!                during the sub timestepping of rheology so as: 
     883      !!                  uice_cvg = MAX( u(t+1) - u(t) , v(t+1) - v(t) ) 
     884      !!                This routine is called every sub-iteration, so it is cpu expensive 
     885      !! 
     886      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)    
     887      !!---------------------------------------------------------------------- 
     888      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
     889      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     890      !! 
     891      INTEGER           ::   it, idtime, istatus 
     892      INTEGER           ::   ji, jj          ! dummy loop indices 
     893      REAL(wp)          ::   zresm           ! local real  
     894      CHARACTER(len=20) ::   clname 
     895      REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
     896      !!---------------------------------------------------------------------- 
     897 
     898      ! create file 
     899      IF( kt == nit000 .AND. kiter == 1 ) THEN 
     900         ! 
     901         IF( lwp ) THEN 
     902            WRITE(numout,*) 
     903            WRITE(numout,*) 'rhg_cvg : ice rheology convergence control' 
     904            WRITE(numout,*) '~~~~~~~' 
     905         ENDIF 
     906         ! 
     907         IF( lwm ) THEN 
     908            clname = 'ice_cvg.nc' 
     909            IF( .NOT. Agrif_Root() )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
     910            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 
     911            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime ) 
     912            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid ) 
     913            istatus = NF90_ENDDEF(ncvgid) 
     914         ENDIF 
     915         ! 
     916      ENDIF 
     917 
     918      ! time 
     919      it = ( kt - 1 ) * kitermax + kiter 
     920       
     921      ! convergence 
     922      IF( kiter == 1 ) THEN ! remove the first iteration for calculations of convergence (always very large) 
     923         zresm = 0._wp 
     924      ELSE 
     925         DO jj = 1, jpj 
     926            DO ji = 1, jpi 
     927               zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     928                  &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
     929            END DO 
     930         END DO 
     931         zresm = MAXVAL( zres ) 
     932         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
     933      ENDIF 
     934 
     935      IF( lwm ) THEN 
     936         ! write variables 
     937         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 
     938         ! close file 
     939         IF( kt == nitend )   istatus = NF90_CLOSE(ncvgid) 
     940      ENDIF 
     941       
     942   END SUBROUTINE rhg_cvg 
    855943 
    856944 
    … …  
    910998   END SUBROUTINE rhg_evp_rst 
    911999 
     1000    
    9121001#else 
    9131002   !!---------------------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/iceistate.F90

    r11715 r12937  
    4141   !                             !! ** namelist (namini) ** 
    4242   LOGICAL, PUBLIC  ::   ln_iceini        !: Ice initialization or not 
    43    LOGICAL, PUBLIC  ::   ln_iceini_file   !: Ice initialization from 2D netcdf file 
     43   INTEGER, PUBLIC  ::   nn_iceini_file   !: Ice initialization: 
     44                                  !        0 = Initialise sea ice based on SSTs 
     45                                  !        1 = Initialise sea ice from single category netcdf file 
     46                                  !        2 = Initialise sea ice from multi category restart file 
    4447   REAL(wp) ::   rn_thres_sst 
    4548   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 
    4649   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 
     50   REAL(wp) ::   rn_apd_ini_n, rn_hpd_ini_n, rn_hld_ini_n 
     51   REAL(wp) ::   rn_apd_ini_s, rn_hpd_ini_s, rn_hld_ini_s 
    4952   ! 
    50    !                              ! if ln_iceini_file = T 
    51    INTEGER , PARAMETER ::   jpfldi = 9           ! maximum number of files to read 
     53   !                              ! if nn_iceini_file = 1 
     54   INTEGER , PARAMETER ::   jpfldi = 10          ! maximum number of files to read 
    5255   INTEGER , PARAMETER ::   jp_hti = 1           ! index of ice thickness    (m) 
    5356   INTEGER , PARAMETER ::   jp_hts = 2           ! index of snw thickness    (m) 
    … …  
    5962   INTEGER , PARAMETER ::   jp_apd = 8           ! index of pnd fraction     (-) 
    6063   INTEGER , PARAMETER ::   jp_hpd = 9           ! index of pnd depth        (m) 
     64   INTEGER , PARAMETER ::   jp_hld = 10          ! index of pnd lid depth    (m) 
    6165   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    6266   !    
    … …  
    98102      REAL(wp), DIMENSION(jpi,jpj)     ::   zht_i_ini, zat_i_ini, ztm_s_ini            !data from namelist or nc file 
    99103      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 
     104      REAL(wp), DIMENSION(jpi,jpj)     ::   zapnd_ini, zhpnd_ini, zhlid_ini            !data from namelist or nc file 
    101105      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zti_3d , zts_3d                            !temporary arrays 
    102106      !! 
    103       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d 
     107      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d 
    104108      !-------------------------------------------------------------------- 
    105109 
    … …  
    155159      a_ip     (:,:,:) = 0._wp 
    156160      v_ip     (:,:,:) = 0._wp 
    157       a_ip_frac(:,:,:) = 0._wp 
     161      v_il     (:,:,:) = 0._wp 
     162      a_ip_eff (:,:,:) = 0._wp 
    158163      h_ip     (:,:,:) = 0._wp 
     164      h_il     (:,:,:) = 0._wp 
    159165      ! 
    160166      ! ice velocities 
    … …  
    167173      IF( ln_iceini ) THEN 
    168174         !                             !---------------! 
    169          IF( ln_iceini_file )THEN      ! Read a file   ! 
     175         IF( nn_iceini_file == 1 )THEN ! Read a file   ! 
    170176            !                          !---------------! 
    171177            WHERE( ff_t(:,:) >= 0._wp )   ;   zswitch(:,:) = 1._wp 
    … …  
    218224            IF( TRIM(si(jp_hpd)%clrootname) == 'NOT USED' ) & 
    219225               &     si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     226            ! 
     227            ! pond lid depth 
     228            IF( TRIM(si(jp_hld)%clrootname) == 'NOT USED' ) & 
     229               &     si(jp_hld)%fnow(:,:,1) = ( rn_hld_ini_n * zswitch + rn_hld_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 
     230            ! 
    220231            zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 
     232            zhlid_ini(:,:) = si(jp_hld)%fnow(:,:,1) 
    221233            ! 
    222234            ! change the switch for the following 
    … …  
    243255               zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
    244256               zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
     257               zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 
    245258            ELSEWHERE 
    246259               zht_i_ini(:,:) = rn_hti_ini_s * zswitch(:,:) 
    … …  
    253266               zapnd_ini(:,:) = rn_apd_ini_s * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    254267               zhpnd_ini(:,:) = rn_hpd_ini_s * zswitch(:,:) 
     268               zhlid_ini(:,:) = rn_hld_ini_s * zswitch(:,:) 
    255269            END WHERE 
    256270            ! 
    … …  
    261275            zapnd_ini(:,:) = 0._wp 
    262276            zhpnd_ini(:,:) = 0._wp 
     277            zhlid_ini(:,:) = 0._wp 
     278         ENDIF 
     279 
     280         IF ( .NOT.ln_pnd_lids ) THEN 
     281            zhlid_ini(:,:) = 0._wp 
    263282         ENDIF 
    264283          
    … …  
    287306         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d(1:npti)  , zapnd_ini ) 
    288307         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
     308         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini ) 
    289309 
    290310         ! allocate temporary arrays 
    291          ALLOCATE( zhi_2d(npti,jpl), zhs_2d(npti,jpl), zai_2d (npti,jpl), & 
    292             &      zti_2d(npti,jpl), zts_2d(npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), zaip_2d(npti,jpl), zhip_2d(npti,jpl) ) 
     311         ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & 
     312            &      zti_2d (npti,jpl), zts_2d (npti,jpl), ztsu_2d(npti,jpl), zsi_2d(npti,jpl), & 
     313            &      zaip_2d(npti,jpl), zhip_2d(npti,jpl), zhil_2d(npti,jpl) ) 
    293314          
    294315         ! distribute 1-cat into jpl-cat: (jpi*jpj) -> (jpi*jpj,jpl) 
    295          CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                                                   & 
    296             &              zhi_2d          , zhs_2d          , zai_2d         ,                                                   & 
    297             &              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), & 
    298             &              zti_2d          , zts_2d          , ztsu_2d        , zsi_2d        , zaip_2d        , zhip_2d ) 
     316         CALL ice_var_itd( h_i_1d(1:npti)  , h_s_1d(1:npti)  , at_i_1d(1:npti),                  & 
     317            &              zhi_2d          , zhs_2d          , zai_2d         ,                  & 
     318            &              t_i_1d(1:npti,1), t_s_1d(1:npti,1), t_su_1d(1:npti),                  & 
     319            &              s_i_1d(1:npti)  , a_ip_1d(1:npti) , h_ip_1d(1:npti), h_il_1d(1:npti), & 
     320            &              zti_2d          , zts_2d          , ztsu_2d        ,                  & 
     321            &              zsi_2d          , zaip_2d         , zhip_2d        , zhil_2d ) 
    299322 
    300323         ! move to 3D arrays: (jpi*jpj,jpl) -> (jpi,jpj,jpl) 
    … …  
    312335         CALL tab_2d_3d( npti, nptidx(1:npti), zaip_2d  , a_ip   ) 
    313336         CALL tab_2d_3d( npti, nptidx(1:npti), zhip_2d  , h_ip   ) 
     337         CALL tab_2d_3d( npti, nptidx(1:npti), zhil_2d  , h_il   ) 
    314338 
    315339         ! deallocate temporary arrays 
    316340         DEALLOCATE( zhi_2d, zhs_2d, zai_2d , & 
    317             &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d ) 
     341            &        zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d, zhil_2d ) 
    318342 
    319343         ! calculate extensive and intensive variables 
    … …  
    357381 
    358382         ! Melt ponds 
    359          WHERE( a_i > epsi10 ) 
    360             a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
    361          ELSEWHERE 
    362             a_ip_frac(:,:,:) = 0._wp 
     383         WHERE( a_i > epsi10 )   ;   a_ip_eff(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 
     384         ELSEWHERE               ;   a_ip_eff(:,:,:) = 0._wp 
    363385         END WHERE 
    364386         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     387         v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    365388           
    366389         ! specific temperatures for coupled runs 
    … …  
    434457      e_s_b  (:,:,:,:) = e_s  (:,:,:,:) 
    435458      sv_i_b (:,:,:)   = sv_i (:,:,:) 
    436       oa_i_b (:,:,:)   = oa_i (:,:,:) 
    437459      u_ice_b(:,:)     = u_ice(:,:) 
    438460      v_ice_b(:,:)     = v_ice(:,:) 
    … …  
    463485      ! 
    464486      CHARACTER(len=256) ::  cn_dir          ! Root directory for location of ice files 
    465       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 
    466488      TYPE(FLD_N), DIMENSION(jpfldi) ::   slf_i                 ! array of namelist informations on the fields to read 
    467489      ! 
    468       NAMELIST/namini/ ln_iceini, ln_iceini_file, rn_thres_sst, & 
     490      NAMELIST/namini/ ln_iceini, nn_iceini_file, rn_thres_sst, & 
    469491         &             rn_hti_ini_n, rn_hti_ini_s, rn_hts_ini_n, rn_hts_ini_s, & 
    470492         &             rn_ati_ini_n, rn_ati_ini_s, rn_smi_ini_n, rn_smi_ini_s, & 
    471493         &             rn_tmi_ini_n, rn_tmi_ini_s, rn_tsu_ini_n, rn_tsu_ini_s, rn_tms_ini_n, rn_tms_ini_s, & 
    472          &             rn_apd_ini_n, rn_apd_ini_s, rn_hpd_ini_n, rn_hpd_ini_s, & 
    473          &             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 
    474496      !!----------------------------------------------------------------------------- 
    475497      ! 
    … …  
    485507      slf_i(jp_ati) = sn_ati  ;  slf_i(jp_smi) = sn_smi 
    486508      slf_i(jp_tmi) = sn_tmi  ;  slf_i(jp_tsu) = sn_tsu   ;   slf_i(jp_tms) = sn_tms 
    487       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 
    488510      ! 
    489511      IF(lwp) THEN                          ! control print 
    … …  
    493515         WRITE(numout,*) '   Namelist namini:' 
    494516         WRITE(numout,*) '      ice initialization (T) or not (F)                ln_iceini      = ', ln_iceini 
    495          WRITE(numout,*) '      ice initialization from a netcdf file            ln_iceini_file = ', ln_iceini_file 
     517         WRITE(numout,*) '      ice initialization from a netcdf file            nn_iceini_file = ', nn_iceini_file 
    496518         WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst 
    497          IF( ln_iceini .AND. .NOT.ln_iceini_file ) THEN 
     519         IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 
    498520            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s  
    499521            WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s 
    … …  
    505527            WRITE(numout,*) '      initial pnd fraction  in the north-south         rn_apd_ini     = ', rn_apd_ini_n,rn_apd_ini_s 
    506528            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 
    507530         ENDIF 
    508531      ENDIF 
    509532      ! 
    510       IF( ln_iceini_file ) THEN                      ! Ice initialization using input file 
     533      IF( nn_iceini_file == 1 ) THEN                      ! Ice initialization using input file 
    511534         ! 
    512535         ! set si structure 
    … …  
    529552         rn_apd_ini_n = 0. ; rn_apd_ini_s = 0. 
    530553         rn_hpd_ini_n = 0. ; rn_hpd_ini_s = 0. 
    531          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' ) 
     556      ENDIF 
     557      ! 
     558      IF( .NOT.ln_pnd_lids ) THEN 
     559         rn_hld_ini_n = 0. ; rn_hld_ini_s = 0. 
    532560      ENDIF 
    533561      ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/iceitd.F90

    r11715 r12937  
    411411      CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    412412      CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     413      CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    413414      CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    414415      DO jl = 1, jpl 
    … …  
    483484                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    484485                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
     486                  ! 
     487                  IF ( ln_pnd_lids ) THEN                            ! Pond lid volume 
     488                     ztrans          = v_il_2d(ji,jl1) * zworka(ji) 
     489                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 
     490                     v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 
     491                  ENDIF 
    485492               ENDIF 
    486493               ! 
    … …  
    527534      ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 
    528535      !       because of truncation error ( i.e. 1. - 1. /= 0 ) 
    529       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 ) 
     536      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 ) 
    530537 
    531538      ! at_i must be <= rn_amax 
    … …  
    555562      CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 
    556563      CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 
     564      CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 
    557565      CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 
    558566      DO jl = 1, jpl 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icerst.F90

    r11715 r12937  
    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         ! melt pond lids 
     254         id3 = iom_varid( numrir, 'v_il' , ldstop = .FALSE. ) 
     255         IF( id3 > 0 ) THEN 
     256            CALL iom_get( numrir, jpdom_autoglo, 'v_il', v_il) 
     257         ELSE 
     258            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds lids output then set it to zero' 
     259            v_il(:,:,:) = 0._wp 
     260         ENDIF 
    252261         ! fields needed for Met Office (Jules) coupling 
    253262         IF( ln_cpl ) THEN 
    254             id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
    255             id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
    256             IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
     263            id4 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 
     264            id5 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
     265            IF( id4 > 0 .AND. id5 > 0 ) THEN         ! fields exist 
    257266               CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 
    258267               CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice  ) 
    … …  
    274283         CALL ice_istate( nit000 ) 
    275284         ! 
    276          IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 
    277             &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 
     285         IF( .NOT.ln_iceini .OR. nn_iceini_file == 0 ) & 
     286            &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and nn_iceini_file=0') 
    278287         ! 
    279288      ENDIF 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icesbc.F90

    r11715 r12937  
    116116      INTEGER  ::   ji, jj, jl      ! dummy loop index 
    117117      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
    118       REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    119       REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
     118      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    120119      !!-------------------------------------------------------------------- 
    121120      ! 
    … …  
    131130      CALL iom_miss_val( "icetemp", zmiss_val ) 
    132131 
    133       ! --- 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 ) 
    135  
    136       ! albedo depends on cloud fraction because of non-linear spectral effects 
    137 !!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument ! 
    138       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    139       ! 
     132      ! --- ice albedo --- ! 
     133      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) 
     134 
    140135      ! 
    141136      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icestp.F90

    r11715 r12937  
    252252      ! 
    253253      !                                ! Initial sea-ice state 
    254       IF( .NOT. ln_rstart ) THEN              ! start from rest: sea-ice deduced from sst 
     254 
     255      IF ( ln_rstart .OR. nn_iceini_file == 2 ) THEN 
     256         CALL ice_rst_read                      ! start from a restart file 
     257      ELSE 
    255258         CALL ice_istate_init 
    256          CALL ice_istate( nit000 ) 
    257       ELSE                                    ! start from a restart file 
    258          CALL ice_rst_read 
     259         CALL ice_istate( nit000 )              ! start from rest: sea-ice deduced from sst 
    259260      ENDIF 
    260261      CALL ice_var_glo2eqv 
    … …  
    363364      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume 
    364365      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content 
    365       oa_i_b(:,:,:)   = oa_i(:,:,:)     ! areal age content 
    366366      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy 
    367367      e_i_b (:,:,:,:) = e_i (:,:,:,:)   ! ice thermal energy 
    … …  
    372372         h_i_b(:,:,:) = 0._wp 
    373373         h_s_b(:,:,:) = 0._wp 
    374       END WHERE 
    375        
    376       WHERE( a_ip(:,:,:) >= epsi20 ) 
    377          h_ip_b(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:)   ! ice pond thickness 
    378       ELSEWHERE 
    379          h_ip_b(:,:,:) = 0._wp 
    380374      END WHERE 
    381375      ! 
    … …  
    421415      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
    422416      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
    423       hfx_err_rem(:,:) = 0._wp 
    424417      hfx_err_dif(:,:) = 0._wp 
    425418      wfx_err_sub(:,:) = 0._wp 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icethd.F90

    r11715 r12937  
    5151   LOGICAL ::   ln_icedO         ! activate ice growth in open-water (T) or not (F) 
    5252   LOGICAL ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F) 
     53   LOGICAL ::   ln_leadhfx       !  heat in the leads is used to melt sea-ice before warming the ocean 
    5354 
    5455   !! * Substitutions 
    … …  
    164165            ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 
    165166            IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 
    166                fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     167               IF( ln_leadhfx ) THEN   ;   fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     168               ELSE                    ;   fhld(ji,jj) = 0._wp 
     169               ENDIF 
    167170               qlead(ji,jj) = 0._wp 
    168171            ELSE 
    … …  
    354357         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    355358         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    356          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     359         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    357360         ! 
    358361         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
    … …  
    406409         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res       ) 
    407410         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif   ) 
    408          CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem   ) 
    409411         CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai     ) 
    410412         ! 
    … …  
    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          
    … …  
    460463         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    461464         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    462          CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 
     465         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    463466         ! 
    464467         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
    … …  
    498501         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d    (1:npti), hfx_res     ) 
    499502         CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 
    500          CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem ) 
    501503         CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d  (1:npti), qt_oce_ai   ) 
    502504         ! 
    … …  
    515517         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    516518         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
     519         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    517520         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
    518521         ! 
    … …  
    536539      INTEGER  ::   ios   ! Local integer output status for namelist read 
    537540      !! 
    538       NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 
     541      NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 
    539542      !!------------------------------------------------------------------- 
    540543      ! 
    … …  
    552555         WRITE(numout,*) '~~~~~~~~~~~~' 
    553556         WRITE(numout,*) '   Namelist namthd:' 
    554          WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)   ln_icedH  = ', ln_icedH 
    555          WRITE(numout,*) '      activate lateral melting (T) or not (F)                 ln_icedA  = ', ln_icedA 
    556          WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)        ln_icedO  = ', ln_icedO 
    557          WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)   ln_icedS  = ', ln_icedS 
     557         WRITE(numout,*) '      activate ice thick change from top/bot (T) or not (F)                ln_icedH   = ', ln_icedH 
     558         WRITE(numout,*) '      activate lateral melting (T) or not (F)                              ln_icedA   = ', ln_icedA 
     559         WRITE(numout,*) '      activate ice growth in open-water (T) or not (F)                     ln_icedO   = ', ln_icedO 
     560         WRITE(numout,*) '      activate gravity drainage and flushing (T) or not (F)                ln_icedS   = ', ln_icedS 
     561         WRITE(numout,*) '      heat in the leads is used to melt sea-ice before warming the ocean   ln_leadhfx = ', ln_leadhfx 
    558562     ENDIF 
    559563      ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icethd_ent.F90

    r11715 r12937  
    128128      ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do),  
    129129      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
    130       DO ji = 1, npti 
    131          hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
    132             &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  
    133       END DO 
     130      !DO ji = 1, npti 
     131      !   hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
     132      !      &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) )  
     133      !END DO 
    134134       
    135135   END SUBROUTINE ice_thd_ent 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icethd_pnd.F90

    r11715 r12937  
    8888         ! 
    8989         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    90             a_ip_frac_1d(ji) = rn_apnd 
    9190            h_ip_1d(ji)      = rn_hpnd     
    92             a_ip_1d(ji)      = a_ip_frac_1d(ji) * a_i_1d(ji) 
     91            a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
     92            h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
    9393         ELSE 
    94             a_ip_frac_1d(ji) = 0._wp 
    9594            h_ip_1d(ji)      = 0._wp     
    9695            a_ip_1d(ji)      = 0._wp 
     96            h_il_1d(ji)      = 0._wp 
    9797         ENDIF 
    9898         ! 
    … …  
    106106      !!                ***  ROUTINE pnd_H12  *** 
    107107      !! 
    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?) 
     108      !! ** Purpose : Compute melt pond evolution 
     109      !! 
     110      !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 
     111      !!              We  work with volumes and then redistribute changes into thickness and concentration 
     112      !!              assuming linear relationship between the two.  
     113      !! 
     114      !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 --- 
     115      !!                                     dVmelt = (1-r)/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i 
     116      !!                                        dh_i  = meltwater from ice surface melt 
     117      !!                                        dh_s  = meltwater from snow melt 
     118      !!                                        (1-r) = fraction of melt water that is not flushed 
     119      !! 
     120      !!              - limtations:       a_ip must not exceed (1-r)*a_i 
     121      !!                                  h_ip must not exceed 0.5*h_i 
     122      !! 
     123      !!              - pond shrinking: 
     124      !!                       if lids:   Vp = Vp -dH * a_ip 
     125      !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 --- 
     126      !! 
     127      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H  
     128      !!                                                                      H = lid thickness 
     129      !!                                                                      Lf = latent heat of fusion 
     130      !!                                                                      Tp = -2C 
     131      !! 
     132      !!                                                                And solved implicitely as: 
     133      !!                                                                   H(t+dt)**2 -H(t) * H(t+dt) -ki * (Tp-Tsu) * dt / (rhoi*Lf) = 0 
     134      !! 
     135      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 --- 
     136      !! 
     137      !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 --- 
     138      !!                                     perm = permability of sea-ice 
     139      !!                                     visc = water viscosity 
     140      !!                                     Hp   = height of top of the pond above sea-level 
     141      !!                                     Hi   = ice thickness thru which there is flushing 
     142      !! 
     143      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness 
     144      !! 
     145      !!              - pond thickness and area is retrieved from pond volume assuming a linear relationship between h_ip and a_ip: 
     146      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect 
     147      !! 
     148      !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 
    119149      !!  
    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  
     150      !! ** Note       :   mostly stolen from CICE 
     151      !! 
     152      !! ** References :   Flocco and Feltham (JGR, 2007) 
     153      !!                   Flocco et al       (JGR, 2010) 
     154      !!                   Holland et al      (J. Clim, 2012) 
     155      !!------------------------------------------------------------------- 
     156      REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array 
     157      !! 
     158      REAL(wp), PARAMETER ::   zaspect =  0.8_wp      ! pond aspect ratio 
     159      REAL(wp), PARAMETER ::   zTp     = -2._wp       ! reference temperature 
     160      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity 
     161      !! 
     162      REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding 
     163      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes 
     164      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh 
     165      REAL(wp) ::   zv_ip_max                         ! max pond volume allowed 
     166      REAL(wp) ::   zdT                               ! zTp-t_su 
     167      REAL(wp) ::   zsbr                              ! Brine salinity 
     168      REAL(wp) ::   zperm                             ! permeability of sea ice 
     169      REAL(wp) ::   zfac, zdum                        ! temporary arrays 
     170      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse 
     171      !! 
     172      INTEGER  ::   ji, jk                            ! loop indices 
     173      !!------------------------------------------------------------------- 
     174      z1_rhow   = 1._wp / rhow  
     175      z1_aspect = 1._wp / zaspect 
     176      z1_Tp     = 1._wp / zTp  
    144177 
    145178      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 
     179         !                                                            !----------------------------------------------------! 
     180         IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction ! 
     181            !                                                         !----------------------------------------------------! 
     182            !--- Remove ponds on thin ice or tiny ice fractions 
    150183            a_ip_1d(ji)      = 0._wp 
    151             a_ip_frac_1d(ji) = 0._wp 
    152184            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) 
     185            h_il_1d(ji)      = 0._wp 
     186            ! 
     187            ! clem: problem with conservation or not ? 
     188            !                                                         !--------------------------------! 
     189         ELSE                                                         ! Case ice thickness >= rn_himin ! 
     190            !                                                         !--------------------------------! 
     191            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     192            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     193            ! 
     194            !------------------! 
     195            ! case ice melting ! 
     196            !------------------! 
     197            ! 
     198            !--- available meltwater for melt ponding ---! 
     199            zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
     200            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 
     201            zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors?  
     202            ! 
     203            !--- overflow ---! 
     204            ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
     205            !    a_ip_max = zfr_mlt * a_i 
     206            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     207            zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
     208            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     209 
     210            ! If pond depth exceeds half the ice thickness then reduce the pond volume 
     211            !    h_ip_max = 0.5 * h_i 
     212            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
     213            zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
     214            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     215             
     216            !--- Pond growing ---! 
     217            v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
     218            ! 
     219            !--- Lid melting ---! 
     220            IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
     221            ! 
     222            !--- mass flux ---! 
    168223            IF( zdv_mlt > 0._wp ) THEN 
    169                zfac = zfr_mlt * zdv_mlt * rhow * r1_rdtice 
     224               zfac = zdv_mlt * rhow * r1_rdtice                        ! melt pond mass flux < 0 [kg.m-2.s-1] 
    170225               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    171226               ! 
    172                ! adjust ice/snow melting flux to balance melt pond flux (>0) 
    173                zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) ) 
     227               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux 
    174228               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 
    175229               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    176230            ENDIF 
     231 
     232            !-------------------! 
     233            ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
     234            !-------------------! 
     235            ! 
     236            zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
    177237            ! 
    178238            !--- 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) ) 
    184             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) 
     239            IF( ln_pnd_lids ) THEN 
     240               ! 
     241               !--- Lid growing and subsequent pond shrinking ---!  
     242               zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
     243                  &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
     244                
     245               ! Lid growing 
     246               v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 
     247                
     248               ! Pond shrinking 
     249               v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 
     250 
     251            ELSE 
     252               ! Pond shrinking 
     253               v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 
     254            ENDIF 
     255            ! 
     256            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     257            ! v_ip     = h_ip * a_ip 
     258            ! 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) 
     259            a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     260            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     261 
     262            !---------------!             
     263            ! Pond flushing ! 
     264            !---------------! 
     265            IF( ln_pnd_flush ) THEN 
     266               ! height of top of the pond above sea-level 
     267               zhp = ( h_i_1d(ji) * ( rau0 - rhoi ) + h_ip_1d(ji) * ( rau0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rau0 
     268 
     269               ! Calculate the permeability of the ice (Assur 1958) 
     270               DO jk = 1, nlay_i 
     271                  zsbr = - 1.2_wp                                  & 
     272                     &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
     273                     &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
     274                     &   - 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) 
     275                  ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
     276               END DO 
     277               zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
     278 
     279               ! Do the drainage using Darcy's law 
     280               zdv_flush   = -zperm * rau0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 
     281               zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) 
     282               v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
     283                
     284               !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     285               a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     286               h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     287 
     288            ENDIF 
     289 
     290            !--- Corrections and lid thickness ---! 
     291            IF( ln_pnd_lids ) THEN 
     292               !--- retrieve lid thickness from volume ---! 
     293               IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
     294               ELSE                              ;   h_il_1d(ji) = 0._wp 
     295               ENDIF 
     296               !--- remove ponds if lids are much larger than ponds ---! 
     297               IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
     298                  a_ip_1d(ji)      = 0._wp 
     299                  h_ip_1d(ji)      = 0._wp 
     300                  h_il_1d(ji)      = 0._wp 
     301               ENDIF 
     302            ENDIF 
    186303            ! 
    187304         ENDIF 
     305          
    188306      END DO 
    189307      ! 
    … …  
    205323      INTEGER  ::   ios, ioptio   ! Local integer 
    206324      !! 
    207       NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb 
     325      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_H12, ln_pnd_lids, ln_pnd_flush, rn_apnd_min, rn_apnd_max, & 
     326         &                          ln_pnd_CST, rn_apnd, rn_hpnd, & 
     327         &                          ln_pnd_alb 
    208328      !!------------------------------------------------------------------- 
    209329      ! 
    … …  
    221341         WRITE(numout,*) '~~~~~~~~~~~~~~~~' 
    222342         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 
     343         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd 
     344         WRITE(numout,*) '         Evolutive  melt pond fraction and depth                  ln_pnd_H12   = ', ln_pnd_H12 
     345         WRITE(numout,*) '            Melt ponds can have frozen lids                       ln_pnd_lids  = ', ln_pnd_lids 
     346         WRITE(numout,*) '            Allow ponds to flush thru the ice                     ln_pnd_flush = ', ln_pnd_flush 
     347         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min 
     348         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max 
     349         WRITE(numout,*) '         Prescribed melt pond fraction and depth                  ln_pnd_CST   = ', ln_pnd_CST 
     350         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd 
     351         WRITE(numout,*) '            Prescribed pond depth                                 rn_hpnd      = ', rn_hpnd 
     352         WRITE(numout,*) '         Melt ponds affect albedo or not                          ln_pnd_alb   = ', ln_pnd_alb 
    229353      ENDIF 
    230354      ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/iceupdate.F90

    r11715 r12937  
    9494      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    9595      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
    96       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  ! 2D workspace 
    97       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace 
     96      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
    9897      !!--------------------------------------------------------------------- 
    9998      IF( ln_timing )   CALL timing_start('ice_update') 
    … …  
    185184      ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 
    186185      !------------------------------------------------------------------ 
    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 
    188       ! 
    189       alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     186      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo 
     187 
    190188      ! 
    191189      IF( lrst_ice ) THEN                       !* write snwice_mass fields in the restart file 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icevar.F90

    r11715 r12937  
    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         ! 
    … …  
    184185      REAL(wp) ::   zhmax, z1_zhmax                 !   -      - 
    185186      REAL(wp) ::   zlay_i, zlay_s                  !   -      - 
    186       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i 
     187      REAL(wp), PARAMETER ::   zhl_max =  0.015_wp  ! pond lid thickness above which the ponds disappear from the albedo calculation 
     188      REAL(wp), PARAMETER ::   zhl_min =  0.005_wp  ! pond lid thickness below which the full pond area is used in the albedo calculation 
     189      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i, z1_v_i, z1_a_ip 
    187190      !!------------------------------------------------------------------- 
    188191 
    … …  
    203206      ELSEWHERE                      ;   z1_v_i(:,:,:) = 0._wp 
    204207      END WHERE 
     208      ! 
     209      WHERE( a_ip(:,:,:) > epsi20 )  ;   z1_a_ip(:,:,:) = 1._wp / a_ip(:,:,:) 
     210      ELSEWHERE                      ;   z1_a_ip(:,:,:) = 0._wp 
     211      END WHERE 
    205212      !                                           !--- ice thickness 
    206213      h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:) 
    … …  
    217224      !                                           !--- ice age       
    218225      o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 
    219       !                                           !--- pond fraction and thickness       
     226      !                                           !--- pond and lid thickness       
     227      h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 
     228      h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) 
     229      !                                           !--- melt pond effective area (used for albedo) 
    220230      a_ip_frac(:,:,:) = a_ip(:,:,:) * z1_a_i(:,:,:) 
    221       WHERE( a_ip_frac(:,:,:) > epsi20 )   ;   h_ip(:,:,:) = v_ip(:,:,:) * z1_a_i(:,:,:) / a_ip_frac(:,:,:) 
    222       ELSEWHERE                            ;   h_ip(:,:,:) = 0._wp 
    223       END WHERE 
    224       ! 
     231      WHERE    ( h_il(:,:,:) <= zhl_min )  ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:)       ! lid is very thin.  Expose all the pond 
     232      ELSEWHERE( h_il(:,:,:) >= zhl_max )  ;   a_ip_eff(:,:,:) = 0._wp                  ! lid is very thick. Cover all the pond up with ice and snow 
     233      ELSEWHERE                            ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * &   ! lid is in between. Expose part of the pond 
     234         &                                                       ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 
     235      END WHERE 
    225236      !                                           !---  salinity (with a minimum value imposed everywhere)      
    226237      IF( nn_icesal == 2 ) THEN 
    … …  
    289300      sv_i(:,:,:) = s_i (:,:,:) * v_i (:,:,:) 
    290301      v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
     302      v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    291303      ! 
    292304   END SUBROUTINE ice_var_eqv2glo 
    … …  
    533545               a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
    534546               v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
     547               v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 
    535548               ! 
    536549            END DO 
    … …  
    555568 
    556569 
    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 ) 
     570   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 ) 
    558571      !!------------------------------------------------------------------- 
    559572      !!                   ***  ROUTINE ice_var_zapneg *** 
    … …  
    570583      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    571584      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     585      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    572586      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    573587      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    636650      WHERE( pa_ip (:,:,:) < 0._wp )   pa_ip (:,:,:) = 0._wp 
    637651      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 
     652      WHERE( pv_il (:,:,:) < 0._wp )   pv_il (:,:,:) = 0._wp !    but it does not change conservation, so keep it this way is ok 
    639653      ! 
    640654   END SUBROUTINE ice_var_zapneg 
    641655 
    642656 
    643    SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pe_s, pe_i ) 
     657   SUBROUTINE ice_var_roundoff( pa_i, pv_i, pv_s, psv_i, poa_i, pa_ip, pv_ip, pv_il, pe_s, pe_i ) 
    644658      !!------------------------------------------------------------------- 
    645659      !!                   ***  ROUTINE ice_var_roundoff *** 
    … …  
    654668      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pa_ip      ! melt pond fraction 
    655669      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_ip      ! melt pond volume 
     670      REAL(wp), DIMENSION(:,:)  , INTENT(inout) ::   pv_il      ! melt pond lid volume 
    656671      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_s       ! snw heat content 
    657672      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe_i       ! ice heat content 
    … …  
    668683         WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10 )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    669684         WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10 )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
     685         IF( ln_pnd_lids ) THEN 
     686            WHERE( pv_il(1:npti,:) < 0._wp .AND. pv_il(1:npti,:) > -epsi10 ) pv_il(1:npti,:)   = 0._wp   ! v_il must be >= 0 
     687         ENDIF 
    670688      ENDIF 
    671689      ! 
    … …  
    786804   !! ** Purpose :  converting N-cat ice to jpl ice categories 
    787805   !!------------------------------------------------------------------- 
    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 ) 
     806   SUBROUTINE ice_var_itd_1c1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     807      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    790808      !!------------------------------------------------------------------- 
    791809      !! ** Purpose :  converting 1-cat ice to 1 ice category 
    … …  
    793811      REAL(wp), DIMENSION(:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    794812      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 
     813      REAL(wp), DIMENSION(:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     814      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 
    797815      !!------------------------------------------------------------------- 
    798816      ! == thickness and concentration == ! 
    … …  
    808826      pa_ip(:) = patip(:) 
    809827      ph_ip(:) = phtip(:) 
     828      ph_il(:) = phtil(:) 
    810829       
    811830   END SUBROUTINE ice_var_itd_1c1c 
    812831 
    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 ) 
     832   SUBROUTINE ice_var_itd_Nc1c( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     833      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    815834      !!------------------------------------------------------------------- 
    816835      !! ** Purpose :  converting N-cat ice to 1 ice category 
    … …  
    818837      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    819838      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 
     839      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     840      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 
    822841      ! 
    823842      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
    … …  
    854873      ! == ponds == ! 
    855874      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 
     875      WHERE( pa_ip(:) /= 0._wp ) 
     876         ph_ip(:) = SUM( phtip(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     877         ph_il(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / pa_ip(:) 
     878      ELSEWHERE 
     879         ph_ip(:) = 0._wp 
     880         ph_il(:) = 0._wp 
    858881      END WHERE 
    859882      ! 
    … …  
    862885   END SUBROUTINE ice_var_itd_Nc1c 
    863886    
    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 ) 
     887   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     888      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    866889      !!------------------------------------------------------------------- 
    867890      !! 
    … …  
    885908      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    886909      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 
     910      REAL(wp), DIMENSION(:)  , INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     911      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 
    889912      ! 
    890913      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zfra, z1_hti 
    … …  
    9971020         END WHERE 
    9981021      END DO 
     1022      ! keep the same v_il/v_i ratio for each category 
     1023      WHERE( ( phti(:) * pati(:) ) /= 0._wp )   ;   zfra(:) = ( phtil(:) * patip(:) ) / ( phti(:) * pati(:) ) 
     1024      ELSEWHERE                                 ;   zfra(:) = 0._wp 
     1025      END WHERE 
     1026      DO jl = 1, jpl 
     1027         WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1028         ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1029         END WHERE 
     1030      END DO 
    9991031      DEALLOCATE( zfra ) 
    10001032      ! 
    10011033   END SUBROUTINE ice_var_itd_1cMc 
    10021034 
    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 ) 
     1035   SUBROUTINE ice_var_itd_NcMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
     1036      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    10051037      !!------------------------------------------------------------------- 
    10061038      !! 
    … …  
    10331065      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    10341066      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 
     1067      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   ptmi, ptms, ptmsu, psmi, patip, phtip, phtil    ! input  ice/snow temp & sal & ponds 
     1068      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 
    10371069      ! 
    10381070      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   jlfil, jlfil2 
    … …  
    10631095         pa_ip(:,:) = patip(:,:) 
    10641096         ph_ip(:,:) = phtip(:,:) 
     1097         ph_il(:,:) = phtil(:,:) 
    10651098         !                              ! ---------------------- ! 
    10661099      ELSEIF( icat == 1 ) THEN          ! input cat = 1          ! 
    … …  
    10681101         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1), & 
    10691102            &                    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(:,:)  ) 
     1103            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), patip(:,1), phtip(:,1), phtil(:,1), & 
     1104            &                    pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:), pa_ip(:,:), ph_ip(:,:), ph_il(:,:)  ) 
    10721105         !                              ! ---------------------- ! 
    10731106      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    … …  
    10751108         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:), & 
    10761109            &                    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)  ) 
     1110            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), patip(:,:), phtip(:,:), phtil(:,:), & 
     1111            &                    pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1), pa_ip(:,1), ph_ip(:,1), ph_il(:,1)  ) 
    10791112         !                              ! ----------------------- ! 
    10801113      ELSE                              ! input cat /= output cat ! 
    … …  
    12181251            END WHERE 
    12191252         END DO 
     1253         ! keep the same v_il/v_i ratio for each category 
     1254         WHERE( SUM( phti(:,:) * pati(:,:), dim=2 ) /= 0._wp ) 
     1255            zfra(:) = SUM( phtil(:,:) * patip(:,:), dim=2 ) / SUM( phti(:,:) * pati(:,:), dim=2 ) 
     1256         ELSEWHERE 
     1257            zfra(:) = 0._wp 
     1258         END WHERE 
     1259         DO jl = 1, jpl 
     1260            WHERE( pa_ip(:,jl) /= 0._wp )   ;   ph_il(:,jl) = zfra(:) * ( ph_i(:,jl) * pa_i(:,jl) ) / pa_ip(:,jl) 
     1261            ELSEWHERE                       ;   ph_il(:,jl) = 0._wp 
     1262            END WHERE 
     1263         END DO 
    12201264         DEALLOCATE( zfra ) 
    12211265         ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/ICE/icewri.F90

    r11715 r12937  
    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 
    … …  
    149151 
    150152      ! --- category-dependent fields --- ! 
     153      IF( iom_use('icehlid_cat' ) )   CALL iom_put( 'icehlid_cat' ,   h_il         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 
     154      IF( iom_use('iceaepnd_cat') )   CALL iom_put( 'iceaepnd_cat',   a_ip_eff     * zmsk00l                                   ) ! melt pond effective frac for categories 
    151155      IF( iom_use('icemask_cat' ) )   CALL iom_put( 'icemask_cat' ,                  zmsk00l                                   ) ! ice mask 0% 
    152156      IF( iom_use('iceconc_cat' ) )   CALL iom_put( 'iceconc_cat' , a_i            * zmsk00l                                   ) ! area for categories 
    … …  
    162166      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    163167      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 
     168      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l                                   ) ! melt pond frac for categories 
    165169      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
    166       IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 
     170      IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l                                   ) ! ice albedo for categories 
    167171 
    168172      !------------------ 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/BDY/bdy_oce.F90

    r11715 r12937  
    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/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/BDY/bdydta.F90

    r11715 r12937  
    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 
    … …  
    197198                        dta_bdy(jbdy)%aip(ib,jl) =  a_ip(ii,ij,jl) * tmask(ii,ij,1)  
    198199                        dta_bdy(jbdy)%hip(ib,jl) =  h_ip(ii,ij,jl) * tmask(ii,ij,1)  
     200                        dta_bdy(jbdy)%hil(ib,jl) =  h_il(ii,ij,jl) * tmask(ii,ij,1)  
    199201                     END DO 
    200202                  END DO 
    … …  
    302304               &                                                                         bf_alias(jp_bdya_i)%fnow(:,1,:)     !   ( a_ip = rice_apnd * a_i ) 
    303305            IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 
     306            IF( TRIM(bf_alias(jp_bdyhil)%clrootname) == 'NOT USED' )   bf_alias(jp_bdyhil)%fnow(:,1,:) = rice_hlid(jbdy) 
    304307            ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 
    305308            IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 
    … …  
    319322               bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 
    320323               bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 
     324               bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 
     325            ENDIF 
     326            IF ( .NOT.ln_pnd_lids ) THEN 
     327               bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 
    321328            ENDIF 
    322329             
    … …  
    324331            ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3)             
    325332            IF( ipl /= jpl ) THEN      ! ice: convert N-cat fields (input) into jpl-cat (output) 
    326                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,:), & 
    327                   &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & 
    328                   &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 
    329                   &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 
    330                   &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), & 
    331                   &              dta_alias%t_i                  , dta_alias%t_s                  , & 
    332                   &              dta_alias%tsu                  , dta_alias%s_i                  , & 
    333                   &              dta_alias%aip                  , dta_alias%hip ) 
     333               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 
     334                  &              dta_alias%h_i                  , dta_alias%h_s                  , dta_alias%a_i                  , & ! out 
     335                  &              bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), &                                  ! in (optional) 
     336                  &              bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), &                                  ! in     - 
     337                  &              bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), bf_alias(jp_bdyhil)%fnow(:,1,:), & ! in     - 
     338                  &              dta_alias%t_i                  , dta_alias%t_s                  , &                                  ! out    - 
     339                  &              dta_alias%tsu                  , dta_alias%s_i                  , &                                  ! out    - 
     340                  &              dta_alias%aip                  , dta_alias%hip                  , dta_alias%hil )                    ! out    - 
    334341            ENDIF 
    335342         ENDIF 
    … …  
    378385      !                                                         ! =F => baroclinic velocities in 3D boundary data 
    379386      LOGICAL                                ::   ln_zinterp    ! =T => requires a vertical interpolation of the bdydta 
    380       REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd  
     387      REAL(wp)                               ::   rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 
    381388      INTEGER                                ::   ipk,ipl       ! 
    382389      INTEGER                                ::   idvar         ! variable ID 
    … …  
    390397      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_tem, bn_sal, bn_u3d, bn_v3d   ! must be an array to be used with fld_fill 
    391398      TYPE(FLD_N), DIMENSION(1), TARGET  ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    392       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        
     399      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        
    393400      TYPE(FLD_N), DIMENSION(:), POINTER ::   bn_alias                        ! must be an array to be used with fld_fill 
    394401      TYPE(FLD  ), DIMENSION(:), POINTER ::   bf_alias 
    395402      ! 
    396403      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
    397       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 
    398       NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 
     404      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 
     405      NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 
    399406      NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp 
    400407      !!--------------------------------------------------------------------------- 
    … …  
    452459#if defined key_si3 
    453460         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' ) 
     461            rn_ice_apnd = 0. ; rn_ice_hpnd = 0. ; rn_ice_hlid = 0. 
     462            CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 & rn_ice_hlid = 0 when no ponds' ) 
     463         ENDIF 
     464         IF( .NOT.ln_pnd_lids ) THEN 
     465            rn_ice_hlid = 0. 
    456466         ENDIF 
    457467#endif 
    … …  
    463473         rice_apnd(jbdy) = rn_ice_apnd 
    464474         rice_hpnd(jbdy) = rn_ice_hpnd 
    465           
     475         rice_hlid(jbdy) = rn_ice_hlid 
     476 
    466477          
    467478         DO jfld = 1, jpbdyfld 
    … …  
    562573            IF(  jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 
    563574               & 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 
     575               & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip .OR. jfld == jp_bdyhil ) THEN 
    565576               igrd = 1                                                    ! T point 
    566577               ipk = ipl                                                   ! jpl-cat data 
    … …  
    613624               bf_alias => bf(jp_bdyhip,jbdy:jbdy)                         ! alias for hip structure of bdy number jbdy 
    614625               bn_alias => bn_hip                                          ! alias for hip structure of nambdy_dta  
     626            ENDIF 
     627            IF( jfld == jp_bdyhil ) THEN 
     628               cl3 = 'hil' 
     629               bf_alias => bf(jp_bdyhil,jbdy:jbdy)                         ! alias for hil structure of bdy number jbdy 
     630               bn_alias => bn_hil                                          ! alias for hil structure of nambdy_dta  
    615631            ENDIF 
    616632 
    … …  
    681697                  ENDIF 
    682698               ENDIF 
     699               IF( jfld == jp_bdyhil ) THEN 
     700                  IF( ipk == jpl ) THEN   ;   dta_bdy(jbdy)%hil => bf_alias(1)%fnow(:,1,:) 
     701                  ELSE                    ;   ALLOCATE( dta_bdy(jbdy)%hil(iszdim,jpl) ) 
     702                  ENDIF 
     703               ENDIF 
    683704            ENDIF 
    684705 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/BDY/bdyice.F90

    r11715 r12937  
    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 
     174            ENDIF 
     175 
     176            IF( .NOT.ln_pnd_lids ) THEN 
     177               h_il(ji,jj,jl) = 0._wp 
    172178            ENDIF 
    173179            ! 
    … …  
    231237               a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) 
    232238               h_ip(ji,jj,  jl) = h_ip(ib,jb,  jl) 
     239               h_il(ji,jj,  jl) = h_il(ib,jb,  jl) 
    233240               ! 
    234241               sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) 
    … …  
    265272               ! 
    266273               ! melt ponds 
    267                IF( a_i(ji,jj,jl) > epsi10 ) THEN 
    268                   a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i (ji,jj,jl) 
    269                ELSE 
    270                   a_ip_frac(ji,jj,jl) = 0._wp 
    271                ENDIF 
    272274               v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 
     275               v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) 
    273276               ! 
    274277            ELSE   ! no ice at the boundary 
    … …  
    278281               h_s (ji,jj,  jl) = 0._wp 
    279282               oa_i(ji,jj,  jl) = 0._wp 
    280                a_ip(ji,jj,  jl) = 0._wp 
    281                v_ip(ji,jj,  jl) = 0._wp 
    282283               t_su(ji,jj,  jl) = rt0 
    283284               t_s (ji,jj,:,jl) = rt0 
    284285               t_i (ji,jj,:,jl) = rt0  
    285286 
    286                a_ip_frac(ji,jj,jl) = 0._wp 
    287                h_ip     (ji,jj,jl) = 0._wp 
    288                a_ip     (ji,jj,jl) = 0._wp 
    289                v_ip     (ji,jj,jl) = 0._wp 
     287               a_ip(ji,jj,jl) = 0._wp 
     288               h_ip(ji,jj,jl) = 0._wp 
     289               h_il(ji,jj,jl) = 0._wp 
    290290                
    291291               IF( nn_icesal == 1 ) THEN     ! if constant salinity 
    … …  
    303303               e_s (ji,jj,:,jl) = 0._wp 
    304304               e_i (ji,jj,:,jl) = 0._wp 
     305               v_ip(ji,jj,  jl) = 0._wp 
     306               v_il(ji,jj,  jl) = 0._wp 
    305307 
    306308            ENDIF 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r11715 r12937  
    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 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/SBC/sbc_ice.F90

    r11715 r12937  
    7171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: wind speed module at T-point                 [m/s] 
    7272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tsfc_ice       !: sea ice surface skin temperature (on categories) 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cloud_fra      !: cloud cover                                    [-] 
    7374#endif 
    7475 
    … …  
    9091   ! variables used in the coupled interface 
    9192   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
     93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice  
    9394    
    9495   ! already defined in ice.F90 for SI3 
    9596   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    9697   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
     98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i_last_couple   !: Sea ice fraction on categories at the last coupling point 
    9799 
    98100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    … …  
    132134         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce   (jpi,jpj)     ,   & 
    133135         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce    (jpi,jpj)     ,   & 
    134          &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz     (jpi,jpj)     , STAT= ierr(2) ) 
     136         &      emp_ice (jpi,jpj)     , tsfc_ice (jpi,jpj,jpl) , sstfrz     (jpi,jpj)     ,   & 
     137         &      cloud_fra(jpi,jpj)    , STAT= ierr(2) ) 
    135138#endif 
    136139 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/SBC/sbcblk.F90

    r11715 r12937  
    8080   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    8181 
    82    INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read 
     82   INTEGER , PARAMETER ::   jpfld   =11           ! maximum number of files to read 
    8383   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    8484   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
    … …  
    9090   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    9191   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa) 
    92    INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
     92   INTEGER , PARAMETER ::   jp_cc   =10           ! index of cloud cover                     (-)      range:0-1 
     93   INTEGER , PARAMETER ::   jp_tdif =11           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    9394 
    9495   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    … …  
    161162      !! 
    162163      !!---------------------------------------------------------------------- 
    163       INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
     164      INTEGER  ::   jfpr, jfld            ! dummy loop indice and argument 
    164165      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    165166      !! 
    … …  
    168169      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    169170      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
    170       TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        " 
     171      TYPE(FLD_N) ::   sn_slp , sn_tdif, sn_cc                 !       "                        " 
    171172      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    172          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
     173         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, sn_cc,         & 
    173174         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    174175         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         &  
    … …  
    214215      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    215216      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    216       slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
     217      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_cc)   = sn_cc 
     218      slf_i(jp_tdif) = sn_tdif 
    217219      ! 
    218220      lhftau = ln_taudif                     !- add an extra field if HF stress is used 
    … …  
    222224      ALLOCATE( sf(jfld), STAT=ierror ) 
    223225      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 
    224       DO ifpr= 1, jfld 
    225          ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226          IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227          IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
    228             &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    229             &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
    230  
    231       END DO 
     226 
    232227      !                                      !- fill the bulk structure with namelist informations 
    233228      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
    234229      ! 
     230      DO jfpr = 1, jfld 
     231         ! 
     232         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
     233            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     234            sf(jfpr)%fnow(:,:,1) = 0._wp 
     235         ELSE                                                  !-- used field --! 
     236            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     237            IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
     238            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )                      & 
     239               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 
     240               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     241         ENDIF 
     242      ENDDO 
     243      ! fill cloud cover array with constant value if "not used" 
     244      IF( TRIM(sf(jp_cc)%clrootname) == 'NOT USED' )   sf(jp_cc)%fnow(:,:,1) = cldf_ice 
     245          
    235246      IF ( ln_wave ) THEN 
    236247      !Activated wave module but neither drag nor stokes drift activated 
    … …  
    792803      REAL(wp) ::   zst3                     ! local variable 
    793804      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    794       REAL(wp) ::   zztmp, z1_rLsub           !   -      - 
    795       REAL(wp) ::   zfr1, zfr2               ! local variables 
     805      REAL(wp) ::   zztmp, z1_rLsub          !   -      - 
    796806      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
    797807      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice 
    … …  
    801811      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (SI3) 
    802812      REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa 
     813      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    803814      !!--------------------------------------------------------------------- 
    804815      ! 
    … …  
    902913      END DO 
    903914 
     915      ! --- cloud cover --- ! 
     916      cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 
     917       
    904918      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    905       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    906       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    907       ! 
    908       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    909          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    910       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    911          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    912       ELSEWHERE                                                         ! zero when hs>0 
    913          qtr_ice_top(:,:,:) = 0._wp  
    914       END WHERE 
     919      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
     920      ! 
     921      DO jl = 1, jpl 
     922         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     923            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     924         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     925            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     926         ELSEWHERE                                                         ! zero when hs>0 
     927            qtr_ice_top(:,:,jl) = 0._wp  
     928         END WHERE 
     929      ENDDO 
    915930      ! 
    916931      IF(ln_ctl) THEN 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/src/OCE/SBC/sbccpl.F90

    r11715 r12937  
    4848   USE lib_mpp        ! distribued memory computing library 
    4949   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     50 
     51#if defined key_oasis3  
     52   USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut  
     53#endif  
    5054 
    5155   IMPLICIT NONE 
    … …  
    152156   INTEGER, PARAMETER ::   jps_wlev   = 32   ! water level  
    153157   INTEGER, PARAMETER ::   jps_fice1  = 33   ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 
    154    INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area 
     158   INTEGER, PARAMETER ::   jps_a_p    = 34   ! meltpond area fraction 
    155159   INTEGER, PARAMETER ::   jps_ht_p   = 35   ! meltpond thickness 
    156160   INTEGER, PARAMETER ::   jps_kice   = 36   ! sea ice effective conductivity 
    … …  
    159163 
    160164   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
     165 
     166#if ! defined key_oasis3  
     167   ! Dummy variables to enable compilation when oasis3 is not being used  
     168   INTEGER                    ::   OASIS_Sent        = -1  
     169   INTEGER                    ::   OASIS_SentOut     = -1  
     170   INTEGER                    ::   OASIS_ToRest      = -1  
     171   INTEGER                    ::   OASIS_ToRestOut   = -1  
     172#endif  
    161173 
    162174   !                                  !!** namelist namsbc_cpl ** 
    … …  
    184196   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    185197                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     198   LOGICAL     ::   ln_scale_ice_flux     !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration)  
     199 
    186200   TYPE ::   DYNARR      
    187201      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
    … …  
    248262      REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos 
    249263      !! 
    250       NAMELIST/namsbc_cpl/  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2  ,   &  
     264      NAMELIST/namsbc_cpl/  nn_cplmodel  , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux,             & 
     265         &                  sn_snd_temp  , sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2   ,  &  
    251266         &                  sn_snd_ttilyr, sn_snd_cond  , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1,  &  
    252          &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc,   &  
    253          &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr  ,   &  
     267         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  &  
     268         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  &  
    254269         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
    255          &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal  ,   & 
    256          &                  sn_rcv_iceflx, sn_rcv_co2   , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,   & 
    257          &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl  ,   & 
     270         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
     271         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
     272         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 & 
    258273         &                  sn_rcv_ts_ice 
    259  
    260274      !!--------------------------------------------------------------------- 
    261275      ! 
    … …  
    279293      ENDIF 
    280294      IF( lwp .AND. ln_cpl ) THEN                        ! control print 
     295         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
     296         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
     297         WRITE(numout,*)'  ln_scale_ice_flux                   = ', ln_scale_ice_flux 
     298         WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
    281299         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    282300         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
    … …  
    327345         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    328346         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
    329          WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    330          WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    331          WRITE(numout,*)'  nn_cats_cpl                         = ', nn_cats_cpl 
    332347      ENDIF 
    333348 
    … …  
    815830      END SELECT 
    816831 
     832      ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 
     833#if defined key_si3 || defined key_cice 
     834       a_i_last_couple(:,:,:) = 0._wp 
     835#endif 
    817836      !                                                      ! ------------------------- !  
    818837      !                                                      !      Ice Meltponds        !  
    … …  
    16391658      ! 
    16401659      INTEGER  ::   ji, jj, jl   ! dummy loop index 
    1641       REAL(wp) ::   ztri         ! local scalar 
    16421660      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 
    16431661      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
    16441662      REAL(wp), DIMENSION(jpi,jpj)     ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
    1645       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice    !!gm , zfrqsr_tr_i 
     1663      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total 
     1664      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top 
     1665      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri, zcloud_fra 
    16461666      !!---------------------------------------------------------------------- 
    16471667      ! 
    … …  
    16631683         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16641684         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1665          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16661685      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    16671686         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    … …  
    16751694 
    16761695#if defined key_si3 
     1696 
     1697      ! --- evaporation over ice (kg/m2/s) --- ! 
     1698      IF (ln_scale_ice_flux) THEN ! typically met-office requirements 
     1699         IF (sn_rcv_emp%clcat == 'yes') THEN 
     1700            WHERE( a_i(:,:,:) > 1.e-10 )  ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     1701            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp 
     1702            END WHERE 
     1703            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 
     1704            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp 
     1705            END WHERE 
     1706         ELSE 
     1707            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 
     1708            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp 
     1709            END WHERE 
     1710            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1711            DO jl = 2, jpl 
     1712               zevap_ice(:,:,jl) = zevap_ice(:,:,1) 
     1713            ENDDO 
     1714         ENDIF 
     1715      ELSE 
     1716         IF (sn_rcv_emp%clcat == 'yes') THEN 
     1717            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 
     1718            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 
     1719            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp 
     1720            END WHERE 
     1721         ELSE 
     1722            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 
     1723            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1724            DO jl = 2, jpl 
     1725               zevap_ice(:,:,jl) = zevap_ice(:,:,1) 
     1726            ENDDO 
     1727         ENDIF 
     1728      ENDIF 
     1729 
     1730      IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 
     1731         ! For conservative case zemp_ice has not been defined yet. Do it now. 
     1732         zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 
     1733      ENDIF 
     1734 
    16771735      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
    16781736      zsnw(:,:) = 0._wp   ;   CALL ice_thd_snwblow( ziceld, zsnw ) 
    … …  
    16831741 
    16841742      ! --- evaporation over ocean (used later for qemp) --- ! 
    1685       zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 
    1686  
    1687       ! --- evaporation over ice (kg/m2/s) --- ! 
    1688       DO jl=1,jpl 
    1689          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    1690          ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    1691       ENDDO 
     1743      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 
    16921744 
    16931745      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
    … …  
    17841836      CASE( 'oce only' )         ! the required field is directly provided 
    17851837         zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1838         ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 
     1839         ! here so the only flux is the ocean only one. 
     1840         zqns_ice(:,:,:) = 0._wp  
    17861841      CASE( 'conservative' )     ! the required fields are directly provided 
    17871842         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    … …  
    19141969      CASE( 'oce only' ) 
    19151970         zqsr_tot(:,:  ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 
     1971         ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 
     1972         ! here so the only flux is the ocean only one. 
     1973         zqsr_ice(:,:,:) = 0._wp 
    19161974      CASE( 'conservative' ) 
    19171975         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    … …  
    19922050            ENDDO 
    19932051         ENDIF 
     2052      CASE( 'none' )  
     2053         zdqns_ice(:,:,:) = 0._wp 
    19942054      END SELECT 
    19952055       
    … …  
    20072067      !                                                      ! ========================= ! 
    20082068      CASE ('coupled') 
    2009          qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
    2010          qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2069         IF (ln_scale_ice_flux) THEN 
     2070            WHERE( a_i(:,:,:) > 1.e-10_wp ) 
     2071               qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2072               qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     2073            ELSEWHERE 
     2074               qml_ice(:,:,:) = 0.0_wp 
     2075               qcn_ice(:,:,:) = 0.0_wp 
     2076            END WHERE 
     2077         ELSE 
     2078            qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 
     2079            qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 
     2080         ENDIF 
    20112081      END SELECT 
    2012       ! 
     2082!!$      !                                                      ! ========================= ! 
     2083!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      ! 
     2084!!$      !                                                      ! ========================= ! 
     2085!!$         cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 
     2086!!$      END SELECT 
     2087      zcloud_fra(:,:) = cldf_ice   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 
     2088      IF( ln_mixcpl ) THEN 
     2089         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 
     2090      ELSE 
     2091         cloud_fra(:,:) = zcloud_fra(:,:) 
     2092      ENDIF 
    20132093      !                                                      ! ========================= ! 
    20142094      !                                                      !      Transmitted Qsr      !   [W/m2] 
    … …  
    20172097         ! 
    20182098         !                    ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
    2019          ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission parameter (Grenfell Maykut 77) 
     2099         !                    !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 
     2100         ztri(:,:) = 0.18 * ( 1.0 - zcloud_fra(:,:) ) + 0.35 * zcloud_fra(:,:)  ! surface transmission when hi>10cm (Grenfell Maykut 77) 
    20202101         ! 
    2021          qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 
    2022          WHERE( phs(:,:,:) >= 0.0_wp )   qtr_ice_top(:,:,:) = 0._wp            ! snow fully opaque 
    2023          WHERE( phi(:,:,:) <= 0.1_wp )   qtr_ice_top(:,:,:) = qsr_ice(:,:,:)   ! thin ice transmits all solar radiation 
     2102         DO jl = 1, jpl 
     2103            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     2104               zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     2105            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     2106               zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     2107            ELSEWHERE                                                         ! zero when hs>0 
     2108               zqtr_ice_top(:,:,jl) = 0._wp 
     2109            END WHERE 
     2110         ENDDO 
    20242111         !      
    20252112      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==! 
    … …  
    21932280      ENDIF 
    21942281 
     2282#if defined key_si3 || defined key_cice 
     2283      ! If this coupling was successful then save ice fraction for use between coupling points.  
     2284      ! This is needed for some calculations where the ice fraction at the last coupling point  
     2285      ! is needed.  
     2286      IF(  info == OASIS_Sent    .OR. info == OASIS_ToRest .OR. &  
     2287         & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN  
     2288         IF ( sn_snd_thick%clcat == 'yes' ) THEN  
     2289           a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 
     2290         ENDIF 
     2291      ENDIF 
     2292#endif 
     2293 
    21952294      IF( ssnd(jps_fice1)%laction ) THEN 
    21962295         SELECT CASE( sn_snd_thick1%clcat ) 
    … …  
    22562355            SELECT CASE( sn_snd_mpnd%clcat )   
    22572356            CASE( 'yes' )   
    2258                ztmp3(:,:,1:jpl) =  a_ip(:,:,1:jpl) 
    2259                ztmp4(:,:,1:jpl) =  v_ip(:,:,1:jpl)   
     2357               ztmp3(:,:,1:jpl) =  a_ip_eff(:,:,1:jpl) 
     2358               ztmp4(:,:,1:jpl) =  h_ip(:,:,1:jpl)   
    22602359            CASE( 'no' )   
    22612360               ztmp3(:,:,:) = 0.0   
    22622361               ztmp4(:,:,:) = 0.0   
    22632362               DO jl=1,jpl   
    2264                  ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl)   
    2265                  ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)  
     2363                 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 
     2364                 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 
    22662365               ENDDO   
    22672366            CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' )   

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/EXPREF/file_def_nemo-oce.xml

    r9572 r12937  
    1515     <field field_ref="soce" />  
    1616     <field field_ref="ssh"  /> 
    17      <field field_ref="salgrad"  /> 
    18      <field field_ref="ke_zint"  /> 
     17     <field field_ref="socegrad"  /> 
     18     <field field_ref="eken_int"  /> 
    1919     <field field_ref="relvor"  /> 
    2020     <field field_ref="potvor"  /> 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/EXPREF/namelist_cfg

    r11536 r12937  
    2020&namusr_def    !   User defined :   CANAL configuration: Flat bottom, beta-plane 
    2121!----------------------------------------------------------------------- 
    22    rn_domszx   =   3600.   !  x horizontal size         [km] 
    23    rn_domszy   =   1800.   !  y horizontal size         [km] 
    24    rn_domszz   =   5000.   !  z vertical size            [m] 
    25    rn_dx       =     30.   !  x horizontal resolution   [km] 
    26    rn_dy       =     30.   !  y horizontal resolution   [km] 
    27    rn_dz       =    500.   !  z vertical resolution      [m] 
     22   rn_domszx   =   2000.   !  x horizontal size         [km] 
     23   rn_domszy   =   1000.   !  y horizontal size         [km] 
     24   rn_domszz   =   1000.   !  z vertical size            [m] 
     25   rn_dx       =     10.   !  x horizontal resolution   [km] 
     26   rn_dy       =     10.   !  y horizontal resolution   [km] 
     27   rn_dz       =   1000.   !  z vertical resolution      [m] 
    2828   rn_0xratio  =      0.5  !  x-domain ratio of the 0 
    2929   rn_0yratio  =      0.5  !  y-domain ratio of the 0 
    … …  
    3131   rn_ppgphi0  =    38.5   !  Reference latitude      [degrees] 
    3232   rn_u10      =      0.   !  10m wind speed              [m/s] 
    33      rn_windszx =   4000.   !  longitudinal wind extension   [km] 
    34      rn_windszy =   4000.   !  latitudinal wind extension    [km] 
    35      rn_uofac  =      0.   !  Uoce multiplicative factor (0.:absolute or 1.:relative winds) 
     33     rn_windszx =   90.    !  longitudinal wind extension   [km] 
     34     rn_windszy =   90.    !  latitudinal wind extension    [km] 
     35!!clem     rn_uofac  =     0.    !  Uoce multiplicative factor (0.:absolute or 1.:relative winds) 
    3636   rn_vtxmax   =      1.   !  initial vortex max current  [m/s] 
    3737   rn_uzonal   =      1.   !  initial zonal current       [m/s] 
    38      rn_ujetszx =   4000.   !  longitudinal jet extension   [km] 
    39      rn_ujetszy =   4000.   !  latitudinal jet extension    [km] 
     38     rn_ujetszx =   4000.  !  longitudinal jet extension   [km] 
     39     rn_ujetszy =   400.   !  latitudinal jet extension    [km] 
    4040   nn_botcase  =      0    !  bottom definition (0:flat, 1:bump) 
    41    nn_initcase =      1    !  initial condition case (0:rest, 1:zonal current, 2:current shear, 3: gaussian zonal current, 
    42       !                    !                          4: geostrophic zonal pulse, 5: vortex) 
    43    ln_sshnoise =  .false.  !  add random noise on initial ssh 
    44    rn_lambda   =     50.   ! gaussian lambda 
     41   nn_initcase =      1    !  initial condition case 
     42   !                       !          -1 : stratif at rest 
     43   !                       !           0 : rest 
     44   !                       !           1 : zonal current 
     45   !                       !           2 : current shear 
     46   !                       !           3 : gaussian zonal current 
     47   !                       !           4 : geostrophic zonal pulse 
     48   !                       !           5 : baroclinic vortex 
     49   ln_sshnoise =  .FALSE.  !  add random noise on initial ssh 
     50   rn_lambda   =     50.   !  gaussian lambda 
     51   nn_perio    = 1 
    4552/ 
    4653!----------------------------------------------------------------------- 
    … …  
    5966!----------------------------------------------------------------------- 
    6067   ln_linssh   =  .false.  !  =T  linear free surface  ==>>  model level are fixed in time 
    61    rn_rdt      =   1440.   !  time step for the dynamics (and tracer if nn_acc=0) 
    62    rn_atfp     =   0.05    !  asselin time filter parameter 
     68   rn_rdt      =   1200.   !  time step for the dynamics (and tracer if nn_acc=0) 
     69   rn_atfp     =   0.0     !  asselin time filter parameter 
     70/ 
     71!----------------------------------------------------------------------- 
     72&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
     73!----------------------------------------------------------------------- 
     74   ln_write_cfg = .false.   !  (=T) create the domain configuration file 
     75      cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename 
    6376/ 
    6477!!====================================================================== 
    … …  
    148161   ln_traadv_OFF = .false. !  No tracer advection 
    149162   ln_traadv_cen = .false. !  2nd order centered scheme 
    150       nn_cen_h   =  4            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
    151       nn_cen_v   =  4            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
     163      nn_cen_h   =  2            !  =2/4, horizontal 2nd order CEN / 4th order CEN 
     164      nn_cen_v   =  2            !  =2/4, vertical   2nd order CEN / 4th order COMPACT 
    152165   ln_traadv_fct = .false. !  FCT scheme 
    153       nn_fct_h   =  2            !  =2/4, horizontal 2nd / 4th order 
     166      nn_fct_h   =  4            !  =2/4, horizontal 2nd / 4th order 
    154167      nn_fct_v   =  2            !  =2/4, vertical   2nd / COMPACT 4th order 
    155168   ln_traadv_mus = .false. !  MUSCL scheme 
    … …  
    162175&namtra_ldf    !   lateral diffusion scheme for tracers                 (default: NO selection) 
    163176!----------------------------------------------------------------------- 
    164    ln_traldf_OFF   =  .true.  !  No explicit diffusion 
     177   !                       !  Operator type: 
     178   ln_traldf_OFF   = .true.    !  No explicit diffusion 
     179   ln_traldf_lap   = .false.   !    laplacian operator 
     180   ln_traldf_blp   = .false.   !  bilaplacian operator 
     181   ! 
     182   !                       !  Direction of action: 
     183   ln_traldf_lev   = .false.   !  iso-level 
     184   ln_traldf_hor   = .true.    !  horizontal  (geopotential) 
     185   ln_traldf_iso   = .false.   !  iso-neutral (standard operator) 
     186   ln_traldf_triad = .false.   !  iso-neutral (triad    operator) 
     187   ! 
     188   !                             !  iso-neutral options: 
     189   ln_traldf_msc   = .false.   !  Method of Stabilizing Correction      (both operators) 
     190   rn_slpmax       =  0.01     !  slope limit                           (both operators) 
     191   ln_triad_iso    = .false.   !  pure horizontal mixing in ML              (triad only) 
     192   rn_sw_triad     = 1         !  =1 switching triad ; =0 all 4 triads used (triad only) 
     193   ln_botmix_triad = .false.   !  lateral mixing on bottom                  (triad only) 
     194   ! 
     195   !                       !  Coefficients: 
     196   nn_aht_ijk_t    = 31         !  space/time variation of eddy coefficient: 
     197      !                             !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file 
     198      !                             !   =  0           constant 
     199      !                             !   = 10 F(k)      =ldf_c1d 
     200      !                             !   = 20 F(i,j)    =ldf_c2d 
     201      !                             !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
     202      !                             !   = 30 F(i,j,k)  =ldf_c2d * ldf_c1d 
     203      !                             !   = 31 F(i,j,k,t)=F(local velocity and grid-spacing) 
     204      !                        !  time invariant coefficients:  aht0 = 1/2  Ud*Ld   (lap case) 
     205      !                             !                           or   = 1/12 Ud*Ld^3 (blp case) 
     206      rn_Ud        = 0.01           !  lateral diffusive velocity [m/s] (nn_aht_ijk_t= 0, 10, 20, 30) 
     207      rn_Ld        = 200.e+3        !  lateral diffusive length   [m]   (nn_aht_ijk_t= 0, 10) 
    165208/ 
    166209!!====================================================================== 
    … …  
    183226      nn_dynkeg     = 0       ! scheme for grad(KE): =0   C2  ;  =1   Hollingsworth correction 
    184227   ln_dynadv_cen2 = .false. !  flux form - 2nd order centered scheme 
    185    ln_dynadv_ubs = .true.  !  flux form - 3rd order UBS      scheme 
     228   ln_dynadv_ubs  = .true.  !  flux form - 3rd order UBS      scheme 
    186229/ 
    187230!----------------------------------------------------------------------- 
    188231&namdyn_vor    !   Vorticity / Coriolis scheme                          (default: NO selection) 
    189232!----------------------------------------------------------------------- 
    190    ln_dynvor_ene = .true.  !  energy conserving scheme 
    191    ln_dynvor_ens = .false. !  enstrophy conserving scheme 
    192    ln_dynvor_mix = .false. !  mixed scheme 
     233   ln_dynvor_ene = .false.  !  energy conserving scheme 
     234   ln_dynvor_ens = .false.  !  enstrophy conserving scheme 
     235   ln_dynvor_mix = .false.  !  mixed scheme 
    193236   ln_dynvor_een = .false.  !  energy & enstrophy scheme 
     237   ln_dynvor_enT = .false.  !  energy conserving scheme (T-point) 
     238   ln_dynvor_eeT = .true.   !  energy conserving scheme (een using e3t) 
    194239      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    195240/ 
    … …  
    210255         !                          !                     = 1 Boxcar over   nn_baro sub-steps 
    211256         !                          !                     = 2 Boxcar over 2*nn_baro  "    " 
    212       ln_bt_auto    = .false.    ! Number of sub-step defined from: 
     257      ln_bt_auto    = .true.    ! Number of sub-step defined from: 
    213258         nn_baro      =  24         ! =F : the number of sub-step in rn_rdt seconds 
    214259/ 
    … …  
    222267   !                       !  Direction of action  : 
    223268   ln_dynldf_lev =  .false.    !  iso-level 
    224    ln_dynldf_hor =  .true.    !  horizontal (geopotential) 
     269   ln_dynldf_hor =  .false.    !  horizontal (geopotential) 
    225270   ln_dynldf_iso =  .false.    !  iso-neutral 
    226271   !                       !  Coefficient 
    227    nn_ahm_ijk_t  = 20           !  space/time variation of eddy coef 
     272   nn_ahm_ijk_t  = 31           !  space/time variation of eddy coef 
    228273      !                             !  =-30  read in eddy_viscosity_3D.nc file 
    229274      !                             !  =-20  read in eddy_viscosity_2D.nc file 
    … …  
    275320!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    276321!!   namdiu       Cool skin and warm layer models                       (default: OFF) 
    277 !!   namflo       float parameters                                      (default: OFF) 
    278 !!   nam_diaharm  Harmonic analysis of tidal constituents               (default: OFF) 
    279 !!   nam_diadct   transports through some sections                      (default: OFF) 
     322!!   namflo       float parameters                                      ("key_float") 
     323!!   nam_diaharm  Harmonic analysis of tidal constituents               ("key_diaharm") 
     324!!   namdct       transports through some sections                      ("key_diadct") 
     325!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
    280326!!   nam_diatmb   Top Middle Bottom Output                              (default: OFF) 
    281327!!   nam_dia25h   25h Mean Output                                       (default: OFF) 
    … …  
    287333!----------------------------------------------------------------------- 
    288334   ln_glo_trd  = .false.   ! (T) global domain averaged diag for T, T^2, KE, and PE 
    289    ln_dyn_trd  = .true.   ! (T) 3D momentum trend output 
     335   ln_dyn_trd  = .true.    ! (T) 3D momentum trend output 
    290336   ln_dyn_mxl  = .false.   ! (T) 2D momentum trends averaged over the mixed layer (not coded yet) 
    291337   ln_vor_trd  = .false.   ! (T) 2D barotropic vorticity trends (not coded yet) 
    … …  
    314360&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi") 
    315361!----------------------------------------------------------------------- 
     362!!   jpni        =   8       !  jpni   number of processors following i (set automatically if < 1) 
     363!!   jpnj        =   1       !  jpnj   number of processors following j (set automatically if < 1) 
    316364/ 
    317365!----------------------------------------------------------------------- 
    318366&namctl        !   Control prints                                       (default: OFF) 
    319367!----------------------------------------------------------------------- 
     368   ln_timing   = .true.   !  timing by routine write out in timing.output file 
     369!!   ln_diacfl   = .true.   !  CFL diagnostics write out in cfl_diagnostics.ascii 
    320370/ 
    321371!----------------------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/MY_SRC/diawri.F90

    r11715 r12937  
    231231      IF( iom_use('logavs') )   CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 
    232232 
    233       IF ( iom_use("salgrad") .OR. iom_use("salgrad2") ) THEN 
     233      IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN 
    234234         z3d(:,:,jpk) = 0. 
    235235         DO jk = 1, jpkm1 
    … …  
    245245         END DO 
    246246         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    247          CALL iom_put( "salgrad2",  z3d )          ! square of module of sal gradient 
     247         CALL iom_put( "socegrad2",  z3d )          ! square of module of sal gradient 
    248248         z3d(:,:,:) = SQRT( z3d(:,:,:) ) 
    249          CALL iom_put( "salgrad" ,  z3d )          ! module of sal gradient 
     249         CALL iom_put( "socegrad" ,  z3d )          ! module of sal gradient 
    250250      ENDIF 
    251251          
    … …  
    300300            END DO 
    301301         END DO 
    302          CALL iom_put( "salt2c", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2) 
    303       ENDIF 
    304       ! 
    305       IF ( iom_use("eken") ) THEN 
     302         CALL iom_put( "salt2c", rau0 * z2d )          ! vertically integrated squared salt content (PSU*kg/m2) 
     303      ENDIF 
     304      ! 
     305      IF ( iom_use("eken") .OR. iom_use("eken_int") ) THEN 
    306306         z3d(:,:,jpk) = 0._wp  
    307307         DO jk = 1, jpkm1 
    308             DO jj = 2, jpj 
    309                DO ji = 2, jpi 
     308            DO jj = 2, jpjm1 
     309               DO ji = 2, jpim1 
    310310                  zztmpx = 0.5 * ( un(ji-1,jj  ,jk) + un(ji,jj,jk) ) 
    311311                  zztmpy = 0.5 * ( vn(ji  ,jj-1,jk) + vn(ji,jj,jk) ) 
    … …  
    316316         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    317317         CALL iom_put( "eken", z3d )                 ! kinetic energy 
    318       ENDIF 
    319  
    320       IF ( iom_use("ke") .or. iom_use("ke_zint") ) THEN 
    321          ! 
    322          z3d(:,:,jpk) = 0._wp 
    323          z3d(1,:, : ) = 0._wp 
    324          z3d(:,1, : ) = 0._wp 
    325          DO jk = 1, jpkm1 
    326             DO jj = 2, jpj 
    327                DO ji = 2, jpi 
    328                   z3d(ji,jj,jk) = 0.25_wp * ( un(ji  ,jj,jk) * un(ji  ,jj,jk) * e1e2u(ji  ,jj) * e3u_n(ji  ,jj,jk)  & 
    329                      &                      + un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1e2u(ji-1,jj) * e3u_n(ji-1,jj,jk)  & 
    330                      &                      + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1e2v(ji,jj  ) * e3v_n(ji,jj  ,jk)  & 
    331                      &                      + vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1e2v(ji,jj-1) * e3v_n(ji,jj-1,jk)  )  & 
    332                      &                    * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    333                END DO 
    334             END DO 
    335          END DO 
    336           
    337          CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    338          CALL iom_put( "ke", z3d ) ! kinetic energy 
    339318 
    340319         z2d(:,:)  = 0._wp  
    … …  
    342321            DO jj = 1, jpj 
    343322               DO ji = 1, jpi 
    344                   z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 
    345                END DO 
    346             END DO 
    347          END DO 
    348          CALL iom_put( "ke_zint", z2d )   ! vertically integrated kinetic energy 
    349  
     323                  z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk) 
     324               END DO 
     325            END DO 
     326         END DO 
     327         CALL iom_put( "eken_int", z2d )   ! vertically integrated kinetic energy 
    350328      ENDIF 
    351329      ! 
    … …  
    359337               DO ji = 1, fs_jpim1   ! vector opt. 
    360338                  z3d(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    361                      &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
     339                     &             - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    362340               END DO 
    363341            END DO 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/MY_SRC/usrdef_istate.F90

    r11715 r12937  
    6464      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
    6565      ! 
    66       IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 
    6766      zjetx = ABS(rn_ujetszx)/2. 
    6867      zjety = ABS(rn_ujetszy)/2. 
    6968      ! 
     69      zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
     70      ! 
    7071      SELECT CASE(nn_initcase) 
     72 
     73      CASE(-1)    ! stratif at rest 
     74 
     75         ! sea level: 
     76         pssh(:,:) = 0. 
     77         ! temperature: 
     78         pts(:,:,1,jp_tem) = 25. !!30._wp 
     79         pts(:,:,2:jpk,jp_tem) = 22. !!24._wp 
     80         ! salinity:   
     81         pts(:,:,:,jp_sal) = 35._wp 
     82         ! velocities: 
     83         pu(:,:,:) = 0. 
     84         pv(:,:,:) = 0. 
     85 
    7186      CASE(0)    ! rest 
    7287          
    … …  
    96111            zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 
    97112            WHERE( ABS(gphit) <= zjety ) 
    98                pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    99             ELSEWHERE 
    100                pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3   & 
     113               pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     114            ELSEWHERE 
     115               pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3   & 
    101116                  &                             + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    102117            END WHERE 
    … …  
    107122         pts(:,:,jpk,jp_sal) = 0. 
    108123         DO jk=1, jpkm1 
    109             pts(:,:,jk,jp_sal) = gphit(:,:) 
     124            WHERE( ABS(gphit) <= zjety ) 
     125!!$            WHERE( ABS(gphit) <= zjety*0.5 .AND. ABS(glamt) <= zjety*0.5 ) ! for a square of salt 
     126               pts(:,:,jk,jp_sal) = 35. 
     127            ELSEWHERE 
     128               pts(:,:,jk,jp_sal) = 30. 
     129            END WHERE                     
    110130         END DO 
    111131         ! velocities: 
    … …  
    132152            WHERE( ABS(gphit) <= zjety ) 
    133153               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    134                   &        * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
     154                  &        * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 
    135155            ELSEWHERE 
    136156               pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav   & 
    137                   &        * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
     157                  &        * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 
    138158            END WHERE 
    139159         END SELECT 
    … …  
    141161         pts(:,:,:,jp_tem) = 10._wp 
    142162         ! salinity:   
    143          pts(:,:,:,jp_sal) = 2. 
    144          DO jk=1, jpkm1 
    145             WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 2. + SIGN(1.,gphiv(:,:)) 
     163         pts(:,:,:,jp_sal) = 30. 
     164         DO jk=1, jpkm1 
     165            WHERE( ABS(gphiv) <= zjety ) pts(:,:,jk,jp_sal) = 30. + SIGN(1.,gphiv(:,:)) 
    146166         END DO 
    147167         ! velocities: 
    … …  
    176196         ! salinity:   
    177197         DO jk=1, jpkm1 
    178             pts(:,:,jk,jp_sal) = gphit(:,:) 
     198            pts(:,:,jk,jp_sal) = pssh(:,:) 
    179199         END DO 
    180200         ! velocities: 
    … …  
    213233         zf0   = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 
    214234         zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 
    215          zlambda = SQRT(2._wp)*rn_lambda       ! Horizontal scale in meters  
     235         zlambda = SQRT(2._wp)*rn_lambda*1.e3       ! Horizontal scale in meters  
    216236         zn2 = 3.e-3**2 
    217237         zH = 0.5_wp * 5000._wp 
    … …  
    253273         ! velocities: 
    254274         za = 2._wp * zP0 / zlambda**2 
    255          DO jj=1, jpj 
    256             DO ji=1, jpim1 
     275         DO jj = 2, jpjm1 
     276            DO ji = 2, jpim1 
    257277               zx = glamu(ji,jj) * 1.e3 
    258278               zy = gphiu(ji,jj) * 1.e3 
    … …  
    270290         END DO 
    271291         ! 
    272          DO jj=1, jpjm1 
    273             DO ji=1, jpi 
     292         DO jj = 2, jpjm1 
     293            DO ji = 2, jpim1 
    274294               zx = glamv(ji,jj) * 1.e3 
    275295               zy = gphiv(ji,jj) * 1.e3 
    … …  
    287307         END DO 
    288308         !             
     309         CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 
     310 
    289311      END SELECT 
    290312 
    291313      IF (ln_sshnoise) THEN 
     314         CALL RANDOM_SEED() 
    292315         CALL RANDOM_NUMBER(zrandom) 
    293316         pssh(:,:) = pssh(:,:) + ( 0.1  * zrandom(:,:) - 0.05 ) 
    294317      END IF 
    295       CALL lbc_lnk( 'usrdef_istate', pssh, 'T',  1. ) 
    296       CALL lbc_lnk(  'usrdef_istate', pts, 'T',  1. ) 
    297       CALL lbc_lnk(   'usrdef_istate', pu, 'U', -1. ) 
    298       CALL lbc_lnk(   'usrdef_istate', pv, 'V', -1. ) 
    299  
     318   
    300319   END SUBROUTINE usr_def_istate 
    301320 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/MY_SRC/usrdef_nam.F90

    r11715 r12937  
    5050   LOGICAL , PUBLIC ::   ln_sshnoise=.false. ! add random noise on initial ssh 
    5151   REAL(wp), PUBLIC ::   rn_lambda  = 50.    ! gaussian lambda 
     52   INTEGER , PUBLIC ::   nn_perio   =    0   ! periodicity of the channel (0=closed, 1=E-W) 
    5253 
    5354   !!---------------------------------------------------------------------- 
    … …  
    7980      !! 
    8081      NAMELIST/namusr_def/  rn_domszx, rn_domszy, rn_domszz, rn_dx, rn_dy, rn_dz, rn_0xratio, rn_0yratio   & 
    81          &                 , nn_fcase, rn_ppgphi0, rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy   & 
    82          &                 , rn_u10, rn_windszx, rn_windszy, rn_uofac   & 
    83          &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda 
     82         &                 , nn_fcase, rn_ppgphi0, rn_u10, rn_windszx, rn_windszy & !!, rn_uofac   & 
     83         &                 , rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy  & 
     84         &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, nn_perio 
    8485      !!---------------------------------------------------------------------- 
    8586      ! 
    … …  
    151152         WRITE(numout,*) '      add random noise on initial ssh   ln_sshnoise= ', ln_sshnoise 
    152153         WRITE(numout,*) '      Gaussian lambda parameter          rn_lambda = ', rn_lambda 
    153          WRITE(numout,*) '   ' 
    154          WRITE(numout,*) '   Lateral boundary condition of the global domain' 
    155          WRITE(numout,*) '      EW_CANAL : closed basin               jperio = ', kperio 
     154         WRITE(numout,*) '      Periodicity of the basin            nn_perio = ', nn_perio 
    156155      ENDIF 
     156      !                             ! Set the lateral boundary condition of the global domain 
     157      kperio = nn_perio                    ! EW_CANAL configuration : closed basin 
    157158      ! 
    158159   END SUBROUTINE usr_def_nam 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/MY_SRC/usrdef_sbc.F90

    r11715 r12937  
    1717   USE sbc_oce         ! Surface boundary condition: ocean fields 
    1818   USE phycst          ! physical constants 
    19    USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy  
     19   USE usrdef_nam, ONLY : rn_u10, rn_uofac, rn_windszy, rn_windszx  
    2020   ! 
    2121   USE in_out_manager  ! I/O manager 
    … …  
    7171         ! 
    7272         utau(:,:) = 0._wp 
    73          IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 
    74             WHERE( ABS(gphit) <= rn_windszy/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 
    75          ENDIF 
    7673         vtau(:,:) = 0._wp 
    7774         taum(:,:) = 0._wp 
    … …  
    8380         qsr (:,:) = 0._wp 
    8481         !          
     82      ENDIF 
     83 
     84      IF( rn_u10 /= 0. .AND. rn_windszy > 0. ) THEN 
     85         IF( nyear == 1 .AND. nmonth == 1 .AND. nday <= 10 ) THEN 
     86            WHERE( ABS(gphit) <= rn_windszy/2. .AND. ABS(glamt) <= rn_windszx/2. ) utau(:,:) = zrhocd * rn_u10 * rn_u10 
     87         ELSE 
     88            utau(:,:) = 0. 
     89         ENDIF 
    8590      ENDIF 
    8691 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/CANAL/MY_SRC/usrdef_zgr.F90

    r11715 r12937  
    199199         zmaxlam = MAXVAL(glamt) 
    200200         CALL mpp_max( 'usrdef_zgr', zmaxlam )                 ! max over the global domain 
    201          zscl = rpi / zmaxlam 
    202          z2d(:,:) = 0.5 * ( 1. - COS( glamt(:,:) * zscl ) ) 
    203          z2d(:,:) = REAL(jpkm1 - NINT( 0.75 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 
     201         zscl = 0.5 * rpi / zmaxlam 
     202         z2d(:,:) = COS( glamt(:,:) * zscl ) 
     203         z2d(:,:) = REAL(jpkm1 - NINT( 0.5 * REAL(jpkm1,wp) * z2d(:,:) ), wp) 
    204204      END SELECT 
    205205      ! 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg

    r10535 r12937  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization 
    9191 
    9292   sn_hti = 'initice_60pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_120pts

    r10431 r12937  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_120pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_240pts

    r10431 r12937  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_240pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/ICE_ADV1D/EXPREF/namelist_ice_cfg_60pts

    r10431 r12937  
    8888!------------------------------------------------------------------------------ 
    8989   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    90    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     90   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    9191 
    9292   sn_hti = 'initice_60pts'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/ICE_ADV2D/EXPREF/namelist_ice_cfg

    r10535 r12937  
    8686!------------------------------------------------------------------------------ 
    8787   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    88    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     88   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    8989 
    9090   sn_hti = 'initice'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 

  • NEMO/branches/UKMO/NEMO_4.0.1_fix_cpl_v2/tests/ICE_AGRIF/EXPREF/namelist_ice_cfg

    r10535 r12937  
    8686!------------------------------------------------------------------------------ 
    8787   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
    88    ln_iceini_file   = .true.          !  netcdf file provided for initialization (T) or not (F) 
     88   nn_iceini_file   =  1              !  netcdf file provided for initialization  
    8989 
    9090   sn_hti = 'initice'                 , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
Note: See TracChangeset for help on using the changeset viewer.