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

Changeset 8738 for branches/UKMO


Ignore:
Timestamp:
2017-11-17T15:40:12+01:00 (6 years ago)
Author:
dancopsey
Message:

Merged in main ICEMODEL branch (branches/2017/dev_r8183_ICEMODEL) up to revision 8588

Location:
branches/UKMO/dev_r8183_ICEMODEL_svn_removed
Files:
35 deleted
86 edited
38 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_dta

    r8733 r8738  
    1111   bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    1212   bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    13 ! for lim2 
    14 !   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    15 !   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    16 !   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    1713! for lim3 
    1814!   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc

    r6997 r8738  
    2323                           !  = 2  Redistribute a single flux over categories (coupled mode only) 
    2424                     ! Sea-ice : 
    25    nn_ice      = 2         !  =0 no ice boundary condition   , 
     25   nn_ice      = 3         !  =0 no ice boundary condition   , 
    2626                           !  =1 use observed ice-cover      , 
    27                            !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice") 
     27                           !  =3-4 ice-model used                         ("key_lim3", "key_cice") 
    2828   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    2929                           !  =1 levitating ice with mass and salt exchange but no presure effect 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_SBC.tex

    r7646 r8738  
    12661266ice-ocean fluxes, that are combined with the air-sea fluxes using the ice fraction of  
    12671267each model cell to provide the surface ocean fluxes. Note that the activation of a  
    1268 sea-ice model is is done by defining a CPP key (\key{lim2}, \key{lim3} or \key{cice}).  
     1268sea-ice model is is done by defining a CPP key (\key{lim3} or \key{cice}).  
    12691269The activation automatically overwrites the read value of nn{\_}ice to its appropriate  
    12701270value ($i.e.$ $2$ for LIM-2, $3$ for LIM-3 or $4$ for CICE). 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg

    r7942 r8738  
    2020/ 
    2121!----------------------------------------------------------------------- 
    22 &namzgr        !   vertical coordinate 
    23 !----------------------------------------------------------------------- 
    24    ln_zps      = .true.    !  z-coordinate - partial steps 
    25 / 
    26 !----------------------------------------------------------------------- 
    2722&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    2823!-----------------------------------------------------------------------   
    29    ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     24   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    3025   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
    3126   ! 
     
    4641!----------------------------------------------------------------------- 
    4742   ln_blk      = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    48    nn_ice      = 3         !  =0 no ice boundary condition   , 
     43   nn_ice      = 2         !  =0 no ice boundary condition   , 
    4944                           !  =1 use observed ice-cover      , 
    50                            !  =2 ice-model used                         ("key_lim3" or "key_lim2) 
     45                           !  =2 ice-model used                         ("key_lim3") 
    5146   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 
    5247   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
     
    176171&namdyn_hpg    !   Hydrostatic pressure gradient option 
    177172!----------------------------------------------------------------------- 
     173   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation) 
    178174/ 
    179175!----------------------------------------------------------------------- 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml

    r7948 r8738  
    9595     <field field_ref="avt"          name="difvho"   /> 
    9696     <field field_ref="w_masstr"     name="vovematr" /> 
    97           <!-- variables available with key_zdftmx_new --> 
    98           <field field_ref="av_wave"      name="av_wave"    /> 
    99           <field field_ref="bn2"          name="bn2"        /> 
    100           <field field_ref="bflx_tmx"     name="bflx_tmx"   /> 
    101           <field field_ref="pcmap_tmx"    name="pcmap_tmx"  /> 
    102           <field field_ref="emix_tmx"     name="emix_tmx"   /> 
    103           <field field_ref="av_ratio"     name="av_ratio"   /> 
     97     <!-- variables available with key_zdftmx_new --> 
     98     <field field_ref="av_wave"      name="av_wave"    /> 
     99     <field field_ref="bn2"          name="bn2"        /> 
     100     <field field_ref="bflx_tmx"     name="bflx_tmx"   /> 
     101     <field field_ref="pcmap_tmx"    name="pcmap_tmx"  /> 
     102     <field field_ref="emix_tmx"     name="emix_tmx"   /> 
     103     <field field_ref="av_ratio"     name="av_ratio"   /> 
    104104   </file> 
    105105 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg

    r7933 r8738  
    1717      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    1818      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    19 / 
    20 !----------------------------------------------------------------------- 
    21 &namzgr        !   vertical coordinate 
    22 !----------------------------------------------------------------------- 
    23    ln_zps      = .true.    !  z-coordinate - partial steps 
    2419/ 
    2520!----------------------------------------------------------------------- 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg

    r7823 r8738  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 
    3 !!              1 - Generic parameters                 (namicerun) 
    4 !!              2 - Diagnostics                        (namicediag) 
    5 !!              3 - Ice initialization                 (namiceini) 
    6 !!              4 - Ice discretization                 (namiceitd) 
    7 !!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
    12 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     2!! ESIM configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 
     3!!              1 - Generic parameters                 (nampar) 
     4!!              2 - Ice thickness discretization       (namitd) 
     5!!              3 - Ice dynamics                       (namdyn) 
     6!!              4 - Ice ridging/rafting                (namdyn_rdgrft) 
     7!!              5 - Ice rheology                       (namdyn_rhg) 
     8!!              6 - Ice advection                      (namdyn_adv) 
     9!!              7 - Ice surface forcing                (namforcing) 
     10!!              8 - Ice thermodynamics                 (namthd) 
     11!!              9 - Ice heat diffusion                 (namthd_zdf) 
     12!!             10 - Ice lateral melting                (namthd_da) 
     13!!             11 - Ice growth in open water           (namthd_do) 
     14!!             12 - Ice salinity                       (namthd_sal) 
     15!!             13 - Ice melt ponds                     (nammp) 
     16!!             14 - Ice initialization                 (namini) 
     17!!             15 - Ice/snow albedos                   (namalb) 
     18!!             16 - Ice diagnostics                    (namdia) 
     19!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     20! 
    1321!------------------------------------------------------------------------------ 
    14 &namicerun     !   Generic parameters 
     22&nampar     !   Generic parameters 
    1523!------------------------------------------------------------------------------ 
    1624/ 
    1725!------------------------------------------------------------------------------ 
    18 &namicediag    !   Diagnostics 
     26&namitd     !   Ice discretization 
    1927!------------------------------------------------------------------------------ 
    2028/ 
    2129!------------------------------------------------------------------------------ 
    22 &namiceini     !   Ice initialization 
     30&namdyn     !   Ice dynamics 
    2331!------------------------------------------------------------------------------ 
    2432/ 
    2533!------------------------------------------------------------------------------ 
    26 &namiceitd     !   Ice discretization 
     34&namdyn_rdgrft  !   Ice ridging/rafting 
    2735!------------------------------------------------------------------------------ 
    2836/ 
    2937!------------------------------------------------------------------------------ 
    30 &namicedyn     !   Ice dynamics and transport 
     38&namdyn_rhg     !   Ice rheology 
    3139!------------------------------------------------------------------------------ 
    3240/ 
    3341!------------------------------------------------------------------------------ 
    34 &namicehdf     !   Ice horizontal diffusion 
     42&namdyn_adv     !   Ice advection 
    3543!------------------------------------------------------------------------------ 
    3644/ 
    3745!------------------------------------------------------------------------------ 
    38 &namicethd     !   Ice thermodynamics 
     46&namforcing     !   Ice surface forcing 
    3947!------------------------------------------------------------------------------ 
    4048/ 
    4149!------------------------------------------------------------------------------ 
    42 &namicesal     !   Ice salinity 
     50&namthd     !   Ice thermodynamics 
    4351!------------------------------------------------------------------------------ 
    4452/ 
    4553!------------------------------------------------------------------------------ 
    46 &namiceitdme   !   Ice mechanical redistribution (ridging and rafting) 
     54&namthd_zdf     !   Ice heat diffusion 
    4755!------------------------------------------------------------------------------ 
    4856/ 
     57!------------------------------------------------------------------------------ 
     58&namthd_da     !   Ice lateral melting 
     59!------------------------------------------------------------------------------ 
     60/ 
     61!------------------------------------------------------------------------------ 
     62&namthd_do     !   Ice growth in open water 
     63!------------------------------------------------------------------------------ 
     64/ 
     65!------------------------------------------------------------------------------ 
     66&namthd_sal     !   Ice salinity 
     67!------------------------------------------------------------------------------ 
     68/ 
     69!------------------------------------------------------------------------------ 
     70&nammp      !   Melt ponds 
     71!------------------------------------------------------------------------------ 
     72/ 
     73!------------------------------------------------------------------------------ 
     74&namini     !   Ice initialization 
     75!------------------------------------------------------------------------------ 
     76/ 
     77!------------------------------------------------------------------------------ 
     78&namalb     !   albedo parameters 
     79!------------------------------------------------------------------------------ 
     80/ 
     81!------------------------------------------------------------------------------ 
     82&namdia     !   Diagnostics 
     83!------------------------------------------------------------------------------ 
     84/ 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml

    r7635 r8738  
    2121    --> 
    2222     
    23     <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
     23    <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
    2424     
    25       <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
     25      <file_group id="2ts" output_freq="2ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
    2626 
    2727      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
     
    3939      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files --> 
    4040       
    41       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->    
     41      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->    
    4242    
    4343   <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 
     
    110110 
    111111   <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 
    112           <field field_ref="snowthic_cea"    name="snthic" /> 
    113           <field field_ref="icethic_cea"     name="sithic" /> 
    114112          <field field_ref="icevolu"         name="sivolu" /> 
    115           <field field_ref="snowvol"         name="snvolu" /> 
    116           <field field_ref="iceconc"         name="siconc" /> 
    117  
    118           <field field_ref="vfxbog"          name="vfxbog" /> 
    119           <field field_ref="vfxdyn"          name="vfxdyn" /> 
    120           <field field_ref="vfxopw"          name="vfxopw" /> 
    121           <field field_ref="vfxsni"          name="vfxsni" /> 
    122           <field field_ref="vfxsum"          name="vfxsum" /> 
    123           <field field_ref="vfxbom"          name="vfxbom" /> 
    124           <field field_ref="vfxres"          name="vfxres" /> 
    125           <field field_ref="vfxice"          name="vfxice" /> 
    126           <field field_ref="vfxsnw"          name="vfxsnw" /> 
    127           <field field_ref="vfxsub"          name="vfxsub" /> 
    128           <field field_ref="vfxspr"          name="vfxspr" /> 
    129  
    130           <field field_ref="icetrp"          name="sivtrp" /> 
    131           <field field_ref="snwtrp"          name="snvtrp" /> 
    132           <field field_ref="saltrp"          name="saltrp" /> 
    133           <field field_ref="deitrp"          name="deitrp" /> 
    134           <field field_ref="destrp"          name="destrp" /> 
    135  
    136           <field field_ref="sfxbri"          name="sfxbri" /> 
    137           <field field_ref="sfxdyn"          name="sfxdyn" /> 
    138           <field field_ref="sfxres"          name="sfxres" /> 
    139           <field field_ref="sfxbog"          name="sfxbog" /> 
    140           <field field_ref="sfxbom"          name="sfxbom" /> 
    141           <field field_ref="sfxsum"          name="sfxsum" /> 
    142           <field field_ref="sfxsni"          name="sfxsni" /> 
    143           <field field_ref="sfxopw"          name="sfxopw" /> 
    144           <field field_ref="sfx"             name="sfx"    /> 
    145  
    146           <field field_ref="hfxsum"          name="hfxsum"     /> 
    147           <field field_ref="hfxbom"          name="hfxbom"     /> 
    148           <field field_ref="hfxbog"          name="hfxbog"     /> 
    149           <field field_ref="hfxdif"          name="hfxdif"     /> 
    150           <field field_ref="hfxopw"          name="hfxopw"     /> 
    151           <field field_ref="hfxout"          name="hfxout"     /> 
    152           <field field_ref="hfxin"           name="hfxin"      /> 
    153           <field field_ref="hfxsnw"          name="hfxsnw"     /> 
    154           <field field_ref="hfxerr"          name="hfxerr"     /> 
    155           <field field_ref="hfxerr_rem"      name="hfxerr_rem" /> 
    156  
    157      <!-- ice-ocean heat flux from mass exchange --> 
    158           <field field_ref="hfxdyn"          name="hfxdyn" /> 
    159           <field field_ref="hfxres"          name="hfxres" /> 
    160           <field field_ref="hfxthd"          name="hfxthd" /> 
    161      <!-- ice-atm. heat flux from mass exchange --> 
    162           <field field_ref="hfxsub"          name="hfxsub" /> 
    163           <field field_ref="hfxspr"          name="hfxspr" /> 
    164  
    165      <!-- diags --> 
    166           <field field_ref="hfxdhc"          name="hfxdhc" /> 
    167           <field field_ref="hfxtur"          name="hfxtur" /> 
    168  
    169           <field field_ref="isst"            name="sst"    /> 
    170           <field field_ref="isss"            name="sss"    /> 
    171           <field field_ref="micesalt"        name="sisali" /> 
    172           <field field_ref="micet"           name="sitemp" /> 
    173           <field field_ref="icest"           name="sistem" /> 
    174           <field field_ref="icehc"           name="siheco" /> 
    175           <field field_ref="isnowhc"         name="snheco" /> 
    176           <field field_ref="miceage"         name="siages" /> 
    177  
    178           <field field_ref="uice_ipa"        name="sivelu" /> 
    179           <field field_ref="vice_ipa"        name="sivelv" /> 
    180           <field field_ref="icevel"          name="sivelo" /> 
    181           <field field_ref="idive"           name="sidive" /> 
    182           <field field_ref="ishear"          name="sishea" /> 
    183           <field field_ref="icestr"          name="sistre" /> 
    184  
    185           <field field_ref="ibrinv"          name="sibrin" /> 
    186           <field field_ref="icecolf"         name="sicolf" /> 
    187  
    188           <field field_ref="iceage_cat"      name="siagecat" /> 
    189           <field field_ref="iceconc_cat"     name="siconcat" /> 
    190           <field field_ref="icethic_cat"     name="sithicat" /> 
    191           <field field_ref="snowthic_cat"    name="snthicat" /> 
    192           <field field_ref="salinity_cat"    name="salincat" /> 
    193           <field field_ref="brinevol_cat"    name="sibricat" /> 
    194      <field field_ref="icetemp_cat"     name="sitemcat" /> 
    195      <field field_ref="snwtemp_cat"     name="sntemcat" /> 
    196113 
    197114   </file> 
    198  
    199         <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 
    200           <field field_ref="voltot"       name="scvoltot"   /> 
    201           <field field_ref="sshtot"       name="scsshtot"   /> 
    202           <field field_ref="sshsteric"    name="scsshste"   /> 
    203           <field field_ref="sshthster"    name="scsshtst"   /> 
    204           <field field_ref="masstot"      name="scmastot"   /> 
    205           <field field_ref="temptot"      name="sctemtot"   /> 
    206           <field field_ref="saltot"       name="scsaltot"   /> 
    207  
    208           <field field_ref="bgtemper"     name="bgtemper"   /> 
    209           <field field_ref="bgsaline"     name="bgsaline"   /> 
    210           <field field_ref="bgheatco"     name="bgheatco"   /> 
    211           <field field_ref="bgsaltco"     name="bgsaltco"   /> 
    212           <field field_ref="bgvolssh"     name="bgvolssh"   />  
    213           <field field_ref="bgvole3t"     name="bgvole3t"   /> 
    214           <field field_ref="bgfrcvol"     name="bgfrcvol"   /> 
    215           <field field_ref="bgfrctem"     name="bgfrctem"   /> 
    216           <field field_ref="bgfrcsal"     name="bgfrcsal"   /> 
    217  
    218           <field field_ref="ibgvoltot"    name="ibgvoltot"  /> 
    219           <field field_ref="sbgvoltot"    name="sbgvoltot"  /> 
    220           <field field_ref="ibgarea"      name="ibgarea"    /> 
    221           <field field_ref="ibgsaline"    name="ibgsaline"  /> 
    222           <field field_ref="ibgtemper"    name="ibgtemper"  /> 
    223           <field field_ref="ibgheatco"    name="ibgheatco"  /> 
    224           <field field_ref="sbgheatco"    name="sbgheatco"  /> 
    225           <field field_ref="ibgsaltco"    name="ibgsaltco"  /> 
    226  
    227           <field field_ref="ibgvfx"       name="ibgvfx"     /> 
    228           <field field_ref="ibgvfxbog"    name="ibgvfxbog"  /> 
    229           <field field_ref="ibgvfxopw"    name="ibgvfxopw"  /> 
    230           <field field_ref="ibgvfxsni"    name="ibgvfxsni"  /> 
    231           <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"  /> 
    232           <field field_ref="ibgvfxbom"    name="ibgvfxbom"  /> 
    233           <field field_ref="ibgvfxsum"    name="ibgvfxsum"  /> 
    234           <field field_ref="ibgvfxres"    name="ibgvfxres"  /> 
    235           <field field_ref="ibgvfxspr"    name="ibgvfxspr"  /> 
    236           <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"  /> 
    237           <field field_ref="ibgvfxsub"    name="ibgvfxsub"  /> 
    238  
    239           <field field_ref="ibgsfx"       name="ibgsfx"     /> 
    240           <field field_ref="ibgsfxbri"    name="ibgsfxbri"  /> 
    241           <field field_ref="ibgsfxdyn"    name="ibgsfxdyn"  /> 
    242           <field field_ref="ibgsfxres"    name="ibgsfxres"  /> 
    243           <field field_ref="ibgsfxbog"    name="ibgsfxbog"  /> 
    244           <field field_ref="ibgsfxopw"    name="ibgsfxopw"  /> 
    245           <field field_ref="ibgsfxsni"    name="ibgsfxsni"  /> 
    246           <field field_ref="ibgsfxbom"    name="ibgsfxbom"  /> 
    247           <field field_ref="ibgsfxsum"    name="ibgsfxsum"  /> 
    248  
    249           <field field_ref="ibghfxdhc"    name="ibghfxdhc"  /> 
    250           <field field_ref="ibghfxspr"    name="ibghfxspr"  /> 
    251  
    252           <field field_ref="ibghfxres"    name="ibghfxres"  /> 
    253           <field field_ref="ibghfxsub"    name="ibghfxsub"  /> 
    254           <field field_ref="ibghfxdyn"    name="ibghfxdyn"  /> 
    255           <field field_ref="ibghfxthd"    name="ibghfxthd"  /> 
    256           <field field_ref="ibghfxsum"    name="ibghfxsum"  /> 
    257           <field field_ref="ibghfxbom"    name="ibghfxbom"  /> 
    258           <field field_ref="ibghfxbog"    name="ibghfxbog"  /> 
    259           <field field_ref="ibghfxdif"    name="ibghfxdif"  /> 
    260           <field field_ref="ibghfxopw"    name="ibghfxopw"  /> 
    261           <field field_ref="ibghfxout"    name="ibghfxout"  /> 
    262           <field field_ref="ibghfxin"     name="ibghfxin"   /> 
    263           <field field_ref="ibghfxsnw"    name="ibghfxsnw"  /> 
    264  
    265           <field field_ref="ibgfrcvol"    name="ibgfrcvol"  /> 
    266           <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
    267           <field field_ref="ibgvolgrm"    name="ibgvolgrm"  /> 
    268  
    269         </file> 
    270115 
    271116   <!-- 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg

    r7404 r8738  
    1919/ 
    2020!----------------------------------------------------------------------- 
    21 &namzgr        !   vertical coordinate 
    22 !----------------------------------------------------------------------- 
    23    ln_zps      = .true.    !  z-coordinate - partial steps 
    24 / 
    25 !----------------------------------------------------------------------- 
    2621&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    2722!----------------------------------------------------------------------- 
     
    8176&nambbc        !   bottom temperature boundary condition                (default: NO) 
    8277!----------------------------------------------------------------------- 
    83    ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    8478/ 
    8579!----------------------------------------------------------------------- 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg

    r7404 r8738  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 
    3 !!              1 - Generic parameters                 (namicerun) 
    4 !!              2 - Diagnostics                        (namicediag) 
    5 !!              3 - Ice initialization                 (namiceini) 
    6 !!              4 - Ice discretization                 (namiceitd) 
    7 !!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
    12 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     2!! ESIM configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 
     3!!              1 - Generic parameters                 (namice_run) 
     4!!              2 - Ice thickness discretization       (namice_itd) 
     5!!              3 - Ice dynamics                       (namice_dyn) 
     6!!              4 - Ice ridging/rafting                (namice_rdgrft) 
     7!!              5 - Ice rheology                       (namice_rhg) 
     8!!              6 - Ice advection                      (namice_adv) 
     9!!              7 - Ice thermodynamics                 (namice_thd) 
     10!!              8 - Ice salinity                       (namice_sal) 
     11!!              9 - Ice melt ponds                     (namice_mp) 
     12!!             10 - Ice initialization                 (namice_ini) 
     13!!             11 - Ice/snow albedos                   (namice_alb) 
     14!!             12 - Ice diagnostics                    (namice_dia) 
     15!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     16! 
    1317!------------------------------------------------------------------------------ 
    14 &namicerun     !   Generic parameters 
     18&namice_run     !   Generic parameters 
    1519!------------------------------------------------------------------------------ 
    1620/ 
    1721!------------------------------------------------------------------------------ 
    18 &namicediag    !   Diagnostics 
     22&namice_itd     !   Ice discretization 
    1923!------------------------------------------------------------------------------ 
    2024/ 
    2125!------------------------------------------------------------------------------ 
    22 &namiceini     !   Ice initialization 
     26&namice_dyn     !   Ice dynamics 
    2327!------------------------------------------------------------------------------ 
    2428/ 
    2529!------------------------------------------------------------------------------ 
    26 &namiceitd     !   Ice discretization 
     30&namice_rdgrft  !   Ice ridging/rafting 
    2731!------------------------------------------------------------------------------ 
    2832/ 
    2933!------------------------------------------------------------------------------ 
    30 &namicedyn     !   Ice dynamics and transport 
     34&namice_rhg     !   Ice rheology 
    3135!------------------------------------------------------------------------------ 
    3236/ 
    3337!------------------------------------------------------------------------------ 
    34 &namicehdf     !   Ice horizontal diffusion 
     38&namice_adv     !   Ice advection 
    3539!------------------------------------------------------------------------------ 
    3640/ 
    3741!------------------------------------------------------------------------------ 
    38 &namicethd     !   Ice thermodynamics 
     42&namice_thd     !   Ice thermodynamics 
    3943!------------------------------------------------------------------------------ 
    4044/ 
    4145!------------------------------------------------------------------------------ 
    42 &namicesal     !   Ice salinity 
     46&namice_sal     !   Ice salinity 
    4347!------------------------------------------------------------------------------ 
    4448/ 
    4549!------------------------------------------------------------------------------ 
    46 &namiceitdme   !   Ice mechanical redistribution (ridging and rafting) 
     50&namicemp      !   Melt ponds 
    4751!------------------------------------------------------------------------------ 
    4852/ 
     53!------------------------------------------------------------------------------ 
     54&namice_ini     !   Ice initialization 
     55!------------------------------------------------------------------------------ 
     56/ 
     57!------------------------------------------------------------------------------ 
     58&namice_alb     !   albedo parameters 
     59!------------------------------------------------------------------------------ 
     60/ 
     61!------------------------------------------------------------------------------ 
     62&namice_dia     !   Diagnostics 
     63!------------------------------------------------------------------------------ 
     64/ 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm

    r7423 r8738  
    1  bld::tool::fppkeys key_trabbl key_lim3  key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_lim3 key_iomput key_mpp_mpi 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml

    r7767 r8738  
    1212      <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc --> 
    1313 
    14          <!-- LIM2(only) fields --> 
    15          <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              standard_name="surface_downwelling_shortwave_flux_in_air"          unit="W/m2"         /> 
    16          <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         /> 
    17          <field id="qla_ai_cea"   long_name="Air-Ice downward Latent heat flux (cell average)"             standard_name="surface_downward_latent_heat_flux"                  unit="W/m2"         />          
    18          <field id="qsr_io_cea"   long_name="Ice-Oce downward solar heat flux (cell average)"              standard_name="net_downward_shortwave_flux_at_sea_water_surface"   unit="W/m2"         /> 
    19          <field id="qns_io_cea"   long_name="Ice-Oce downward non-solar heat flux (cell average)"                                                                             unit="W/m2"         /> 
    20          <field id="iceprod_cea"  long_name="Ice production (cell average)"                                                                                                   unit="m/s"          /> 
    21          <field id="iiceconc"     long_name="Ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="1"            /> 
    22          <field id="ice_pres"     long_name="Ice presence"                                                                                                                    unit=""             /> 
    23          <field id="ist_cea"      long_name="Ice surface temperature (cell average)"                       standard_name="surface_temperature"                                unit="degC"         /> 
    24          <field id="ist_ipa"      long_name="Ice surface temperature (ice presence average)"               standard_name="surface_temperature"                                unit="degC"         /> 
    25          <field id="u_imasstr"    long_name="Sea-ice mass transport along i-axis"                          standard_name="sea_ice_x_transport"                                unit="kg/s"         /> 
    26          <field id="v_imasstr"    long_name="Sea-ice mass transport along j-axis"                          standard_name="sea_ice_y_transport"                                unit="kg/s"         /> 
     14         <!-- SIMIP LIM fields --> 
     15         <field id="icethick"     long_name="Sea-ice thickness per area"                           standard_name="sea_ice_thickness"                          unit="m"   /> 
     16         <field id="icethic"      long_name="Sea-ice thickness"                                    standard_name="sea_ice_thickness"                          unit="m"   /> 
     17         <field id="uice_mv"      long_name="X-component of sea ice velocity"                      standard_name="sea_ice_x_velocity"                         unit="m/s" />  
     18         <field id="vice_mv"      long_name="Y-component of sea ice velocity"                      standard_name="sea_ice_y_velocity"                         unit="m/s" />       
     19         <field id="icevel_mv"    long_name="Sea-ice speed"                                        standard_name="sea_ice_speed"                              unit="m/s" /> 
     20         <field id="icepres"      long_name="Fraction of time steps with sea ice"                  standard_name="sea_ice_time_fraction"                      unit=""             /> 
     21         <field id="iceconc"      long_name="Sea-ice area fraction"                                standard_name="sea_ice_area_fraction"                      unit=""             /> 
     22         <field id="iceconc_pct"  long_name="Sea-ice area fraction in percent"                     standard_name="sea_ice_area_fraction_in_percent"           unit="%"             > iceconc * 100. </field > 
     23         <field id="icemass"      long_name="Sea-ice mass per area"                                standard_name="sea_ice_amount"                             unit="kg/m2"        /> 
     24         <field id="icevolu"      long_name="Sea-ice volume per area"                              standard_name="sea_ice_thickness"                          unit="m"            /> 
     25         <field id="snomass"      long_name="Snow mass per area"                                   standard_name="liquid_water_content_of_surface_snow"       unit="kg/m2"        /> 
     26         <field id="snothic"      long_name="Snow thickness"                                       standard_name="surface_snow_thickness"                     unit="m"            /> 
     27 
     28         <field id="iceconc_cat_mv"     long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories"      unit=""   grid_ref="grid_T_3D_ncatice" /> 
     29         <field id="iceconc_cat_pct_mv" long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories"      unit="%"  grid_ref="grid_T_3D_ncatice"  > iceconc_cat_mv * 100. </field > 
     30         <field id="icethic_cat_mv"     long_name="Sea-ice thickness in thickness categories"      standard_name="sea_ice_thickness_over_categories"          unit="m"  grid_ref="grid_T_3D_ncatice" /> 
     31         <field id="snowthic_cat_mv"    long_name="Snow thickness in thickness categories"         standard_name="snow_thickness_over_categories"             unit="m"  grid_ref="grid_T_3D_ncatice" /> 
     32 
     33         <field id="icestK"       long_name="Surface temperature of sea ice"                       standard_name="sea_ice_surface_temperature"                unit="K"            />  
     34         <field id="icesntK"      long_name="Temperature at snow-ice interface"                    standard_name="sea_ice_snow_interface_temperature"         unit="K"            /> 
     35         <field id="icebotK"      long_name="Temperature at ice-ocean interface"                   standard_name="sea_ice_bottom_temperature"                 unit="K"            /> 
     36 
     37         <field id="iceage"       long_name="Age of sea ice"                                       standard_name="age_of_sea_ice"                             unit="s"            /> 
     38         <field id="icealb"       long_name="Sea-ice or snow albedo"                               standard_name="sea_ice_albedo"                             unit=""             /> 
     39         <field id="icesmass"     long_name="Mass of salt in sea ice per area"                     standard_name="sea_ice_salt_mass"                          unit="kg/m2"        /> 
     40         <field id="icesal"       long_name="Sea ice salinity"                                     standard_name="sea_ice_salinity"                           unit="g/kg"         /> 
     41         <field id="icefb"        long_name="Sea-ice freeboard"                                    standard_name="sea_ice_freeboard"                          unit="m"            /> 
     42 
     43         <field id="icehcneg"     long_name="Sea-ice heat content per unit area"  standard_name="integral_of_sea_ice_temperature_wrt_depth_expressed_as_heat_content" unit="J/m2" > (-1.0)*icehc </field> 
     44         <field id="isnhcneg"     long_name="Snow-heat content per unit area"     standard_name="thermal_energy_content_of_surface_snow"                              unit="J/m2" > </field> 
     45 
     46         <field id="wfxsum"       long_name="Freshwater flux from sea-ice surface"               standard_name="freshwater_flux_from_ice_surface"                   unit="kg/m2/s"      /> 
     47 
     48         <field id="afxthd"       long_name="sea-ice area fraction change from thermodynamics"   standard_name="tendency_of_sea_ice_area_fraction_due_to_dynamics"  unit="s-1"   /> 
     49         <field id="afxdyn"       long_name="sea-ice area fraction change from dynamics"         standard_name="tendency_of_sea_ice_area_fraction_due_to_dynamics"  unit="s-1"   /> 
     50 
     51         <field id="dmithd"       long_name="sea-ice mass change from thermodynamics"            standard_name="tendency_of_sea_ice_amount_due_to_thermodynamics"   unit="kg/m2/s" /> 
     52         <field id="dmidyn"       long_name="sea-ice mass change from dynamics"                  standard_name="tendency_of_sea_ice_amount_due_to_dynamics"         unit="kg/m2/s" /> 
     53         <field id="dmiopw"       long_name="sea-ice mass change through growth in supercooled open water (aka frazil)"   standard_name="tendency_of_sea_ice_amount_due_to_freezing_in_open_water"   unit="kg/m2/s" /> 
     54         <field id="dmibog"       long_name="sea-ice mass change through basal growth"           standard_name="tendency_of_sea_ice_amount_due_to_congelation_ice_accumulation"  unit="kg/m2/s" /> 
     55         <field id="dmisni"       long_name="sea-ice mass change through snow-to-ice conversion" standard_name="tendency_of_sea_ice_amount_due_to_snow_conversion"               unit="kg/m2/s" /> 
     56         <field id="dmtsub"       long_name="snow and sea ice mass change through sublimation"   standard_name="tendency_of_snow_and_ice_amount_due_to_sublimation"              unit="kg/m2/s" /> 
     57         <field id="dmssub"       long_name="sea-ice mass change through evaporation and sublimation" standard_name="water_evaporation_flux"                                     unit="kg/m2/s" /> 
     58         <field id="dmisub"       long_name="snow mass change through evaporation or sublimation"     standard_name="surface_snow_sublimation_flux"           unit="kg/m2/s" /> 
     59         <field id="dmisum"       long_name="sea-ice mass change through surface melting"        standard_name="tendency_of_sea_ice_amount_due_to_surface_melting"               unit="kg/m2/s" /> 
     60         <field id="dmibom"       long_name="sea-ice mass change through bottom melting"         standard_name="tendency_of_sea_ice_amount_due_to_basal_melting"                 unit="kg/m2/s" /> 
     61 
     62         <field id="dmsspr"       long_name="snow mass change through snow fall"                 standard_name="snowfall_flux"                                                   unit="kg/m2/s" /> 
     63         <field id="dmsmel"       long_name="snow mass change through melt"                      standard_name="surface_snow_melt_flux"                                          unit="kg/m2/s" /> 
     64         <field id="dmsdyn"       long_name="snow mass change through advection by sea-ice dynamics" standard_name="tendency_of_snow_mass_due_to_sea_ice_dynamics"               unit="kg/m2/s" /> 
     65         <field id="dmsssi"       long_name="snow mass change through snow-to-ice conversion"    standard_name="tendency_of_snow_mass_due_to_snow_to_ice_conversion"             unit="kg/m2/s" /> 
     66 
     67         <field id="hfxsenso"     long_name="Net sensible heat flux under sea ice"               standard_name="ice_ocean_heat_flux"                          unit="W/m2" /> 
     68         <field id="hfxconsu"     long_name="Net conductive heat flux in ice at the surface"     standard_name="conductive_heat_flux_at_sea_ice_surface"      unit="W/m2" />  
     69         <field id="hfxconbo"     long_name="Net conductive heat fluxes in ice at the bottom"    standard_name="conductive_heat_flux_at_sea_ice_bottom"       unit="W/m2" /> 
     70 
     71         <field id="sfx_mv"       long_name="Salt flux from sea ice"                             standard_name="salt_flux_from_ice"                           unit="kg/m2/s" /> 
     72         <field id="wfxtot"       long_name="Freshwater flux from sea ice"                       standard_name="freshwater_flux_from_ice"                     unit="kg/m2/s" />  
     73 
     74         <field id="utau_ice"     long_name="X-component of atmospheric stress on sea ice"       standard_name="surface_downward_x_stress"                    unit="N/m2"    /> 
     75         <field id="vtau_ice"     long_name="Y-component of atmospheric stress on sea ice"       standard_name="surface_downward_y_stress"                    unit="N/m2"    /> 
     76 
     77         <field id="utau_oi"      long_name="X-component of ocean stress on sea ice"             standard_name="sea_ice_base_upward_x_stress"                 unit="N/m2"    /> 
     78         <field id="vtau_oi"      long_name="Y-component of ocean stress on sea ice"             standard_name="sea_ice_base_upward_y_stress"                 unit="N/m2"    /> 
     79 
     80         <field id="icestr"       long_name="Compressive sea ice strength"                       standard_name="compressive_strength_of_sea_ice"              unit="N/m"     /> 
     81 
     82         <field id="dssh_dx"      long_name="Sea-surface tilt term in force balance (x-component)"  standard_name="sea_surface_tilt_force_on_sea_ice_x"       unit="N/m2"    /> 
     83         <field id="dssh_dy"      long_name="Sea-surface tilt term in force balance (y-component)"  standard_name="sea_surface_tilt_force_on_sea_ice_y"       unit="N/m2"    /> 
     84 
     85         <field id="corstrx"      long_name="Coriolis force term in force balance (x-component)"    standard_name="coriolis_force_on_sea_ice_x"               unit="N/m2"    /> 
     86         <field id="corstry"      long_name="Coriolis force term in force balance (y-component)"    standard_name="coriolis_force_on_sea_ice_y"               unit="N/m2"    /> 
     87 
     88         <field id="intstrx"      long_name="Internal stress term in force balance (x-component)"   standard_name="internal_stress_in_sea_ice_x"              unit="N/m2"    /> 
     89         <field id="intstry"      long_name="Internal stress term in force balance (y-component)"   standard_name="internal_stress_in_sea_ice_y"              unit="N/m2"    /> 
     90 
     91         <field id="xmtrpice"     long_name="X-component of ice mass transport"                  standard_name="ice_x_transport"                              unit="kg/s" /> 
     92         <field id="ymtrpice"     long_name="Y-component of ice mass transport"                  standard_name="ice_y_transport"                              unit="kg/s" /> 
     93 
     94         <field id="xmtrpsnw"     long_name="X-component of snw mass transport"                  standard_name="snw_x_transport"                              unit="kg/s" /> 
     95         <field id="ymtrpsnw"     long_name="Y-component of snw mass transport"                  standard_name="snw_y_transport"                              unit="kg/s" /> 
     96 
     97         <field id="xatrp"        long_name="X-component of ice area transport"                  standard_name="area_x_transport"                             unit="m2/s" /> 
     98         <field id="yatrp"        long_name="Y-component of ice area transport"                  standard_name="area_y_transport"                             unit="m2/s" /> 
     99 
     100         <field id="xmtrptot"     long_name="X-component of sea-ice mass transport"              standard_name="sea_ice_x_transport"                          unit="kg/s" > xmtrpice + xmtrpsnw </field> 
     101         <field id="ymtrptot"     long_name="Y-component of sea-ice mass transport"              standard_name="sea_ice_y_transport"                          unit="kg/s" > ymtrpice + ymtrpsnw </field> 
     102 
     103         <field id="normstr"      long_name="Average normal stress in sea ice"                   standard_name="average_normal_stress"                        unit="N/m"     /> 
     104         <field id="sheastr"      long_name="Maximum shear stress in sea ice"                    standard_name="maximum_shear_stress"                         unit="N/m"     /> 
     105 
     106         <field id="idive"        long_name="Divergence of the sea-ice velocity field"           standard_name="divergence_of_sea_ice_velocity"               unit="s-1"     /> 
     107         <field id="ishear"       long_name="Maximum shear of sea-ice velocity field"            standard_name="maximum_shear_of_sea_ice_velocity"            unit="s-1"     /> 
     108 
     109 
    27110 
    28111         <!-- LIM3 fields -->   
     112 
    29113         <field id="ice_cover"    long_name="Ice fraction"                                                 standard_name="sea_ice_area_fraction"                              unit="1"            /> 
    30   
    31          <field id="snowthic_cea" long_name="Snow thickness (cell average)"                                standard_name="surface_snow_thickness"                             unit="m"            /> 
    32          <field id="icethic_cea"  long_name="Ice thickness (cell average)"                                 standard_name="sea_ice_thickness"                                  unit="m"            /> 
    33  
    34          <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  standard_name="sea_ice_x_velocity"                                 unit="m/s"          />       
    35          <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  standard_name="sea_ice_y_velocity"                                 unit="m/s"          />                
    36          <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             standard_name="surface_downward_x_stress"                          unit="N/m2"         /> 
    37          <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             standard_name="surface_downward_y_stress"                          unit="N/m2"         /> 
    38           
    39          <field id="iceconc"      long_name="ice concentration"                                            standard_name="sea_ice_area_fraction"                              unit="%"            /> 
     114         <field id="icepres"      long_name="Ice presence"                                                                                                                    unit=""             /> 
     115 
     116         <field id="uice_ipa"     long_name="X-component of sea ice velocity"                              standard_name="sea_ice_x_velocity"                                 unit="m/s"          />  
     117         <field id="vice_ipa"     long_name="Y-component of sea ice velocity"                              standard_name="sea_ice_y_velocity"                                 unit="m/s"          />       
     118         <field id="icevel"       long_name="Sea-ice speed"                                                standard_name="sea_ice_speed"                                      unit="m/s"          /> 
    40119          <field id="isst"         long_name="sea surface temperature"                                      standard_name="sea_surface_temperature"                            unit="degC"         /> 
    41120         <field id="isss"         long_name="sea surface salinity"                                         standard_name="sea_surface_salinity"                               unit="1e-3"         />  
     
    48127         <field id="qtr_ice"      long_name="solar heat flux transmitted through ice: sum over categories"                                                                    unit="W/m2"         /> 
    49128         <field id="qemp_ice"     long_name="Downward Heat Flux from E-P over ice"                                                                                            unit="W/m2"         /> 
    50          <field id="micesalt"     long_name="Mean ice salinity"                                                                                                               unit="1e-3"         /> 
    51          <field id="miceage"      long_name="Mean ice age"                                                                                                                    unit="years"        /> 
    52          <field id="alb_ice"      long_name="Mean albedo over sea ice"                                                                                                        unit=""             /> 
    53129         <field id="albedo"       long_name="Mean albedo over sea ice and ocean"                                                                                              unit=""             /> 
    54130 
     131    <field id="iceamp"       long_name="melt pond fraction"                                           standard_name="sea_ice_meltpond_fraction"                          unit="%"            />  
     132         <field id="icevmp"       long_name="melt pond volume"                                             standard_name="sea_ice_meltpond_volume"                            unit="m"            />  
     133 
     134         <field id="iceconc_cat"  long_name="Sea-ice area fractions in thickness categories"               unit=""   grid_ref="grid_T_3D_ncatice" /> 
     135         <field id="icethic_cat"  long_name="Sea-ice thickness in thickness categories"                    unit="m"  grid_ref="grid_T_3D_ncatice" /> 
     136         <field id="snowthic_cat" long_name="Snow thickness in thickness categories"                       unit="m"  grid_ref="grid_T_3D_ncatice" /> 
    55137         <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   grid_ref="grid_T_3D_ncatice" /> 
    56          <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      grid_ref="grid_T_3D_ncatice" /> 
    57          <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      grid_ref="grid_T_3D_ncatice" /> 
    58          <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      grid_ref="grid_T_3D_ncatice" /> 
    59138         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="g/kg"   grid_ref="grid_T_3D_ncatice" /> 
    60139         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      grid_ref="grid_T_3D_ncatice" /> 
    61140         <field id="icetemp_cat"  long_name="Ice temperature for categories"                               unit="degC"   grid_ref="grid_T_3D_ncatice" /> 
    62141         <field id="snwtemp_cat"  long_name="Snow temperature for categories"                              unit="degC"   grid_ref="grid_T_3D_ncatice" /> 
     142         <field id="iceamp_cat"   long_name="Ice melt pond fraction for categories"                        unit="%"      grid_ref="grid_T_3D_ncatice" />  
     143         <field id="icevmp_cat"   long_name="Ice melt pond volume for categories"                          unit="m"      grid_ref="grid_T_3D_ncatice" />  
    63144 
    64145         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     /> 
    65          <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"    />  
    66          <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    /> 
     146         <field id="miceage"      long_name="Age of sea ice"                                               unit="s"        /> 
     147         <field id="micesalt"     long_name="Sea ice salinity"                                             unit="g/kg"     /> 
     148         <field id="icehc"        long_name="ice total heat content"                                       unit="J/m2"     />  
     149         <field id="isnowhc"      long_name="snow total heat content"                                      unit="J/m2"     /> 
    67150         <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     /> 
    68151         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        /> 
    69152         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        /> 
    70          <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      /> 
    71          <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      /> 
    72          <field id="idive"        long_name="divergence"                                                   unit="1e-8s-1"  /> 
    73          <field id="ishear"       long_name="shear"                                                        unit="1e-8s-1"  /> 
    74          <field id="icevolu"      long_name="ice volume"                                                   unit="m"        /> 
    75153         <field id="snowvol"      long_name="snow volume"                                                  unit="m"        /> 
    76154         <field id="tau_icebfr"   long_name="ice friction on ocean bottom for landfast ice"                unit="N/2"      /> 
    77155 
    78          <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"          /> 
    79          <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"          /> 
    80          <field id="saltrp"       long_name="salt content transport"                                       unit="1e-3*kg/m2/day" /> 
     156         <field id="icetrp"       long_name="ice mass transport"                                           unit="kg/m2/s"          /> 
     157         <field id="snwtrp"       long_name="snw mass transport"                                           unit="kg/m2/s"          /> 
     158         <field id="saltrp"       long_name="salt     transport"                                           unit="1e-3*kg/m2/s" /> 
    81159         <field id="deitrp"       long_name="advected ice enthalpy"                                        unit="W/m2"           /> 
    82160         <field id="destrp"       long_name="advected snw enthalpy"                                        unit="W/m2"           /> 
    83161 
    84          <field id="sfxbri"       long_name="brine salt flux"                                              unit="1e-3*kg/m2/day" /> 
    85          <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/day" /> 
    86          <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/day" /> 
    87          <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/day" /> 
    88          <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/day" /> 
    89          <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/day" /> 
    90          <field id="sfxlam"       long_name="salt flux from lateral melt"                                  unit="1e-3*kg/m2/day" /> 
    91          <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/day" /> 
    92          <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/day" /> 
    93          <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/day" /> 
    94          <field id="sfx"          long_name="salt flux total"                                              unit="1e-3*kg/m2/day" /> 
    95  
    96          <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   /> 
    97          <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   /> 
    98          <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   /> 
    99          <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   /> 
    100          <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   /> 
    101          <field id="vfxlam"       long_name="lateral melt"                                                 unit="m/day"   /> 
    102          <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   /> 
    103          <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   /> 
    104          <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   /> 
    105          <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   /> 
    106          <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   /> 
    107          <field id="vfxsub_err"   long_name="excess of snw sublimation sent to ocean"                      unit="m/day"   /> 
    108          <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   /> 
    109          <field id="vfxthin"      long_name="daily thermo ice prod. for thin ice(20cm) + open water"      unit="m/day"   /> 
    110  
    111          <field id="afxtot"       long_name="area tendency (total)"                                        unit="day-1"   /> 
    112          <field id="afxdyn"       long_name="area tendency (dynamics)"                                     unit="day-1"   /> 
    113          <field id="afxthd"       long_name="area tendency (thermo)"                                       unit="day-1"   /> 
     162         <field id="sfxbri"       long_name="salt flux from brines"                                        unit="1e-3*kg/m2/s" /> 
     163         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="1e-3*kg/m2/s" /> 
     164         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="1e-3*kg/m2/s" /> 
     165         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="1e-3*kg/m2/s" /> 
     166         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="1e-3*kg/m2/s" /> 
     167         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="1e-3*kg/m2/s" /> 
     168         <field id="sfxlam"       long_name="salt flux from lateral melt"                                  unit="1e-3*kg/m2/s" /> 
     169         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="1e-3*kg/m2/s" /> 
     170         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="1e-3*kg/m2/s" /> 
     171         <field id="sfxsub"       long_name="salt flux from sublimation"                                   unit="1e-3*kg/m2/s" /> 
     172         <field id="sfx"          long_name="Salt flux from sea ice"                                       unit="1e-3*kg/m2/s" /> 
     173 
     174         <field id="vfxbog"       long_name="bottom thermo ice prod."                                      unit="kg/m2/s"   /> 
     175         <field id="vfxdyn"       long_name="dynamic ice prod."                                            unit="kg/m2/s"   /> 
     176         <field id="vfxopw"       long_name="lateral thermo ice prod."                                     unit="kg/m2/s"   /> 
     177         <field id="vfxsni"       long_name="snowice ice prod."                                            unit="kg/m2/s"   /> 
     178         <field id="vfxsum"       long_name="surface melt"                                                 unit="kg/m2/s"   /> 
     179         <field id="vfxlam"       long_name="lateral melt"                                                 unit="kg/m2/s"   /> 
     180         <field id="vfxbom"       long_name="bottom melt"                                                  unit="kg/m2/s"   /> 
     181         <field id="vfxres"       long_name="resultant ice prod./melting"                                  unit="kg/m2/s"   /> 
     182         <field id="vfxice"       long_name="ice melt/growth"                                              unit="kg/m2/s"   /> 
     183         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="kg/m2/s"   /> 
     184         <field id="vfxsub"       long_name="snw sublimation"                                              unit="kg/m2/s"   /> 
     185         <field id="vfxsub_err"   long_name="excess of snw sublimation sent to ocean"                      unit="kg/m2/s"   /> 
     186         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="kg/m2/s"   /> 
     187         <field id="vfxthin"      long_name="thermo ice prod. for thin ice(20cm) + open water"             unit="kg/m2/s"   /> 
     188 
     189         <field id="afxtot"       long_name="area tendency (total)"                                        unit="s-1"   /> 
    114190 
    115191         <field id="hfxsum"       long_name="heat fluxes causing surface ice melt"                         unit="W/m2"  /> 
     
    135211         <field id="hfxtur"       long_name="turbulent heat flux at the ice base"                          unit="W/m2" /> 
    136212 
    137     <!-- sbcssm variables --> 
     213        <!-- sbcssm variables --> 
    138214         <field id="sst_m"    unit="degC" /> 
    139215         <field id="sss_m"    unit="psu"  /> 
     
    144220         <field id="frq_m"    unit="-"    /> 
    145221 
     222         <!-- specific for rheology --> 
     223         <field id="isig1"        long_name="1st principal stress component for EVP rhg"                   unit="unitless" /> 
     224         <field id="isig2"        long_name="2nd principal stress component for EVP rhg"                   unit="unitless" /> 
     225         <field id="isig3"        long_name="convergence measure for EVP rheology (must be =1)"            unit="unitless" /> 
     226 
    146227      </field_group> 
    147228 
     
    149230      <field_group id="SBC_scalar"  grid_ref="grid_T_2D" > 
    150231         <!-- available with ln_limdiaout --> 
    151          <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"       /> 
    152          <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"       /> 
    153          <field id="ibgfrctemtop"    long_name="global mean heat on top of ice/snw/ocean-atm "                                             unit="1e20J"     /> 
    154          <field id="ibgfrctembot"    long_name="global mean heat below ice (on top of ocean) "                                             unit="1e20J"     /> 
    155          <field id="ibgfrcsal"       long_name="global mean ice/snow forcing (salt equivalent ocean volume)"                               unit="pss*km3"   /> 
    156          <field id="ibgfrchfxtop"    long_name="global mean heat flux on top of ice/snw/ocean-atm "                                        unit="W/m2"      /> 
    157          <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"      /> 
     232         <field id="ibgfrcvoltop"    long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)"   unit="km3"        /> 
     233         <field id="ibgfrcvolbot"    long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3"        /> 
     234         <field id="ibgfrctemtop"    long_name="global mean heat on top of ice/snw/ocean-atm "                                             unit="1e20J"      /> 
     235         <field id="ibgfrctembot"    long_name="global mean heat below ice (on top of ocean) "                                             unit="1e20J"      /> 
     236         <field id="ibgfrcsal"       long_name="global mean ice/snow forcing (salt equivalent ocean volume)"                               unit="pss*km3"    /> 
     237         <field id="ibgfrchfxtop"    long_name="global mean heat flux on top of ice/snw/ocean-atm "                                        unit="W/m2"       /> 
     238         <field id="ibgfrchfxbot"    long_name="global mean heat flux below ice (on top of ocean) "                                        unit="W/m2"       /> 
    158239  
    159          <field id="ibgvolume"       long_name="drift in ice/snow volume (equivalent ocean volume)"            unit="km3"        /> 
    160          <field id="ibgsaltco"       long_name="drift in ice salt content (equivalent ocean volume)"           unit="pss*km3"    /> 
    161          <field id="ibgheatco"       long_name="drift in ice/snow heat content"                                unit="1e20J"      /> 
    162          <field id="ibgheatfx"       long_name="drift in ice/snow heat flux"                                   unit="W/m2"       /> 
    163  
    164          <field id="ibgvol_tot"      long_name="global mean ice volume"                                        unit="km3"        /> 
    165          <field id="sbgvol_tot"      long_name="global mean snow volume"                                       unit="km3"        /> 
    166          <field id="ibgarea_tot"     long_name="global mean ice area"                                          unit="km2"        /> 
    167          <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                  unit="1e-3*km3"   /> 
    168          <field id="ibgheat_tot"     long_name="global mean ice heat content"                                  unit="1e20J"      /> 
    169          <field id="sbgheat_tot"     long_name="global mean snow heat content"                                 unit="1e20J"      /> 
     240         <field id="ibgvolume"       long_name="drift in ice/snow volume (equivalent ocean volume)"                                        unit="km3"        /> 
     241         <field id="ibgsaltco"       long_name="drift in ice salt content (equivalent ocean volume)"                                       unit="pss*km3"    /> 
     242         <field id="ibgheatco"       long_name="drift in ice/snow heat content"                                                            unit="1e20J"      /> 
     243         <field id="ibgheatfx"       long_name="drift in ice/snow heat flux"                                                               unit="W/m2"       /> 
     244 
     245         <field id="ibgvol_tot"      long_name="global mean ice volume"                                                                    unit="km3"        /> 
     246         <field id="sbgvol_tot"      long_name="global mean snow volume"                                                                   unit="km3"        /> 
     247         <field id="ibgarea_tot"     long_name="global mean ice area"                                                                      unit="km2"        /> 
     248         <field id="ibgsalt_tot"     long_name="global mean ice salt content"                                                              unit="1e-3*km3"   /> 
     249         <field id="ibgheat_tot"     long_name="global mean ice heat content"                                                              unit="1e20J"      /> 
     250         <field id="sbgheat_tot"     long_name="global mean snow heat content"                                                             unit="1e20J"      /> 
     251 
     252         <field id="NH_iceextt"      long_name="Sea ice extent North"                            standard_name="sea_ice_extent_n"          unit="1e6_km2"    /> 
     253         <field id="SH_iceextt"      long_name="Sea ice extent South"                            standard_name="sea_ice_extent_s"          unit="1e6_km2"    /> 
     254         <field id="NH_icevolu"      long_name="Sea ice volume North"                            standard_name="sea_ice_volume_n"          unit="1e3_km3"    /> 
     255         <field id="SH_icevolu"      long_name="Sea ice volume South"                            standard_name="sea_ice_volume_s"          unit="1e3_km3"    /> 
     256         <field id="NH_icearea"      long_name="Sea ice area North"                              standard_name="sea_ice_area_n"            unit="1e6_km2"    /> 
     257         <field id="SH_icearea"      long_name="Sea ice area South"                              standard_name="sea_ice_area_s"            unit="1e6_km2"    /> 
     258 
     259         <field id="strait_mifl"     long_name="Sea ice mass flux through straits"      standard_name="sea_ice_mass_transport_across_line" unit="kg/s"  grid_ref="grid_4strait"   /> 
     260         <field id="strait_arfl"     long_name="Sea ice area flux through straits"      standard_name="sea_ice_area_transport_across_line" unit="m2/s"  grid_ref="grid_4strait"   />   
     261         <field id="strait_msfl"     long_name="Sea ice snow flux through straits"      standard_name="snow_mass_transport_across_line"    unit="kg/s"  grid_ref="grid_4strait"   /> 
     262 
    170263      </field_group> 
    171264   
     
    176269       
    177270      <field_group id="myvarICE" > 
    178          <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        /> 
     271         <field field_ref="icethick"          name="sithic"     long_name="sea_ice_thickness"        /> 
    179272         <field field_ref="icevolu"          name="sivolu"  /> 
    180273         <field field_ref="iceconc"          name="siconc"  /> 
    181274      </field_group>     
    182        
     275 
     276      <field_group id="ICE_globalbudget"> 
     277 
     278      <field field_ref="ibgvol_tot"     grid_ref="grid_1point"  name="ibgvol_tot"   /> 
     279       <field field_ref="sbgvol_tot"     grid_ref="grid_1point"  name="sbgvol_tot"   /> 
     280      <field field_ref="ibgarea_tot"    grid_ref="grid_1point"  name="ibgarea_tot"  /> 
     281      <field field_ref="ibgsalt_tot"    grid_ref="grid_1point"  name="ibgsalt_tot"  /> 
     282      <field field_ref="ibgheat_tot"    grid_ref="grid_1point"  name="ibgheat_tot"  /> 
     283      <field field_ref="sbgheat_tot"    grid_ref="grid_1point"  name="sbgheat_tot"  /> 
     284 
     285      <field field_ref="ibgvolume"      grid_ref="grid_1point"  name="ibgvolume"    /> 
     286      <field field_ref="ibgsaltco"      grid_ref="grid_1point"  name="ibgsaltco"    /> 
     287      <field field_ref="ibgheatco"      grid_ref="grid_1point"  name="ibgheatco"    /> 
     288        <field field_ref="ibgheatfx"      grid_ref="grid_1point"  name="ibgheatfx"    /> 
     289 
     290      <field field_ref="ibgfrcvoltop"   grid_ref="grid_1point"  name="ibgfrcvoltop" /> 
     291      <field field_ref="ibgfrcvolbot"   grid_ref="grid_1point"  name="ibgfrcvolbot" /> 
     292      <field field_ref="ibgfrctemtop"   grid_ref="grid_1point"  name="ibgfrctemtop" /> 
     293      <field field_ref="ibgfrctembot"   grid_ref="grid_1point"  name="ibgfrctembot" /> 
     294      <field field_ref="ibgfrcsal"      grid_ref="grid_1point"  name="ibgfrcsal"    /> 
     295        <field field_ref="ibgfrchfxtop"   grid_ref="grid_1point"  name="ibgfrchfxtop" /> 
     296        <field field_ref="ibgfrchfxbot"   grid_ref="grid_1point"  name="ibgfrchfxbot" /> 
     297 
     298      </field_group> 
     299 
     300 
     301      <!--============================--> 
     302      <!-- SIMIP sea ice field groups --> 
     303      <!-- Notz et al 2016            --> 
     304      <!--============================--> 
     305 
     306      <!-- SIMIP monthly scalar variables --> 
     307      <field_group id="SImon_scalars"> 
     308        <!-- Integrated quantities --> 
     309        <field field_ref="NH_iceextt"     grid_ref="grid_1point"  name="siextentn"    /> 
     310        <field field_ref="SH_iceextt"     grid_ref="grid_1point"  name="siextents"    /> 
     311        <field field_ref="NH_icevolu"     grid_ref="grid_1point"  name="sivoln"       /> 
     312        <field field_ref="SH_icevolu"     grid_ref="grid_1point"  name="sivols"       /> 
     313        <field field_ref="NH_icearea"     grid_ref="grid_1point"  name="siarean"      /> 
     314        <field field_ref="SH_icearea"     grid_ref="grid_1point"  name="siareas"      /> 
     315      </field_group> 
     316 
     317      <!-- SIMIP daily fields --> <field_group id="SIday_fields">  
     318          <field field_ref="icepres"          name="sitimefrac"   />  
     319          <field field_ref="iceconc_pct"      name="siconc"       />  
     320          <field field_ref="icethic"          name="sithick"      default_value="1.0e20" detect_missing_value="true" operation="average" />  
     321          <field field_ref="snothic"          name="sisnthick"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     322          <field field_ref="icestK"           name="sitemptop"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     323          <field field_ref="uice_mv"          name="siu"          default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     324          <field field_ref="vice_mv"          name="siv"          default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     325          <field field_ref="icevel_mv"        name="sispeed"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     326      </field_group> 
     327 
     328      <!-- SIMIP monthly fields --> 
     329      <field_group id="SImon_fields"> 
     330          <!-- Sea-ice state variables --> 
     331          <field field_ref="icepres"          name="sitimefrac"   /> 
     332          <field field_ref="iceconc_pct"      name="siconc"       /> 
     333          <field field_ref="icemass"          name="simass"       /> 
     334          <field field_ref="icethic"          name="sithick"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     335          <field field_ref="icevolu"          name="sivol"        /> 
     336          <field field_ref="snomass"          name="sisnmass"     default_value="1.0e20" detect_missing_value="true" operation="average" />  
     337          <field field_ref="snothic"          name="sisnthick"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     338    
     339          <!-- category-dependent fields --> 
     340          <field field_ref="iceconc_cat_pct_mv"  name="siitdconc"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     341          <field field_ref="icethic_cat_mv"      name="siitdthick"   default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     342          <field field_ref="snowthic_cat_mv"     name="siitdsnthick" default_value="1.0e20" detect_missing_value="true" operation="average"/> 
     343 
     344          <!-- additional state variables--> 
     345          <field field_ref="icestK"           name="sitemptop"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     346          <field field_ref="icesntK"          name="sitempsnic"   default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     347          <field field_ref="icebotK"          name="sitempbot"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     348          <field field_ref="iceage"           name="siage"        default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     349          <field field_ref="icesmass"         name="sisaltmass"   /> 
     350          <field field_ref="icesal"           name="sisali"       default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     351          <field field_ref="icefb"            name="sifb"         default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     352          <field field_ref="icehcneg"         name="sihc"         /> 
     353          <field field_ref="isnhcneg"         name="sisnhc"       default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     354 
     355          <!-- freshwater fluxes --> 
     356          <field field_ref="wfxtot"           name="siflfwbot"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     357          <field field_ref="wfxsum"           name="siflfwdrain"  default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     358 
     359          <!-- area balance --> 
     360          <field field_ref="afxthd"           name="sidconcth"    /> 
     361          <field field_ref="afxdyn"           name="sidconcdyn"   /> 
     362 
     363          <!-- mass balance --> 
     364          <field field_ref="dmithd"           name="sidmassth"    /> 
     365          <field field_ref="dmidyn"           name="sidmassdyn"   /> 
     366          <field field_ref="dmiopw"           name="sidmassgrowthwat" /> 
     367          <field field_ref="dmibog"           name="sidmassgrowthbot" /> 
     368          <field field_ref="dmisni"           name="sidmasssi"        /> 
     369          <field field_ref="dmisub"           name="sidmassevapsubl"  /> 
     370          <field field_ref="dmisum"           name="sidmassmelttop"   /> 
     371          <field field_ref="dmibom"           name="sidmassmeltbot"   /> 
     372          <field field_ref="dmsspr"           name="sndmasssnf"       /> 
     373          <field field_ref="dmsmel"           name="sndmassmelt"      /> 
     374          <field field_ref="dmssub"           name="sndmasssubl"      /> 
     375          <field field_ref="dmsdyn"           name="sndmassdyn"       /> 
     376          <field field_ref="dmsssi"           name="sndmasssi"        /> 
     377 
     378          <!-- heat balance --> 
     379          <field field_ref="hfxsenso"         name="siflsensupbot"    default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     380          <field field_ref="hfxconsu"         name="siflcondtop"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     381          <field field_ref="hfxconbo"         name="siflcondbot"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     382 
     383          <!-- salt balance --> 
     384          <field field_ref="sfx_mv"           name="siflsaltbot"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     385 
     386          <!-- sea-ice dynamics --> 
     387          <field field_ref="uice_mv"          name="siu"              default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     388          <field field_ref="vice_mv"          name="siv"              default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     389          <field field_ref="icevel_mv"        name="sispeed"          default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     390 
     391          <field field_ref="utau_ice"         name="sistrxdtop"       default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     392          <field field_ref="vtau_ice"         name="sistrydtop"       default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     393 
     394          <field field_ref="utau_oi"          name="sistrxubot"       default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     395          <field field_ref="vtau_oi"          name="sistryubot"       default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     396 
     397          <field field_ref="icestr"           name="sicompstren"      default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     398 
     399          <field field_ref="dssh_dx"          name="siforcetiltx"     default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     400          <field field_ref="dssh_dy"          name="siforcetilty"     default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     401 
     402          <field field_ref="corstrx"          name="siforcecoriolx"   default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     403          <field field_ref="corstry"          name="siforcecorioly"   default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     404 
     405          <field field_ref="intstrx"          name="siforceintstrx"   default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     406          <field field_ref="intstry"          name="siforceintstry"   default_value="1.0e20" detect_missing_value="true" operation="average" /> 
     407 
     408          <field field_ref="xmtrptot"         name="sidmasstranx"     /> 
     409          <field field_ref="ymtrptot"         name="sidmasstrany"     /> 
     410 
     411          <field field_ref="normstr"          name="sistresave"       default_value="1.0e20" detect_missing_value="true" operation="instant" /> 
     412          <field field_ref="sheastr"          name="sistremax"        default_value="1.0e20" detect_missing_value="true" operation="instant" /> 
     413 
     414          <field field_ref="idive"            name="sidivvel"         default_value="1.0e20" detect_missing_value="true" operation="instant" /> 
     415          <field field_ref="ishear"           name="sishevel"         default_value="1.0e20" detect_missing_value="true" operation="instant" /> 
     416 
     417          <!-- sea ice fluxes across straits: 2D arrays to be post-processed  --> 
     418          <field field_ref="xmtrpice"         name="simassacrossline_x" /> 
     419          <field field_ref="ymtrpice"         name="simassacrossline_y" /> 
     420          <field field_ref="xmtrpsnw"         name="snmassacrossline_x" /> 
     421          <field field_ref="ymtrpsnw"         name="snmassacrossline_y" /> 
     422          <field field_ref="xatrp"            name="siareaacrossline_x" /> 
     423          <field field_ref="yatrp"            name="siareaacrossline_y" /> 
     424 
     425      </field_group> 
     426 
    183427   </field_definition> 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r7813 r8738  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! LIM3 namelist:   
    3 !!              1 - Generic parameters                 (namicerun) 
    4 !!              2 - Diagnostics                        (namicediag) 
    5 !!              3 - Ice initialization                 (namiceini) 
    6 !!              4 - Ice discretization                 (namiceitd) 
    7 !!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
     2!! ESIM namelist:   
     3!!              1 - Generic parameters                 (nampar) 
     4!!              2 - Ice thickness discretization       (namitd) 
     5!!              3 - Ice dynamics                       (namdyn) 
     6!!              4 - Ice ridging/rafting                (namdyn_rdgrft) 
     7!!              5 - Ice rheology                       (namdyn_rhg) 
     8!!              6 - Ice advection                      (namdyn_adv) 
     9!!              7 - Ice surface forcing                (namforcing) 
     10!!              8 - Ice thermodynamics                 (namthd) 
     11!!              9 - Ice heat diffusion                 (namthd_zdf) 
     12!!             10 - Ice lateral melting                (namthd_da) 
     13!!             11 - Ice growth in open water           (namthd_do) 
     14!!             12 - Ice salinity                       (namthd_sal) 
     15!!             13 - Ice melt ponds                     (nammp) 
     16!!             14 - Ice initialization                 (namini) 
     17!!             15 - Ice/snow albedos                   (namalb) 
     18!!             16 - Ice diagnostics                    (namdia) 
    1219!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1320! 
    1421!------------------------------------------------------------------------------ 
    15 &namicerun     !   Generic parameters 
    16 !------------------------------------------------------------------------------ 
    17    jpl              =    5          !  number of ice  categories 
    18    nlay_i           =    2          !  number of ice  layers 
    19    nlay_s           =    1          !  number of snow layers (only 1 is working) 
    20    rn_amax_n        =   0.997       !  maximum tolerated ice concentration NH 
    21    rn_amax_s        =   0.997       !  maximum tolerated ice concentration SH 
    22    cn_icerst_in     = "restart_ice" !  suffix of ice restart name (input) 
    23    cn_icerst_out    = "restart_ice" !  suffix of ice restart name (output) 
    24    cn_icerst_indir  = "."           !  directory to read   input ice restarts 
    25    cn_icerst_outdir = "."           !  directory to write output ice restarts 
    26    ln_limthd        =  .true.       !  ice thermo   (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    27    ln_limdyn        =  .true.       !  ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    28    nn_limdyn        =   2           !     (ln_limdyn=T) switch for ice dynamics    
    29                                     !      2: total 
    30                                     !      1: advection only (no diffusion, no ridging/rafting) 
    31                                     !      0: advection only (as 1 but with prescribed velocity, bypass rheology) 
    32    rn_uice          =   0.00001     !     (nn_limdyn=0) ice u-velocity 
    33    rn_vice          =  -0.00001     !     (nn_limdyn=0) ice v-velocity 
    34 / 
    35 !------------------------------------------------------------------------------ 
    36 &namicediag    !   Diagnostics 
    37 !------------------------------------------------------------------------------ 
    38    ln_limdiachk   =  .false.        !  check online the heat, mass & salt budgets (T) or not (F) 
    39    ln_limdiahsb   =  .false.        !  output the heat, mass & salt budgets (T) or not (F) 
    40    ln_limctl      =  .false.        !  ice points output for debug (T or F) 
    41    iiceprt        =    10           !  i-index for debug 
    42    jiceprt        =    10           !  j-index for debug 
    43 / 
    44 !------------------------------------------------------------------------------ 
    45 &namiceini     !   Ice initialization 
    46 !------------------------------------------------------------------------------ 
    47                   ! -- limistate -- ! 
    48    ln_limini      = .true.          !  activate ice initialization (T) or not (F) 
    49    ln_limini_file = .false.         !  netcdf file provided for initialization (T) or not (F) 
    50    rn_thres_sst   =  2.0            !  maximum water temperature with initial ice (degC) 
    51    rn_hts_ini_n   =  0.3            !  initial real snow thickness (m), North 
    52    rn_hts_ini_s   =  0.3            !        "            "             South 
    53    rn_hti_ini_n   =  3.0            !  initial real ice thickness  (m), North 
    54    rn_hti_ini_s   =  1.0            !        "            "             South 
    55    rn_ati_ini_n   =  0.9            !  initial ice concentration   (-), North 
    56    rn_ati_ini_s   =  0.9            !        "            "             South 
    57    rn_smi_ini_n   =  6.3            !  initial ice salinity     (g/kg), North 
    58    rn_smi_ini_s   =  6.3            !        "            "             South 
    59    rn_tmi_ini_n   =  270.           !  initial ice/snw temperature (K), North 
    60    rn_tmi_ini_s   =  270.           !        "            "             South 
    61 / 
    62 !------------------------------------------------------------------------------ 
    63 &namiceitd     !   Ice discretization 
    64 !------------------------------------------------------------------------------ 
    65    nn_catbnd      =    2           !  computation of ice category boundaries based on 
    66                                    !      1: tanh function 
    67                                    !      2: h^(-alpha), function of rn_himean 
    68    rn_himean      =    2.0         !  expected domain-average ice thickness (m), nn_catbnd = 2 only 
    69 / 
    70 !------------------------------------------------------------------------------ 
    71 &namicedyn     !   Ice dynamics and transport 
    72 !------------------------------------------------------------------------------ 
    73                   ! -- limtrp & limadv -- ! 
    74    nn_limadv      =    0            !  choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 
    75    nn_limadv_ord  =    5            !  choose the order of the advection scheme (if nn_limadv=0) 
    76                   ! -- limitd_me -- ! 
    77    nn_icestr      =    0            !  ice strength parameteriztaion                       
    78                                     !     0: Hibler_79     P = pstar*<h>*exp(-c_rhg*A) 
    79                                     !     1: Rothrock_75   P = Cf*coeff*integral(wr.h^2)     
    80    rn_pe_rdg      =   17.0          !     (nn_icestr=1) ridging work divided by pot. energy change in ridging 
    81    rn_pstar       =    2.0e+04      !     (nn_icestr=0) ice strength thickness parameter (N/m2)  
    82    rn_crhg        =   20.0          !     (nn_icestr=0) ice strength conc. parameter (-) 
    83    ln_icestr_bvf  =    .false.      !     ice strength function brine volume (T) or not (F) 
    84                                     ! 
    85             ! -- limdyn & limrhg -- ! 
    86    rn_cio         =    5.0e-03      !  ice-ocean drag coefficient (-) 
    87    rn_creepl      =    1.0e-12      !  creep limit (s-1) 
    88    rn_ecc         =    2.0          !  eccentricity of the elliptical yield curve           
    89    nn_nevp        =  120            !  number of EVP subcycles                              
    90    rn_relast      =    0.333        !  ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
    91                                     !     advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
    92    ln_landfast    =  .false.        !  landfast ice parameterization (T or F)                            
    93    rn_gamma       =    0.15         !     (ln_landfast=T)  fraction of ocean depth that ice must reach to initiate landfast 
    94                                     !                      recommended range: [0.1 ; 0.25] 
    95    rn_icebfr      =    10.          !     (ln_landfast=T)  maximum bottom stress per unit area of contact (N/m2)                  
    96                                     !                      a very large value ensures ice velocity=0 even with a small contact area 
    97                                     !                      recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2) 
    98    rn_lfrelax     =    1.e-5        !     (ln_landfast=T)  relaxation time scale to reach static friction (s-1)                  
    99 / 
    100 !------------------------------------------------------------------------------ 
    101 &namicehdf     !   Ice horizontal diffusion 
    102 !------------------------------------------------------------------------------ 
    103                      ! -- limhdf -- ! 
    104    nn_ahi0        =    -1           !  horizontal diffusivity computation 
    105                                     !    -1: no diffusion (bypass limhdf) 
    106                                     !     0: use rn_ahi0_ref 
    107                                     !     1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 
    108                                     !     2: use rn_ahi0_ref x grid cell length      / ( 2deg mean grid cell length ) 
    109    rn_ahi0_ref    = 350.0           !  horizontal sea ice diffusivity (m2/s)  
    110                                     !     if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 
    111 / 
    112 !------------------------------------------------------------------------------ 
    113 &namicethd     !   Ice thermodynamics 
    114 !------------------------------------------------------------------------------ 
    115                  ! -- limthd_dif -- ! 
    116    rn_kappa_i     = 1.0             !  radiation attenuation coefficient in sea ice (m-1) 
    117    nn_conv_dif    = 50              !  maximal number of iterations for heat diffusion computation 
    118    rn_terr_dif    = 1.0e-04         !  maximum temperature after heat diffusion (degC) 
    119    nn_ice_thcon   = 1               !  sea ice thermal conductivity 
    120                                     !     0: k = k0 + beta.S/T            (Untersteiner, 1964) 
    121                                     !     1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 
    122    ln_it_qnsice   = .true.          !  iterate the surface non-solar flux with surface temperature (T) or not (F) 
    123    nn_monocat     = 0               !  virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 
    124                                     !     2: simple piling instead of ridging    --- temporary option 
    125                                     !     3: activate G(he) only                 --- temporary option 
    126                                     !     4: activate extra lateral melting only --- temporary option 
    127    rn_cdsn     = 0.31              !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 
    128                                    !  Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 
    129                   ! -- limthd_dh -- ! 
    130    ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    131    rn_betas       = 0.66            !  exponent in lead-ice repratition of snow precipitation 
    132                                     !     betas = 1 -> equipartition, betas < 1 -> more on leads 
    133                   ! -- limthd_da -- ! 
    134    ln_limdA       = .true.          !  activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    135    rn_beta        = 1.0             !     (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[0.8-1.2] 
    136                                     !      => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 
    137                                     !         0.3 = best fit for western Fram Strait and Antarctica 
    138                                     !         1.4 = best fit for eastern Fram Strait       
    139    rn_dmin        = 8.              !     (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10] 
    140                                     !      => 6  vs 8m = +40% melting at the peak (A~0.5) 
    141                                     !         10 vs 8m = -20% melting 
    142                  ! -- limthd_lac -- ! 
    143    ln_limdO       = .true.          !  activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    144    rn_hnewice     = 0.1             !  thickness for new ice formation in open water (m) 
    145    ln_frazil      = .false.         !  Frazil ice parameterization (ice collection as a function of wind) 
    146    rn_maxfrazb    = 1.0             !     (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base 
    147    rn_vfrazb      = 0.417           !     (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s) 
    148    rn_Cfrazb      = 5.0             !     (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom 
    149                   ! -- limitd_th -- ! 
    150    rn_himin       = 0.1             !  minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 
    151 / 
    152 !------------------------------------------------------------------------------ 
    153 &namicesal     !   Ice salinity 
    154 !------------------------------------------------------------------------------ 
    155                  ! -- limthd_sal -- ! 
    156    ln_limdS       = .true.          !  activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    157    nn_icesal      =  2              !  ice salinity option 
    158                                     !     1: constant ice salinity (S=rn_icesal) 
    159                                     !     2: varying salinity parameterization S(z,t) 
    160                                     !     3: prescribed salinity profile S(z), Schwarzacher, 1959 
    161    rn_icesal      =  4.             !    (nn_icesal=1) ice salinity (g/kg) 
    162    rn_sal_gd      =  5.             !  restoring ice salinity, gravity drainage (g/kg) 
    163    rn_time_gd     =  1.73e+6        !  restoring time scale, gravity drainage  (s) 
    164    rn_sal_fl      =  2.             !  restoring ice salinity, flushing (g/kg) 
    165    rn_time_fl     =  8.64e+5        !  restoring time scale, flushing (s) 
    166    rn_simax       = 20.             !  maximum tolerated ice salinity (g/kg) 
    167    rn_simin       =  0.1            !  minimum tolerated ice salinity (g/kg) 
    168 / 
    169 !------------------------------------------------------------------------------ 
    170 &namiceitdme   !   Ice mechanical redistribution (ridging and rafting) 
    171 !------------------------------------------------------------------------------ 
    172                   ! -- limitd_me -- ! 
    173    rn_cs          =   0.5           !  fraction of shearing energy contributing to ridging 
    174    nn_partfun     =   1             !  type of ridging participation function 
    175                                     !     0: linear      (Thorndike et al, 1975) 
    176                                     !     1: exponential (Lipscomb, 2007) 
    177    rn_gstar       =   0.15          !     (nn_partfun = 0) fractional area of thin ice being ridged  
    178    rn_astar       =   0.03          !     (nn_partfun = 1) exponential measure of ridging ice fraction [set to 0.05 if hstar=100] 
    179    ln_ridging     =   .true.        !  ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    180    rn_hstar       =  25.0           !     (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980) 
    181    rn_por_rdg     =   0.3           !     (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995) 
    182    rn_fsnowrdg    =   0.5           !     (ln_ridging = T) snow volume fraction that survives in ridging 
    183    ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    184    rn_hraft       =   0.75          !     (ln_rafting = T) threshold thickness for rafting (m) 
    185    rn_craft       =   5.0           !     (ln_rafting = T) squeezing coefficient used in the rafting function 
    186    rn_fsnowrft    =   0.5           !     (ln_rafting = T) snow volume fraction that survives in rafting 
    187 / 
     22&nampar     !   Generic parameters 
     23!------------------------------------------------------------------------------ 
     24   jpl              =   5             !  number of ice  categories 
     25   nlay_i           =   2             !  number of ice  layers 
     26   nlay_s           =   1             !  number of snow layers (only 1 is working) 
     27   nn_monocat       =   0             !  virtual ITD mono-category parameterizations (1-4 => jpl = 1 only) or not (0) 
     28                                      !     2: simple piling instead of ridging    --- temporary option 
     29                                      !     3: activate G(he) only                 --- temporary option 
     30                                      !     4: activate extra lateral melting only --- temporary option 
     31   ln_icedyn        = .true.          !  ice dynamics (T) or not (F) 
     32   ln_icethd        = .true.          !  ice thermo   (T) or not (F) 
     33   rn_amax_n        =   0.997         !  maximum tolerated ice concentration NH 
     34   rn_amax_s        =   0.997         !  maximum tolerated ice concentration SH 
     35   cn_icerst_in     = "restart_ice"   !  suffix of ice restart name (input) 
     36   cn_icerst_out    = "restart_ice"   !  suffix of ice restart name (output) 
     37   cn_icerst_indir  = "."             !  directory to read   input ice restarts 
     38   cn_icerst_outdir = "."             !  directory to write output ice restarts 
     39/ 
     40!------------------------------------------------------------------------------ 
     41&namitd     !   Ice discretization 
     42!------------------------------------------------------------------------------ 
     43   rn_himean        =   2.0           !  expected domain-average ice thickness (m) 
     44   rn_himin         =   0.1           !  minimum ice thickness (m) used in remapping 
     45/ 
     46!------------------------------------------------------------------------------ 
     47&namdyn     !   Ice dynamics 
     48!------------------------------------------------------------------------------ 
     49   ln_dynFULL       = .true.          !  dyn.: full ice dynamics               (rheology + advection + ridging/rafting + correction) 
     50   ln_dynRHGADV     = .false.         !  dyn.: no ridge/raft & no corrections  (rheology + advection) 
     51   ln_dynADV        = .false.         !  dyn.: only advection w prescribed vel.(rn_uvice + advection) 
     52      rn_uice       =   0.00001       !        prescribed ice u-velocity 
     53      rn_vice       =   0.            !        prescribed ice v-velocity 
     54   rn_ishlat        =   2.            !  free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2) 
     55   ln_landfast      = .false.         !  landfast ice parameterization (T or F)                            
     56      rn_gamma      =   0.15          !     fraction of ocean depth that ice must reach to initiate landfast 
     57                                      !        recommended range: [0.1 ; 0.25] 
     58      rn_icebfr     =  10.            !     maximum bottom stress per unit area of contact [N/m2]                  
     59                                      !        a very large value ensures ice velocity=0 even with a small contact area 
     60                                      !        recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2) 
     61      rn_lfrelax    =   1.e-5         !     relaxation time scale to reach static friction [s-1] 
     62/ 
     63!------------------------------------------------------------------------------ 
     64&namdyn_rdgrft  !   Ice ridging/rafting 
     65!------------------------------------------------------------------------------ 
     66          ! -- ice_rdgrft_strength -- ! 
     67   ln_str_H79       = .true.          !  ice strength param.: Hibler_79   => P = pstar*<h>*exp(-c_rhg*A)                       
     68      rn_pstar      =   2.0e+04       !     ice strength thickness parameter [N/m2] 
     69      rn_crhg       =   20.0          !     ice strength conc. parameter (-) 
     70                   ! -- ice_rdgrft -- ! 
     71   rn_csrdg         =   0.5           !  fraction of shearing energy contributing to ridging 
     72              ! -- ice_rdgrft_prep -- ! 
     73   ln_partf_lin     = .false.         !  Linear ridging participation function (Thorndike et al, 1975) 
     74      rn_gstar      =   0.15          !     fractional area of thin ice being ridged  
     75   ln_partf_exp     = .true.          !  Exponential ridging participation function (Lipscomb, 2007) 
     76      rn_astar      =   0.03          !     exponential measure of ridging ice fraction [set to 0.05 if hstar=100] 
     77   ln_ridging       = .true.          !  ridging activated (T) or not (F) 
     78      rn_hstar      =  25.0           !     determines the maximum thickness of ridged ice [m] (Hibler, 1980) 
     79      rn_porordg    =   0.3           !     porosity of newly ridged ice (Lepparanta et al., 1995) 
     80      rn_fsnwrdg    =   0.5           !     snow volume fraction that survives in ridging 
     81      rn_fpndrdg    =   1.0           !     pond fraction that survives in ridging (small a priori) 
     82   ln_rafting       = .true.          !  rafting activated (T) or not (F) 
     83      rn_hraft      =   0.75          !     threshold thickness for rafting [m] 
     84      rn_craft      =   5.0           !     squeezing coefficient used in the rafting function 
     85      rn_fsnwrft    =   0.5           !     snow volume fraction that survives in rafting 
     86      rn_fpndrft    =   1.0           !     pond fraction that survives in rafting (0.5 a priori) 
     87/ 
     88!------------------------------------------------------------------------------ 
     89&namdyn_rhg     !   Ice rheology 
     90!------------------------------------------------------------------------------ 
     91   ln_rhg_EVP       = .true.          !  EVP rheology 
     92      rn_creepl     =   1.0e-12       !     creep limit [1/s] 
     93      rn_ecc        =   2.0           !     eccentricity of the elliptical yield curve           
     94      nn_nevp       = 120             !     number of EVP subcycles                              
     95      rn_relast     =   0.333         !     ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast  
     96                                      !        advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 
     97/ 
     98!------------------------------------------------------------------------------ 
     99&namdyn_adv     !   Ice advection 
     100!------------------------------------------------------------------------------ 
     101   ln_adv_Pra       = .false.         !  Advection scheme (Prather) 
     102   ln_adv_UMx       = .true.          !  Advection scheme (Ultimate-Macho) 
     103      nn_UMx        =   5             !     order of the scheme for UMx (1-5 ; 20=centered 2nd order) 
     104/ 
     105!------------------------------------------------------------------------------ 
     106&namforcing     !   Ice surface forcing 
     107!------------------------------------------------------------------------------ 
     108   rn_cio           =   5.0e-03       !  ice-ocean drag coefficient (-) 
     109   rn_blow_s        =   0.66          !  mesure of snow blowing into the leads 
     110                                      !     = 1 => no snow blowing, < 1 => some snow blowing 
     111   nn_iceflx        =  -1             !  Redistribute heat flux over ice categories 
     112                                      !     =-1  Do nothing (needs N(cat) fluxes) 
     113                                      !          ==> forced mode only 
     114                                      !     = 0  Average N(cat) fluxes then apply the average over the N(cat) ice 
     115                                      !          ==> forced and coupled modes 
     116                                      !     = 1  Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity 
     117                                      !          ==> forced mode only 
     118                                      !     = 2  Redistribute a single flux over categories 
     119                                      !          ==> coupled mode only 
     120/ 
     121!------------------------------------------------------------------------------ 
     122&namthd     !   Ice thermodynamics 
     123!------------------------------------------------------------------------------ 
     124   ln_icedH         = .true.          !  activate ice thickness change from growing/melting (T) or not (F) 
     125   ln_icedA         = .true.          !  activate lateral melting param. (T) or not (F) 
     126   ln_icedO         = .true.          !  activate ice growth in open-water (T) or not (F) 
     127   ln_icedS         = .true.          !  activate gravity drainage and flushing (T) or not (F) 
     128/ 
     129!------------------------------------------------------------------------------ 
     130&namthd_zdf     !   Ice heat diffusion 
     131!------------------------------------------------------------------------------ 
     132   ln_zdf_BL99      = .true.          !  Heat diffusion follows Bitz and Lipscomb 1999 
     133   ln_cndi_U64      = .false.         !  sea ice thermal conductivity: k = k0 + beta.S/T            (Untersteiner, 1964) 
     134   ln_cndi_P07      = .true.          !  sea ice thermal conductivity: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 
     135   rn_cnd_s         =   0.31          !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 
     136                                      !     Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 
     137   rn_kappa_i       =   1.0           !  radiation attenuation coefficient in sea ice [1/m] 
     138   ln_dqns_i        = .true.          !  change the surface non-solar flux with surface temperature (T) or not (F) 
     139/ 
     140!------------------------------------------------------------------------------ 
     141&namthd_da     !   Ice lateral melting 
     142!------------------------------------------------------------------------------ 
     143   rn_beta          =   1.0           !  coef. beta for lateral melting param. Recommended range=[0.8-1.2] 
     144                                      !   => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 
     145                                      !      0.3 = best fit for western Fram Strait and Antarctica 
     146                                      !      1.4 = best fit for eastern Fram Strait       
     147   rn_dmin          =   8.            !  minimum floe diameter for lateral melting param. Recommended range=[6-10] 
     148                                      !   => 6  vs 8m = +40% melting at the peak (A~0.5) 
     149                                      !      10 vs 8m = -20% melting 
     150/ 
     151!------------------------------------------------------------------------------ 
     152&namthd_do     !   Ice growth in open water 
     153!------------------------------------------------------------------------------ 
     154   rn_hinew         =   0.1           !  thickness for new ice formation in open water (m), must be larger than rn_hnewice 
     155   ln_frazil        = .false.         !  Frazil ice parameterization (ice collection as a function of wind) 
     156      rn_maxfraz    =   1.0           !     maximum fraction of frazil ice collecting at the ice base 
     157      rn_vfraz      =   0.417         !     thresold drift speed for frazil ice collecting at the ice bottom (m/s) 
     158      rn_Cfraz      =   5.0           !     squeezing coefficient for frazil ice collecting at the ice bottom 
     159/ 
     160!------------------------------------------------------------------------------ 
     161&namthd_sal     !   Ice salinity 
     162!------------------------------------------------------------------------------ 
     163   nn_icesal        =   2             !  ice salinity option 
     164                                      !     1: constant ice salinity (S=rn_icesal) 
     165                                      !     2: varying salinity parameterization S(z,t) 
     166                                      !     3: prescribed salinity profile S(z), Schwarzacher, 1959 
     167   rn_icesal        =   4.            !    (nn_icesal=1) ice salinity (g/kg) 
     168   rn_sal_gd        =   5.            !  restoring ice salinity, gravity drainage (g/kg) 
     169   rn_time_gd       =   1.73e+6       !  restoring time scale, gravity drainage  (s) 
     170   rn_sal_fl        =   2.            !  restoring ice salinity, flushing (g/kg) 
     171   rn_time_fl       =   8.64e+5       !  restoring time scale, flushing (s) 
     172   rn_simax         =  20.            !  maximum tolerated ice salinity (g/kg) 
     173   rn_simin         =   0.1           !  minimum tolerated ice salinity (g/kg) 
     174/ 
     175!------------------------------------------------------------------------------ 
     176&nammp      !   Melt ponds 
     177!------------------------------------------------------------------------------ 
     178   ln_pnd           = .false.         !  active melt ponds 
     179   ln_pnd_rad       = .false.         !  active melt ponds radiative coupling 
     180   ln_pnd_fw        = .false.         !  active melt ponds freshwater coupling 
     181   nn_pnd_scheme    =   0             !  type of melt pond scheme  : =0 prescribed ( Tsu=0 ), =1 empirical, =2 topographic 
     182   rn_apnd          =   0.2           !  prescribed pond fraction, at Tsu=0  : (0<rn_apnd<1, nn_pnd_scheme = 0) 
     183   rn_hpnd          =   0.05          !  prescribed pond depth, at Tsu=0     : (0<rn_apnd<1, nn_pnd_scheme = 0) 
     184/ 
     185!------------------------------------------------------------------------------ 
     186&namini     !   Ice initialization 
     187!------------------------------------------------------------------------------ 
     188   ln_iceini        = .true.          !  activate ice initialization (T) or not (F) 
     189   ln_iceini_file   = .false.         !  netcdf file provided for initialization (T) or not (F) 
     190   rn_thres_sst     =   2.0           !  max delta temp. above Tfreeze with initial ice = (sst - tfreeze) 
     191   rn_hts_ini_n     =   0.3           !  initial real snow thickness (m), North 
     192   rn_hts_ini_s     =   0.3           !        "            "             South 
     193   rn_hti_ini_n     =   3.0           !  initial real ice thickness  (m), North 
     194   rn_hti_ini_s     =   1.0           !        "            "             South 
     195   rn_ati_ini_n     =   0.9           !  initial ice concentration   (-), North 
     196   rn_ati_ini_s     =   0.9           !        "            "             South 
     197   rn_smi_ini_n     =   6.3           !  initial ice salinity     (g/kg), North 
     198   rn_smi_ini_s     =   6.3           !        "            "             South 
     199   rn_tmi_ini_n     = 270.            !  initial ice/snw temperature (K), North 
     200   rn_tmi_ini_s     = 270.            !        "            "             South 
     201 
     202   sn_hti = 'Ice_initialization'    , -12 ,'hti'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     203   sn_hts = 'Ice_initialization'    , -12 ,'hts'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     204   sn_ati = 'Ice_initialization'    , -12 ,'ati'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     205   sn_tsu = 'Ice_initialization'    , -12 ,'tsu'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     206   sn_tmi = 'Ice_initialization'    , -12 ,'tmi'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     207   sn_smi = 'Ice_initialization'    , -12 ,'smi'   ,  .false.  , .true., 'yearly'  , '' , '', '' 
     208   cn_dir='./' 
     209/ 
     210!------------------------------------------------------------------------------ 
     211&namalb     !   albedo parameters 
     212!------------------------------------------------------------------------------ 
     213   nn_ice_alb       =    1            !  parameterization of ice/snow albedo 
     214                                      !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo 
     215                                      !     1: "home made" based on Brandt et al. (JClim 2005) 
     216                                      !                         and Grenfell & Perovich (JGR 2004), giving cloud-sky albedo 
     217                                      !     2: as 1 with melt ponds 
     218   rn_alb_sdry      =   0.85          !  dry snow albedo         : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky) 
     219   rn_alb_smlt      =   0.75          !  melting snow albedo     : 0.65 ( '' )          ; 0.75 ( '' )          ; obs 0.72-0.82 ( '' ) 
     220   rn_alb_idry      =   0.60          !  dry ice albedo          : 0.72 ( '' )          ; 0.60 ( '' )          ; obs 0.54-0.65 ( '' ) 
     221   rn_alb_imlt      =   0.50          !  bare puddled ice albedo : 0.53 ( '' )          ; 0.50 ( '' )          ; obs 0.49-0.58 ( '' ) 
     222   rn_alb_dpnd      =   0.27          !  ponded ice albedo       : 0.25 ( '' )          ; 0.27 ( '' )          ; obs 0.10-0.30 ( '' ) 
     223/ 
     224!------------------------------------------------------------------------------ 
     225&namdia     !   Diagnostics 
     226!------------------------------------------------------------------------------ 
     227   ln_icediachk     = .false.         !  check online the heat, mass & salt budgets (T) or not (F) 
     228   ln_icediahsb     = .false.         !  output the heat, mass & salt budgets (T) or not (F) 
     229   ln_icectl        = .false.         !  ice points output for debug (T or F) 
     230   iiceprt          =  10             !  i-index for debug 
     231   jiceprt          =  10             !  j-index for debug 
     232/ 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ref

    r8733 r8738  
    192192                           !  =1 opa-sas OASIS coupling: multi executable configuration, OPA component 
    193193                           !  =2 opa-sas OASIS coupling: multi executable configuration, SAS component  
    194    nn_limflx = -1          !  LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used) 
    195                            !  =-1  Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled 
    196                            !  = 0  Average per-category fluxes (forced and coupled mode) 
    197                            !  = 1  Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled 
    198                            !  = 2  Redistribute a single flux over categories (coupled mode only) 
    199194                     ! Sea-ice : 
    200    nn_ice      = 3         !  =0 no ice boundary condition   , 
     195   nn_ice      = 2         !  =0 no ice boundary condition   , 
    201196                           !  =1 use observed ice-cover      , 
    202                            !  =2 to 4 :  ice-model used (LIM2, LIM3 or CICE)                         ("key_lim3", "key_lim2", or "key_cice") 
    203    nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    204                            !  =1 levitating ice with mass and salt exchange but no presure effect 
    205                            !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
     197                           !  =2 & 3 :  ice-model used (LIM3 or CICE)                         ("key_lim3" or "key_cice") 
     198   ln_ice_embd = .false.   !  =F levitating ice with mass and salt exchange but no presure effect 
     199                           !  =T embedded sea-ice (full salt and mass exchanges and pressure) 
    206200                     ! Misc. options of sbc :  
    207201   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
     
    264258   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
    265259                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
    266    ln_Cd_L12   = .false.   !  Modify the drag ice-atm and oce-atm depending on ice concentration 
    267                            !  This parameterization is from Lupkes et al. (JGR 2012) 
     260   ln_Cd_L12   = .false.   !  Modify the drag ice-atm depending on ice concentration with Lupkes 2012 
     261   ln_Cd_L15   = .false.   !  Modify the drag ice-atm depending on ice concentration with Lupkes 2015 
    268262/ 
    269263!----------------------------------------------------------------------- 
     
    313307!              !             !  (if <0  months)  !   name    !  (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    314308   l_sasread   = .TRUE.   ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE. 
    315    sn_usp      = 'sas_grid_U',     120           , 'vozocrtx',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
    316    sn_vsp      = 'sas_grid_V',     120           , 'vomecrty',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
     309   sn_usp      = 'sas_grid_U',     120           ,    'uos'  ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
     310   sn_vsp      = 'sas_grid_V',     120           ,    'vos'  ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
    317311   sn_tem      = 'sas_grid_T',     120           , 'sosstsst',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
    318312   sn_sal      = 'sas_grid_T',     120           , 'sosaline',   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
     
    321315   sn_frq      = 'sas_grid_T',     120           , 'frq_m'   ,   .true.    , .true. , 'yearly'  ,    ''    ,    ''    ,    '' 
    322316 
    323    ln_3d_uve   = .true.    !  specify whether we are supplying a 3D u,v and e3 field 
     317   ln_3d_uve   = .false.   !  specify whether we are supplying a 3D u,v and e3 field 
    324318   ln_read_frq = .false.   !  specify whether we must read frq or not 
    325319   cn_dir      = './'      !  root directory for the location of the bulk files are 
     
    340334   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction 
    341335   rn_si1      =   23.0    !  2 bands: longest depth of extinction 
    342    ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3 
    343336/ 
    344337!----------------------------------------------------------------------- 
     
    434427   ln_sssr_bnd =  .true.   !  flag to bound erp term (associated with nn_sssr=2) 
    435428   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
    436 / 
    437 !----------------------------------------------------------------------- 
    438 &namsbc_alb    !   albedo parameters 
    439 !----------------------------------------------------------------------- 
    440    nn_ice_alb   =    1   !  parameterization of ice/snow albedo 
    441                          !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo 
    442                          !     1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004), 
    443                          !        giving cloud-sky albedo 
    444    rn_alb_sdry  =  0.85  !  dry snow albedo         : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky) 
    445    rn_alb_smlt  =  0.75  !  melting snow albedo     : 0.65 ( '' )          ; 0.75 ( '' )          ; obs 0.72-0.82 ( '' ) 
    446    rn_alb_idry  =  0.60  !  dry ice albedo          : 0.72 ( '' )          ; 0.60 ( '' )          ; obs 0.54-0.65 ( '' ) 
    447    rn_alb_imlt  =  0.50  !  bare puddled ice albedo : 0.53 ( '' )          ; 0.50 ( '' )          ; obs 0.49-0.58 ( '' ) 
    448429/ 
    449430!----------------------------------------------------------------------- 
     
    581562   bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    582563   bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    583 ! for lim2 
    584 !   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    585 !   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    586 !   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    587564! for lim3 
    588565!   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    589 !   bn_ht_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    590 !   bn_ht_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
     566!   bn_h_i    = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
     567!   bn_h_s    = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    591568 
    592569   cn_dir      = 'bdydta/' !  root directory for the location of the bulk files 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg

    r8018 r8738  
    6464                           !  =1 use observed ice-cover      ,  
    6565                           !  =2 ice-model used                 
    66    nn_ice_embd = 0         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    67                            !  =1 levitating ice with mass and salt exchange but no presure effect 
    68                            !  =2 embedded sea-ice (full salt and mass exchanges and pressure) 
     66   ln_ice_embd = .false.   !  =F levitating ice with mass and salt exchange but no presure effect 
     67                           !  =T embedded sea-ice (full salt and mass exchanges and pressure) 
     68                     ! Misc. options of sbc : 
    6969   ln_traqsr   = .false.   !  Light penetration (T) or not (F) 
    7070   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg

    r7822 r8738  
    2626&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    2727!----------------------------------------------------------------------- 
    28    ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
     28   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
    2929   ! 
    3030   nn_msh      =    1      !  create (>0) a mesh file or not (=0) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg

    r7820 r8738  
    66!!              4 - Ice discretization                 (namiceitd) 
    77!!              5 - Ice dynamics and transport         (namicedyn) 
    8 !!              6 - Ice diffusion                      (namicehdf) 
    9 !!              7 - Ice thermodynamics                 (namicethd) 
    10 !!              8 - Ice salinity                       (namicesal) 
    11 !!              9 - Ice mechanical redistribution      (namiceitdme) 
     8!!              6 - Ice thermodynamics                 (namicethd) 
     9!!              7 - Ice salinity                       (namicesal) 
     10!!              8 - Ice mechanical redistribution      (namiceitdme) 
     11!!              9 - Ice/snow albedos                   (namicealb) 
    1212!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    1313! 
     
    5656/ 
    5757!------------------------------------------------------------------------------ 
    58 &namicehdf     !   Ice horizontal diffusion 
    59 !------------------------------------------------------------------------------ 
    60 / 
    61 !------------------------------------------------------------------------------ 
    6258&namicethd     !   Ice thermodynamics 
    6359!------------------------------------------------------------------------------ 
     
    8581   ln_rafting     =   .true.        !  rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
    8682/ 
     83!----------------------------------------------------------------------- 
     84&namicealb     !   albedo parameters 
     85!----------------------------------------------------------------------- 
     86/ 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90

    r8733 r8738  
    351351        IF(lwp) WRITE(numout,*) 
    352352 
    353 #if defined key_lim2 
    354         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    355         SELECT CASE( cn_ice_lim(ib_bdy) )                   
    356           CASE('none') 
    357              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    358              dta_bdy(ib_bdy)%ll_frld  = .false. 
    359              dta_bdy(ib_bdy)%ll_hicif = .false. 
    360              dta_bdy(ib_bdy)%ll_hsnif = .false. 
    361           CASE('frs') 
    362              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    363              dta_bdy(ib_bdy)%ll_frld  = .true. 
    364              dta_bdy(ib_bdy)%ll_hicif = .true. 
    365              dta_bdy(ib_bdy)%ll_hsnif = .true. 
    366           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
    367         END SELECT 
    368         IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN  
    369            SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   !  
    370               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    371               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    372               CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 
    373            END SELECT 
    374         ENDIF 
    375         IF(lwp) WRITE(numout,*) 
    376 #elif defined key_lim3 
     353#if defined key_lim3 
    377354        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    378355        SELECT CASE( cn_ice_lim(ib_bdy) )                   
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h

    r8733 r8738  
    3636#define LONG_FNAME 1000    // Max length for a file name 
    3737#define LONG_C     200 
    38 #define LONG_M     1500 
     38#define LONG_M     2000 
    3939 
    4040#define NB_CAT_VARIABLES 5 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r8733 r8738  
    11MODULE ice 
    22   !!====================================================================== 
    3    !!                        ***  MODULE ice  *** 
    4    !! LIM-3 Sea Ice physics:  diagnostics variables of ice defined in memory 
    5    !!===================================================================== 
     3   !!                        ***  MODULE  ice  *** 
     4   !!   sea-ice:  ice variables defined in memory 
     5   !!====================================================================== 
    66   !! History :  3.0  ! 2008-03  (M. Vancoppenolle) original code LIM-3 
    77   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
     
    99#if defined key_lim3 
    1010   !!---------------------------------------------------------------------- 
    11    !!   'key_lim3'                                      LIM-3 sea-ice model 
     11   !!   'key_lim3'                                       ESIM sea-ice model 
    1212   !!---------------------------------------------------------------------- 
    1313   USE in_out_manager ! I/O manager 
     
    1717   PRIVATE 
    1818 
    19    PUBLIC    ice_alloc  !  Called in sbc_lim_init 
     19   PUBLIC    ice_alloc  ! called by icestp.F90 
    2020 
    2121   !!====================================================================== 
     
    6363   !!   meaningful and/or used in ice thermodynamics                      | 
    6464   !!                                                                     | 
    65    !! Routines in limvar.F90 perform conversions                          | 
    66    !!  - lim_var_glo2eqv  : from global to equivalent variables           | 
    67    !!  - lim_var_eqv2glo  : from equivalent to global variables           | 
     65   !! Routines in icevar.F90 perform conversions                          | 
     66   !!  - ice_var_glo2eqv  : from global to equivalent variables           | 
     67   !!  - ice_var_eqv2glo  : from equivalent to global variables           | 
    6868   !!                                                                     | 
    6969   !! For various purposes, the sea ice state variables have sometimes    | 
    7070   !! to be aggregated over all ice thickness categories. This operation  | 
    7171   !! is done in :                                                        | 
    72    !!  - lim_var_agg                                                      | 
     72   !!  - ice_var_agg                                                      | 
    7373   !!                                                                     | 
    7474   !! in icestp.F90, the routines that compute the changes in the ice     | 
    7575   !! state variables are called                                          | 
    76    !! - lim_dyn : ice dynamics                                            | 
    77    !! - lim_trp : ice transport                                           | 
    78    !! - lim_itd_me : mechanical redistribution (ridging and rafting)      | 
    79    !! - lim_thd : ice halo-thermodynamics                                 | 
    80    !! - lim_itd_th : thermodynamic changes in ice thickness distribution  | 
    81    !!                and creation of new ice                              | 
     76   !! - ice_rhg : ice dynamics                                            | 
     77   !! - ice_adv : ice advection                                           | 
     78   !! - ice_rdgrft : ice ridging and rafting                              | 
     79   !! - ice_thd : ice halo-thermodynamics and creation of new ice         | 
     80   !! - ice_itd : thermodynamic changes in ice thickness distribution     | 
    8281   !!                                                                     | 
    8382   !! See the associated routines for more information                    | 
     
    107106   !! v_i         |      -      |    Ice volume per unit area     | m     | 
    108107   !! v_s         |      -      |    Snow volume per unit area    | m     | 
    109    !! smv_i       |      -      |    Sea ice salt content         | ppt.m | 
    110    !! oa_i        !      -      !    Sea ice areal age content    | day   | 
     108   !! sv_i        |      -      |    Sea ice salt content         | ppt.m | 
     109   !! oa_i        !      -      !    Sea ice areal age content    |    | 
    111110   !! e_i         !      -      !    Ice enthalpy                 | J/m2  |  
    112    !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
     111   !!      -      ! e_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
    113112   !! e_s         !      -      !    Snow enthalpy                | J/m2  |  
    114    !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
     113   !!      -      ! e_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
    115114   !!                                                                     | 
    116115   !!-------------|-------------|---------------------------------|-------| 
     
    119118   !!-------------|-------------|---------------------------------|-------| 
    120119   !!                                                                     | 
    121    !! ht_i        | ht_i_1d     |    Ice thickness                | m     | 
    122    !! ht_s        ! ht_s_1d     |    Snow depth                   | m     | 
    123    !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   | 
    124    !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   | 
    125    !! o_i         !      -      |    Sea ice Age                  ! days  | 
     120   !! h_i         | h_i_1d      |    Ice thickness                | m     | 
     121   !! h_s         ! h_s_1d      |    Snow depth                   | m     | 
     122   !! s_i         ! s_i_1d      |    Sea ice bulk salinity        ! ppt   | 
     123   !! sz_i        ! sz_i_1d     |    Sea ice salinity profile     ! ppt   | 
     124   !! o_i         !      -      |    Sea ice Age                  ! s     | 
    126125   !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     | 
    127126   !! t_s         ! t_s_1d      |    Snow temperature             ! K     | 
     
    144143   !! vt_i        |      -      |    Total ice vol. per unit area | m     | 
    145144   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     | 
    146    !! smt_i       |      -      |    Mean sea ice salinity        | ppt   | 
     145   !! sm_i        |      -      |    Mean sea ice salinity        | ppt   | 
    147146   !! tm_i        |      -      |    Mean sea ice temperature     | K     | 
    148147   !! et_i        !      -      !    Total ice enthalpy           | J/m2  |  
     
    151150   !!===================================================================== 
    152151 
    153    LOGICAL, PUBLIC ::   con_i = .false.   ! switch for conservation test 
    154  
    155    !!-------------------------------------------------------------------------- 
     152   !!---------------------------------------------------------------------- 
    156153   !! * Share Module variables 
    157    !!-------------------------------------------------------------------------- 
    158    !                                     !!** ice-generic parameters namelist (namicerun) ** 
     154   !!---------------------------------------------------------------------- 
     155   !                                     !!** ice-generic parameters namelist (nampar) ** 
    159156   INTEGER           , PUBLIC ::   jpl             !: number of ice  categories  
    160157   INTEGER           , PUBLIC ::   nlay_i          !: number of ice  layers  
    161158   INTEGER           , PUBLIC ::   nlay_s          !: number of snow layers  
     159   INTEGER           , PUBLIC ::   nn_monocat      !: virtual ITD mono-category parameterizations (1-4) or not (0) 
     160   LOGICAL           , PUBLIC ::   ln_icedyn       !: flag for ice dynamics (T) or not (F) 
     161   LOGICAL           , PUBLIC ::   ln_icethd       !: flag for ice thermo   (T) or not (F) 
    162162   REAL(wp)          , PUBLIC ::   rn_amax_n       !: maximum ice concentration Northern hemisphere 
    163163   REAL(wp)          , PUBLIC ::   rn_amax_s       !: maximum ice concentration Southern hemisphere 
     
    166166   CHARACTER(len=256), PUBLIC ::   cn_icerst_indir !: ice restart input directory 
    167167   CHARACTER(len=256), PUBLIC ::   cn_icerst_outdir!: ice restart output directory 
    168    LOGICAL           , PUBLIC ::   ln_limthd       !: flag for ice thermo (T) or not (F) 
    169    LOGICAL           , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F) 
    170    INTEGER           , PUBLIC ::   nn_limdyn       !: flag for ice dynamics 
    171    REAL(wp)          , PUBLIC ::   rn_uice         !: prescribed u-vel (case nn_limdyn=0) 
    172    REAL(wp)          , PUBLIC ::   rn_vice         !: prescribed v-vel (case nn_limdyn=0) 
     168 
     169   !                                     !!** ice-itd namelist (namitd) ** 
     170   REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness 
    173171    
    174    !                                     !!** ice-diagnostics namelist (namicediag) ** 
    175    LOGICAL , PUBLIC ::   ln_limdiachk     !: flag for ice diag (T) or not (F) 
    176    LOGICAL , PUBLIC ::   ln_limdiahsb     !: flag for ice diag (T) or not (F) 
    177    LOGICAL , PUBLIC ::   ln_limctl        !: flag for sea-ice points output (T) or not (F) 
    178    INTEGER , PUBLIC ::   iiceprt          !: debug i-point 
    179    INTEGER , PUBLIC ::   jiceprt          !: debug j-point 
    180  
    181    !                                     !!** ice-init namelist (namiceini) ** 
    182                                           ! -- limistate -- ! 
    183    LOGICAL , PUBLIC ::   ln_limini        ! initialization or not 
    184    LOGICAL , PUBLIC ::   ln_limini_file   ! Ice initialization state from 2D netcdf file 
    185    REAL(wp), PUBLIC ::   rn_thres_sst     ! threshold water temperature for initial sea ice 
    186    REAL(wp), PUBLIC ::   rn_hts_ini_n     ! initial snow thickness in the north 
    187    REAL(wp), PUBLIC ::   rn_hts_ini_s     ! initial snow thickness in the south 
    188    REAL(wp), PUBLIC ::   rn_hti_ini_n     ! initial ice thickness in the north 
    189    REAL(wp), PUBLIC ::   rn_hti_ini_s     ! initial ice thickness in the south 
    190    REAL(wp), PUBLIC ::   rn_ati_ini_n     ! initial leads area in the north 
    191    REAL(wp), PUBLIC ::   rn_ati_ini_s     ! initial leads area in the south 
    192    REAL(wp), PUBLIC ::   rn_smi_ini_n     ! initial salinity  
    193    REAL(wp), PUBLIC ::   rn_smi_ini_s     ! initial salinity 
    194    REAL(wp), PUBLIC ::   rn_tmi_ini_n     ! initial temperature 
    195    REAL(wp), PUBLIC ::   rn_tmi_ini_s     ! initial temperature 
    196     
    197    !                                     !!** ice-thickness distribution namelist (namiceitd) ** 
    198    INTEGER , PUBLIC ::   nn_catbnd        !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 
    199    REAL(wp), PUBLIC ::   rn_himean        !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 
    200  
    201    !                                     !!** ice-dynamics namelist (namicedyn) ** 
    202                                           ! -- limtrp & limadv -- ! 
    203    INTEGER , PUBLIC ::   nn_limadv        !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 
    204    INTEGER , PUBLIC ::   nn_limadv_ord    !: choose the order of the advection scheme (if Ultimate-Macho)    
    205                                           ! -- limitd_me -- ! 
    206    INTEGER , PUBLIC ::   nn_icestr        !: ice strength parameterization (0=Hibler79 1=Rothrock75) 
    207    REAL(wp), PUBLIC ::   rn_pe_rdg        !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 
    208    REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength, Hibler JPO79 
    209    REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength 
    210    LOGICAL , PUBLIC ::   ln_icestr_bvf    !: use brine volume to diminish ice strength 
    211                                           ! -- limdyn & limrhg -- ! 
    212    REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     172   !                                     !!** ice-dynamics namelist (namdyn) ** 
     173   REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice 
     174   LOGICAL , PUBLIC ::   ln_landfast      !: landfast ice parameterization (T or F)  
     175   REAL(wp), PUBLIC ::   rn_gamma         !:    fraction of ocean depth that ice must reach to initiate landfast ice 
     176   REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (landfast ice)  
     177   REAL(wp), PUBLIC ::   rn_lfrelax       !:    relaxation time scale (s-1) to reach static friction (landfast ice)  
     178   ! 
     179   !                                     !!** ice-rheology namelist (namrhg) ** 
    213180   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
    214181   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
    215182   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
    216183   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
    217    LOGICAL , PUBLIC ::   ln_landfast      !: landfast ice parameterization (T or F)  
    218    REAL(wp), PUBLIC ::   rn_gamma         !: fraction of ocean depth that ice must reach to initiate landfast ice 
    219    REAL(wp), PUBLIC ::   rn_icebfr        !: maximum bottom stress per unit area of contact (landfast ice)  
    220    REAL(wp), PUBLIC ::   rn_lfrelax       !: relaxation time scale (s-1) to reach static friction (landfast ice)  
    221  
    222    !                                     !!** ice-diffusion namelist (namicehdf) ** 
    223    INTEGER , PUBLIC ::   nn_ahi0          !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 
    224    REAL(wp), PUBLIC ::   rn_ahi0_ref      !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    225  
    226    !                                     !!** ice-thermodynamics namelist (namicethd) ** 
    227                                           ! -- limthd_dif -- ! 
    228    REAL(wp), PUBLIC ::   rn_kappa_i       !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    229    REAL(wp), PUBLIC ::   nn_conv_dif      !: maximal number of iterations for heat diffusion 
    230    REAL(wp), PUBLIC ::   rn_terr_dif      !: maximal tolerated error (C) for heat diffusion 
    231    INTEGER , PUBLIC ::   nn_ice_thcon     !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
    232    LOGICAL , PUBLIC ::   ln_it_qnsice     !: iterate surface flux with changing surface temperature or not (F) 
    233    INTEGER , PUBLIC ::   nn_monocat       !: virtual ITD mono-category parameterizations (1) or not (0) 
    234    REAL(wp), PUBLIC ::   rn_cdsn          !: thermal conductivity of the snow [W/m/K] 
    235                                           ! -- limthd_dh -- ! 
    236    LOGICAL , PUBLIC ::   ln_limdH         !: activate ice thickness change from growing/melting (T) or not (F) 
    237    REAL(wp), PUBLIC ::   rn_betas         !: coef. for partitioning of snowfall between leads and sea ice 
    238                                           ! -- limthd_da -- ! 
    239    LOGICAL , PUBLIC ::   ln_limdA         !: activate lateral melting param. (T) or not (F) 
    240    REAL(wp), PUBLIC ::   rn_beta          !: coef. beta for lateral melting param. 
    241    REAL(wp), PUBLIC ::   rn_dmin          !: minimum floe diameter for lateral melting param. 
    242                                           ! -- limthd_lac -- ! 
    243    LOGICAL , PUBLIC ::   ln_limdO         !: activate ice growth in open-water (T) or not (F) 
    244    REAL(wp), PUBLIC ::   rn_hnewice       !: thickness for new ice formation (m) 
    245    LOGICAL , PUBLIC ::   ln_frazil        !: use of frazil ice collection as function of wind (T) or not (F) 
    246    REAL(wp), PUBLIC ::   rn_maxfrazb      !: maximum portion of frazil ice collecting at the ice bottom 
    247    REAL(wp), PUBLIC ::   rn_vfrazb        !: threshold drift speed for collection of bottom frazil ice 
    248    REAL(wp), PUBLIC ::   rn_Cfrazb        !: squeezing coefficient for collection of bottom frazil ice 
    249                                           ! -- limitd_th -- ! 
    250    REAL(wp), PUBLIC ::   rn_himin         !: minimum ice thickness 
    251  
    252    !                                     !!** ice-salinity namelist (namicesal) ** 
    253    LOGICAL , PUBLIC ::   ln_limdS         !: activate gravity drainage and flushing (T) or not (F) 
     184   ! 
     185   !                                     !!** ice-surface forcing namelist (namforcing) ** 
     186                                          ! -- icethd_dh -- ! 
     187   REAL(wp), PUBLIC ::   rn_blow_s        !: coef. for partitioning of snowfall between leads and sea ice 
     188                                          ! -- icethd -- ! 
     189   REAL(wp), PUBLIC ::   rn_cio           !: drag coefficient for oceanic stress 
     190   INTEGER , PUBLIC ::   nn_iceflx        !: Redistribute heat flux over ice categories 
     191   !                                      !   =-1  Do nothing (needs N(cat) fluxes) 
     192   !                                      !   = 0  Average N(cat) fluxes then apply the average over the N(cat) ice  
     193   !                                      !   = 1  Average N(cat) fluxes then redistribute over the N(cat) ice 
     194   !                                      !                                   using T-ice and albedo sensitivity 
     195   !                                      !   = 2  Redistribute a single flux over categories 
     196 
     197   !                                     !!** ice-salinity namelist (namthd_sal) ** 
    254198   INTEGER , PUBLIC ::   nn_icesal        !: salinity configuration used in the model 
    255199   !                                      ! 1 - constant salinity in both space and time 
     
    257201   !                                      ! 3 - salinity profile, constant in time 
    258202   REAL(wp), PUBLIC ::   rn_icesal        !: bulk salinity (ppt) in case of constant salinity 
    259    REAL(wp), PUBLIC ::   rn_sal_gd        !: restoring salinity for gravity drainage [PSU] 
    260    REAL(wp), PUBLIC ::   rn_time_gd       !: restoring time constant for gravity drainage (= 20 days) [s] 
    261    REAL(wp), PUBLIC ::   rn_sal_fl        !: restoring salinity for flushing [PSU] 
    262    REAL(wp), PUBLIC ::   rn_time_fl       !: restoring time constant for gravity drainage (= 10 days) [s] 
    263203   REAL(wp), PUBLIC ::   rn_simax         !: maximum ice salinity [PSU] 
    264204   REAL(wp), PUBLIC ::   rn_simin         !: minimum ice salinity [PSU] 
    265205 
    266    !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    267    REAL(wp), PUBLIC ::   rn_cs            !: fraction of shearing energy contributing to ridging             
    268    INTEGER , PUBLIC ::   nn_partfun       !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
    269    REAL(wp), PUBLIC ::   rn_gstar         !: fractional area of young ice contributing to ridging 
    270    REAL(wp), PUBLIC ::   rn_astar         !: equivalent of G* for an exponential participation function 
    271    LOGICAL , PUBLIC ::   ln_ridging       !: ridging of ice or not                         
    272    REAL(wp), PUBLIC ::   rn_hstar         !: thickness that determines the maximal thickness of ridged ice 
    273    REAL(wp), PUBLIC ::   rn_por_rdg       !: initial porosity of ridges (0.3 regular value) 
    274    REAL(wp), PUBLIC ::   rn_fsnowrdg      !: fractional snow loss to the ocean during ridging 
    275    LOGICAL , PUBLIC ::   ln_rafting       !: rafting of ice or not                         
    276    REAL(wp), PUBLIC ::   rn_hraft         !: threshold thickness (m) for rafting / ridging  
    277    REAL(wp), PUBLIC ::   rn_craft         !: coefficient for smoothness of the hyperbolic tangent in rafting 
    278    REAL(wp), PUBLIC ::   rn_fsnowrft      !: fractional snow loss to the ocean during ridging 
     206   ! MV MP 2016 
     207   !                                     !!** melt pond namelist (nammp) 
     208   LOGICAL , PUBLIC ::   ln_pnd           !: activate ponds or not 
     209   LOGICAL , PUBLIC ::   ln_pnd_rad       !: ponds radiatively active or not 
     210   LOGICAL , PUBLIC ::   ln_pnd_fw        !: ponds active wrt meltwater or not 
     211   INTEGER , PUBLIC ::   nn_pnd_scheme    !: type of melt pond scheme:   =0 prescribed, =1 empirical, =2 topographic 
     212   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1), only if nn_pnd_scheme = 0 
     213   REAL(wp), PUBLIC ::   rn_hpnd          !: prescribed pond depth    (0<rn_hpnd<1), only if nn_pnd_scheme = 0 
     214   ! END MV MP 2016 
     215   !                                     !!** ice-diagnostics namelist (namdia) ** 
     216   LOGICAL , PUBLIC ::   ln_icediachk     !: flag for ice diag (T) or not (F) 
     217   LOGICAL , PUBLIC ::   ln_icediahsb     !: flag for ice diag (T) or not (F) 
     218   LOGICAL , PUBLIC ::   ln_icectl        !: flag for sea-ice points output (T) or not (F) 
     219   INTEGER , PUBLIC ::   iiceprt          !: debug i-point 
     220   INTEGER , PUBLIC ::   jiceprt          !: debug j-point 
    279221 
    280222   !                                     !!** some other parameters  
    281    INTEGER , PUBLIC ::   nstart           !: iteration number of the begining of the run  
    282    INTEGER , PUBLIC ::   nlast            !: iteration number of the end of the run  
    283    INTEGER , PUBLIC ::   nitrun           !: number of iteration 
    284    INTEGER , PUBLIC ::   numit            !: iteration number 
     223   INTEGER , PUBLIC ::   kt_ice           !: iteration number 
    285224   REAL(wp), PUBLIC ::   rdt_ice          !: ice time step 
    286225   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice 
     
    288227   REAL(wp), PUBLIC ::   r1_nlay_s        !: 1 / nlay_s  
    289228   REAL(wp), PUBLIC ::   rswitch          !: switch for the presence of ice (1) or not (0) 
    290    REAL(wp), PUBLIC, PARAMETER ::   epsi06   = 1.e-06_wp  !: small number  
    291    REAL(wp), PUBLIC, PARAMETER ::   epsi10   = 1.e-10_wp  !: small number  
    292    REAL(wp), PUBLIC, PARAMETER ::   epsi20   = 1.e-20_wp  !: small number  
     229   REAL(wp), PUBLIC ::   rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft   !: conservation diagnostics 
     230   REAL(wp), PUBLIC, PARAMETER ::   epsi06 = 1.e-06_wp  !: small number  
     231   REAL(wp), PUBLIC, PARAMETER ::   epsi10 = 1.e-10_wp  !: small number  
     232   REAL(wp), PUBLIC, PARAMETER ::   epsi20 = 1.e-20_wp  !: small number  
     233 
    293234 
    294235   !                                     !!** define arrays 
    295    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce !: surface ocean velocity used in ice dynamics 
    296    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 
    297    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicol       !: ice collection thickness accreted in leads 
     236   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce,v_oce !: surface ocean velocity used in ice dynamics 
     237   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_i_new    !: ice collection thickness accreted in leads 
    298238   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength    !: ice strength 
    299239   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
     
    303243   ! 
    304244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    305    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
    306    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time   
    307    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness 
    308245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
    309246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean 
     
    311248 
    312249   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw     !: snow-ocean mass exchange   [kg.m-2.s-1] 
     250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sni !: snow ice growth component of wfx_snw [kg.m-2.s-1] 
     251   ! MV MP 2016 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sum !: surface melt component of wfx_snw [kg.m-2.s-1] 
     253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_pnd     !: melt pond-ocean mass exchange   [kg.m-2.s-1] 
     254   ! END MV MP 2016 
    313255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr     !: snow precipitation on ice  [kg.m-2.s-1] 
    314    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: snow/ice sublimation       [kg.m-2.s-1] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub     !: sublimation of snow/ice    [kg.m-2.s-1] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_sub !: snow sublimation           [kg.m-2.s-1] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice_sub !: ice sublimation            [kg.m-2.s-1] 
     259 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw_dyn !: dynamical component of wfx_snw    [kg.m-2.s-1] 
    315261 
    316262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice     !: ice-ocean mass exchange                   [kg.m-2.s-1] 
     
    325271 
    326272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)          [s-1] 
    327    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_thd     !: ice concentration tendency (thermodynamics) [s-1] 
    328    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_dyn     !: ice concentration tendency (dynamics)       [s-1] 
    329273 
    330274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     
    346290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice   [W.m-2] 
    347291   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt                          [W.m-2] 
    348    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion             [W.m-2] 
    349292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 
    350293   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping             [W.m-2] 
     
    358301 
    359302   ! heat flux associated with ice-ocean mass exchange 
    360    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh) [W.m-2] 
    361    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  [W.m-2] 
     303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 
     304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from ridging                      [W.m-2] 
    362305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness [W.m-2] 
    363306 
    364307   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_amax_2d     !: maximum ice concentration 2d array 
    365308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice        !: transmitted solar radiation under ice 
    366    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 
    367  
    368    !!-------------------------------------------------------------------------- 
     309 
     310   !!---------------------------------------------------------------------- 
    369311   !! * Ice global state variables 
    370    !!-------------------------------------------------------------------------- 
     312   !!---------------------------------------------------------------------- 
    371313   !! Variables defined for each ice category 
    372    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i      !: Ice thickness (m) 
     314   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i       !: Ice thickness (m) 
    373315   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i       !: Ice fractional areas (concentration) 
    374316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i       !: Ice volume per unit area (m) 
    375317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s       !: Snow volume per unit area(m) 
    376    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s      !: Snow thickness (m) 
     318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_s       !: Snow thickness (m) 
    377319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su      !: Sea-Ice Surface Temperature (K) 
    378    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i      !: Sea-Ice Bulk salinity (ppt) 
    379    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m) 
    380    !                                                                    !  this is an extensive variable that has to be transported 
    381    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (days) 
    382    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (days) 
     320   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   s_i       !: Sea-Ice Bulk salinity (ppt) 
     321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sv_i     !: Sea-Ice Bulk salinity times volume per area (ppt.m) 
     322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i       !: Sea-Ice Age (s) 
     323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i      !: Sea-Ice Age times ice area (s) 
    383324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   bv_i      !: brine volume 
    384325 
     
    391332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i         !: mean ice temperature over all categories 
    392333   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bvm_i        !: brine volume averaged over all categories 
    393    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i        !: mean sea ice salinity averaged over all categories [PSU] 
     334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sm_i         !: mean sea ice salinity averaged over all categories [PSU] 
    394335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_su        !: mean surface temperature over all categories 
    395    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_i        !: mean ice  thickness over all categories 
    396    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htm_s        !: mean snow thickness over all categories 
     336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_i         !: mean ice  thickness over all categories 
     337   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hm_s         !: mean snow thickness over all categories 
    397338   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   om_i         !: mean ice age over all categories 
    398339   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tau_icebfr   !: ice friction with bathy (landfast param activated) 
    399340 
    400    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures [K] 
    401    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow ...       
    402        
    403    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures          [K] 
    404    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice thermal contents    [J/m2] 
    405    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i      !: ice salinities          [PSU] 
    406  
    407    !!-------------------------------------------------------------------------- 
    408    !! * Moments for advection 
    409    !!-------------------------------------------------------------------------- 
    410    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   !: open water in sea ice 
    411    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   !: ice thickness  
    412    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    !: snow thickness 
    413    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     !: lead fraction 
    414    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    !: snow thermal content 
    415    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   !: ice salinity 
    416    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   !: ice age 
    417    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     !: ice layers heat content 
    418  
    419    !!-------------------------------------------------------------------------- 
     341   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s      !: Snow temperatures     [K] 
     342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s      !: Snow enthalpy         [J/m2] 
     343   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i      !: ice temperatures      [K] 
     344   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i      !: ice enthalpy          [J/m2] 
     345   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sz_i     !: ice salinity          [PSU] 
     346 
     347   ! MV MP 2016 
     348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip       !: melt pond fraction per grid cell area 
     349   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_ip       !: melt pond volume per grid cell area [m] 
     350   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_ip_frac  !: melt pond volume per ice area 
     351   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_ip       !: melt pond thickness [m] 
     352 
     353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   at_ip      !: total melt pond fraction 
     354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vt_ip      !: total melt pond volume per unit area [m] 
     355   ! END MV MP 2016 
     356 
     357   !!---------------------------------------------------------------------- 
    420358   !! * Old values of global variables 
    421    !!-------------------------------------------------------------------------- 
    422    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes 
    423    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !: 
    424    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
    425    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
    426    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
    427    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                     !: ice concentration (total) 
     359   !!---------------------------------------------------------------------- 
     360   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b  !: snow and ice volumes/thickness 
     361   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b, oa_i_b        !: 
     362   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                         !: snow heat content 
     363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                         !: ice temperatures 
     364   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b              !: ice velocity 
     365   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   at_i_b                        !: ice concentration (total) 
    428366             
    429    !!-------------------------------------------------------------------------- 
     367   !!---------------------------------------------------------------------- 
    430368   !! * Ice thickness distribution variables 
    431    !!-------------------------------------------------------------------------- 
     369   !!---------------------------------------------------------------------- 
    432370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    433371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    434372   ! 
    435    !!-------------------------------------------------------------------------- 
     373   !!---------------------------------------------------------------------- 
    436374   !! * Ice diagnostics 
    437    !!-------------------------------------------------------------------------- 
     375   !!---------------------------------------------------------------------- 
    438376   ! thd refers to changes induced by thermodynamics 
    439377   ! trp   ''         ''     ''       advection (transport of ice) 
     
    443381   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
    444382   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
    445    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_smv  !: transport of salt content 
     383   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_trp_sv   !: transport of salt content 
    446384   ! 
    447385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_heat     !: snw/ice heat content variation   [W/m2]  
    448    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_smvi     !: ice salt content variation   []  
     386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_sice     !: ice salt content variation   []  
    449387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vice     !: ice volume variation   [m/s]  
    450388   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_vsnw     !: snw volume variation   [m/s]  
    451    ! 
    452    !!---------------------------------------------------------------------- 
    453    !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 
     389 
     390   ! 
     391   !!---------------------------------------------------------------------- 
     392   !! * SIMIP extra diagnostics 
     393   !!---------------------------------------------------------------------- 
     394   ! Extra sea ice diagnostics to address the data request 
     395   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   t_si          !: Temperature at Snow-ice interface (K)  
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tm_si         !: mean temperature at the snow-ice interface (K)  
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_fc_bo    !: Bottom conduction flux (W/m2) 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   diag_fc_su    !: Surface conduction flux (W/m2) 
     399 
     400   ! 
     401   !!---------------------------------------------------------------------- 
     402   !! NEMO/ICE 4.0 , NEMO Consortium (2017) 
    454403   !! $Id$ 
    455404   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    463412      INTEGER :: ice_alloc 
    464413      ! 
    465       INTEGER :: ierr(15), ii 
     414      INTEGER :: ierr(18), ii 
    466415      !!----------------------------------------------------------------- 
    467416 
     
    471420      ! stay within Fortran's max-line length limit. 
    472421      ii = 1 
    473       ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) ,                                             & 
    474          &      ahiu    (jpi,jpj) , ahiv     (jpi,jpj) , hicol    (jpi,jpj) ,                        & 
     422      ALLOCATE( u_oce   (jpi,jpj) , v_oce    (jpi,jpj) , ht_i_new (jpi,jpj) ,                        & 
    475423         &      strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,  & 
    476424         &      delta_i (jpi,jpj) , divu_i   (jpi,jpj) , shear_i  (jpi,jpj) , STAT=ierr(ii) ) 
    477425 
    478426      ii = ii + 1 
    479       ALLOCATE( t_bo   (jpi,jpj) , frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,     & 
    480          &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) ,     & 
     427      ALLOCATE( t_bo   (jpi,jpj) , wfx_snw_sni(jpi,jpj) ,                                                & 
     428         &      wfx_snw(jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) ,  & 
     429         &      wfx_ice(jpi,jpj) , wfx_sub    (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam    (jpi,jpj) ,  & 
     430         &      wfx_pnd(jpi,jpj) ,                                                              & 
    481431         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
    482432         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,     & 
    483          &      afx_tot(jpi,jpj) , afx_thd(jpi,jpj),  afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj),   & 
     433         &      afx_tot(jpi,jpj) , rn_amax_2d(jpi,jpj),                                         & 
    484434         &      fhtur  (jpi,jpj) , qlead  (jpi,jpj) ,                                           & 
    485435         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
    486436         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,  & 
    487          &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,     &  
     437         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) ,     &  
    488438         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld   (jpi,jpj) ,                        & 
    489439         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) ,     & 
     
    493443      ! * Ice global state variables 
    494444      ii = ii + 1 
    495       ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) , & 
    496          &      ht_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     & 
    497          &      v_s    (jpi,jpj,jpl) , ht_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     & 
    498          &      sm_i   (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     & 
     445      ALLOCATE( ftr_ice(jpi,jpj,jpl) ,                                                 & 
     446         &      h_i   (jpi,jpj,jpl) , a_i   (jpi,jpj,jpl) , v_i   (jpi,jpj,jpl) ,     & 
     447         &      v_s    (jpi,jpj,jpl) , h_s  (jpi,jpj,jpl) , t_su  (jpi,jpj,jpl) ,     & 
     448         &      s_i   (jpi,jpj,jpl) , sv_i (jpi,jpj,jpl) , o_i   (jpi,jpj,jpl) ,     & 
    499449         &      oa_i   (jpi,jpj,jpl) , bv_i  (jpi,jpj,jpl) ,  STAT=ierr(ii) ) 
    500450      ii = ii + 1 
     
    502452         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) ,     & 
    503453         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) ,     & 
    504          &      smt_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) ,     & 
     454         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,     & 
    505455         &      om_i (jpi,jpj) , tau_icebfr(jpi,jpj)                              , STAT=ierr(ii) ) 
    506456      ii = ii + 1 
    507457      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
    508458      ii = ii + 1 
    509       ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 
    510  
    511       ! * Moments for advection 
    512       ii = ii + 1 
    513       ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , STAT=ierr(ii) ) 
    514       ii = ii + 1 
    515       ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   & 
    516          &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   & 
    517          &      STAT=ierr(ii) ) 
    518       ii = ii + 1 
    519       ALLOCATE( sxa  (jpi,jpj,jpl) , sya  (jpi,jpj,jpl) , sxxa  (jpi,jpj,jpl) , syya  (jpi,jpj,jpl) , sxya  (jpi,jpj,jpl) ,   & 
    520          &      sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) ,   & 
    521          &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   & 
    522          &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   & 
    523          &      STAT=ierr(ii) ) 
    524       ii = ii + 1 
    525       ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) ,     & 
    526          &      syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl)                            , STAT=ierr(ii) ) 
     459      ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 
     460 
     461      ii = ii + 1 
     462      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , & 
     463         &      h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 
     464      ii = ii + 1 
     465      ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 
    527466 
    528467      ! * Old values of global variables 
    529468      ii = ii + 1 
    530       ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
    531          &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,     & 
    532          &      oa_i_b (jpi,jpj,jpl)                                                    , STAT=ierr(ii) ) 
     469      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)        ,   & 
     470         &      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) ,   & 
     471         &      oa_i_b (jpi,jpj,jpl)                                                     , STAT=ierr(ii) ) 
    533472      ii = ii + 1 
    534473      ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) ) 
     
    541480      ii = ii + 1 
    542481      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),   &  
    543          &      diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat  (jpi,jpj),   & 
    544          &      diag_smvi  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
     482         &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),   & 
     483         &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), STAT=ierr(ii) ) 
     484 
     485      ! * SIMIP diagnostics 
     486      ii = ii + 1 
     487      ALLOCATE( t_si (jpi,jpj,jpl)    , tm_si(jpi,jpj)        ,    &  
     488                diag_fc_bo(jpi,jpj)   , diag_fc_su(jpi,jpj)   ,    & 
     489                STAT = ierr(ii) ) 
    545490 
    546491      ice_alloc = MAXVAL( ierr(:) ) 
     
    551496#else 
    552497   !!---------------------------------------------------------------------- 
    553    !!   Default option         Empty module            NO LIM sea-ice model 
     498   !!   Default option         Empty module           NO ESIM sea-ice model 
    554499   !!---------------------------------------------------------------------- 
    555500#endif 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90

    r8733 r8738  
    77   !!            3.6  ! 2016-05  (C. Rousset)   Add LIM3 compatibility 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_agrif && defined key_lim2 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_agrif'                                              AGRIF zoom 
    12    !!---------------------------------------------------------------------- 
    13    USE par_oce      ! ocean parameters 
    14     
    15    IMPLICIT NONE 
    16    PRIVATE  
    17  
    18    PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90 
    19  
    20    INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id 
    21    REAL(wp), PUBLIC :: lim_nbstep = 0.    ! child time position in sea-ice model 
    22 #if defined key_lim2_vp 
    23    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)     :: u_ice_nst, v_ice_nst    
    24 #else 
    25    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: u_ice_oe, u_ice_sn     !: boundaries arrays 
    26    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)   :: v_ice_oe, v_ice_sn     !:  "          "  
    27 #endif 
    28    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !:  "          " 
    29  
    30    !!---------------------------------------------------------------------- 
    31    !! NEMO/NST 3.3.4 , NEMO Consortium (2012) 
    32    !! $Id$ 
    33    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
    36 CONTAINS  
    37  
    38    INTEGER FUNCTION agrif_ice_alloc() 
    39       !!---------------------------------------------------------------------- 
    40       !!                ***  FUNCTION agrif_ice_alloc  *** 
    41       !!---------------------------------------------------------------------- 
    42 #if defined key_lim2_vp 
    43       ALLOCATE( u_ice_nst(jpi,jpj), v_ice_nst(jpi,jpj) ,   & 
    44 #else 
    45       ALLOCATE( u_ice_oe(4,jpj,2) , v_ice_oe(4,jpj,2) ,    & 
    46          &      u_ice_sn(jpi,4,2) , v_ice_sn(jpi,4,2) ,    & 
    47 #endif 
    48          &      adv_ice_oe (4,jpj,7,2) , adv_ice_sn (jpi,4,7,2) ,   & 
    49          &      STAT = agrif_ice_alloc) 
    50  
    51 #if ! defined key_lim2_vp 
    52       u_ice_oe(:,:,:) =  0.e0 
    53       v_ice_oe(:,:,:) =  0.e0 
    54       u_ice_sn(:,:,:) =  0.e0 
    55       v_ice_sn(:,:,:) =  0.e0 
    56 #endif 
    57       adv_ice_oe (:,:,:,:) = 0.e0  
    58       adv_ice_sn (:,:,:,:) = 0.e0  
    59       ! 
    60    END FUNCTION agrif_ice_alloc 
    61  
    62 #elif defined key_agrif && defined key_lim3 
     9#if defined key_agrif && defined key_lim3 
    6310   !!---------------------------------------------------------------------- 
    6411   !!   'key_agrif'                                              AGRIF zoom 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90

    r8733 r8738  
    5252      !!----------------------------------------------------------------------- 
    5353      ! 
    54       IF( Agrif_Root() )  RETURN 
     54      IF( Agrif_Root() .OR. nn_ice==0 )  RETURN   ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice 
    5555      ! 
    5656      SELECT CASE(cd_type) 
     
    9090      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 
    9191      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 
    92       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
     92      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    9393      !!----------------------------------------------------------------------- 
    9494      INTEGER , INTENT(in) :: i1, i2, j1, j2 
     
    101101      IF( before ) THEN  ! parent grid 
    102102         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2) 
    103          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     103         WHERE( umask(i1:i2,j1:j2,1) == 0. )   ptab(i1:i2,j1:j2) = Agrif_SpecialValue 
    104104      ELSE               ! child grid 
    105105         zrhoy = Agrif_Rhoy() 
    106          u_ice(i1:i2,j1:j2) = ptab(:,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 
     106         u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 
    107107      ENDIF 
    108108      ! 
     
    116116      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 
    117117      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 
    118       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
     118      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    119119      !!-----------------------------------------------------------------------       
    120120      INTEGER , INTENT(in) :: i1, i2, j1, j2 
     
    127127      IF( before ) THEN  ! parent grid 
    128128         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2) 
    129          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     129         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2) = Agrif_SpecialValue 
    130130      ELSE               ! child grid 
    131131         zrhox = Agrif_Rhox() 
    132          v_ice(i1:i2,j1:j2) = ptab(:,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 
     132         v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 
    133133      ENDIF 
    134134      ! 
     
    142142      !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 
    143143      !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 
    144       !! put -9999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
     144      !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 
    145145      !!----------------------------------------------------------------------- 
    146146      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     
    158158      ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 
    159159      ! and it is ok since we conserve tracers (same as in the ocean). 
    160       ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) 
     160      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 
    161161      
    162162      IF( before ) THEN  ! parent grid 
    163163         jm = 1 
    164164         DO jl = 1, jpl 
    165             ptab(i1:i2,j1:j2,jm) = a_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    166             ptab(i1:i2,j1:j2,jm) = v_i_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    167             ptab(i1:i2,j1:j2,jm) = v_s_b  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    168             ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 
    169             ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 
     165            ptab(i1:i2,j1:j2,jm  ) = a_i_b (i1:i2,j1:j2,jl) 
     166            ptab(i1:i2,j1:j2,jm+1) = v_i_b (i1:i2,j1:j2,jl) 
     167            ptab(i1:i2,j1:j2,jm+2) = v_s_b (i1:i2,j1:j2,jl) 
     168            ptab(i1:i2,j1:j2,jm+3) = sv_i_b(i1:i2,j1:j2,jl) 
     169            ptab(i1:i2,j1:j2,jm+4) = oa_i_b(i1:i2,j1:j2,jl) 
     170            jm = jm + 5 
    170171            DO jk = 1, nlay_s 
    171172               ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     
    177178          
    178179         DO jk = k1, k2 
    179             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = -9999. 
     180            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue 
    180181         ENDDO 
    181182          
    182183      ELSE               ! child grid 
    183 !! ==> The easiest interpolation is the following commented lines 
    184          jm = 1 
    185          DO jl = 1, jpl 
    186             a_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    187             v_i  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    188             v_s  (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    189             smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    190             oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    191             DO jk = 1, nlay_s 
    192                e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    193             ENDDO 
    194             DO jk = 1, nlay_i 
    195                e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    196             ENDDO 
    197          ENDDO 
    198  
    199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 
    200 !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 
    201 !!        clem: for some reason (I don't know why), the following lines do not work  
    202 !!              with mpp (or in realistic configurations?). It makes the model crash 
    203 !         ! record ztab 
    204 !         jm = 1 
    205 !         DO jl = 1, jpl 
    206 !            ztab(:,:,jm) = a_i  (:,:,jl) ; jm = jm + 1 
    207 !            ztab(:,:,jm) = v_i  (:,:,jl) ; jm = jm + 1 
    208 !            ztab(:,:,jm) = v_s  (:,:,jl) ; jm = jm + 1 
    209 !            ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 
    210 !            ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 
    211 !            DO jk = 1, nlay_s 
    212 !               ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 
    213 !            ENDDO 
    214 !            DO jk = 1, nlay_i 
    215 !               ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 
    216 !            ENDDO 
    217 !         ENDDO 
    218 !         ! 
    219 !         ! borders of the domain 
    220 !         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
    221 !         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
    222 !         ! 
    223 !         ! spatial smoothing 
    224 !         zrhox = Agrif_Rhox() 
    225 !         z1 =      ( zrhox - 1. ) * 0.5  
    226 !         z3 =      ( zrhox - 1. ) / ( zrhox + 1. ) 
    227 !         z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    228 !         z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    229 !         z2 = 1. - z1 
    230 !         z4 = 1. - z3 
    231 !         z5 = 1. - z6 - z7 
    232 !         ! 
    233 !         ! Remove corners 
    234 !         imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
    235 !         IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
    236 !         IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
    237 !         IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
    238 !         IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
    239 ! 
    240 !         ! smoothed fields 
    241 !         IF( eastern_side ) THEN 
    242 !            ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
    243 !            DO jj = jmin, jmax 
    244 !               rswitch = 0. 
    245 !               IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
    246 !               ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
    247 !                  &                +      umask(nlci-2,jj,1)   *  & 
    248 !                  &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
    249 !                  &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
    250 !               ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
    251 !            END DO 
    252 !         ENDIF 
    253 !         !  
    254 !         IF( northern_side ) THEN 
    255 !            ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
    256 !            DO ji = imin, imax 
    257 !               rswitch = 0. 
    258 !               IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
    259 !               ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
    260 !                  &                +      vmask(ji,nlcj-2,1)   *  & 
    261 !                  &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
    262 !                  &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
    263 !               ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
    264 !            END DO 
    265 !         END IF 
    266 !         ! 
    267 !         IF( western_side) THEN 
    268 !            ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 
    269 !            DO jj = jmin, jmax 
    270 !               rswitch = 0. 
    271 !               IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 
    272 !               ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  & 
    273 !                  &           +      umask(2,jj,1)   *   & 
    274 !                  &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 
    275 !                  &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 
    276 !               ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 
    277 !            END DO 
    278 !         ENDIF 
    279 !         ! 
    280 !         IF( southern_side ) THEN 
    281 !            ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 
    282 !            DO ji = imin, imax 
    283 !               rswitch = 0. 
    284 !               IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 
    285 !               ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  & 
    286 !                  &           +      vmask(ji,2,1)   *  & 
    287 !                  &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 
    288 !                  &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 
    289 !               ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 
    290 !            END DO 
    291 !         END IF 
    292 !         ! 
    293 !         ! Treatment of corners 
    294 !         IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
    295 !         IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
    296 !         IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
    297 !         IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
    298 ! 
    299 !         ! retrieve ice tracers 
    300 !         jm = 1 
    301 !         DO jl = 1, jpl 
    302 !            a_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    303 !            v_i  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    304 !            v_s  (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    305 !            smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    306 !            oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    307 !            DO jk = 1, nlay_s 
    308 !               e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    309 !            ENDDO 
    310 !            DO jk = 1, nlay_i 
    311 !               e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 
    312 !            ENDDO 
    313 !         ENDDO 
    314         
     184 
     185         IF( nbghostcells > 1 ) THEN 
     186            !! ==> The easiest interpolation is the following lines 
     187 
     188            jm = 1 
     189            DO jl = 1, jpl 
     190               ! 
     191               DO jj = j1, j2 
     192                  DO ji = i1, i2 
     193                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1) 
     194                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 
     195                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 
     196                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 
     197                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 
     198                  ENDDO 
     199               ENDDO 
     200               jm = jm + 5 
     201               ! 
     202               DO jk = 1, nlay_s 
     203                  e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 
     204                  jm = jm + 1 
     205               ENDDO 
     206               ! 
     207               DO jk = 1, nlay_i 
     208                  e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 
     209                  jm = jm + 1 
     210               ENDDO 
     211               ! 
     212            ENDDO 
     213             
     214         ELSE 
     215            !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 
     216            !!     it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 
     217            !!        clem: for some reason (I don't know why), the following lines do not work  
     218            !!              with mpp (or in realistic configurations?). It makes the model crash 
     219            !      I think there is an issue with Agrif_SpecialValue here (not taken into account properly) 
     220            ! record ztab 
     221            jm = 1 
     222            DO jl = 1, jpl 
     223               ztab(:,:,jm  ) = a_i  (:,:,jl) 
     224               ztab(:,:,jm+1) = v_i  (:,:,jl) 
     225               ztab(:,:,jm+2) = v_s  (:,:,jl) 
     226               ztab(:,:,jm+3) = sv_i(:,:,jl) 
     227               ztab(:,:,jm+4) = oa_i(:,:,jl) 
     228               jm = jm + 5 
     229               DO jk = 1, nlay_s 
     230                  ztab(:,:,jm) = e_s(:,:,jk,jl) 
     231                  jm = jm + 1 
     232               ENDDO 
     233               DO jk = 1, nlay_i 
     234                  ztab(:,:,jm) = e_i(:,:,jk,jl) 
     235                  jm = jm + 1 
     236               ENDDO 
     237               ! 
     238            ENDDO 
     239            ! 
     240            ! borders of the domain 
     241            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
     242            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     243            ! 
     244            ! spatial smoothing 
     245            zrhox = Agrif_Rhox() 
     246            z1 =      ( zrhox - 1. ) * 0.5  
     247            z3 =      ( zrhox - 1. ) / ( zrhox + 1. ) 
     248            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     249            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     250            z2 = 1. - z1 
     251            z4 = 1. - z3 
     252            z5 = 1. - z6 - z7 
     253            ! 
     254            ! Remove corners 
     255            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
     256            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
     257            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
     258            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
     259            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
     260 
     261            ! smoothed fields 
     262            IF( eastern_side ) THEN 
     263               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
     264               DO jj = jmin, jmax 
     265                  rswitch = 0. 
     266                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
     267                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
     268                     &                +      umask(nlci-2,jj,1)   *  & 
     269                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
     270                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
     271                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
     272               END DO 
     273            ENDIF 
     274            !  
     275            IF( northern_side ) THEN 
     276               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
     277               DO ji = imin, imax 
     278                  rswitch = 0. 
     279                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
     280                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
     281                     &                +      vmask(ji,nlcj-2,1)   *  & 
     282                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
     283                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
     284                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
     285               END DO 
     286            END IF 
     287            ! 
     288            IF( western_side) THEN 
     289               ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 
     290               DO jj = jmin, jmax 
     291                  rswitch = 0. 
     292                  IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 
     293                  ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:)  & 
     294                     &           +      umask(2,jj,1)   *   & 
     295                     &           ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 
     296                     &             +      rswitch   * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 
     297                  ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 
     298               END DO 
     299            ENDIF 
     300            ! 
     301            IF( southern_side ) THEN 
     302               ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 
     303               DO ji = imin, imax 
     304                  rswitch = 0. 
     305                  IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 
     306                  ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:)  & 
     307                     &           +      vmask(ji,2,1)   *  & 
     308                     &           ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 
     309                     &             +      rswitch   * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 
     310                  ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 
     311               END DO 
     312            END IF 
     313            ! 
     314            ! Treatment of corners 
     315            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
     316            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
     317            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
     318            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
     319             
     320            ! retrieve ice tracers 
     321            jm = 1 
     322            DO jl = 1, jpl 
     323               ! 
     324               DO jj = j1, j2 
     325                  DO ji = i1, i2 
     326                     a_i (ji,jj,jl) = ztab(ji,jj,jm  ) * tmask(ji,jj,1) 
     327                     v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1) 
     328                     v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1) 
     329                     sv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1) 
     330                     oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1) 
     331                  ENDDO 
     332               ENDDO 
     333               jm = jm + 5 
     334               ! 
     335               DO jk = 1, nlay_s 
     336                  e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     337                  jm = jm + 1 
     338               ENDDO 
     339               ! 
     340               DO jk = 1, nlay_i 
     341                  e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     342                  jm = jm + 1 
     343               ENDDO 
     344               ! 
     345            ENDDO 
     346           
     347         ENDIF  ! nbghostcells=1 
     348          
    315349         ! integrated values 
    316350         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 
     
    319353         et_s(i1:i2,j1:j2)  = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    320354         et_i(i1:i2,j1:j2)  = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 
    321  
     355          
    322356      ENDIF 
     357 
     358      DEALLOCATE( ztab ) 
    323359       
    324       DEALLOCATE( ztab ) 
    325360      ! 
    326361   END SUBROUTINE interp_tra_ice 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90

    r8733 r8738  
    5656      IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 
    5757                                                                                                                           ! i.e. update only at the parent time step 
     58      IF( nn_ice == 0 ) RETURN   ! clem2017: do not update if child domain does not have ice 
     59      ! 
     60      Agrif_SpecialValueFineGrid = -9999. 
    5861      Agrif_UseSpecialValueInUpdate = .TRUE. 
    59       Agrif_SpecialValueFineGrid = -9999. 
    6062# if defined TWO_WAY 
    6163      IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps 
     
    7072      ENDIF 
    7173# endif 
     74      Agrif_SpecialValueFineGrid = 0. 
    7275      Agrif_UseSpecialValueInUpdate = .FALSE. 
    7376      ! 
     
    8891      LOGICAL , INTENT(in) :: before 
    8992      !! 
    90       INTEGER  :: jk, jl, jm 
     93      INTEGER  :: ji, jj, jk, jl, jm 
    9194      !!----------------------------------------------------------------------- 
    9295      ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). 
     
    9497         jm = 1 
    9598         DO jl = 1, jpl 
    96             ptab(:,:,jm) = a_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    97             ptab(:,:,jm) = v_i  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    98             ptab(:,:,jm) = v_s  (i1:i2,j1:j2,jl) ; jm = jm + 1 
    99             ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 
    100             ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 
     99            ptab(i1:i2,j1:j2,jm  ) = a_i (i1:i2,j1:j2,jl) 
     100            ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl) 
     101            ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl) 
     102            ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl) 
     103            ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl) 
     104            jm = jm + 5 
    101105            DO jk = 1, nlay_s 
    102                ptab(:,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     106               ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    103107            ENDDO 
    104108            DO jk = 1, nlay_i 
    105                ptab(:,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
     109               ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 
    106110            ENDDO 
    107111         ENDDO 
    108  
     112         ! 
    109113         DO jk = k1, k2 
    110             WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:,jk) = -9999. 
     114            WHERE( tmask(i1:i2,j1:j2,1) == 0. )  ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid  
    111115         ENDDO 
    112                    
     116         ! 
    113117      ELSE 
     118         ! 
    114119         jm = 1 
    115120         DO jl = 1, jpl 
    116             a_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    117             v_i  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    118             v_s  (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    119             smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    120             oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
     121            ! 
     122            DO jj = j1, j2 
     123               DO ji = i1, i2 
     124                  IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN 
     125                     a_i (ji,jj,jl) = ptab(ji,jj,jm  ) * tmask(ji,jj,1) 
     126                     v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 
     127                     v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 
     128                     sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 
     129                     oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 
     130                  ENDIF 
     131               ENDDO 
     132            ENDDO 
     133            jm = jm + 5 
     134            ! 
    121135            DO jk = 1, nlay_s 
    122                e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    123             ENDDO 
     136               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 
     137                  e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     138               ENDWHERE 
     139               jm = jm + 1 
     140            ENDDO 
     141            ! 
    124142            DO jk = 1, nlay_i 
    125                e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 
    126             ENDDO 
     143               WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 
     144                  e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 
     145               ENDWHERE 
     146               jm = jm + 1 
     147            ENDDO 
     148            ! 
    127149         ENDDO 
    128  
     150         ! 
    129151         ! integrated values 
    130152         vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 
     
    154176         zrhoy = Agrif_Rhoy() 
    155177         ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 
    156          WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     178         WHERE( umask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid 
    157179      ELSE 
    158          u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     180         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 
     181            u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 
     182         ENDWHERE 
    159183      ENDIF 
    160184      !  
     
    177201         zrhox = Agrif_Rhox() 
    178202         ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 
    179          WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = -9999. 
     203         WHERE( vmask(i1:i2,j1:j2,1) == 0. )  ptab(:,:) = Agrif_SpecialValueFineGrid 
    180204      ELSE 
    181          v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     205         WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 
     206            v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 
     207         ENDWHERE 
    182208      ENDIF 
    183209      ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r8733 r8738  
    3535   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    3636   PUBLIC   interpun, interpvn 
    37    PUBLIC   interptsn,  interpsshn 
     37   PUBLIC   interptsn, interpsshn 
    3838   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
    3939   PUBLIC   interpe3t, interpumsk, interpvmsk 
     
    100100      IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci-2 
    101101 
     102      ! --- West --- ! 
    102103      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    103104         ! 
    104          ! Smoothing 
    105          ! --------- 
    106105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    107             ua_b(2,:) = 0._wp 
     106            ua_b(2:1+nbghostcells,:) = 0._wp 
    108107            DO jk = 1, jpkm1 
    109108               DO jj = 1, jpj 
    110                   ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     109                  ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk) 
    111110               END DO 
    112111            END DO 
    113112            DO jj = 1, jpj 
    114                ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)             
    115             END DO 
    116          ENDIF 
    117          ! 
    118          DO jk=1,jpkm1                 ! Smooth 
    119             DO jj=j1,j2 
    120                ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
    121                ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
    122             END DO 
    123          END DO 
    124          ! 
    125          zub(2,:) = 0._wp              ! Correct transport 
    126          DO jk = 1, jpkm1 
    127             DO jj = 1, jpj 
    128                zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
    129             END DO 
    130          END DO 
    131          DO jj=1,jpj 
    132             zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
    133          END DO 
    134  
    135          DO jk=1,jpkm1 
    136             DO jj=1,jpj 
    137                ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 
    138             END DO 
    139          END DO 
    140  
    141          ! Set tangential velocities to time splitting estimate 
    142          !----------------------------------------------------- 
    143          IF( ln_dynspg_ts ) THEN 
    144             zvb(2,:) = 0._wp 
     113               ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj) 
     114            END DO 
     115         ENDIF 
     116         ! 
     117         ! Smoothing if only 1 ghostcell 
     118         ! ----------------------------- 
     119         IF( nbghostcells == 1 ) THEN 
     120            DO jk=1,jpkm1                 ! Smooth 
     121               DO jj=j1,j2 
     122                  ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 
     123                  ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
     124               END DO 
     125            END DO 
     126            ! 
     127            zub(2,:) = 0._wp              ! Correct transport 
    145128            DO jk = 1, jpkm1 
    146129               DO jj = 1, jpj 
    147                   zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
    148                END DO 
    149             END DO 
    150             DO jj = 1, jpj 
    151                zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
    152             END DO 
     130                  zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 
     131               END DO 
     132            END DO 
     133            DO jj=1,jpj 
     134               zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 
     135            END DO 
     136             
     137            DO jk=1,jpkm1 
     138               DO jj=1,jpj 
     139                  ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 
     140               END DO 
     141            END DO 
     142             
     143            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     144               zvb(2,:) = 0._wp 
     145               DO jk = 1, jpkm1 
     146                  DO jj = 1, jpj 
     147                     zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 
     148                  END DO 
     149               END DO 
     150               DO jj = 1, jpj 
     151                  zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 
     152               END DO 
     153               DO jk = 1, jpkm1 
     154                  DO jj = 1, jpj 
     155                     va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
     156                  END DO 
     157               END DO 
     158            ENDIF 
     159            ! 
     160         ENDIF 
     161         ! 
     162         ! Mask domain edges: 
     163         !------------------- 
     164!         DO jk = 1, jpkm1 
     165!            DO jj = 1, jpj 
     166!               ua(1,jj,jk) = 0._wp 
     167!               va(1,jj,jk) = 0._wp 
     168!            END DO 
     169!         END DO 
     170         ! 
     171      ENDIF 
     172 
     173      ! --- East --- ! 
     174      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
     175 
     176         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     177            ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 
     178            DO jk=1,jpkm1 
     179               DO jj=1,jpj 
     180                  ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk)  & 
     181                     &                                                                         * ua(nlci-nbghostcells-1:nlci-2,jj,jk) 
     182               END DO 
     183            END DO 
     184            DO jj=1,jpj 
     185               ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj)  
     186            END DO 
     187         ENDIF 
     188         ! 
     189         ! Smoothing if only 1 ghostcell 
     190         ! ----------------------------- 
     191         IF( nbghostcells == 1 ) THEN 
     192            DO jk = 1, jpkm1              ! Smooth 
     193               DO jj = j1, j2 
     194                  ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
     195                     &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
     196               END DO 
     197            END DO 
     198             
     199            zub(nlci-2,:) = 0._wp        ! Correct transport 
    153200            DO jk = 1, jpkm1 
    154201               DO jj = 1, jpj 
    155                   va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 
    156                END DO 
    157             END DO 
     202                  zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
     203               END DO 
     204            END DO 
     205            DO jj = 1, jpj 
     206               zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
     207            END DO 
     208             
     209            DO jk = 1, jpkm1 
     210               DO jj = 1, jpj 
     211                  ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
     212               END DO 
     213            END DO 
     214            ! 
     215            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     216               zvb(nlci-1,:) = 0._wp 
     217               DO jk = 1, jpkm1 
     218                  DO jj = 1, jpj 
     219                     zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
     220                  END DO 
     221               END DO 
     222               DO jj=1,jpj 
     223                  zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
     224               END DO 
     225               DO jk = 1, jpkm1 
     226                  DO jj = 1, jpj 
     227                     va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
     228                  END DO 
     229               END DO 
     230            ENDIF 
     231            ! 
    158232         ENDIF 
    159233         ! 
    160234         ! Mask domain edges: 
    161235         !------------------- 
    162          DO jk = 1, jpkm1 
    163             DO jj = 1, jpj 
    164                ua(1,jj,jk) = 0._wp 
    165                va(1,jj,jk) = 0._wp 
    166             END DO 
    167          END DO          
    168          ! 
    169       ENDIF 
    170  
    171       IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    172  
    173          ! Smoothing 
    174          ! --------- 
     236!         DO jk = 1, jpkm1 
     237!            DO jj = 1, jpj 
     238!               ua(nlci-1,jj,jk) = 0._wp 
     239!               va(nlci  ,jj,jk) = 0._wp 
     240!            END DO 
     241!         END DO 
     242         ! 
     243      ENDIF 
     244 
     245      ! --- South --- ! 
     246      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
     247 
    175248         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    176             ua_b(nlci-2,:) = 0._wp 
     249            va_b(:,2:nbghostcells+1) = 0._wp 
     250            DO jk = 1, jpkm1 
     251               DO ji = 1, jpi 
     252                  va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk) 
     253               END DO 
     254            END DO 
     255            DO ji=1,jpi 
     256               va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 
     257            END DO 
     258         ENDIF 
     259         ! 
     260         ! Smoothing if only 1 ghostcell 
     261         ! ----------------------------- 
     262         IF( nbghostcells == 1 ) THEN 
     263            DO jk = 1, jpkm1              ! Smooth 
     264               DO ji = i1, i2 
     265                  va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
     266                     &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
     267               END DO 
     268            END DO 
     269            ! 
     270            zvb(:,2) = 0._wp              ! Correct transport 
    177271            DO jk=1,jpkm1 
    178                DO jj=1,jpj 
    179                   ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    180                END DO 
    181             END DO 
    182             DO jj=1,jpj 
    183                ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)             
    184             END DO 
    185          ENDIF 
    186  
    187          DO jk = 1, jpkm1              ! Smooth 
    188             DO jj = j1, j2 
    189                ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      & 
    190                   &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 
    191             END DO 
    192          END DO 
    193  
    194          zub(nlci-2,:) = 0._wp        ! Correct transport 
    195          DO jk = 1, jpkm1 
    196             DO jj = 1, jpj 
    197                zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 
    198             END DO 
    199          END DO 
    200          DO jj = 1, jpj 
    201             zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 
    202          END DO 
    203  
    204          DO jk = 1, jpkm1 
    205             DO jj = 1, jpj 
    206                ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 
    207             END DO 
    208          END DO 
    209          ! 
    210          ! Set tangential velocities to time splitting estimate 
    211          !----------------------------------------------------- 
    212          IF( ln_dynspg_ts ) THEN 
    213             zvb(nlci-1,:) = 0._wp 
     272               DO ji=1,jpi 
     273                  zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
     274               END DO 
     275            END DO 
     276            DO ji = 1, jpi 
     277               zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
     278            END DO 
    214279            DO jk = 1, jpkm1 
    215                DO jj = 1, jpj 
    216                   zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 
    217                END DO 
    218             END DO 
    219             DO jj=1,jpj 
    220                zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 
    221             END DO 
    222             DO jk = 1, jpkm1 
    223                DO jj = 1, jpj 
    224                   va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 
    225                END DO 
    226             END DO 
     280               DO ji = 1, jpi 
     281                  va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
     282               END DO 
     283            END DO 
     284             
     285            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     286               zub(:,2) = 0._wp 
     287               DO jk = 1, jpkm1 
     288                  DO ji = 1, jpi 
     289                     zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
     290                  END DO 
     291               END DO 
     292               DO ji = 1, jpi 
     293                  zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
     294               END DO 
     295                
     296               DO jk = 1, jpkm1 
     297                  DO ji = 1, jpi 
     298                     ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
     299                  END DO 
     300               END DO 
     301            ENDIF 
     302            ! 
    227303         ENDIF 
    228304         ! 
    229305         ! Mask domain edges: 
    230306         !------------------- 
    231          DO jk = 1, jpkm1 
    232             DO jj = 1, jpj 
    233                ua(nlci-1,jj,jk) = 0._wp 
    234                va(nlci  ,jj,jk) = 0._wp 
    235             END DO 
    236          END DO  
    237          ! 
    238       ENDIF 
    239  
    240       IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    241  
    242          ! Smoothing 
    243          ! --------- 
     307!         DO jk = 1, jpkm1 
     308!            DO ji = 1, jpi 
     309!               ua(ji,1,jk) = 0._wp 
     310!               va(ji,1,jk) = 0._wp 
     311!            END DO 
     312!         END DO 
     313         ! 
     314      ENDIF 
     315 
     316      ! --- North --- ! 
     317      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
     318         ! 
    244319         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    245             va_b(:,2) = 0._wp 
     320            va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 
    246321            DO jk = 1, jpkm1 
    247322               DO ji = 1, jpi 
    248                   va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 
    249                END DO 
    250             END DO 
    251             DO ji=1,jpi 
    252                va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)             
    253             END DO 
    254          ENDIF 
    255          ! 
    256          DO jk = 1, jpkm1              ! Smooth 
    257             DO ji = i1, i2 
    258                va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    & 
    259                   &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 
    260             END DO 
    261          END DO 
    262          ! 
    263          zvb(:,2) = 0._wp              ! Correct transport 
    264          DO jk=1,jpkm1 
    265             DO ji=1,jpi 
    266                zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 
    267             END DO 
    268          END DO 
    269          DO ji = 1, jpi 
    270             zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 
    271          END DO 
    272          DO jk = 1, jpkm1 
     323                  va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk)  & 
     324                     &                                                                         * va(ji,nlcj-nbghostcells-1:nlcj-2,jk) 
     325               END DO 
     326            END DO 
    273327            DO ji = 1, jpi 
    274                va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 
    275             END DO 
    276          END DO 
    277  
    278          ! Set tangential velocities to time splitting estimate 
    279          !----------------------------------------------------- 
    280          IF( ln_dynspg_ts ) THEN 
    281             zub(:,2) = 0._wp 
     328               va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2) 
     329            END DO 
     330         ENDIF 
     331         ! 
     332         ! Smoothing if only 1 ghostcell 
     333         ! ----------------------------- 
     334         IF( nbghostcells == 1 ) THEN 
     335            DO jk = 1, jpkm1              ! Smooth 
     336               DO ji = i1, i2 
     337                  va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
     338                     &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
     339               END DO 
     340            END DO 
     341            ! 
     342            zvb(:,nlcj-2) = 0._wp         ! Correct transport 
    282343            DO jk = 1, jpkm1 
    283344               DO ji = 1, jpi 
    284                   zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 
     345                  zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    285346               END DO 
    286347            END DO 
    287348            DO ji = 1, jpi 
    288                zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 
    289             END DO 
    290  
     349               zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
     350            END DO 
    291351            DO jk = 1, jpkm1 
    292352               DO ji = 1, jpi 
    293                   ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 
    294                END DO 
    295             END DO 
    296          ENDIF 
    297  
     353                  va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
     354               END DO 
     355            END DO 
     356            ! 
     357            IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     358               zub(:,nlcj-1) = 0._wp 
     359               DO jk = 1, jpkm1 
     360                  DO ji = 1, jpi 
     361                     zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
     362                  END DO 
     363               END DO 
     364               DO ji = 1, jpi 
     365                  zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
     366               END DO 
     367               ! 
     368               DO jk = 1, jpkm1 
     369                  DO ji = 1, jpi 
     370                     ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
     371                  END DO 
     372               END DO 
     373            ENDIF 
     374            ! 
     375         ENDIF 
     376         ! 
    298377         ! Mask domain edges: 
    299378         !------------------- 
    300          DO jk = 1, jpkm1 
    301             DO ji = 1, jpi 
    302                ua(ji,1,jk) = 0._wp 
    303                va(ji,1,jk) = 0._wp 
    304             END DO 
    305          END DO  
    306  
    307       ENDIF 
    308  
    309       IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    310          ! 
    311          ! Smoothing 
    312          ! --------- 
    313          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    314             va_b(:,nlcj-2) = 0._wp 
    315             DO jk = 1, jpkm1 
    316                DO ji = 1, jpi 
    317                   va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 
    318                END DO 
    319             END DO 
    320             DO ji = 1, jpi 
    321                va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)             
    322             END DO 
    323          ENDIF 
    324          ! 
    325          DO jk = 1, jpkm1              ! Smooth 
    326             DO ji = i1, i2 
    327                va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   & 
    328                   &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 
    329             END DO 
    330          END DO 
    331          ! 
    332          zvb(:,nlcj-2) = 0._wp         ! Correct transport 
    333          DO jk = 1, jpkm1 
    334             DO ji = 1, jpi 
    335                zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    336             END DO 
    337          END DO 
    338          DO ji = 1, jpi 
    339             zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 
    340          END DO 
    341          DO jk = 1, jpkm1 
    342             DO ji = 1, jpi 
    343                va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 
    344             END DO 
    345          END DO 
    346          ! 
    347          ! Set tangential velocities to time splitting estimate 
    348          !----------------------------------------------------- 
    349          IF( ln_dynspg_ts ) THEN 
    350             zub(:,nlcj-1) = 0._wp 
    351             DO jk = 1, jpkm1 
    352                DO ji = 1, jpi 
    353                   zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 
    354                END DO 
    355             END DO 
    356             DO ji = 1, jpi 
    357                zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 
    358             END DO 
    359             ! 
    360             DO jk = 1, jpkm1 
    361                DO ji = 1, jpi 
    362                   ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 
    363                END DO 
    364             END DO 
    365          ENDIF 
    366          ! 
    367          ! Mask domain edges: 
    368          !------------------- 
    369          DO jk = 1, jpkm1 
    370             DO ji = 1, jpi 
    371                ua(ji,nlcj  ,jk) = 0._wp 
    372                va(ji,nlcj-1,jk) = 0._wp 
    373             END DO 
    374          END DO  
     379!         DO jk = 1, jpkm1 
     380!            DO ji = 1, jpi 
     381!               ua(ji,nlcj  ,jk) = 0._wp 
     382!               va(ji,nlcj-1,jk) = 0._wp 
     383!            END DO 
     384!         END DO 
    375385         ! 
    376386      ENDIF 
     
    392402      ! 
    393403      IF( Agrif_Root() )   RETURN 
    394       ! 
     404      !! clem ghost 
    395405      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    396406         DO jj=1,jpj 
    397             va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 
     407            va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj) 
    398408            ! Specified fluxes: 
    399             ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 
    400             ! Characteristics method: 
     409            ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj) 
     410            ! Characteristics method (only if ghostcells=1): 
    401411            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
    402412            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
     
    406416      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    407417         DO jj=1,jpj 
    408             va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 
     418            va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 
    409419            ! Specified fluxes: 
    410             ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 
    411             ! Characteristics method: 
     420            ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 
     421            ! Characteristics method (only if ghostcells=1): 
    412422            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
    413423            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
     
    417427      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    418428         DO ji=1,jpi 
    419             ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 
     429            ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1) 
    420430            ! Specified fluxes: 
    421             va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 
    422             ! Characteristics method: 
     431            va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1) 
     432            ! Characteristics method (only if ghostcells=1): 
    423433            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
    424434            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
     
    428438      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    429439         DO ji=1,jpi 
    430             ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 
     440            ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 
    431441            ! Specified fluxes: 
    432             va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 
    433             ! Characteristics method: 
     442            va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 
     443            ! Characteristics method (only if ghostcells=1): 
    434444            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
    435445            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
     
    476486      ! 
    477487      IF( ll_int_cons ) THEN  ! Conservative interpolation 
    478          ! orders matters here !!!!!! 
     488         ! order matters here !!!!!! 
    479489         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
    480490         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
     
    504514      !!----------------------------------------------------------------------   
    505515      INTEGER, INTENT(in) ::   kt 
    506       !! 
     516      ! 
     517      INTEGER  :: ji, jj, indx 
    507518      !!----------------------------------------------------------------------   
    508519      ! 
    509520      IF( Agrif_Root() )   RETURN 
    510       ! 
     521      !! clem ghost 
     522      ! --- West --- ! 
    511523      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    512          ssha(2,:)=ssha(3,:) 
    513          sshn(2,:)=sshn(3,:) 
    514       ENDIF 
    515       ! 
     524         indx = 1+nbghostcells 
     525         DO jj = 1, jpj 
     526            DO ji = 2, indx 
     527               ssha(ji,jj)=ssha(indx+1,jj) 
     528               sshn(ji,jj)=sshn(indx+1,jj) 
     529            ENDDO 
     530         ENDDO 
     531      ENDIF 
     532      ! 
     533      ! --- East --- ! 
    516534      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    517          ssha(nlci-1,:)=ssha(nlci-2,:) 
    518          sshn(nlci-1,:)=sshn(nlci-2,:) 
    519       ENDIF 
    520       ! 
     535         indx = nlci-nbghostcells 
     536         DO jj = 1, jpj 
     537            DO ji = indx, nlci-1 
     538               ssha(ji,jj)=ssha(indx-1,jj) 
     539               sshn(ji,jj)=sshn(indx-1,jj) 
     540            ENDDO 
     541         ENDDO 
     542      ENDIF 
     543      ! 
     544      ! --- South --- ! 
    521545      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    522          ssha(:,2)=ssha(:,3) 
    523          sshn(:,2)=sshn(:,3) 
    524       ENDIF 
    525       ! 
     546         indx = 1+nbghostcells 
     547         DO jj = 2, indx 
     548            DO ji = 1, jpi 
     549               ssha(ji,jj)=ssha(ji,indx+1) 
     550               sshn(ji,jj)=sshn(ji,indx+1) 
     551            ENDDO 
     552         ENDDO 
     553      ENDIF 
     554      ! 
     555      ! --- North --- ! 
    526556      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    527          ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    528          sshn(:,nlcj-1)=sshn(:,nlcj-2) 
     557         indx = nlcj-nbghostcells 
     558         DO jj = indx, nlcj-1 
     559            DO ji = 1, jpi 
     560               ssha(ji,jj)=ssha(ji,indx-1) 
     561               sshn(ji,jj)=sshn(ji,indx-1) 
     562            ENDDO 
     563         ENDDO 
    529564      ENDIF 
    530565      ! 
     
    538573      INTEGER, INTENT(in) ::   jn 
    539574      !! 
    540       INTEGER :: ji,jj 
    541       !!----------------------------------------------------------------------   
    542       ! 
     575      INTEGER :: ji, jj 
     576      !!----------------------------------------------------------------------   
     577      !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 
    543578      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    544579         DO jj = 1, jpj 
    545             ssha_e(2,jj) = hbdy_w(jj) 
     580            ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj) 
    546581         END DO 
    547582      ENDIF 
     
    549584      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    550585         DO jj = 1, jpj 
    551             ssha_e(nlci-1,jj) = hbdy_e(jj) 
     586            ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj) 
    552587         END DO 
    553588      ENDIF 
     
    555590      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    556591         DO ji = 1, jpi 
    557             ssha_e(ji,2) = hbdy_s(ji) 
     592            ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji) 
    558593         END DO 
    559594      ENDIF 
     
    561596      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    562597         DO ji = 1, jpi 
    563             ssha_e(ji,nlcj-1) = hbdy_n(ji) 
     598            ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji) 
    564599         END DO 
    565600      ENDIF 
     
    601636      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    602637      INTEGER  ::   imin, imax, jmin, jmax 
    603       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    604       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
     638      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
    605639      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    606640      !!---------------------------------------------------------------------- 
     
    610644      ELSE 
    611645         ! 
    612          western_side  = (nb == 1).AND.(ndir == 1) 
    613          eastern_side  = (nb == 1).AND.(ndir == 2) 
    614          southern_side = (nb == 2).AND.(ndir == 1) 
    615          northern_side = (nb == 2).AND.(ndir == 2) 
    616          ! 
    617          zrhox = Agrif_Rhox() 
    618          !  
    619          zalpha1 = ( zrhox - 1. ) * 0.5 
    620          zalpha2 = 1. - zalpha1 
    621          !  
    622          zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
    623          zalpha4 = 1. - zalpha3 
    624          !  
    625          zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    626          zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    627          zalpha5 = 1. - zalpha6 - zalpha7 
    628          ! 
    629          imin = i1 
    630          imax = i2 
    631          jmin = j1 
    632          jmax = j2 
    633          !  
    634          ! Remove CORNERS 
    635          IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
    636          IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
    637          IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
    638          IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
    639          ! 
    640          IF( eastern_side ) THEN 
    641             DO jn = 1, jpts 
    642                tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
    643                DO jk = 1, jpkm1 
    644                   DO jj = jmin,jmax 
    645                      IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
    646                         tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    647                      ELSE 
    648                         tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    649                         IF( un(nlci-2,jj,jk) > 0._wp ) THEN 
    650                            tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) &  
    651                                  + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     646         western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
     647         southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     648         ! 
     649         IF( nbghostcells > 1 ) THEN  ! no smoothing 
     650            tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 
     651         ELSE                         ! smoothing 
     652            ! 
     653            zrhox = Agrif_Rhox() 
     654            z1 = ( zrhox - 1. ) * 0.5 
     655            z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     656            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     657            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     658            ! 
     659            z2 = 1. - z1 
     660            z4 = 1. - z3 
     661            z5 = 1. - z6 - z7 
     662            ! 
     663            imin = i1 ; imax = i2 
     664            jmin = j1 ; jmax = j2 
     665            !  
     666            ! Remove CORNERS 
     667            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     668            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     669            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     670            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     671            ! 
     672            IF( eastern_side ) THEN 
     673               DO jn = 1, jpts 
     674                  tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     675                  DO jk = 1, jpkm1 
     676                     DO jj = jmin,jmax 
     677                        IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
     678                           tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     679                        ELSE 
     680                           tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     681                           IF( un(nlci-2,jj,jk) > 0._wp ) THEN 
     682                              tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) &  
     683                                                   + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     684                           ENDIF 
    652685                        ENDIF 
    653                      ENDIF 
     686                     END DO 
    654687                  END DO 
    655                END DO 
    656                tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 
    657             END DO 
    658          ENDIF 
    659          !  
    660          IF( northern_side ) THEN             
    661             DO jn = 1, jpts 
    662                tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
    663                DO jk = 1, jpkm1 
    664                   DO ji = imin,imax 
    665                      IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
    666                         tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    667                      ELSE 
    668                         tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    669                         IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 
    670                            tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  & 
    671                                  + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     688                  tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 
     689               END DO 
     690            ENDIF 
     691            !  
     692            IF( northern_side ) THEN             
     693               DO jn = 1, jpts 
     694                  tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     695                  DO jk = 1, jpkm1 
     696                     DO ji = imin,imax 
     697                        IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
     698                           tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     699                        ELSE 
     700                           tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     701                           IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 
     702                              tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn)  & 
     703                                                   + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     704                           ENDIF 
    672705                        ENDIF 
    673                      ENDIF 
     706                     END DO 
    674707                  END DO 
    675                END DO 
    676                tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 
    677             END DO 
    678          ENDIF 
    679          ! 
    680          IF( western_side ) THEN             
    681             DO jn = 1, jpts 
    682                tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
    683                DO jk = 1, jpkm1 
    684                   DO jj = jmin,jmax 
    685                      IF( umask(2,jj,jk) == 0._wp ) THEN 
    686                         tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
    687                      ELSE 
    688                         tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
    689                         IF( un(2,jj,jk) < 0._wp ) THEN 
    690                            tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     708                  tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 
     709               END DO 
     710            ENDIF 
     711            ! 
     712            IF( western_side ) THEN             
     713               DO jn = 1, jpts 
     714                  tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 
     715                  DO jk = 1, jpkm1 
     716                     DO jj = jmin,jmax 
     717                        IF( umask(2,jj,jk) == 0._wp ) THEN 
     718                           tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     719                        ELSE 
     720                           tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     721                           IF( un(2,jj,jk) < 0._wp ) THEN 
     722                              tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     723                           ENDIF 
    691724                        ENDIF 
    692                      ENDIF 
     725                     END DO 
    693726                  END DO 
    694                END DO 
    695                tsa(1,j1:j2,k1:k2,jn) = 0._wp 
    696             END DO 
    697          ENDIF 
    698          ! 
    699          IF( southern_side ) THEN            
    700             DO jn = 1, jpts 
    701                tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
    702                DO jk = 1, jpk       
    703                   DO ji=imin,imax 
    704                      IF( vmask(ji,2,jk) == 0._wp ) THEN 
    705                         tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
    706                      ELSE 
    707                         tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
    708                         IF( vn(ji,2,jk) < 0._wp ) THEN 
    709                            tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     727                  tsa(1,j1:j2,k1:k2,jn) = 0._wp 
     728               END DO 
     729            ENDIF 
     730            ! 
     731            IF( southern_side ) THEN            
     732               DO jn = 1, jpts 
     733                  tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 
     734                  DO jk = 1, jpk       
     735                     DO ji=imin,imax 
     736                        IF( vmask(ji,2,jk) == 0._wp ) THEN 
     737                           tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     738                        ELSE 
     739                           tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     740                           IF( vn(ji,2,jk) < 0._wp ) THEN 
     741                              tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     742                           ENDIF 
    710743                        ENDIF 
    711                      ENDIF 
     744                     END DO 
    712745                  END DO 
    713                END DO 
    714                tsa(i1:i2,1,k1:k2,jn) = 0._wp 
    715             END DO 
    716          ENDIF 
    717          ! 
    718          ! Treatment of corners 
    719          !  
    720          ! East south 
    721          IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    722             tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
    723          ENDIF 
    724          ! East north 
    725          IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    726             tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
    727          ENDIF 
    728          ! West south 
    729          IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    730             tsa(2,2,:,:) = ptab(2,2,:,:) 
    731          ENDIF 
    732          ! West north 
    733          IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    734             tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
    735          ENDIF 
    736          ! 
     746                  tsa(i1:i2,1,k1:k2,jn) = 0._wp 
     747               END DO 
     748            ENDIF 
     749            ! 
     750            ! Treatment of corners 
     751            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south 
     752            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north 
     753            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))   tsa(2,2,:,:) = ptab(2,2,:,:)                      ! West south 
     754            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))   tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north 
     755            ! 
     756         ENDIF 
    737757      ENDIF 
    738758      ! 
     
    759779         southern_side = (nb == 2).AND.(ndir == 1) 
    760780         northern_side = (nb == 2).AND.(ndir == 2) 
    761          IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
    762          IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
    763          IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
     781         !! clem ghost 
     782         IF(western_side)  hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) 
     783         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1 
     784         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 
    764785         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
    765786      ENDIF 
     
    854875         ELSEIF( bdy_tinterp == 2 ) THEN 
    855876            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    856                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    857  
     877               &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
    858878         ELSE 
    859879            ztcoeff = 1 
    860880         ENDIF 
    861          !    
    862          IF(western_side) THEN 
    863             ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    864          ENDIF 
    865          IF(eastern_side) THEN 
    866             ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    867          ENDIF 
    868          IF(southern_side) THEN 
    869             ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    870          ENDIF 
    871          IF(northern_side) THEN 
    872             ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    873          ENDIF 
     881         !! clem ghost    
     882         IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)   
     883         IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1   
     884         IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
     885         IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    874886         !             
    875887         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    876             IF(western_side) THEN 
    877                ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    878             ENDIF 
    879             IF(eastern_side) THEN 
    880                ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
    881             ENDIF 
    882             IF(southern_side) THEN 
    883                ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    884             ENDIF 
    885             IF(northern_side) THEN 
    886                ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    887             ENDIF 
     888            IF(western_side)   ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 
     889            IF(eastern_side)   ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 
     890            IF(southern_side)  ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 
     891            IF(northern_side)  ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 
    888892         ENDIF 
    889893      ENDIF 
     
    927931            ztcoeff = 1 
    928932         ENDIF 
    929          ! 
    930          IF(western_side) THEN 
    931             vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    932          ENDIF 
    933          IF(eastern_side) THEN 
    934             vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
    935          ENDIF 
    936          IF(southern_side) THEN 
    937             vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
    938          ENDIF 
    939          IF(northern_side) THEN 
    940             vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    941          ENDIF 
     933         !! clem ghost 
     934         IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)   
     935         IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1   
     936         IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 
     937         IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
    942938         !             
    943939         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    944             IF(western_side) THEN 
    945                vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    946                      &                                  * vmask(i1,j1:j2,1) 
    947             ENDIF 
    948             IF(eastern_side) THEN 
    949                vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    950                      &                                  * vmask(i1,j1:j2,1) 
    951             ENDIF 
    952             IF(southern_side) THEN 
    953                vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    954                      &                                  * vmask(i1:i2,j1,1) 
    955             ENDIF 
    956             IF(northern_side) THEN 
    957                vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    958                      &                                  * vmask(i1:i2,j1,1) 
    959             ENDIF 
     940            IF(western_side)   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 
     941            IF(eastern_side)   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
     942            IF(southern_side)  vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 
     943            IF(northern_side)  vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
    960944         ENDIF 
    961945      ENDIF 
     
    991975         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
    992976            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    993          !  
    994          IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    995          IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
    996          IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     977         !! clem ghost 
     978         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2)   
     979         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
     980         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 
    997981         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    998982      ENDIF 
     
    10301014            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    10311015         ! 
    1032          IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    1033          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)  
    1034          IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1016         IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i2,j1:j2)   
     1017         IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1  
     1018         IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1  
    10351019         IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    10361020      ENDIF 
     
    10501034      INTEGER :: ji, jj, jk 
    10511035      LOGICAL :: western_side, eastern_side, northern_side, southern_side 
    1052       REAL(wp) :: ztmpmsk       
    10531036      !!----------------------------------------------------------------------   
    10541037      !     
     
    10601043         southern_side = (nb == 2).AND.(ndir == 1) 
    10611044         northern_side = (nb == 2).AND.(ndir == 2) 
    1062  
     1045         ! 
    10631046         DO jk = k1, k2 
    10641047            DO jj = j1, j2 
    10651048               DO ji = i1, i2 
    1066                   ! Get velocity mask at boundary edge points: 
    1067                   IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1) 
    1068                   IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1) 
    1069                   IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1) 
    1070                   IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1) 
    10711049                  ! 
    1072                   IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 
     1050                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 
    10731051                     IF (western_side) THEN 
    10741052                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r8733 r8738  
    3434      !!   *** ROUTINE Agrif_Sponge_Tra *** 
    3535      !!--------------------------------------------- 
    36       REAL(wp) :: timecoeff 
     36      REAL(wp) :: zcoef 
    3737      !!--------------------------------------------- 
    3838      ! 
    3939#if defined SPONGE 
    40       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     40      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    4141 
    4242      CALL Agrif_Sponge 
     
    4545      tabspongedone_tsn = .FALSE. 
    4646 
    47       CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 
     47      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge) 
    4848 
    4949      Agrif_UseSpecialValue = .FALSE. 
     
    5757      !!   *** ROUTINE Agrif_Sponge_dyn *** 
    5858      !!--------------------------------------------- 
    59       REAL(wp) :: timecoeff 
     59      REAL(wp) :: zcoef 
    6060      !!--------------------------------------------- 
    6161 
    6262#if defined SPONGE 
    63       timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
     63      zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    6464 
    6565      Agrif_SpecialValue=0. 
     
    6868      tabspongedone_u = .FALSE. 
    6969      tabspongedone_v = .FALSE.          
    70       CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 
     70      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge) 
    7171 
    7272      tabspongedone_u = .FALSE. 
    7373      tabspongedone_v = .FALSE. 
    74       CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 
     74      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge) 
    7575 
    7676      Agrif_UseSpecialValue = .FALSE. 
     
    8484      !!   *** ROUTINE  Agrif_Sponge *** 
    8585      !!--------------------------------------------- 
    86       INTEGER  :: ji,jj,jk 
    87       INTEGER  :: ispongearea, ilci, ilcj 
    88       LOGICAL  :: ll_spdone 
    89       REAL(wp) :: z1spongearea, zramp 
    90       REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 
     86      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 
     87      ! 
     88      INTEGER  :: ji, jj, ind1, ind2 
     89      INTEGER  :: ispongearea 
     90      REAL(wp) :: z1_spongearea 
     91      !!--------------------------------------------- 
    9192 
    9293#if defined SPONGE || defined SPONGE_TOP 
    93       ll_spdone=.TRUE. 
    9494      IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 
    95          ! Define ramp from boundaries towards domain interior 
    96          ! at T-points 
     95         ! Define ramp from boundaries towards domain interior at T-points 
    9796         ! Store it in ztabramp 
    98          ll_spdone=.FALSE. 
    99  
    100          CALL wrk_alloc( jpi, jpj, ztabramp ) 
    10197 
    10298         ispongearea  = 2 + nn_sponge_len * Agrif_irhox() 
    103          ilci = nlci - ispongearea 
    104          ilcj = nlcj - ispongearea  
    105          z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
    106  
     99         z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 
     100          
    107101         ztabramp(:,:) = 0._wp 
    108102 
     103         ! --- West --- ! 
    109104         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
     105            ind1 = 1+nbghostcells 
     106            ind2 = 1+nbghostcells + (ispongearea-1) 
    110107            DO jj = 1, jpj 
    111                IF ( umask(2,jj,1) == 1._wp ) THEN 
    112                  DO ji = 2, ispongearea                   
    113                     ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 
    114                  END DO 
    115                ENDIF 
     108               DO ji = ind1, ind2                   
     109                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 
     110               END DO 
    116111            ENDDO 
    117112         ENDIF 
    118113 
     114         ! --- East --- ! 
    119115         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
     116            ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 
     117            ind2 = nlci - (1+nbghostcells) 
    120118            DO jj = 1, jpj 
    121                IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 
    122                   DO ji = ilci+1,nlci-1 
    123                      zramp = (ji - (ilci+1) ) * z1spongearea 
    124                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    125                   ENDDO 
    126                ENDIF 
     119               DO ji = ind1, ind2 
     120                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 
     121               ENDDO 
    127122            ENDDO 
    128123         ENDIF 
    129124 
     125         ! --- South --- ! 
    130126         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    131             DO ji = 1, jpi 
    132                IF ( vmask(ji,2,1) == 1._wp ) THEN 
    133                   DO jj = 2, ispongearea 
    134                      zramp = ( ispongearea-jj ) * z1spongearea 
    135                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    136                   END DO 
    137                ENDIF 
     127            ind1 = 1+nbghostcells 
     128            ind2 = 1+nbghostcells + (ispongearea-1) 
     129            DO jj = ind1, ind2 
     130               DO ji = 1, jpi 
     131                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 
     132               END DO 
    138133            ENDDO 
    139134         ENDIF 
    140135 
     136         ! --- North --- ! 
    141137         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    142             DO ji = 1, jpi 
    143                IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 
    144                   DO jj = ilcj+1,nlcj-1 
    145                      zramp = (jj - (ilcj+1) ) * z1spongearea 
    146                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    147                   END DO 
    148                ENDIF 
     138            ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 
     139            ind2 = nlcj - (1+nbghostcells) 
     140            DO jj = ind1, ind2 
     141               DO ji = 1, jpi 
     142                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 
     143               END DO 
    149144            ENDDO 
    150145         ENDIF 
     
    158153         DO jj = 2, jpjm1 
    159154            DO ji = 2, jpim1   ! vector opt. 
    160                fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  )) 
    161                fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1)) 
    162             END DO 
    163          END DO 
    164  
     155               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
     156               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) 
     157            END DO 
     158         END DO 
    165159         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions 
    166160         CALL lbc_lnk( fsaht_spv, 'V', 1. ) 
     161          
    167162         spongedoneT = .TRUE. 
    168163      ENDIF 
     
    179174            END DO 
    180175         END DO 
    181  
    182176         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
    183177         CALL lbc_lnk( fsahm_spf, 'F', 1. ) 
     178          
    184179         spongedoneU = .TRUE. 
    185180      ENDIF 
    186       ! 
    187       IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp ) 
    188181      ! 
    189182#endif 
     
    205198      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 
    206199      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
     200      !!---------------------------------------------     
    207201      ! 
    208202      IF( before ) THEN 
     
    327321 
    328322         jmax = j2-1 
    329          IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3) 
     323         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
    330324 
    331325         DO jj = j1+1, jmax 
     
    404398 
    405399         imax = i2-1 
    406          IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-3) 
     400         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    407401 
    408402         DO jj = j1+1, j2 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r8733 r8738  
    5050      ! 
    5151      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    52       INTEGER :: imin, imax, jmin, jmax 
    53       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    54       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    55       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    56  
     52      INTEGER  ::  imin, imax, jmin, jmax 
     53      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
     54      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     55      !!----------------------------------------------------------------------- 
     56      ! 
    5757      IF (before) THEN          
    5858         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
    5959      ELSE 
    6060         ! 
    61          western_side  = (nb == 1).AND.(ndir == 1) 
    62          eastern_side  = (nb == 1).AND.(ndir == 2) 
    63          southern_side = (nb == 2).AND.(ndir == 1) 
    64          northern_side = (nb == 2).AND.(ndir == 2) 
    65          ! 
    66          zrhox = Agrif_Rhox() 
    67          !  
    68          zalpha1 = ( zrhox - 1. ) * 0.5 
    69          zalpha2 = 1. - zalpha1 
    70          !  
    71          zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
    72          zalpha4 = 1. - zalpha3 
    73          !  
    74          zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    75          zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    76          zalpha5 = 1. - zalpha6 - zalpha7 
    77          ! 
    78          imin = i1 
    79          imax = i2 
    80          jmin = j1 
    81          jmax = j2 
    82          !  
    83          ! Remove CORNERS 
    84          IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
    85          IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
    86          IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
    87          IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
    88          ! 
    89          IF( eastern_side) THEN 
    90             DO jn = 1, jptra 
    91                tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
    92                DO jk = 1, jpkm1 
    93                   DO jj = jmin,jmax 
    94                      IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    95                         tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    96                      ELSE 
    97                         tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    98                         IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    99                            tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) &  
    100                                  + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     61         IF( nbghostcells > 1 ) THEN  ! no smoothing 
     62            tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 
     63         ELSE                         ! smoothing 
     64            ! 
     65            western_side  = (nb == 1).AND.(ndir == 1)  ;  eastern_side  = (nb == 1).AND.(ndir == 2) 
     66            southern_side = (nb == 2).AND.(ndir == 1)  ;  northern_side = (nb == 2).AND.(ndir == 2) 
     67            ! 
     68            zrhox = Agrif_Rhox() 
     69            z1 = ( zrhox - 1. ) * 0.5 
     70            z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     71            z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     72            z7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     73            ! 
     74            z2 = 1. - z1 
     75            z4 = 1. - z3 
     76            z5 = 1. - z6 - z7 
     77            ! 
     78            imin = i1 ; imax = i2 
     79            jmin = j1 ; jmax = j2 
     80            !  
     81            ! Remove CORNERS 
     82            IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     83            IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     84            IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     85            IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     86            ! 
     87            IF( eastern_side) THEN 
     88               DO jn = 1, jptra 
     89                  tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     90                  DO jk = 1, jpkm1 
     91                     DO jj = jmin,jmax 
     92                        IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     93                           tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     94                        ELSE 
     95                           tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     96                           IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     97                              tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) &  
     98                                                   + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     99                           ENDIF 
    101100                        ENDIF 
    102                      ENDIF 
     101                     END DO 
     102                  END DO 
     103               ENDDO 
     104            ENDIF 
     105            !  
     106            IF( northern_side ) THEN             
     107               DO jn = 1, jptra 
     108                  tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     109                  DO jk = 1, jpkm1 
     110                     DO ji = imin,imax 
     111                        IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     112                           tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     113                        ELSE 
     114                           tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     115                           IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     116                              tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn)  & 
     117                                                   + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     118                           ENDIF 
     119                        ENDIF 
     120                     END DO 
     121                  END DO 
     122               ENDDO 
     123            ENDIF 
     124            ! 
     125            IF( western_side) THEN             
     126               DO jn = 1, jptra 
     127                  tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 
     128                  DO jk = 1, jpkm1 
     129                     DO jj = jmin,jmax 
     130                        IF( umask(2,jj,jk) == 0.e0 ) THEN 
     131                           tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
     132                        ELSE 
     133                           tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
     134                           IF( un(2,jj,jk) < 0.e0 ) THEN 
     135                              tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
     136                           ENDIF 
     137                        ENDIF 
     138                     END DO 
    103139                  END DO 
    104140               END DO 
    105             ENDDO 
     141            ENDIF 
     142            ! 
     143            IF( southern_side ) THEN            
     144               DO jn = 1, jptra 
     145                  tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 
     146                  DO jk=1,jpk       
     147                     DO ji=imin,imax 
     148                        IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     149                           tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
     150                        ELSE 
     151                           tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
     152                           IF( vn(ji,2,jk) < 0.e0 ) THEN 
     153                              tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
     154                           ENDIF 
     155                        ENDIF 
     156                     END DO 
     157                  END DO 
     158               ENDDO 
     159            ENDIF 
     160            ! 
     161            ! Treatment of corners 
     162            IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)            ! East south 
     163            IF ((eastern_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)  ! East north 
     164            IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2)))  tra(2,2,:,:) = ptab(2,2,:,:)                      ! West south 
     165            IF ((western_side).AND.((nbondj ==  1).OR.(nbondj == 2)))  tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)            ! West north 
     166            ! 
    106167         ENDIF 
    107          !  
    108          IF( northern_side ) THEN             
    109             DO jn = 1, jptra 
    110                tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
    111                DO jk = 1, jpkm1 
    112                   DO ji = imin,imax 
    113                      IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    114                         tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    115                      ELSE 
    116                         tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    117                         IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    118                            tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  & 
    119                                  + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
    120                         ENDIF 
    121                      ENDIF 
    122                   END DO 
    123                END DO 
    124             ENDDO 
    125          ENDIF 
    126          ! 
    127          IF( western_side) THEN             
    128             DO jn = 1, jptra 
    129                tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
    130                DO jk = 1, jpkm1 
    131                   DO jj = jmin,jmax 
    132                      IF( umask(2,jj,jk) == 0.e0 ) THEN 
    133                         tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
    134                      ELSE 
    135                         tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
    136                         IF( un(2,jj,jk) < 0.e0 ) THEN 
    137                            tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    138                         ENDIF 
    139                      ENDIF 
    140                   END DO 
    141                END DO 
    142             END DO 
    143          ENDIF 
    144          ! 
    145          IF( southern_side ) THEN            
    146             DO jn = 1, jptra 
    147                tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
    148                DO jk=1,jpk       
    149                   DO ji=imin,imax 
    150                      IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    151                         tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    152                      ELSE 
    153                         tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
    154                         IF( vn(ji,2,jk) < 0.e0 ) THEN 
    155                            tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    156                         ENDIF 
    157                      ENDIF 
    158                   END DO 
    159                END DO 
    160             ENDDO 
    161          ENDIF 
    162          ! 
    163          ! Treatment of corners 
    164          !  
    165          ! East south 
    166          IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    167             tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
    168          ENDIF 
    169          ! East north 
    170          IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    171             tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
    172          ENDIF 
    173          ! West south 
    174          IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
    175             tra(2,2,:,:) = ptab(2,2,:,:) 
    176          ENDIF 
    177          ! West north 
    178          IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
    179             tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
    180          ENDIF 
    181          ! 
    182168      ENDIF 
    183169      ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r8733 r8738  
    127127   !! 
    128128   IMPLICIT NONE 
     129   ! 
     130   INTEGER :: ind1, ind2, ind3 
    129131   !!---------------------------------------------------------------------- 
    130132 
    131133   ! 1. Declaration of the type of variable which have to be interpolated 
    132134   !--------------------------------------------------------------------- 
    133    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    134    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     135   !!clem ghost 
     136   ind1 =     nbghostcells 
     137   ind2 = 1 + nbghostcells 
     138   ind3 = 2 + nbghostcells 
     139   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     140   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     141   !!clem ghost 
    135142 
    136143   ! 2. Type of interpolation 
     
    141148   ! 3. Location of interpolation 
    142149   !----------------------------- 
    143    CALL Agrif_Set_bc(e1u_id,(/0,0/)) 
    144    CALL Agrif_Set_bc(e2v_id,(/0,0/)) 
     150   !!clem ghost (previously set to /0,0/) 
     151   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
     152   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     153   !!clem ghost 
    145154 
    146155   ! 5. Update type 
     
    337346   !!---------------------------------------------------------------------- 
    338347   USE agrif_util 
    339    USE par_oce       !   ONLY : jpts 
     348   USE par_oce       !   ONLY : jpts and ghostcells 
    340349   USE oce 
    341350   USE agrif_oce 
    342351   !! 
    343352   IMPLICIT NONE 
     353   ! 
     354   INTEGER :: ind1, ind2, ind3 
    344355   !!---------------------------------------------------------------------- 
    345356 
    346357   ! 1. Declaration of the type of variable which have to be interpolated 
    347358   !--------------------------------------------------------------------- 
    348    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    349    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    350  
    351    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
    352    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
    353    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
    354    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
    355    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
    356    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
    357  
    358    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    359    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
    360    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
    361  
    362    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
    363  
    364    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    365    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    366    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    367    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    368    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    369    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    370  
    371    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     359   !!clem ghost 
     360   ind1 =     nbghostcells 
     361   ind2 = 1 + nbghostcells 
     362   ind3 = 2 + nbghostcells 
     363   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     364   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     365 
     366   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
     367   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
     368   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
     369   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
     370   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
     371   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
     372 
     373   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     374   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
     375   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     376 
     377   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
     378 
     379   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     380   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     381   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     382   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     383   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     384   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     385 
     386   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    372387 
    373388# if defined key_zdftke 
    374    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    375    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    376    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     389   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     390   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
     391   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
    377392# endif 
     393   !!clem ghost 
    378394 
    379395   ! 2. Type of interpolation 
     
    407423   ! 3. Location of interpolation 
    408424   !----------------------------- 
    409    CALL Agrif_Set_bc(tsn_id,(/0,1/)) 
    410    CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 
    411    CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 
    412  
    413 !   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 
    414 !   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
    415 !   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
    416    CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     425   !!clem ghost 
     426   CALL Agrif_Set_bc(tsn_id,(/0,ind1/)) 
     427   CALL Agrif_Set_bc(un_interp_id,(/0,ind1/)) 
     428   CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/)) 
     429 
     430   ! clem: previously set to /-,0/ 
     431   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9  
    417432   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    418433   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    419434 
    420    CALL Agrif_Set_bc(sshn_id,(/0,0/)) 
    421    CALL Agrif_Set_bc(unb_id ,(/0,0/)) 
    422    CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 
    423    CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 
    424    CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 
    425  
    426    CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9 
    427    CALL Agrif_Set_bc(umsk_id,(/0,0/)) 
    428    CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 
    429  
     435   CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/)) 
     436   CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/)) 
     437   CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/)) 
     438   CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/)) 
     439   CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/)) 
     440 
     441   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/))   ! if west and rhox=3 and ghost=1: column 2 to 9 
     442   CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/)) 
     443   CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/)) 
     444 
     445   ! clem: previously set to /0,1/ 
    430446# if defined key_zdftke 
    431    CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
     447   CALL Agrif_Set_bc(avm_id ,(/0,ind1/)) 
    432448# endif 
     449   !!clem ghost 
    433450 
    434451   ! 5. Update type 
     
    463480   ! 
    464481END SUBROUTINE agrif_declare_var 
    465  
    466 #  if defined key_lim2 
    467 SUBROUTINE Agrif_InitValues_cont_lim2 
    468    !!---------------------------------------------------------------------- 
    469    !!                 *** ROUTINE Agrif_InitValues_cont_lim2 *** 
    470    !! 
    471    !! ** Purpose :: Initialisation of variables to be interpolated for LIM2 
    472    !!---------------------------------------------------------------------- 
    473    USE Agrif_Util 
    474    USE ice_2 
    475    USE agrif_ice 
    476    USE in_out_manager 
    477    USE agrif_lim2_update 
    478    USE agrif_lim2_interp 
    479    USE lib_mpp 
    480    !! 
    481    IMPLICIT NONE 
    482    !!---------------------------------------------------------------------- 
    483  
    484    ! 1. Declaration of the type of variable which have to be interpolated 
    485    !--------------------------------------------------------------------- 
    486    CALL agrif_declare_var_lim2 
    487  
    488    ! 2. First interpolations of potentially non zero fields 
    489    !------------------------------------------------------- 
    490    Agrif_SpecialValue=-9999. 
    491    Agrif_UseSpecialValue = .TRUE. 
    492    !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice ) 
    493    !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   ) 
    494    !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   ) 
    495    Agrif_SpecialValue=0. 
    496    Agrif_UseSpecialValue = .FALSE. 
    497  
    498    ! 3. Some controls 
    499    !----------------- 
    500  
    501 #   if ! defined key_lim2_vp 
    502    lim_nbstep = 1. 
    503    CALL agrif_rhg_lim2_load 
    504    CALL agrif_trp_lim2_load 
    505    lim_nbstep = 0. 
    506 #   endif 
    507    !RB mandatory but why ??? 
    508    !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN 
    509    !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc') 
    510    !         nbclineupdate = nn_fsbc 
    511    !       ENDIF 
    512    CALL Agrif_Update_lim2(0) 
    513    ! 
    514 END SUBROUTINE Agrif_InitValues_cont_lim2 
    515  
    516  
    517 SUBROUTINE agrif_declare_var_lim2 
    518    !!---------------------------------------------------------------------- 
    519    !!                 *** ROUTINE agrif_declare_var_lim2 *** 
    520    !! 
    521    !! ** Purpose :: Declaration of variables to be interpolated for LIM2 
    522    !!---------------------------------------------------------------------- 
    523    USE agrif_util 
    524    USE ice_2 
    525    !! 
    526    IMPLICIT NONE 
    527    !!---------------------------------------------------------------------- 
    528  
    529    ! 1. Declaration of the type of variable which have to be interpolated 
    530    !--------------------------------------------------------------------- 
    531    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id ) 
    532 #   if defined key_lim2_vp 
    533    CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
    534    CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
    535 #   else 
    536    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id) 
    537    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id) 
    538 #   endif 
    539  
    540    ! 2. Type of interpolation 
    541    !------------------------- 
    542    CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 
    543    CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    544    CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    545  
    546    ! 3. Location of interpolation 
    547    !----------------------------- 
    548    CALL Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
    549    CALL Agrif_Set_bc(u_ice_id,(/0,1/)) 
    550    CALL Agrif_Set_bc(v_ice_id,(/0,1/)) 
    551  
    552    ! 5. Update type 
    553    !--------------- 
    554    CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
    555    CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    556    CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    557    !  
    558 END SUBROUTINE agrif_declare_var_lim2 
    559 #  endif 
    560482 
    561483#if defined key_lim3 
     
    623545   USE Agrif_Util 
    624546   USE ice 
    625  
    626    IMPLICIT NONE 
     547   USE par_oce, ONLY : nbghostcells 
     548   ! 
     549   IMPLICIT NONE 
     550   ! 
     551   INTEGER :: ind1, ind2, ind3 
    627552   !!---------------------------------------------------------------------- 
    628553   ! 
     
    634559   !                            2,2 = two ghost lines 
    635560   !------------------------------------------------------------------------------------- 
    636    CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 
    637    CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   ) 
    638    CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   ) 
     561   !!clem ghost 
     562   ind1 =     nbghostcells 
     563   ind2 = 1 + nbghostcells 
     564   ind3 = 2 + nbghostcells 
     565   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 
     566   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   ) 
     567   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   ) 
     568   !!clem ghost 
    639569 
    640570   ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     
    646576   ! 3. Set location of interpolations 
    647577   !---------------------------------- 
    648    CALL Agrif_Set_bc(tra_ice_id,(/0,1/)) 
    649    CALL Agrif_Set_bc(u_ice_id  ,(/0,1/)) 
    650    CALL Agrif_Set_bc(v_ice_id  ,(/0,1/)) 
     578   !!clem ghost 
     579   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 
     580   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
     581   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     582   !!clem ghost 
    651583 
    652584   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     
    777709   !! 
    778710   IMPLICIT NONE 
     711   ! 
     712   INTEGER :: ind1, ind2, ind3 
    779713   !!---------------------------------------------------------------------- 
    780714 
    781715   ! 1. Declaration of the type of variable which have to be interpolated 
    782716   !--------------------------------------------------------------------- 
    783    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
    784    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     717   !!clem ghost 
     718   ind1 =     nbghostcells 
     719   ind2 = 1 + nbghostcells 
     720   ind3 = 2 + nbghostcells 
     721   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
     722   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
    785723 
    786724   ! 2. Type of interpolation 
     
    791729   ! 3. Location of interpolation 
    792730   !----------------------------- 
    793    CALL Agrif_Set_bc(trn_id,(/0,1/)) 
    794 !   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 
     731   !!clem ghost 
     732   CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 
     733   !clem: previously set to /-,0/ 
    795734   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    796735 
     
    868807   ! 
    869808   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
    870 # if defined key_lim2 
    871    IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3) 
    872 # endif 
    873809   ! 
    874810END SUBROUTINE agrif_nemo_init 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r8733 r8738  
    3838   USE asmpar             ! Parameters for the assmilation interface 
    3939   USE zdfmxl             ! mixed layer depth 
    40 #if defined key_lim2 
    41    USE ice_2 
    42 #endif 
    4340#if defined key_lim3 
    4441   USE ice 
     
    148145            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
    149146            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    150 #if defined key_lim2 || defined key_lim3 
    151             IF( nn_ice == 2  .OR.  nn_ice == 3 ) THEN 
    152                IF( ALLOCATED(frld) ) THEN 
    153                   CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:)   ) 
     147#if defined key_lim3 
     148            IF( nn_ice == 2 ) THEN 
     149               IF( ALLOCATED(at_i) ) THEN 
     150                  CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', at_i(:,:)   ) 
    154151               ELSE 
    155                   CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 
     152                  CALL ctl_warn('Ice concentration not written to background as ice variable at_i not allocated on this timestep') 
    156153               ENDIF 
    157154            ENDIF 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r8733 r8738  
    3535   USE in_out_manager   ! I/O manager 
    3636   USE lib_mpp          ! MPP library 
    37 #if defined key_lim2 
    38    USE ice_2            ! LIM2 
     37#if defined key_lim3 
     38   USE ice,   ONLY: hm_i, at_i, at_i_b 
    3939#endif 
    4040   USE sbc_oce          ! Surface boundary condition variables. 
     
    809809      INTEGER  ::   it 
    810810      REAL(wp) ::   zincwgt   ! IAU weight for current time step 
    811 #if defined key_lim2 
     811#if defined key_lim3 
    812812      REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc  ! LIM 
    813813      REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres 
     
    831831            ENDIF 
    832832            ! 
    833             ! Sea-ice : LIM-3 case (to add) 
    834             ! 
    835 #if defined key_lim2 
    836             ! Sea-ice : LIM-2 case 
    837             zofrld (:,:) = frld(:,:) 
    838             zohicif(:,:) = hicif(:,:) 
    839             ! 
    840             frld  = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    841             pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    842             fr_i(:,:) = 1.0_wp - frld(:,:)        ! adjust ice fraction 
    843             ! 
    844             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)   ! find out actual sea ice nudge applied 
     833            ! Sea-ice : LIM-3 case 
     834            ! 
     835#if defined key_lim3 
     836            zofrld (:,:) = 1._wp - at_i(:,:) 
     837            zohicif(:,:) = hm_i(:,:) 
     838            ! 
     839            at_i  (:,:) = 1. - MIN( MAX( 1.-at_i  (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     840            at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
     841            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
     842            ! 
     843            zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
    845844            ! 
    846845            ! Nudge sea ice depth to bring it up to a required minimum depth 
    847             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
    848                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     846            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
     847               zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt     
    849848            ELSEWHERE 
    850849               zhicifinc(:,:) = 0.0_wp 
     
    852851            ! 
    853852            ! nudge ice depth 
    854             hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 
    855             phicif(:,:) = phicif(:,:) + zhicifinc(:,:)        
     853            hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 
    856854            ! 
    857855            ! seaice salinity balancing (to add) 
     
    882880            neuler = 0                    ! Force Euler forward step 
    883881            ! 
    884             ! Sea-ice : LIM-3 case (to add) 
    885             ! 
    886 #if defined key_lim2 
    887             ! Sea-ice : LIM-2 case. 
    888             zofrld(:,:)=frld(:,:) 
    889             zohicif(:,:)=hicif(:,:) 
     882            ! Sea-ice : LIM-3 case 
     883            ! 
     884#if defined key_lim3 
     885            zofrld (:,:) = 1._wp - at_i(:,:) 
     886            zohicif(:,:) = hm_i(:,:) 
    890887            !  
    891888            ! Initialize the now fields the background + increment 
    892             frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
    893             pfrld(:,:) = frld(:,:)  
    894             fr_i (:,:) = 1.0_wp - frld(:,:)                ! adjust ice fraction 
    895             zseaicendg(:,:) = zofrld(:,:) - frld(:,:)      ! find out actual sea ice nudge applied 
     889            at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
     890            at_i_b(:,:) = at_i(:,:)  
     891            fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
     892            ! 
     893            zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
    896894            ! 
    897895            ! Nudge sea ice depth to bring it up to a required minimum depth 
    898             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hicif(:,:) < zhicifmin )  
    899                zhicifinc(:,:) = (zhicifmin - hicif(:,:)) * zincwgt     
     896            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
     897               zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt     
    900898            ELSEWHERE 
    901                zhicifinc(:,:) = 0._wp 
     899               zhicifinc(:,:) = 0.0_wp 
    902900            END WHERE 
    903901            ! 
    904902            ! nudge ice depth 
    905             hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 
    906             phicif(:,:) = phicif(:,:)        
     903            hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 
    907904            ! 
    908905            ! seaice salinity balancing (to add) 
     
    926923         ENDIF 
    927924 
    928 !#if defined defined key_lim2 || defined key_cice 
     925!#if defined defined key_lim3 || defined key_cice 
    929926! 
    930927!            IF (ln_seaicebal ) THEN        
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r8733 r8738  
    5555      REAL(wp), POINTER, DIMENSION(:,:) ::  tem 
    5656      REAL(wp), POINTER, DIMENSION(:,:) ::  sal 
    57 #if defined key_lim2 
    58       LOGICAL                           ::   ll_frld 
    59       LOGICAL                           ::   ll_hicif 
    60       LOGICAL                           ::   ll_hsnif 
    61       REAL(wp), POINTER, DIMENSION(:)   ::   frld 
    62       REAL(wp), POINTER, DIMENSION(:)   ::   hicif 
    63       REAL(wp), POINTER, DIMENSION(:)   ::   hsnif 
    64 #elif defined key_lim3 
     57#if defined key_lim3 
    6558      LOGICAL                           ::   ll_a_i 
    66       LOGICAL                           ::   ll_ht_i 
    67       LOGICAL                           ::   ll_ht_s 
     59      LOGICAL                           ::   ll_h_i 
     60      LOGICAL                           ::   ll_h_s 
    6861      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology 
    69       REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology 
    70       REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness 
     62      REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology 
     63      REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness 
    7164#endif 
    7265#if defined key_top 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r8733 r8738  
    2525   USE iom             ! IOM library 
    2626   USE in_out_manager  ! I/O logical units 
    27 #if defined key_lim2 
    28    USE ice_2 
    29 #elif defined key_lim3 
     27#if defined key_lim3 
    3028   USE ice 
    31    USE limvar          ! redistribute ice input into categories 
     29   USE icevar          ! redistribute ice input into categories 
    3230#endif 
    3331   USE sbcapr 
     
    5048 
    5149#if defined key_lim3 
    52    LOGICAL :: ll_bdylim3                  ! determine whether ice input is lim2 (F) or lim3 (T) type 
     50   LOGICAL :: ll_bdylim3                  ! determine whether ice input is 1cat (F) or Xcat (T) type 
    5351   INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 
    5452#endif 
     
    176174            ENDIF 
    177175 
    178 #if defined key_lim2 
    179             IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    180                ilen1(:) = nblen(:) 
    181                IF( dta%ll_frld ) THEN 
    182                   igrd = 1  
    183                   DO ib = 1, ilen1(igrd) 
    184                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    185                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    186                      dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
    187                   END DO  
    188                END IF 
    189                IF( dta%ll_hicif ) THEN 
    190                   igrd = 1  
    191                   DO ib = 1, ilen1(igrd) 
    192                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    193                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    194                      dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
    195                   END DO  
    196                END IF 
    197                IF( dta%ll_hsnif ) THEN 
    198                   igrd = 1  
    199                   DO ib = 1, ilen1(igrd) 
    200                      ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    201                      ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    202                      dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
    203                   END DO  
    204                END IF 
    205             ENDIF 
    206 #elif defined key_lim3 
     176#if defined key_lim3 
    207177            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    208178               ilen1(:) = nblen(:) 
     
    217187                  END DO 
    218188               ENDIF 
    219                IF( dta%ll_ht_i ) THEN 
     189               IF( dta%ll_h_i ) THEN 
    220190                  igrd = 1    
    221191                  DO jl = 1, jpl 
     
    223193                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    224194                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    225                         dta_bdy(ib_bdy)%ht_i (ib,jl) =  ht_i(ii,ij,jl) * tmask(ii,ij,1)  
     195                        dta_bdy(ib_bdy)%h_i (ib,jl) =  h_i(ii,ij,jl) * tmask(ii,ij,1)  
    226196                     END DO 
    227197                  END DO 
    228198               ENDIF 
    229                IF( dta%ll_ht_s ) THEN 
     199               IF( dta%ll_h_s ) THEN 
    230200                  igrd = 1    
    231201                  DO jl = 1, jpl 
     
    233203                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    234204                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    235                         dta_bdy(ib_bdy)%ht_s (ib,jl) =  ht_s(ii,ij,jl) * tmask(ii,ij,1)  
     205                        dta_bdy(ib_bdy)%h_s (ib,jl) =  h_s(ii,ij,jl) * tmask(ii,ij,1)  
    236206                     END DO 
    237207                  END DO 
     
    373343               ENDIF 
    374344#if defined key_lim3 
    375                IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type) 
    376                 CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 
    377                                   & dta_bdy(ib_bdy)%ht_i,     dta_bdy(ib_bdy)%ht_s,     dta_bdy(ib_bdy)%a_i     ) 
     345               IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is 1cat) 
     346                CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 
     347                                  & dta_bdy(ib_bdy)%h_i,     dta_bdy(ib_bdy)%h_s,     dta_bdy(ib_bdy)%a_i     ) 
    378348               ENDIF 
    379349#endif 
     
    449419      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
    450420      TYPE(FLD_N) ::   bn_ssh, bn_u2d, bn_v2d           ! informations about the fields to be read 
    451 #if defined key_lim2 
    452       TYPE(FLD_N) ::   bn_frld, bn_hicif, bn_hsnif      ! 
    453 #elif defined key_lim3 
    454       TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s       
     421#if defined key_lim3 
     422      TYPE(FLD_N) ::   bn_a_i, bn_h_i, bn_h_s       
    455423#endif 
    456424      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
    457 #if defined key_lim2 
    458       NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 
    459 #elif defined key_lim3 
    460       NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s 
     425#if defined key_lim3 
     426      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 
    461427#endif 
    462428      NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy 
     
    475441                               ,nn_dyn3d_dta(ib_bdy)       & 
    476442                               ,nn_tra_dta(ib_bdy)         & 
    477 #if ( defined key_lim2 || defined key_lim3 ) 
     443#if defined key_lim3 
    478444                              ,nn_ice_lim_dta(ib_bdy)    & 
    479445#endif 
     
    496462            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    497463         ENDIF 
    498 #if ( defined key_lim2 || defined key_lim3 ) 
     464#if defined key_lim3 
    499465         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN 
    500466            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
     
    637603            ENDIF 
    638604 
    639 #if defined key_lim2 
     605#if defined key_lim3 
    640606            ! sea ice 
    641607            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    642  
    643                IF( dta%ll_frld ) THEN 
    644                   jfld = jfld + 1 
    645                   blf_i(jfld) = bn_frld 
    646                   ibdy(jfld) = ib_bdy 
    647                   igrid(jfld) = 1 
    648                   ilen1(jfld) = nblen(igrid(jfld)) 
    649                   ilen3(jfld) = 1 
    650                ENDIF 
    651  
    652                IF( dta%ll_hicif ) THEN 
    653                   jfld = jfld + 1 
    654                   blf_i(jfld) = bn_hicif 
    655                   ibdy(jfld) = ib_bdy 
    656                   igrid(jfld) = 1 
    657                   ilen1(jfld) = nblen(igrid(jfld)) 
    658                   ilen3(jfld) = 1 
    659                ENDIF 
    660  
    661                IF( dta%ll_hsnif ) THEN 
    662                   jfld = jfld + 1 
    663                   blf_i(jfld) = bn_hsnif 
    664                   ibdy(jfld) = ib_bdy 
    665                   igrid(jfld) = 1 
    666                   ilen1(jfld) = nblen(igrid(jfld)) 
    667                   ilen3(jfld) = 1 
    668                ENDIF 
    669  
    670             ENDIF 
    671 #elif defined key_lim3 
    672             ! sea ice 
    673             IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    674                ! Test for types of ice input (lim2 or lim3)  
     608               ! Test for types of ice input (1cat or Xcat)  
    675609               ! Build file name to find dimensions  
    676610               clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) 
     
    689623 
    690624                IF ( zndims == 4 ) THEN 
    691                  ll_bdylim3 = .TRUE.   ! lim3 input 
     625                 ll_bdylim3 = .TRUE.   ! Xcat input 
    692626               ELSE 
    693                  ll_bdylim3 = .FALSE.  ! lim2 input       
     627                 ll_bdylim3 = .FALSE.  ! 1cat input       
    694628               ENDIF 
    695629               ! End test 
     
    704638               ENDIF 
    705639 
    706                IF( dta%ll_ht_i ) THEN 
    707                   jfld = jfld + 1 
    708                   blf_i(jfld) = bn_ht_i 
     640               IF( dta%ll_h_i ) THEN 
     641                  jfld = jfld + 1 
     642                  blf_i(jfld) = bn_h_i 
    709643                  ibdy(jfld) = ib_bdy 
    710644                  igrid(jfld) = 1 
     
    713647               ENDIF 
    714648 
    715                IF( dta%ll_ht_s ) THEN 
    716                   jfld = jfld + 1 
    717                    blf_i(jfld) = bn_ht_s 
     649               IF( dta%ll_h_s ) THEN 
     650                  jfld = jfld + 1 
     651                   blf_i(jfld) = bn_h_s 
    718652                  ibdy(jfld) = ib_bdy 
    719653                  igrid(jfld) = 1 
     
    848782         ENDIF 
    849783 
    850 #if defined key_lim2 
     784#if defined key_lim3 
    851785         IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    852786            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    853                ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
    854                ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
    855                ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 
     787               ALLOCATE( dta_bdy(ib_bdy)%a_i(nblen(1),jpl) ) 
     788               ALLOCATE( dta_bdy(ib_bdy)%h_i(nblen(1),jpl) ) 
     789               ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) ) 
    856790            ELSE 
    857                jfld = jfld + 1 
    858                dta_bdy(ib_bdy)%frld  => bf(jfld)%fnow(:,1,1) 
    859                jfld = jfld + 1 
    860                dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1) 
    861                jfld = jfld + 1 
    862                dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1) 
    863             ENDIF 
    864          ENDIF 
    865 #elif defined key_lim3 
    866          IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    867             IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    868                ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) ) 
    869                ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 
    870                ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 
    871             ELSE 
    872                IF ( ll_bdylim3 ) THEN ! case input is lim3 type 
    873                   jfld = jfld + 1 
    874                   dta_bdy(ib_bdy)%a_i  => bf(jfld)%fnow(:,1,:) 
    875                   jfld = jfld + 1 
    876                   dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:) 
    877                   jfld = jfld + 1 
    878                   dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:) 
    879                ELSE ! case input is lim2 type 
     791               IF ( ll_bdylim3 ) THEN ! case input is Xcat 
     792                  jfld = jfld + 1 
     793                  dta_bdy(ib_bdy)%a_i => bf(jfld)%fnow(:,1,:) 
     794                  jfld = jfld + 1 
     795                  dta_bdy(ib_bdy)%h_i => bf(jfld)%fnow(:,1,:) 
     796                  jfld = jfld + 1 
     797                  dta_bdy(ib_bdy)%h_s => bf(jfld)%fnow(:,1,:) 
     798               ELSE ! case input is 1cat 
    880799                  jfld_ai  = jfld + 1 
    881800                  jfld_hti = jfld + 2 
    882801                  jfld_hts = jfld + 3 
    883802                  jfld     = jfld + 3 
    884                   ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) ) 
    885                   ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 
    886                   ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 
    887                   dta_bdy(ib_bdy)%a_i (:,:) = 0._wp 
    888                   dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp 
    889                   dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp 
     803                  ALLOCATE( dta_bdy(ib_bdy)%a_i(nblen(1),jpl) ) 
     804                  ALLOCATE( dta_bdy(ib_bdy)%h_i(nblen(1),jpl) ) 
     805                  ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) ) 
     806                  dta_bdy(ib_bdy)%a_i(:,:) = 0._wp 
     807                  dta_bdy(ib_bdy)%h_i(:,:) = 0._wp 
     808                  dta_bdy(ib_bdy)%h_s(:,:) = 0._wp 
    890809               ENDIF 
    891810 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r8733 r8738  
    351351        IF(lwp) WRITE(numout,*) 
    352352 
    353 #if defined key_lim2 
     353#if defined key_lim3 
    354354        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    355355        SELECT CASE( cn_ice_lim(ib_bdy) )                   
    356356          CASE('none') 
    357357             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    358              dta_bdy(ib_bdy)%ll_frld = .false. 
    359              dta_bdy(ib_bdy)%ll_hicif = .false. 
    360              dta_bdy(ib_bdy)%ll_hsnif = .false. 
     358             dta_bdy(ib_bdy)%ll_a_i = .false. 
     359             dta_bdy(ib_bdy)%ll_h_i = .false. 
     360             dta_bdy(ib_bdy)%ll_h_s = .false. 
    361361          CASE('frs') 
    362362             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    363              dta_bdy(ib_bdy)%ll_frld  = .true. 
    364              dta_bdy(ib_bdy)%ll_hicif = .true. 
    365              dta_bdy(ib_bdy)%ll_hsnif = .true. 
    366           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
    367         END SELECT 
    368         IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN  
    369            SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   !  
    370               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    371               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    372               CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 
    373            END SELECT 
    374         ENDIF 
    375         IF(lwp) WRITE(numout,*) 
    376 #elif defined key_lim3 
    377         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    378         SELECT CASE( cn_ice_lim(ib_bdy) )                   
    379           CASE('none') 
    380              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    381              dta_bdy(ib_bdy)%ll_a_i  = .false. 
    382              dta_bdy(ib_bdy)%ll_ht_i = .false. 
    383              dta_bdy(ib_bdy)%ll_ht_s = .false. 
    384           CASE('frs') 
    385              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    386              dta_bdy(ib_bdy)%ll_a_i  = .true. 
    387              dta_bdy(ib_bdy)%ll_ht_i = .true. 
    388              dta_bdy(ib_bdy)%ll_ht_s = .true. 
     363             dta_bdy(ib_bdy)%ll_a_i = .true. 
     364             dta_bdy(ib_bdy)%ll_h_i = .true. 
     365             dta_bdy(ib_bdy)%ll_h_s = .true. 
    389366          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
    390367        END SELECT 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    r8733 r8738  
    1515    
    1616   INTERFACE crs_lbc_lnk 
    17       MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d 
     17      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d 
    1818   END INTERFACE 
    1919    
     
    5656      ! 
    5757      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
    58       ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  ) 
     58      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn        , pval=zval  ) 
    5959      ENDIF 
    6060      ! 
     
    6262      ! 
    6363   END SUBROUTINE crs_lbc_lnk_3d 
    64     
    65     
    66    SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    67       !!--------------------------------------------------------------------- 
    68       !!                  ***  SUBROUTINE crs_lbc_lnk  *** 
    69       !! 
    70       !! ** Purpose :   set lateral boundary conditions for coarsened grid 
    71       !! 
    72       !! ** Method  :   Swap domain indices from full to coarse domain 
    73       !!                before arguments are passed directly to lbc_lnk. 
    74       !!                Upon exiting, switch back to full domain indices. 
    75       !!---------------------------------------------------------------------- 
    76       CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type 
    77       REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign 
    78       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied 
    79       ! 
    80       LOGICAL ::   ll_grid_crs 
    81       !!---------------------------------------------------------------------- 
    82       ! 
    83       ll_grid_crs = ( jpi == jpi_crs ) 
    84       ! 
    85       IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    86       ! 
    87       CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  ) 
    88       ! 
    89       IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    90       ! 
    91    END SUBROUTINE crs_lbc_lnk_3d_gather 
    92  
    9364    
    9465    
     
    12192      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    12293      ! 
    123       IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
    124       ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  ) 
     94      IF( PRESENT( cd_mpp ) ) THEN   ;  CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
     95      ELSE                           ;   CALL lbc_lnk( pt2d, cd_type, psgn,        pval=zval  ) 
    12596      ENDIF 
    12697      ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r8733 r8738  
    148148         rmxln_25h(:,:,:) = mxln(:,:,:) 
    149149#endif 
    150 #if defined key_lim3 || defined key_lim2 
     150#if defined key_lim3 
    151151         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
    152152#endif  
     
    207207      ENDIF 
    208208 
    209 #if defined key_lim3 || defined key_lim2 
     209#if defined key_lim3 
    210210      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice') 
    211211#endif 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r8733 r8738  
    3232   USE dianam          ! build name of file 
    3333   USE lib_mpp         ! distributed memory computing library 
    34 #if defined key_lim2 
    35    USE ice_2 
    36 #endif 
    3734#if defined key_lim3 
    3835   USE ice 
     
    747744           END DO !end of loop on the level 
    748745 
    749 #if defined key_lim2 || defined key_lim3 
     746#if defined key_lim3 
    750747 
    751748           !ICE CASE     
     
    769766              zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 
    770767 
    771 #if defined key_lim2    
    772               transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*   &  
    773                                    (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &  
    774                                   *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) +  &  
    775                                     hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 
    776               transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   &  
    777                                     (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 
    778 #endif 
    779768#if defined key_lim3 
    780769              DO jl=1,jpl 
    781                  transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*     & 
    782                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * & 
    783                                   ( ht_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) +  & 
    784                                     ht_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) ) 
     770                 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)*       & 
     771                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * & 
     772                                  ( h_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) +  & 
     773                                    h_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) ) 
    785774                                    
    786775                 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)*   & 
    787                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) 
     776                                    a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) 
    788777              END DO 
    789778#endif 
     
    960949           ENDDO ! loop over jk  
    961950  
    962 #if defined key_lim2 || defined key_lim3  
     951#if defined key_lim3  
    963952  
    964953           !ICE CASE      
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r8733 r8738  
    5151   USE ioipsl 
    5252 
    53 #if defined key_lim2 
    54    USE limwri_2  
    55 #elif defined key_lim3 
    56    USE limwri  
     53#if defined key_lim3 
     54   USE icewri  
    5755#endif 
    5856   USE lib_mpp         ! MPP library 
     
    707705#endif 
    708706 
    709          IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    710             CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    711                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    712             CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    713                &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    714          ENDIF 
    715  
    716707         CALL histend( nid_T, snc4chunks=snc4set ) 
    717708 
     
    861852#endif 
    862853 
    863       IF( ln_cpl .AND. nn_ice == 2 ) THEN 
    864          CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    865          CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    866       ENDIF 
    867  
    868854      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    869855      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
     
    1009995      ENDIF 
    1010996 
    1011 #if defined key_lim2 
    1012       CALL lim_wri_state_2( kt, id_i, nh_i ) 
    1013 #elif defined key_lim3 
    1014       CALL lim_wri_state( kt, id_i, nh_i ) 
     997#if defined key_lim3 
     998      IF( nn_ice == 2 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid 
     999         CALL ice_wri_state( kt, id_i, nh_i ) 
     1000      ENDIF 
    10151001#else 
    10161002      CALL histend( id_i, snc4chunks=snc4set ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r8733 r8738  
    184184      END DO 
    185185 
    186       CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.) 
    187       CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.) 
    188       CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.) 
    189  
     186!!gm  ERROR !!!! 
     187!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos) 
     188! 
     189!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1.) 
     190!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.) 
     191!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.) 
     192      STOP ' iscpl_cons:   please modify this module !' 
     193!!gm end 
    190194      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
    191195      ! allocation and initialisation of the list of problematic point 
     
    283287      pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:) 
    284288 
    285       ! compute sum over the halo and set it to 0. 
    286       CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp) 
    287       CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 
    288       CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 
     289!!gm  ERROR !!!! 
     290!!    juste use tmask_i  or in case of ISF smask_i (to be created to compute the sum without halos) 
     291! 
     292!      ! compute sum over the halo and set it to 0. 
     293!      CALL lbc_sum(pvol_flx(:,:,:       ),'T',1._wp) 
     294!      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 
     295!      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 
     296!!gm end 
    289297 
    290298      ! deallocate variables 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r8733 r8738  
    5454 
    5555   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3] 
     56   ! MV MP 2016 
     57   REAL(wp), PUBLIC ::   rhofw    = 1000._wp         !: volumic mass of freshwater in melt ponds [kg/m3] 
     58   ! END MV MP 2016 
    5659   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice 
    5760   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu] 
     
    8891   REAL(wp), PUBLIC ::   r1_rhoic                    !: 1 / rhoic 
    8992   REAL(wp), PUBLIC ::   r1_rhosn                    !: 1 / rhosn 
     93   REAL(wp), PUBLIC ::   r1_cpic                     !: 1 / cpic 
    9094#endif 
    9195   !!---------------------------------------------------------------------- 
     
    156160      r1_rhoic = 1._wp / rhoic 
    157161      r1_rhosn = 1._wp / rhosn 
     162      r1_cpic  = 1._wp / cpic 
    158163#endif 
    159164      IF(lwp) THEN 
     
    176181         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3' 
    177182         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3' 
     183         WRITE(numout,*) '          density of freshwater (in melt ponds)     = ', rhofw   , ' kg/m^3' 
    178184         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic   
    179185         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu' 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r8733 r8738  
    8282            END DO   
    8383         END DO   
    84          IF( .NOT. AGRIF_Root() ) THEN 
    85             IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn(nlci-1,   :  ,jk) = 0._wp      ! east 
    86             IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(  2   ,   :  ,jk) = 0._wp      ! west 
    87             IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(  :   ,nlcj-1,jk) = 0._wp      ! north 
    88             IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(  :   ,  2   ,jk) = 0._wp      ! south 
    89          ENDIF 
    9084      END DO 
     85#if defined key_agrif 
     86      IF( .NOT. Agrif_Root() ) THEN 
     87         IF( nbondi == -1 .OR. nbondi == 2 )   hdivn( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
     88         IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
     89         IF( nbondj == -1 .OR. nbondj == 2 )   hdivn( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
     90         IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
     91      ENDIF 
     92#endif 
    9193      ! 
    9294      IF( ln_rnf )   CALL sbc_rnf_div( hdivn )      !==  runoffs    ==!   (update hdivn field) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r8733 r8738  
    1717   USE phycst         ! physical constants 
    1818   USE sbc_oce        ! surface boundary condition: ocean 
     19   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b 
    1920   USE sbcapr         ! surface boundary condition: atmospheric pressure 
    2021   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine) 
     
    8990      IF(      ln_apr_dyn                                                &   ! atmos. pressure 
    9091         .OR.  ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. ln_tide) )   &   ! tide potential (no time slitting) 
    91          .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice 
     92         .OR.  ln_ice_embd ) THEN                                            ! embedded sea-ice 
    9293         ! 
    9394         DO jj = 2, jpjm1 
     
    123124         ENDIF 
    124125         ! 
    125          IF( nn_ice_embd == 2 ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
     126         IF( ln_ice_embd ) THEN          !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
    126127            CALL wrk_alloc( jpi,jpj,   zpice ) 
    127128            !                                             
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r8733 r8738  
    686686            IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    687687               DO jj=1,jpj 
    688                   zwx(2,jj) = ubdy_w(jj) * e2u(2,jj) 
     688                  zwx(2:nbghostcells+1,jj) = ubdy_w(jj) * e2u(2:nbghostcells+1,jj) 
    689689               END DO 
    690690            ENDIF 
    691691            IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
    692692               DO jj=1,jpj 
    693                   zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj) 
     693                  zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 
    694694               END DO 
    695695            ENDIF 
    696696            IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    697697               DO ji=1,jpi 
    698                   zwy(ji,2) = vbdy_s(ji) * e1v(ji,2) 
     698                  zwy(ji,2:nbghostcells+1) = vbdy_s(ji) * e1v(ji,2:nbghostcells+1) 
    699699               END DO 
    700700            ENDIF 
    701701            IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
    702702               DO ji=1,jpi 
    703                   zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2) 
     703                  zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 
    704704               END DO 
    705705            ENDIF 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r8733 r8738  
    9090   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ua_e, va_e 
    9191   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_e 
    92 #if defined key_lim2 || defined key_lim3 || defined key_cice 
     92#if defined key_lim3 || defined key_cice 
    9393   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ui_e, vi_e 
    9494#endif 
     
    170170      ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,   & 
    171171         &      vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,   & 
    172 #if defined key_lim2 || defined key_lim3 || defined key_cice 
     172#if defined key_lim3 || defined key_cice 
    173173         &      ui_e(0:jpi+1,0:jpj+1) ,                            & 
    174174         &      vi_e(0:jpi+1,0:jpj+1) ,                            & 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r8733 r8738  
    2121   USE icb_oce                             ! define iceberg arrays 
    2222   USE sbc_oce                             ! ocean surface boundary conditions 
    23 #if defined key_lim2 
    24    USE ice_2,         ONLY: u_ice, v_ice   ! LIM-2 ice velocities  (CAUTION in C-grid do not use key_vp option) 
    25    USE ice_2,         ONLY: hicif          ! LIM-2 ice thickness 
    26 #elif defined key_lim3 
    27    USE ice,           ONLY: u_ice, v_ice   ! LIM-3 variables  (always in C-grid) 
    28                                            ! gm  LIM3 case the mean ice thickness (i.e. averaged over categories) 
    29                                            ! gm            has to be computed somewhere in the ice and accessed here 
     23#if defined key_lim3 
     24   USE ice,    ONLY: u_ice, v_ice, hm_i    ! LIM-3 variables 
    3025#endif 
    3126 
     
    8580      CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 ) 
    8681      CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 ) 
    87 #if defined key_lim2 
    88       hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hicif(:,:)   
    89       CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 )   
    90 #endif 
    91  
    92 #if defined key_lim2 || defined key_lim3 
     82#if defined key_lim3 
     83      hicth(:,:) = 0._wp ;  hicth(1:jpi,1:jpj) = hm_i (:,:)   
    9384      ui_e(:,:) = 0._wp ;   ui_e(1:jpi, 1:jpj) = u_ice(:,:) 
    9485      vi_e(:,:) = 0._wp ;   vi_e(1:jpi, 1:jpj) = v_ice(:,:) 
    95  
     86      CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 ) 
    9687      CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 ) 
    9788      CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 ) 
     
    157148      pva  = pva * zmod 
    158149 
    159 #if defined key_lim2 || defined key_lim3 
     150#if defined key_lim3 
    160151      pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' )              ! sea-ice velocities 
    161152      pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' ) 
    162 # if defined key_lim3 
    163       phi = 0._wp                                             ! LIM-3 case (to do) 
    164 # else 
    165153      phi = icb_utl_bilin_h(hicth, pi, pj, 'T' )              ! ice thickness 
    166 # endif 
    167154#else 
    168155      pui = 0._wp 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r8733 r8738  
    8888   INTEGER ::   nitrst                !: time step at which restart file should be written 
    8989   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
     90   LOGICAL ::   lrst_ice              !: logical to control the ice restart write  
    9091   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
     92   INTEGER ::   numrir                !: logical unit for ice   restart (read) 
    9193   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
     94   INTEGER ::   numriw                !: logical unit for ice   restart (write) 
    9295   INTEGER ::   nrst_lst              !: number of restart to output next 
    9396 
     
    126129   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice 
    127130   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution) 
    128    INTEGER ::   numsol          =   -1      !: logical unit for solver statistics 
     131   INTEGER ::   numrun          =   -1      !: logical unit for run statistics 
    129132   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing 
    130133   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8733 r8738  
    3434#if defined key_lim3 
    3535   USE ice    , ONLY :   jpl 
    36 #elif defined key_lim2 
    37    USE par_ice_2 
    3836#endif 
    3937   USE domngb          ! ocean space and time domain 
     
    193191      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    194192# endif 
    195 #if defined key_lim3 || defined key_lim2 
     193#if defined key_lim3 
    196194      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
     195      ! SIMIP diagnostics (4 main arctic straits) 
     196      CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 
    197197#endif 
    198198      CALL iom_set_axis_attr( "icbcla", class_num ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r8733 r8738  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  lbclnk  *** 
    4    !! Ocean        : lateral boundary conditions 
     4   !! NEMO        : lateral boundary conditions 
    55   !!===================================================================== 
    66   !! History :  OPA  ! 1997-06  (G. Madec)  Original code 
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    88   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment   
    9    !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 
     9   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 
    1010   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case   
    1111   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi   
     12   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size) 
     13   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather) 
     14   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines 
    1215   !!---------------------------------------------------------------------- 
    1316#if defined key_mpp_mpi 
     
    1518   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    1619   !!---------------------------------------------------------------------- 
    17    !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
    18    !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp 
    19    !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    20    !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
    21    !!---------------------------------------------------------------------- 
     20   !!           define the generic interfaces of lib_mpp routines 
     21   !!---------------------------------------------------------------------- 
     22   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
     23   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
     24   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
     25   !!---------------------------------------------------------------------- 
     26   USE par_oce        ! ocean dynamics and tracers    
    2227   USE lib_mpp        ! distributed memory computing library 
    23  
     28   USE lbcnfd         ! north fold 
     29 
     30   INTERFACE lbc_lnk 
     31      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d 
     32   END INTERFACE 
     33   INTERFACE lbc_lnk_ptr 
     34      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr 
     35   END INTERFACE 
    2436   INTERFACE lbc_lnk_multi 
    25       MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 
    26    END INTERFACE 
    27    ! 
    28    INTERFACE lbc_lnk 
    29       MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
    30    END INTERFACE 
    31    ! 
    32    INTERFACE lbc_sum 
    33       MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     37      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 
    3438   END INTERFACE 
    3539   ! 
     
    4650   END INTERFACE 
    4751 
    48    PUBLIC   lbc_lnk       ! ocean lateral boundary conditions 
    49    PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
    50    PUBLIC   lbc_sum 
    51    PUBLIC   lbc_lnk_e     ! 
     52   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions 
     53   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 
     54   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions 
    5255   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    53    PUBLIC   lbc_lnk_icb   ! 
    54  
    55    !!---------------------------------------------------------------------- 
    56    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     56   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
     57 
     58   !!---------------------------------------------------------------------- 
     59   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5760   !! $Id$ 
    5861   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5962   !!---------------------------------------------------------------------- 
     63CONTAINS 
     64 
    6065#else 
    6166   !!---------------------------------------------------------------------- 
    6267   !!   Default option                              shared memory computing 
    6368   !!---------------------------------------------------------------------- 
    64    !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d  
     69   !!                routines setting the appropriate values 
     70   !!         on first and last row and column of the global domain 
     71   !!---------------------------------------------------------------------- 
    6572   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 
    6673   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh 
     
    7077   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition 
    7178   !!---------------------------------------------------------------------- 
    72    USE oce             ! ocean dynamics and tracers    
    73    USE dom_oce         ! ocean space and time domain  
    74    USE in_out_manager  ! I/O manager 
    75    USE lbcnfd          ! north fold 
     79   USE oce            ! ocean dynamics and tracers    
     80   USE dom_oce        ! ocean space and time domain  
     81   USE in_out_manager ! I/O manager 
     82   USE lbcnfd         ! north fold 
    7683 
    7784   IMPLICIT NONE 
     
    7986 
    8087   INTERFACE lbc_lnk 
    81       MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 
    82    END INTERFACE 
    83    ! 
    84    INTERFACE lbc_sum 
    85       MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d 
    86    END INTERFACE 
    87  
     88      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d 
     89   END INTERFACE 
     90   INTERFACE lbc_lnk_ptr 
     91      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr 
     92   END INTERFACE 
     93   INTERFACE lbc_lnk_multi 
     94      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 
     95   END INTERFACE 
     96   ! 
    8897   INTERFACE lbc_lnk_e 
    8998      MODULE PROCEDURE lbc_lnk_2d_e 
    9099   END INTERFACE 
    91100   ! 
    92    INTERFACE lbc_lnk_multi 
    93       MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 
    94    END INTERFACE 
    95  
    96101   INTERFACE lbc_bdy_lnk 
    97102      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
     
    102107   END INTERFACE 
    103108    
    104    TYPE arrayptr 
    105       REAL , DIMENSION (:,:),  POINTER :: pt2d 
    106    END TYPE arrayptr 
    107    PUBLIC   arrayptr 
    108  
    109109   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    110    PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region) 
    111    PUBLIC   lbc_lnk_e     ! 
    112    PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
     110   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions 
     111   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 
    113112   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    114    PUBLIC   lbc_lnk_icb   ! 
    115     
    116    !!---------------------------------------------------------------------- 
    117    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     113   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
     114    
     115   !!---------------------------------------------------------------------- 
     116   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    118117   !! $Id$ 
    119118   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    122121 
    123122# if defined key_c1d 
    124    !!---------------------------------------------------------------------- 
     123   !!====================================================================== 
    125124   !!   'key_c1d'                                          1D configuration 
    126    !!---------------------------------------------------------------------- 
    127  
    128    SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    129       !!--------------------------------------------------------------------- 
    130       !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
    131       !! 
    132       !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case) 
    133       !! 
    134       !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2 
    135       !!---------------------------------------------------------------------- 
    136       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
    138       REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
    139       !!---------------------------------------------------------------------- 
    140       ! 
    141       CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
    142       CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
    143       ! 
    144    END SUBROUTINE lbc_lnk_3d_gather 
    145  
     125   !!====================================================================== 
     126   !!     central point value replicated over the 8 surrounding points 
     127   !!---------------------------------------------------------------------- 
    146128 
    147129   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
     
    153135      !! ** Method  :   1D case, the central water column is set everywhere 
    154136      !!---------------------------------------------------------------------- 
    155       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    156       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    157       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    158       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    159       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     137      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     138      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     139      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold  
     140      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     141      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    160142      ! 
    161143      INTEGER  ::   jk     ! dummy loop index 
     
    163145      !!---------------------------------------------------------------------- 
    164146      ! 
    165       DO jk = 1, jpk 
     147      DO jk = 1, SIZE( pt3d, 3 ) 
    166148         ztab = pt3d(2,2,jk) 
    167149         pt3d(:,:,jk) = ztab 
     
    179161      !! ** Method  :   1D case, the central water column is set everywhere 
    180162      !!---------------------------------------------------------------------- 
     163      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    181164      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    182       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    183       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
     165      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold  
    184166      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    185167      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     
    193175   END SUBROUTINE lbc_lnk_2d 
    194176    
    195    SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
    196       !! 
    197       INTEGER :: num_fields 
    198       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    199       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
    200       !                                                               ! = T , U , V , F , W and I points 
    201       REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
    202       !                                                               ! =  1. , the sign is kept 
    203       ! 
    204       INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
    205       ! 
    206       DO ii = 1, num_fields 
    207         CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
    208       END DO      
    209       ! 
    210    END SUBROUTINE lbc_lnk_2d_multiple 
    211  
    212    SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
    213       &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
    214       &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
    215       !!--------------------------------------------------------------------- 
    216       ! Second 2D array on which the boundary condition is applied 
    217       REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
    218       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
    219       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
    220       ! define the nature of ptab array grid-points 
    221       CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
    222       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
    223       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
    224       ! =-1 the sign change across the north fold boundary 
    225       REAL(wp)                                      , INTENT(in   ) ::   psgnA 
    226       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
    227       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
    228       CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    229       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    230       !! 
    231       !!--------------------------------------------------------------------- 
    232  
    233       !!The first array 
    234       CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
    235  
    236       !! Look if more arrays to process 
    237       IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB ) 
    238       IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
    239       IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
    240       IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
    241       IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
    242       IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
    243       IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
    244       IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
    245  
    246    END SUBROUTINE lbc_lnk_2d_9 
    247  
    248  
    249  
    250  
    251  
    252177#else 
    253    !!---------------------------------------------------------------------- 
     178   !!====================================================================== 
    254179   !!   Default option                           3D shared memory computing 
    255    !!---------------------------------------------------------------------- 
    256  
    257    SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    258       !!--------------------------------------------------------------------- 
    259       !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
    260       !! 
    261       !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case) 
    262       !! 
    263       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    264       !!                      =  1 : no change of the sign across the north fold 
    265       !!                      =  0 : no change of the sign across the north fold and 
    266       !!                             strict positivity preserved: use inner row/column 
    267       !!                             for closed boundaries. 
    268       !!---------------------------------------------------------------------- 
    269       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
    270       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
    271       REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
    272       !!---------------------------------------------------------------------- 
    273       ! 
    274       CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
    275       CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
    276       ! 
    277    END SUBROUTINE lbc_lnk_3d_gather 
    278  
    279  
    280    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
    281       !!--------------------------------------------------------------------- 
    282       !!                  ***  ROUTINE lbc_lnk_3d  *** 
    283       !! 
    284       !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case) 
    285       !! 
    286       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    287       !!                      =  1 : no change of the sign across the north fold 
    288       !!                      =  0 : no change of the sign across the north fold and 
    289       !!                             strict positivity preserved: use inner row/column 
    290       !!                             for closed boundaries. 
    291       !!---------------------------------------------------------------------- 
    292       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    293       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    294       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    295       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    296       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    297       !! 
    298       REAL(wp) ::   zland 
    299       !!---------------------------------------------------------------------- 
    300  
    301       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    302       ELSE                         ;   zland = 0._wp 
    303       ENDIF 
    304  
    305  
    306       IF( PRESENT( cd_mpp ) ) THEN 
    307          ! only fill the overlap area and extra allows  
    308          ! this is in mpp case. In this module, just do nothing 
    309       ELSE 
    310          !                                     !  East-West boundaries 
    311          !                                     ! ====================== 
    312          SELECT CASE ( nperio ) 
    313          ! 
    314          CASE ( 1 , 4 , 6 )                       !**  cyclic east-west 
    315             pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points 
    316             pt3d(jpi,:,:) = pt3d(  2  ,:,:) 
    317             ! 
    318          CASE DEFAULT                             !**  East closed  --  West closed 
    319             SELECT CASE ( cd_type ) 
    320             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    321                pt3d( 1 ,:,:) = zland 
    322                pt3d(jpi,:,:) = zland 
    323             CASE ( 'F' )                               ! F-point 
    324                pt3d(jpi,:,:) = zland 
    325             END SELECT 
    326             ! 
    327          END SELECT 
    328          !                                     ! North-South boundaries 
    329          !                                     ! ====================== 
    330          SELECT CASE ( nperio ) 
    331          ! 
    332          CASE ( 2 )                               !**  South symmetric  --  North closed 
    333             SELECT CASE ( cd_type ) 
    334             CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
    335                pt3d(:, 1 ,:) = pt3d(:,3,:) 
    336                pt3d(:,jpj,:) = zland 
    337             CASE ( 'V' , 'F' )                         ! V-, F-points 
    338                pt3d(:, 1 ,:) = psgn * pt3d(:,2,:) 
    339                pt3d(:,jpj,:) = zland 
    340             END SELECT 
    341             ! 
    342          CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed 
    343             SELECT CASE ( cd_type )                    ! South : closed 
    344             CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point 
    345                pt3d(:, 1 ,:) = zland 
    346             END SELECT 
    347             !                                          ! North fold 
    348             CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn ) 
    349             ! 
    350          CASE DEFAULT                             !**  North closed  --  South closed 
    351             SELECT CASE ( cd_type ) 
    352             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    353                pt3d(:, 1 ,:) = zland 
    354                pt3d(:,jpj,:) = zland 
    355             CASE ( 'F' )                               ! F-point 
    356                pt3d(:,jpj,:) = zland 
    357             END SELECT 
    358             ! 
    359          END SELECT 
    360          ! 
    361       ENDIF 
    362       ! 
    363    END SUBROUTINE lbc_lnk_3d 
    364  
    365  
    366    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    367       !!--------------------------------------------------------------------- 
    368       !!                 ***  ROUTINE lbc_lnk_2d  *** 
    369       !! 
    370       !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
    371       !! 
    372       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    373       !!                      =  1 : no change of the sign across the north fold 
    374       !!                      =  0 : no change of the sign across the north fold and 
    375       !!                             strict positivity preserved: use inner row/column 
    376       !!                             for closed boundaries. 
    377       !!---------------------------------------------------------------------- 
    378       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    379       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    380       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
    381       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    382       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    383       !! 
    384       REAL(wp) ::   zland 
    385       !!---------------------------------------------------------------------- 
    386  
    387       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    388       ELSE                         ;   zland = 0._wp 
    389       ENDIF 
    390  
    391       IF (PRESENT(cd_mpp)) THEN 
    392          ! only fill the overlap area and extra allows  
    393          ! this is in mpp case. In this module, just do nothing 
    394       ELSE       
    395          !                                     ! East-West boundaries 
    396          !                                     ! ==================== 
    397          SELECT CASE ( nperio ) 
    398          ! 
    399          CASE ( 1 , 4 , 6 )                       !** cyclic east-west 
    400             pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points 
    401             pt2d(jpi,:) = pt2d(  2  ,:) 
    402             ! 
    403          CASE DEFAULT                             !** East closed  --  West closed 
    404             SELECT CASE ( cd_type ) 
    405             CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points 
    406                pt2d( 1 ,:) = zland 
    407                pt2d(jpi,:) = zland 
    408             CASE ( 'F' )                              ! F-point 
    409                pt2d(jpi,:) = zland 
    410             END SELECT 
    411             ! 
    412          END SELECT 
    413          !                                     ! North-South boundaries 
    414          !                                     ! ====================== 
    415          SELECT CASE ( nperio ) 
    416          ! 
    417          CASE ( 2 )                               !**  South symmetric  --  North closed 
    418             SELECT CASE ( cd_type ) 
    419             CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
    420                pt2d(:, 1 ) = pt2d(:,3) 
    421                pt2d(:,jpj) = zland 
    422             CASE ( 'V' , 'F' )                         ! V-, F-points 
    423                pt2d(:, 1 ) = psgn * pt2d(:,2) 
    424                pt2d(:,jpj) = zland 
    425             END SELECT 
    426             ! 
    427          CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed 
    428             SELECT CASE ( cd_type )                    ! South : closed 
    429             CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point 
    430                pt2d(:, 1 ) = zland 
    431             END SELECT 
    432             !                                          ! North fold 
    433             CALL lbc_nfd( pt2d(:,:), cd_type, psgn ) 
    434             ! 
    435          CASE DEFAULT                             !**  North closed  --  South closed 
    436             SELECT CASE ( cd_type ) 
    437             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    438                pt2d(:, 1 ) = zland 
    439                pt2d(:,jpj) = zland 
    440             CASE ( 'F' )                               ! F-point 
    441                pt2d(:,jpj) = zland 
    442             END SELECT 
    443             ! 
    444          END SELECT 
    445          ! 
    446       ENDIF 
    447       !     
    448    END SUBROUTINE lbc_lnk_2d 
    449     
    450    SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
    451       !! 
    452       INTEGER :: num_fields 
    453       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    454       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
    455       !                                                               ! = T , U , V , F , W and I points 
    456       REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
    457       !                                                               ! =  1. , the sign is kept 
    458       ! 
    459       INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
    460       ! 
    461       DO ii = 1, num_fields 
    462         CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
    463       END DO      
    464       ! 
    465    END SUBROUTINE lbc_lnk_2d_multiple 
    466  
    467    SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
    468       &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
    469       &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
    470       !!--------------------------------------------------------------------- 
    471       ! Second 2D array on which the boundary condition is applied 
    472       REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
    473       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
    474       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
    475       ! define the nature of ptab array grid-points 
    476       CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
    477       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
    478       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
    479       ! =-1 the sign change across the north fold boundary 
    480       REAL(wp)                                      , INTENT(in   ) ::   psgnA 
    481       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
    482       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
    483       CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    484       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    485       !! 
    486       !!--------------------------------------------------------------------- 
    487  
    488       !!The first array 
    489       CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
    490  
    491       !! Look if more arrays to process 
    492       IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB ) 
    493       IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
    494       IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
    495       IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
    496       IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
    497       IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
    498       IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
    499       IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
    500  
    501    END SUBROUTINE lbc_lnk_2d_9 
    502  
    503    SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    504       !!--------------------------------------------------------------------- 
    505       !!                 ***  ROUTINE lbc_lnk_sum_2d  *** 
    506       !! 
    507       !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
    508       !! 
    509       !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean  
    510       !!                coupling if conservation option activated. As no ice shelf are present along 
    511       !!                this line, nothing is done along the north fold. 
    512       !!---------------------------------------------------------------------- 
    513       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    514       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    515       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
    516       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    517       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    518       !! 
    519       REAL(wp) ::   zland 
    520       !!---------------------------------------------------------------------- 
    521  
    522       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    523       ELSE                         ;   zland = 0._wp 
    524       ENDIF 
    525  
    526       IF (PRESENT(cd_mpp)) THEN 
    527          ! only fill the overlap area and extra allows  
    528          ! this is in mpp case. In this module, just do nothing 
    529       ELSE 
    530          !                                     ! East-West boundaries 
    531          !                                     ! ==================== 
    532          SELECT CASE ( nperio ) 
    533          ! 
    534          CASE ( 1 , 4 , 6 )                       !** cyclic east-west 
    535             pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:) 
    536             pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d(jpi,:) 
    537             pt2d( 1 ,:) = 0.0_wp               ! all points 
    538             pt2d(jpi,:) = 0.0_wp 
    539             ! 
    540          CASE DEFAULT                             !** East closed  --  West closed 
    541             SELECT CASE ( cd_type ) 
    542             CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points 
    543                pt2d( 1 ,:) = zland 
    544                pt2d(jpi,:) = zland 
    545             CASE ( 'F' )                              ! F-point 
    546                pt2d(jpi,:) = zland 
    547             END SELECT 
    548             ! 
    549          END SELECT 
    550          !                                     ! North-South boundaries 
    551          !                                     ! ====================== 
    552          ! Nothing to do for the north fold, there is no ice shelf along this line. 
    553          ! 
    554       END IF 
    555  
    556    END SUBROUTINE 
    557  
    558    SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
    559       !!--------------------------------------------------------------------- 
    560       !!                 ***  ROUTINE lbc_lnk_sum_3d  *** 
    561       !! 
    562       !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case) 
    563       !! 
    564       !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean  
    565       !!                coupling if conservation option activated. As no ice shelf are present along 
    566       !!                this line, nothing is done along the north fold. 
    567       !!---------------------------------------------------------------------- 
    568       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    569       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    570       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    571       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    572       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    573       !! 
    574       REAL(wp) ::   zland 
    575       !!---------------------------------------------------------------------- 
    576  
    577       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    578       ELSE                         ;   zland = 0._wp 
    579       ENDIF 
    580  
    581  
    582       IF( PRESENT( cd_mpp ) ) THEN 
    583          ! only fill the overlap area and extra allows  
    584          ! this is in mpp case. In this module, just do nothing 
    585       ELSE 
    586          !                                     !  East-West boundaries 
    587          !                                     ! ====================== 
    588          SELECT CASE ( nperio ) 
    589          ! 
    590          CASE ( 1 , 4 , 6 )                       !**  cyclic east-west 
    591             pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:) 
    592             pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:)  
    593             pt3d( 1 ,:,:) = 0.0_wp            ! all points 
    594             pt3d(jpi,:,:) = 0.0_wp 
    595             ! 
    596          CASE DEFAULT                             !**  East closed  --  West closed 
    597             SELECT CASE ( cd_type ) 
    598             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    599                pt3d( 1 ,:,:) = zland 
    600                pt3d(jpi,:,:) = zland 
    601             CASE ( 'F' )                               ! F-point 
    602                pt3d(jpi,:,:) = zland 
    603             END SELECT 
    604             ! 
    605          END SELECT 
    606          !                                     ! North-South boundaries 
    607          !                                     ! ====================== 
    608          ! Nothing to do for the north fold, there is no ice shelf along this line. 
    609          ! 
    610       END IF 
    611    END SUBROUTINE 
    612  
    613  
     180   !!====================================================================== 
     181   !!          routines setting land point, or east-west cyclic, 
     182   !!             or north-south cyclic, or north fold values 
     183   !!         on first and last row and column of the global domain 
     184   !!---------------------------------------------------------------------- 
     185 
     186   !!---------------------------------------------------------------------- 
     187   !!                   ***  routine lbc_lnk_(2,3,4)d  *** 
     188   !! 
     189   !!   * Argument : dummy argument use in lbc_lnk_... routines 
     190   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
     191   !!                cd_nat :   nature of array grid-points 
     192   !!                psgn   :   sign used across the north fold boundary 
     193   !!                kfld   :   optional, number of pt3d arrays 
     194   !!                cd_mpp :   optional, fill the overlap area only 
     195   !!                pval   :   optional, background value (used at closed boundaries) 
     196   !!---------------------------------------------------------------------- 
     197   ! 
     198   !                       !==  2D array and array of 2D pointer  ==! 
     199   ! 
     200#  define DIM_2d 
     201#     define ROUTINE_LNK           lbc_lnk_2d 
     202#     include "lbc_lnk_generic.h90" 
     203#     undef ROUTINE_LNK 
     204#     define MULTI 
     205#     define ROUTINE_LNK           lbc_lnk_2d_ptr 
     206#     include "lbc_lnk_generic.h90" 
     207#     undef ROUTINE_LNK 
     208#     undef MULTI 
     209#  undef DIM_2d 
     210   ! 
     211   !                       !==  3D array and array of 3D pointer  ==! 
     212   ! 
     213#  define DIM_3d 
     214#     define ROUTINE_LNK           lbc_lnk_3d 
     215#     include "lbc_lnk_generic.h90" 
     216#     undef ROUTINE_LNK 
     217#     define MULTI 
     218#     define ROUTINE_LNK           lbc_lnk_3d_ptr 
     219#     include "lbc_lnk_generic.h90" 
     220#     undef ROUTINE_LNK 
     221#     undef MULTI 
     222#  undef DIM_3d 
     223   ! 
     224   !                       !==  4D array and array of 4D pointer  ==! 
     225   ! 
     226#  define DIM_4d 
     227#     define ROUTINE_LNK           lbc_lnk_4d 
     228#     include "lbc_lnk_generic.h90" 
     229#     undef ROUTINE_LNK 
     230#     define MULTI 
     231#     define ROUTINE_LNK           lbc_lnk_4d_ptr 
     232#     include "lbc_lnk_generic.h90" 
     233#     undef ROUTINE_LNK 
     234#     undef MULTI 
     235#  undef DIM_4d 
     236    
    614237#endif 
    615238 
     239   !!====================================================================== 
     240   !!   identical routines in both C1D and shared memory computing 
     241   !!====================================================================== 
     242 
     243   !!---------------------------------------------------------------------- 
     244   !!                   ***  routine lbc_bdy_lnk_(2,3)d  *** 
     245   !! 
     246   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
     247   !!   to maintain the same interface with regards to the mpp case 
     248   !!---------------------------------------------------------------------- 
     249    
    616250   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy ) 
    617       !!--------------------------------------------------------------------- 
    618       !!                  ***  ROUTINE lbc_bdy_lnk  *** 
    619       !! 
    620       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
    621       !!              to maintain the same interface with regards to the mpp case 
    622       !! 
    623       !!---------------------------------------------------------------------- 
    624       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    625       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied 
    626       REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign  
    627       INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
    628       !!---------------------------------------------------------------------- 
    629       ! 
     251      !!---------------------------------------------------------------------- 
     252      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied 
     253      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     254      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold  
     255      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
     256      !!---------------------------------------------------------------------- 
    630257      CALL lbc_lnk_3d( pt3d, cd_type, psgn) 
    631       ! 
    632258   END SUBROUTINE lbc_bdy_lnk_3d 
    633259 
    634260 
    635261   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy ) 
    636       !!--------------------------------------------------------------------- 
    637       !!                  ***  ROUTINE lbc_bdy_lnk  *** 
    638       !! 
    639       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
    640       !!              to maintain the same interface with regards to the mpp case 
    641       !! 
    642       !!---------------------------------------------------------------------- 
    643       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    644       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied 
    645       REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign  
    646       INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
    647       !!---------------------------------------------------------------------- 
    648       ! 
     262      !!---------------------------------------------------------------------- 
     263      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied 
     264      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     265      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold  
     266      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
     267      !!---------------------------------------------------------------------- 
    649268      CALL lbc_lnk_2d( pt2d, cd_type, psgn) 
    650       ! 
    651269   END SUBROUTINE lbc_bdy_lnk_2d 
    652270 
    653271 
    654    SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 
    655       !!--------------------------------------------------------------------- 
    656       !!                 ***  ROUTINE lbc_lnk_2d  *** 
    657       !! 
    658       !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
    659       !!                special dummy routine to allow for use of halo indexing in mpp case 
    660       !! 
    661       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    662       !!                      =  1 : no change of the sign across the north fold 
    663       !!                      =  0 : no change of the sign across the north fold and 
    664       !!                             strict positivity preserved: use inner row/column 
    665       !!                             for closed boundaries. 
    666       !!---------------------------------------------------------------------- 
    667       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    668       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied 
    669       REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign  
    670       INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp) 
    671       INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp) 
    672       !!---------------------------------------------------------------------- 
    673       ! 
     272!!gm  This routine should be remove with an optional halos size added in orgument of generic routines 
     273 
     274   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj ) 
     275      !!---------------------------------------------------------------------- 
     276      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied 
     277      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     278      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold  
     279      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp) 
     280      !!---------------------------------------------------------------------- 
    674281      CALL lbc_lnk_2d( pt2d, cd_type, psgn ) 
    675       !     
    676282   END SUBROUTINE lbc_lnk_2d_e 
     283!!gm end 
    677284 
    678285#endif 
    679286 
    680287   !!====================================================================== 
     288   !!   identical routines in both distributed and shared memory computing 
     289   !!====================================================================== 
     290 
     291   !!---------------------------------------------------------------------- 
     292   !!                   ***   load_ptr_(2,3,4)d   *** 
     293   !! 
     294   !!   * Dummy Argument : 
     295   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D) 
     296   !!                   cd_nat     ! nature of pt2d array grid-points 
     297   !!                   psgn       ! sign used across the north fold boundary 
     298   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers 
     299   !!                   cdna_ptr   ! nature of ptab array grid-points 
     300   !!                   psgn_ptr   ! sign used across the north fold boundary 
     301   !!                   kfld       ! number of elements that has been attributed 
     302   !!---------------------------------------------------------------------- 
     303 
     304   !!---------------------------------------------------------------------- 
     305   !!                  ***   lbc_lnk_(2,3,4)d_multi   *** 
     306   !!                     ***   load_ptr_(2,3,4)d   *** 
     307   !! 
     308   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines 
     309   !! 
     310   !!---------------------------------------------------------------------- 
     311 
     312#  define DIM_2d 
     313#     define ROUTINE_MULTI          lbc_lnk_2d_multi 
     314#     define ROUTINE_LOAD           load_ptr_2d 
     315#     include "lbc_lnk_multi_generic.h90" 
     316#     undef ROUTINE_MULTI 
     317#     undef ROUTINE_LOAD 
     318#  undef DIM_2d 
     319 
     320 
     321#  define DIM_3d 
     322#     define ROUTINE_MULTI          lbc_lnk_3d_multi 
     323#     define ROUTINE_LOAD           load_ptr_3d 
     324#     include "lbc_lnk_multi_generic.h90" 
     325#     undef ROUTINE_MULTI 
     326#     undef ROUTINE_LOAD 
     327#  undef DIM_3d 
     328 
     329 
     330#  define DIM_4d 
     331#     define ROUTINE_MULTI          lbc_lnk_4d_multi 
     332#     define ROUTINE_LOAD           load_ptr_4d 
     333#     include "lbc_lnk_multi_generic.h90" 
     334#     undef ROUTINE_MULTI 
     335#     undef ROUTINE_LOAD 
     336#  undef DIM_4d 
     337 
     338   !!====================================================================== 
    681339END MODULE lbclnk 
    682340 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r8733 r8738  
    55   !!====================================================================== 
    66   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code  
    7    !!            3.5  ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization  
     7   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization 
     8   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension) 
    89   !!---------------------------------------------------------------------- 
    910 
     
    1213   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd) 
    1314   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd) 
    14    !!   mpp_lbc_nfd_3d    : North fold treatment for a 3D arrays optimized for MPP 
    15    !!   mpp_lbc_nfd_2d    : North fold treatment for a 2D arrays optimized for MPP 
     15   !!   lbc_nfd_nogather       : generic interface for lbc_nfd_nogather_3d and  
     16   !!                            lbc_nfd_nogather_2d routines (designed for use 
     17   !!                            with ln_nnogather to avoid global width arrays 
     18   !!                            mpi all gather operations) 
    1619   !!---------------------------------------------------------------------- 
    1720   USE dom_oce        ! ocean space and time domain  
     
    2225 
    2326   INTERFACE lbc_nfd 
    24       MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d 
     27      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d 
     28      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr 
    2529   END INTERFACE 
    2630   ! 
    27    INTERFACE mpp_lbc_nfd 
    28       MODULE PROCEDURE   mpp_lbc_nfd_3d, mpp_lbc_nfd_2d 
     31   INTERFACE lbc_nfd_nogather 
     32!                        ! Currently only 4d array version is needed 
     33!     MODULE PROCEDURE   lbc_nfd_nogather_2d    , lbc_nfd_nogather_3d 
     34      MODULE PROCEDURE   lbc_nfd_nogather_4d 
     35!     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr 
     36!     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr 
    2937   END INTERFACE 
    3038 
    31    PUBLIC   lbc_nfd       ! north fold conditions 
    32    PUBLIC   mpp_lbc_nfd   ! north fold conditions (parallel case) 
     39   TYPE, PUBLIC ::   PTR_2D   !: array of 2D pointers (also used in lib_mpp) 
     40      REAL(wp), DIMENSION (:,:)    , POINTER ::   pt2d 
     41   END TYPE PTR_2D 
     42   TYPE, PUBLIC ::   PTR_3D   !: array of 3D pointers (also used in lib_mpp) 
     43      REAL(wp), DIMENSION (:,:,:)  , POINTER ::   pt3d 
     44   END TYPE PTR_3D 
     45   TYPE, PUBLIC ::   PTR_4D   !: array of 4D pointers (also used in lib_mpp) 
     46      REAL(wp), DIMENSION (:,:,:,:), POINTER ::   pt4d 
     47   END TYPE PTR_4D 
     48 
     49   PUBLIC   lbc_nfd            ! north fold conditions 
     50   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case) 
    3351 
    3452   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !: 
     
    4361CONTAINS 
    4462 
    45    SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn ) 
    46       !!---------------------------------------------------------------------- 
    47       !!                  ***  routine lbc_nfd_3d  *** 
    48       !! 
    49       !! ** Purpose :   3D lateral boundary condition : North fold treatment 
    50       !!              without processor exchanges.  
    51       !! 
    52       !! ** Method  :    
    53       !! 
    54       !! ** Action  :   pt3d with updated values along the north fold 
    55       !!---------------------------------------------------------------------- 
    56       CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points 
    57       !                                                        !   = T , U , V , F , W points 
    58       REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change 
    59       !                                                        !   = -1. , the sign is changed if north fold boundary 
    60       !                                                        !   =  1. , the sign is kept  if north fold boundary 
    61       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied 
    62       ! 
    63       INTEGER  ::   ji, jk 
    64       INTEGER  ::   ijt, iju, ijpj, ijpjm1 
    65       !!---------------------------------------------------------------------- 
    66  
    67       SELECT CASE ( jpni ) 
    68       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
    69       CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
    70       END SELECT 
    71       ijpjm1 = ijpj-1 
    72  
    73       DO jk = 1, jpk 
    74          ! 
    75          SELECT CASE ( npolj ) 
    76          ! 
    77          CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
    78             ! 
    79             SELECT CASE ( cd_type ) 
    80             CASE ( 'T' , 'W' )                         ! T-, W-point 
    81                DO ji = 2, jpiglo 
    82                   ijt = jpiglo-ji+2 
    83                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk) 
    84                END DO 
    85                pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk) 
    86                DO ji = jpiglo/2+1, jpiglo 
    87                   ijt = jpiglo-ji+2 
    88                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk) 
    89                END DO 
    90             CASE ( 'U' )                               ! U-point 
    91                DO ji = 1, jpiglo-1 
    92                   iju = jpiglo-ji+1 
    93                   pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk) 
    94                END DO 
    95                pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk) 
    96                pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk)  
    97                DO ji = jpiglo/2, jpiglo-1 
    98                   iju = jpiglo-ji+1 
    99                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk) 
    100                END DO 
    101             CASE ( 'V' )                               ! V-point 
    102                DO ji = 2, jpiglo 
    103                   ijt = jpiglo-ji+2 
    104                   pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk) 
    105                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk) 
    106                END DO 
    107                pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk)  
    108             CASE ( 'F' )                               ! F-point 
    109                DO ji = 1, jpiglo-1 
    110                   iju = jpiglo-ji+1 
    111                   pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk) 
    112                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk) 
    113                END DO 
    114                pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk) 
    115                pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk)  
    116             END SELECT 
    117             ! 
    118          CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
    119             ! 
    120             SELECT CASE ( cd_type ) 
    121             CASE ( 'T' , 'W' )                         ! T-, W-point 
    122                DO ji = 1, jpiglo 
    123                   ijt = jpiglo-ji+1 
    124                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk) 
    125                END DO 
    126             CASE ( 'U' )                               ! U-point 
    127                DO ji = 1, jpiglo-1 
    128                   iju = jpiglo-ji 
    129                   pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk) 
    130                END DO 
    131                pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk) 
    132             CASE ( 'V' )                               ! V-point 
    133                DO ji = 1, jpiglo 
    134                   ijt = jpiglo-ji+1 
    135                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk) 
    136                END DO 
    137                DO ji = jpiglo/2+1, jpiglo 
    138                   ijt = jpiglo-ji+1 
    139                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk) 
    140                END DO 
    141             CASE ( 'F' )                               ! F-point 
    142                DO ji = 1, jpiglo-1 
    143                   iju = jpiglo-ji 
    144                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk) 
    145                END DO 
    146                pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk) 
    147                DO ji = jpiglo/2+1, jpiglo-1 
    148                   iju = jpiglo-ji 
    149                   pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk) 
    150                END DO 
    151             END SELECT 
    152             ! 
    153          CASE DEFAULT                           ! *  closed : the code probably never go through 
    154             ! 
    155             SELECT CASE ( cd_type) 
    156             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    157                pt3d(:, 1  ,jk) = 0.e0 
    158                pt3d(:,ijpj,jk) = 0.e0 
    159             CASE ( 'F' )                               ! F-point 
    160                pt3d(:,ijpj,jk) = 0.e0 
    161             END SELECT 
    162             ! 
    163          END SELECT     !  npolj 
    164          ! 
    165       END DO 
    166       ! 
    167    END SUBROUTINE lbc_nfd_3d 
    168  
    169  
    170    SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj ) 
     63   !!---------------------------------------------------------------------- 
     64   !!                   ***  routine lbc_nfd_(2,3,4)d  *** 
     65   !!---------------------------------------------------------------------- 
     66   !! 
     67   !! ** Purpose :   lateral boundary condition  
     68   !!                North fold treatment without processor exchanges.  
     69   !! 
     70   !! ** Method  :    
     71   !! 
     72   !! ** Action  :   ptab with updated values along the north fold 
     73   !!---------------------------------------------------------------------- 
     74   ! 
     75   !                       !==  2D array and array of 2D pointer  ==! 
     76   ! 
     77#  define DIM_2d 
     78#     define ROUTINE_NFD           lbc_nfd_2d 
     79#     include "lbc_nfd_generic.h90" 
     80#     undef ROUTINE_NFD 
     81#     define MULTI 
     82#     define ROUTINE_NFD           lbc_nfd_2d_ptr 
     83#     include "lbc_nfd_generic.h90" 
     84#     undef ROUTINE_NFD 
     85#     undef MULTI 
     86#  undef DIM_2d 
     87   ! 
     88   !                       !==  3D array and array of 3D pointer  ==! 
     89   ! 
     90#  define DIM_3d 
     91#     define ROUTINE_NFD           lbc_nfd_3d 
     92#     include "lbc_nfd_generic.h90" 
     93#     undef ROUTINE_NFD 
     94#     define MULTI 
     95#     define ROUTINE_NFD           lbc_nfd_3d_ptr 
     96#     include "lbc_nfd_generic.h90" 
     97#     undef ROUTINE_NFD 
     98#     undef MULTI 
     99#  undef DIM_3d 
     100   ! 
     101   !                       !==  4D array and array of 4D pointer  ==! 
     102   ! 
     103#  define DIM_4d 
     104#     define ROUTINE_NFD           lbc_nfd_4d 
     105#     include "lbc_nfd_generic.h90" 
     106#     undef ROUTINE_NFD 
     107#     define MULTI 
     108#     define ROUTINE_NFD           lbc_nfd_4d_ptr 
     109#     include "lbc_nfd_generic.h90" 
     110#     undef ROUTINE_NFD 
     111#     undef MULTI 
     112#  undef DIM_4d 
     113   ! 
     114   !  lbc_nfd_nogather routines 
     115   ! 
     116   !                       !==  2D array and array of 2D pointer  ==! 
     117   ! 
     118!#  define DIM_2d 
     119!#     define ROUTINE_NFD           lbc_nfd_nogather_2d 
     120!#     include "lbc_nfd_nogather_generic.h90" 
     121!#     undef ROUTINE_NFD 
     122!#     define MULTI 
     123!#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr 
     124!#     include "lbc_nfd_nogather_generic.h90" 
     125!#     undef ROUTINE_NFD 
     126!#     undef MULTI 
     127!#  undef DIM_2d 
     128   ! 
     129   !                       !==  3D array and array of 3D pointer  ==! 
     130   ! 
     131!#  define DIM_3d 
     132!#     define ROUTINE_NFD           lbc_nfd_nogather_3d 
     133!#     include "lbc_nfd_nogather_generic.h90" 
     134!#     undef ROUTINE_NFD 
     135!#     define MULTI 
     136!#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr 
     137!#     include "lbc_nfd_nogather_generic.h90" 
     138!#     undef ROUTINE_NFD 
     139!#     undef MULTI 
     140!#  undef DIM_3d 
     141   ! 
     142   !                       !==  4D array and array of 4D pointer  ==! 
     143   ! 
     144#  define DIM_4d 
     145#     define ROUTINE_NFD           lbc_nfd_nogather_4d 
     146#     include "lbc_nfd_nogather_generic.h90" 
     147#     undef ROUTINE_NFD 
     148!#     define MULTI 
     149!#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr 
     150!#     include "lbc_nfd_nogather_generic.h90" 
     151!#     undef ROUTINE_NFD 
     152!#     undef MULTI 
     153#  undef DIM_4d 
     154 
     155   !!---------------------------------------------------------------------- 
     156 
     157 
     158!!gm   CAUTION HERE  optional pr2dj  not implemented in generic case 
     159!!gm                 furthermore, in the _org routine it is OK only for T-point pivot !! 
     160 
     161 
     162   SUBROUTINE lbc_nfd_2d_org( pt2d, cd_nat, psgn, pr2dj ) 
    171163      !!---------------------------------------------------------------------- 
    172164      !!                  ***  routine lbc_nfd_2d  *** 
     
    179171      !! ** Action  :   pt2d with updated values along the north fold 
    180172      !!---------------------------------------------------------------------- 
    181       CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points 
    182       !                                                      ! = T , U , V , F , W points 
    183       REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change 
    184       !                                                      !   = -1. , the sign is changed if north fold boundary 
    185       !                                                      !   =  1. , the sign is kept  if north fold boundary 
    186173      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied 
     174      CHARACTER(len=1)        , INTENT(in   ) ::   cd_nat   ! nature of pt2d grid-point 
     175      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
    187176      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos 
    188177      ! 
     
    210199      CASE ( 3, 4 )                       ! *  North fold  T-point pivot 
    211200         ! 
    212          SELECT CASE ( cd_type ) 
     201         SELECT CASE ( cd_nat ) 
    213202         ! 
    214203         CASE ( 'T' , 'W' )                               ! T- , W-points 
     
    265254               END DO 
    266255            END DO 
    267          CASE ( 'J' )                                     ! first ice U-V point 
    268             DO jl =0, ipr2dj 
    269                pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 
    270                DO ji = 3, jpiglo 
    271                   iju = jpiglo - ji + 3 
    272                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 
    273                END DO 
    274             END DO 
    275          CASE ( 'K' )                                     ! second ice U-V point 
    276             DO jl =0, ipr2dj 
    277                pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 
    278                DO ji = 3, jpiglo 
    279                   iju = jpiglo - ji + 3 
    280                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 
    281                END DO 
    282             END DO 
    283256         END SELECT 
    284257         ! 
    285258      CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
    286259         ! 
    287          SELECT CASE ( cd_type ) 
     260         SELECT CASE ( cd_nat ) 
    288261         CASE ( 'T' , 'W' )                               ! T-, W-point 
    289262            DO jl = 0, ipr2dj 
     
    325298            END DO 
    326299         CASE ( 'I' )                                  ! ice U-V point (I-point) 
    327             pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 
     300            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp 
    328301            DO jl = 0, ipr2dj 
    329302               DO ji = 2 , jpiglo-1 
     
    332305               END DO 
    333306            END DO 
    334          CASE ( 'J' )                                  ! first ice U-V point 
    335             pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 
    336             DO jl = 0, ipr2dj 
    337                DO ji = 2 , jpiglo-1 
    338                   ijt = jpiglo - ji + 2 
    339                   pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl) 
    340                END DO 
    341             END DO 
    342          CASE ( 'K' )                                  ! second ice U-V point 
    343             pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0 
    344             DO jl = 0, ipr2dj 
    345                DO ji = 2 , jpiglo-1 
    346                   ijt = jpiglo - ji + 2 
    347                   pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl) 
    348                END DO 
    349             END DO 
    350307         END SELECT 
    351308         ! 
    352309      CASE DEFAULT                           ! *  closed : the code probably never go through 
    353310         ! 
    354          SELECT CASE ( cd_type) 
     311         SELECT CASE ( cd_nat) 
    355312         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points 
    356             pt2d(:, 1:1-ipr2dj     ) = 0.e0 
    357             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
     313            pt2d(:, 1:1-ipr2dj     ) = 0._wp 
     314            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 
    358315         CASE ( 'F' )                                   ! F-point 
    359             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
     316            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 
    360317         CASE ( 'I' )                                   ! ice U-V point 
    361             pt2d(:, 1:1-ipr2dj     ) = 0.e0 
    362             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
    363          CASE ( 'J' )                                   ! first ice U-V point 
    364             pt2d(:, 1:1-ipr2dj     ) = 0.e0 
    365             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
    366          CASE ( 'K' )                                   ! second ice U-V point 
    367             pt2d(:, 1:1-ipr2dj     ) = 0.e0 
    368             pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 
     318            pt2d(:, 1:1-ipr2dj     ) = 0._wp 
     319            pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 
    369320         END SELECT 
    370321         ! 
    371322      END SELECT 
    372323      ! 
    373    END SUBROUTINE lbc_nfd_2d 
    374  
    375  
    376    SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn ) 
    377       !!---------------------------------------------------------------------- 
    378       !!                  ***  routine mpp_lbc_nfd_3d  *** 
    379       !! 
    380       !! ** Purpose :   3D lateral boundary condition : North fold treatment 
    381       !!              without processor exchanges.  
    382       !! 
    383       !! ** Method  :    
    384       !! 
    385       !! ** Action  :   pt3d with updated values along the north fold 
    386       !!---------------------------------------------------------------------- 
    387       CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points 
    388       !                                                        !   = T , U , V , F , W points 
    389       REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change 
    390       !                                                        !   = -1. , the sign is changed if north fold boundary 
    391       !                                                        !   =  1. , the sign is kept    if north fold boundary 
    392       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3dl     ! 3D array on which the boundary condition is applied 
    393       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pt3dr     ! 3D array on which the boundary condition is applied 
    394       ! 
    395       INTEGER  ::   ji, jk 
    396       INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
    397       !!---------------------------------------------------------------------- 
    398       ! 
    399       SELECT CASE ( jpni ) 
    400       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
    401       CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
    402       END SELECT 
    403       ijpjm1 = ijpj-1 
    404  
    405          ! 
    406          SELECT CASE ( npolj ) 
    407          ! 
    408          CASE ( 3 , 4 )                        ! *  North fold  T-point pivot 
    409             ! 
    410             SELECT CASE ( cd_type ) 
    411             CASE ( 'T' , 'W' )                         ! T-, W-point 
    412                IF (nimpp .ne. 1) THEN 
    413                  startloop = 1 
    414                ELSE 
    415                  startloop = 2 
    416                ENDIF 
    417  
    418                DO jk = 1, jpk 
    419                   DO ji = startloop, nlci 
    420                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    421                      pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    422                   END DO 
    423                   IF(nimpp .eq. 1) THEN 
    424                      pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 
    425                   ENDIF 
    426                END DO 
    427  
    428                IF(nimpp .ge. (jpiglo/2+1)) THEN 
    429                  startloop = 1 
    430                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
    431                  startloop = jpiglo/2+1 - nimpp + 1 
    432                ELSE 
    433                  startloop = nlci + 1 
    434                ENDIF 
    435                IF(startloop .le. nlci) THEN 
    436                  DO jk = 1, jpk 
    437                     DO ji = startloop, nlci 
    438                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    439                        jia = ji + nimpp - 1 
    440                        ijta = jpiglo - jia + 2 
    441                        IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN 
    442                           pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk) 
    443                        ELSE 
    444                           pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
    445                        ENDIF 
    446                     END DO 
    447                  END DO 
    448                ENDIF 
    449  
    450  
    451             CASE ( 'U' )                               ! U-point 
    452                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    453                   endloop = nlci 
    454                ELSE 
    455                   endloop = nlci - 1 
    456                ENDIF 
    457                DO jk = 1, jpk 
    458                   DO ji = 1, endloop 
    459                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    460                      pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    461                   END DO 
    462                   IF(nimpp .eq. 1) THEN 
    463                      pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk) 
    464                   ENDIF 
    465                   IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    466                      pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 
    467                   ENDIF 
    468                END DO 
    469  
    470                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    471                   endloop = nlci 
    472                ELSE 
    473                   endloop = nlci - 1 
    474                ENDIF 
    475                IF(nimpp .ge. (jpiglo/2)) THEN 
    476                   startloop = 1 
    477                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN 
    478                   startloop = jpiglo/2 - nimpp + 1 
    479                ELSE 
    480                   startloop = endloop + 1 
    481                ENDIF 
    482                IF (startloop .le. endloop) THEN 
    483                  DO jk = 1, jpk 
    484                     DO ji = startloop, endloop 
    485                       iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    486                       jia = ji + nimpp - 1 
    487                       ijua = jpiglo - jia + 1 
    488                       IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN 
    489                         pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk) 
    490                       ELSE 
    491                         pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
    492                       ENDIF 
    493                     END DO 
    494                  END DO 
    495                ENDIF 
    496  
    497             CASE ( 'V' )                               ! V-point 
    498                IF (nimpp .ne. 1) THEN 
    499                   startloop = 1 
    500                ELSE 
    501                   startloop = 2 
    502                ENDIF 
    503                DO jk = 1, jpk 
    504                   DO ji = startloop, nlci 
    505                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    506                      pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    507                      pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 
    508                   END DO 
    509                   IF(nimpp .eq. 1) THEN 
    510                      pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 
    511                   ENDIF 
    512                END DO 
    513             CASE ( 'F' )                               ! F-point 
    514                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    515                   endloop = nlci 
    516                ELSE 
    517                   endloop = nlci - 1 
    518                ENDIF 
    519                DO jk = 1, jpk 
    520                   DO ji = 1, endloop 
    521                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    522                      pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    523                      pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 
    524                   END DO 
    525                   IF(nimpp .eq. 1) THEN 
    526                      pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk) 
    527                   ENDIF 
    528                   IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    529                      pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 
    530                   ENDIF 
    531                END DO 
    532             END SELECT 
    533             ! 
    534  
    535          CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
    536             ! 
    537             SELECT CASE ( cd_type ) 
    538             CASE ( 'T' , 'W' )                         ! T-, W-point 
    539                DO jk = 1, jpk 
    540                   DO ji = 1, nlci 
    541                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    542                      pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 
    543                   END DO 
    544                END DO 
    545  
    546             CASE ( 'U' )                               ! U-point 
    547                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    548                   endloop = nlci 
    549                ELSE 
    550                   endloop = nlci - 1 
    551                ENDIF 
    552                DO jk = 1, jpk 
    553                   DO ji = 1, endloop 
    554                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    555                      pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 
    556                   END DO 
    557                   IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    558                      pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 
    559                   ENDIF 
    560                END DO 
    561  
    562             CASE ( 'V' )                               ! V-point 
    563                DO jk = 1, jpk 
    564                   DO ji = 1, nlci 
    565                      ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 
    566                      pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    567                   END DO 
    568                END DO 
    569  
    570                IF(nimpp .ge. (jpiglo/2+1)) THEN 
    571                   startloop = 1 
    572                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
    573                   startloop = jpiglo/2+1 - nimpp + 1 
    574                ELSE 
    575                   startloop = nlci + 1 
    576                ENDIF 
    577                IF(startloop .le. nlci) THEN 
    578                  DO jk = 1, jpk 
    579                     DO ji = startloop, nlci 
    580                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    581                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
    582                     END DO 
    583                  END DO 
    584                ENDIF 
    585  
    586             CASE ( 'F' )                               ! F-point 
    587                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    588                   endloop = nlci 
    589                ELSE 
    590                   endloop = nlci - 1 
    591                ENDIF 
    592                DO jk = 1, jpk 
    593                   DO ji = 1, endloop 
    594                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    595                      pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    596                   END DO 
    597                   IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    598                      pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 
    599                   ENDIF 
    600                END DO 
    601  
    602                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    603                   endloop = nlci 
    604                ELSE 
    605                   endloop = nlci - 1 
    606                ENDIF 
    607                IF(nimpp .ge. (jpiglo/2+1)) THEN 
    608                   startloop = 1 
    609                ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
    610                   startloop = jpiglo/2+1 - nimpp + 1 
    611                ELSE 
    612                   startloop = endloop + 1 
    613                ENDIF 
    614                IF (startloop .le. endloop) THEN 
    615                   DO jk = 1, jpk 
    616                      DO ji = startloop, endloop 
    617                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    618                         pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
    619                      END DO 
    620                   END DO 
    621                ENDIF 
    622  
    623             END SELECT 
    624  
    625          CASE DEFAULT                           ! *  closed : the code probably never go through 
    626             ! 
    627             SELECT CASE ( cd_type) 
    628             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    629                pt3dl(:, 1  ,jk) = 0.e0 
    630                pt3dl(:,ijpj,jk) = 0.e0 
    631             CASE ( 'F' )                               ! F-point 
    632                pt3dl(:,ijpj,jk) = 0.e0 
    633             END SELECT 
    634             ! 
    635          END SELECT     !  npolj 
    636          ! 
    637       ! 
    638    END SUBROUTINE mpp_lbc_nfd_3d 
    639  
    640  
    641    SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn ) 
    642       !!---------------------------------------------------------------------- 
    643       !!                  ***  routine mpp_lbc_nfd_2d  *** 
    644       !! 
    645       !! ** Purpose :   2D lateral boundary condition : North fold treatment 
    646       !!       without processor exchanges.  
    647       !! 
    648       !! ** Method  :    
    649       !! 
    650       !! ** Action  :   pt2d with updated values along the north fold 
    651       !!---------------------------------------------------------------------- 
    652       CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points 
    653       !                                                      ! = T , U , V , F , W points 
    654       REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change 
    655       !                                                      !   = -1. , the sign is changed if north fold boundary 
    656       !                                                      !   =  1. , the sign is kept  if north fold boundary 
    657       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2dl     ! 2D array on which the boundary condition is applied 
    658       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pt2dr     ! 2D array on which the boundary condition is applied 
    659       ! 
    660       INTEGER  ::   ji 
    661       INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 
    662       !!---------------------------------------------------------------------- 
    663  
    664       SELECT CASE ( jpni ) 
    665       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
    666       CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
    667       END SELECT 
    668       ! 
    669       ijpjm1 = ijpj-1 
    670  
    671  
    672       SELECT CASE ( npolj ) 
    673       ! 
    674       CASE ( 3, 4 )                       ! *  North fold  T-point pivot 
    675          ! 
    676          SELECT CASE ( cd_type ) 
    677          ! 
    678          CASE ( 'T' , 'W' )                               ! T- , W-points 
    679             IF (nimpp .ne. 1) THEN 
    680               startloop = 1 
    681             ELSE 
    682               startloop = 2 
    683             ENDIF 
    684             DO ji = startloop, nlci 
    685               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    686               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    687             END DO 
    688             IF (nimpp .eq. 1) THEN 
    689               pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2) 
    690             ENDIF 
    691  
    692             IF(nimpp .ge. (jpiglo/2+1)) THEN 
    693                startloop = 1 
    694             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
    695                startloop = jpiglo/2+1 - nimpp + 1 
    696             ELSE 
    697                startloop = nlci + 1 
    698             ENDIF 
    699             DO ji = startloop, nlci 
    700                ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    701                jia = ji + nimpp - 1 
    702                ijta = jpiglo - jia + 2 
    703                IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN 
    704                   pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1) 
    705                ELSE 
    706                   pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
    707                ENDIF 
    708             END DO 
    709  
    710          CASE ( 'U' )                                     ! U-point 
    711             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    712                endloop = nlci 
    713             ELSE 
    714                endloop = nlci - 1 
    715             ENDIF 
    716             DO ji = 1, endloop 
    717                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    718                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    719             END DO 
    720  
    721             IF (nimpp .eq. 1) THEN 
    722               pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2) 
    723               pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 
    724             ENDIF 
    725             IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    726               pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2) 
    727             ENDIF 
    728  
    729             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    730                endloop = nlci 
    731             ELSE 
    732                endloop = nlci - 1 
    733             ENDIF 
    734             IF(nimpp .ge. (jpiglo/2)) THEN 
    735                startloop = 1 
    736             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN 
    737                startloop = jpiglo/2 - nimpp + 1 
    738             ELSE 
    739                startloop = endloop + 1 
    740             ENDIF 
    741             DO ji = startloop, endloop 
    742                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    743                jia = ji + nimpp - 1 
    744                ijua = jpiglo - jia + 1 
    745                IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN 
    746                   pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1) 
    747                ELSE 
    748                   pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
    749                ENDIF 
    750             END DO 
    751  
    752          CASE ( 'V' )                                     ! V-point 
    753             IF (nimpp .ne. 1) THEN 
    754               startloop = 1 
    755             ELSE 
    756               startloop = 2 
    757             ENDIF 
    758             DO ji = startloop, nlci 
    759               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    760               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 
    761               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 
    762             END DO 
    763             IF (nimpp .eq. 1) THEN 
    764               pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3)  
    765             ENDIF 
    766  
    767          CASE ( 'F' )                                     ! F-point 
    768             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    769                endloop = nlci 
    770             ELSE 
    771                endloop = nlci - 1 
    772             ENDIF 
    773             DO ji = 1, endloop 
    774                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    775                pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 
    776                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 
    777             END DO 
    778             IF (nimpp .eq. 1) THEN 
    779               pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3) 
    780               pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2) 
    781             ENDIF 
    782             IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    783               pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3) 
    784               pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)  
    785             ENDIF 
    786  
    787          CASE ( 'I' )                                     ! ice U-V point (I-point) 
    788             IF (nimpp .ne. 1) THEN 
    789                startloop = 1 
    790             ELSE 
    791                startloop = 3 
    792                pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 
    793             ENDIF 
    794             DO ji = startloop, nlci 
    795                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    796                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    797             END DO 
    798  
    799          CASE ( 'J' )                                     ! first ice U-V point 
    800             IF (nimpp .ne. 1) THEN 
    801                startloop = 1 
    802             ELSE 
    803                startloop = 3 
    804                pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 
    805             ENDIF 
    806             DO ji = startloop, nlci 
    807                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    808                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    809             END DO 
    810  
    811          CASE ( 'K' )                                     ! second ice U-V point 
    812             IF (nimpp .ne. 1) THEN 
    813                startloop = 1 
    814             ELSE 
    815                startloop = 3 
    816                pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 
    817             ENDIF 
    818             DO ji = startloop, nlci 
    819                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    820                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    821             END DO 
    822  
    823          END SELECT 
    824          ! 
    825       CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
    826          ! 
    827          SELECT CASE ( cd_type ) 
    828          CASE ( 'T' , 'W' )                               ! T-, W-point 
    829             DO ji = 1, nlci 
    830                ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    831                pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 
    832             END DO 
    833  
    834          CASE ( 'U' )                                     ! U-point 
    835             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    836                endloop = nlci 
    837             ELSE 
    838                endloop = nlci - 1 
    839             ENDIF 
    840             DO ji = 1, endloop 
    841                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    842                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    843             END DO 
    844             IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    845                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 
    846             ENDIF 
    847  
    848          CASE ( 'V' )                                     ! V-point 
    849             DO ji = 1, nlci 
    850                ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    851                pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    852             END DO 
    853             IF(nimpp .ge. (jpiglo/2+1)) THEN 
    854                startloop = 1 
    855             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
    856                startloop = jpiglo/2+1 - nimpp + 1 
    857             ELSE 
    858                startloop = nlci + 1 
    859             ENDIF 
    860             DO ji = startloop, nlci 
    861                ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    862                pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
    863             END DO 
    864  
    865          CASE ( 'F' )                               ! F-point 
    866             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    867                endloop = nlci 
    868             ELSE 
    869                endloop = nlci - 1 
    870             ENDIF 
    871             DO ji = 1, endloop 
    872                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    873                pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    874             END DO 
    875             IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    876                 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 
    877             ENDIF 
    878  
    879             IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    880                endloop = nlci 
    881             ELSE 
    882                endloop = nlci - 1 
    883             ENDIF 
    884             IF(nimpp .ge. (jpiglo/2+1)) THEN 
    885                startloop = 1 
    886             ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 
    887                startloop = jpiglo/2+1 - nimpp + 1 
    888             ELSE 
    889                startloop = endloop + 1 
    890             ENDIF 
    891  
    892             DO ji = startloop, endloop 
    893                iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    894                pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
    895             END DO 
    896  
    897          CASE ( 'I' )                                  ! ice U-V point (I-point) 
    898                IF (nimpp .ne. 1) THEN 
    899                   startloop = 1 
    900                ELSE 
    901                   startloop = 2 
    902                ENDIF 
    903                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    904                   endloop = nlci 
    905                ELSE 
    906                   endloop = nlci - 1 
    907                ENDIF 
    908                DO ji = startloop , endloop 
    909                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    910                   pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    911                END DO 
    912  
    913          CASE ( 'J' )                                  ! first ice U-V point 
    914                IF (nimpp .ne. 1) THEN 
    915                   startloop = 1 
    916                ELSE 
    917                   startloop = 2 
    918                ENDIF 
    919                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    920                   endloop = nlci 
    921                ELSE 
    922                   endloop = nlci - 1 
    923                ENDIF 
    924                DO ji = startloop , endloop 
    925                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    926                   pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 
    927                END DO 
    928  
    929          CASE ( 'K' )                                  ! second ice U-V point 
    930                IF (nimpp .ne. 1) THEN 
    931                   startloop = 1 
    932                ELSE 
    933                   startloop = 2 
    934                ENDIF 
    935                IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    936                   endloop = nlci 
    937                ELSE 
    938                   endloop = nlci - 1 
    939                ENDIF 
    940                DO ji = startloop, endloop 
    941                   ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    942                   pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 
    943                END DO 
    944  
    945          END SELECT 
    946          ! 
    947       CASE DEFAULT                           ! *  closed : the code probably never go through 
    948          ! 
    949          SELECT CASE ( cd_type) 
    950          CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points 
    951             pt2dl(:, 1     ) = 0.e0 
    952             pt2dl(:,ijpj) = 0.e0 
    953          CASE ( 'F' )                                   ! F-point 
    954             pt2dl(:,ijpj) = 0.e0 
    955          CASE ( 'I' )                                   ! ice U-V point 
    956             pt2dl(:, 1     ) = 0.e0 
    957             pt2dl(:,ijpj) = 0.e0 
    958          CASE ( 'J' )                                   ! first ice U-V point 
    959             pt2dl(:, 1     ) = 0.e0 
    960             pt2dl(:,ijpj) = 0.e0 
    961          CASE ( 'K' )                                   ! second ice U-V point 
    962             pt2dl(:, 1     ) = 0.e0 
    963             pt2dl(:,ijpj) = 0.e0 
    964          END SELECT 
    965          ! 
    966       END SELECT 
    967       ! 
    968    END SUBROUTINE mpp_lbc_nfd_2d 
     324   END SUBROUTINE lbc_nfd_2d_org 
    969325 
    970326   !!====================================================================== 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r8733 r8738  
    88   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
    99   !!                 !  1998  (J.M. Molines) Open boundary conditions 
    10    !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form 
     10   !!   NEMO     1.0  !  2003  (J.M. Molines, G. Madec)  F90, free form 
    1111   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d) 
    1212   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi 
     
    1919   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
    2020   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager 
    21    !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d',  
    22    !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update 
    23    !!                          the mppobc routine to optimize the BDY and OBC communications 
    24    !!            3.5  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables  
     21   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm. 
     22   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables  
    2523   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 
    26    !!            3.6  !  2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple'  
     24   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max 
     25   !!            4.0  !  2017  (G. Madec) automatique allocation of array argument (use any 3rd dimension) 
     26   !!             -   !  2017  (G. Madec) create generic.h90 files to generate all lbc and north fold routines 
    2727   !!---------------------------------------------------------------------- 
    2828 
     
    4141   !!   mynode        : indentify the processor unit 
    4242   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 
    43    !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays 
    4443   !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
    4544   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 
    4645   !!   mpprecv       : 
    47    !!   mppsend       :   SUBROUTINE mpp_ini_znl 
     46   !!   mppsend       : 
    4847   !!   mppscatter    : 
    4948   !!   mppgather     : 
     
    5655   !!   mppstop       : 
    5756   !!   mpp_ini_north : initialisation of north fold 
    58    !!   mpp_lbc_north : north fold processors gathering 
     57!!gm   !!   mpp_lbc_north : north fold processors gathering 
    5958   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 
    6059   !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs 
     
    6766   IMPLICIT NONE 
    6867   PRIVATE 
    69     
     68 
     69   INTERFACE mpp_nfd 
     70      MODULE PROCEDURE   mpp_nfd_2d      , mpp_nfd_3d      , mpp_nfd_4d 
     71      MODULE PROCEDURE   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr 
     72   END INTERFACE 
     73 
     74   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk 
     75   PUBLIC   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d 
     76   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 
     77   PUBLIC   mpp_lnk_2d_e 
     78   ! 
     79!!gm  this should be useless 
     80   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d 
     81   PUBLIC   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr 
     82!!gm end 
     83   ! 
    7084   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam 
    7185   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free 
    72    PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 
     86   PUBLIC   mpp_ini_north, mpp_lbc_north_e 
     87!!gm   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 
     88   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
    7389   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    7490   PUBLIC   mpp_max_multiple 
    75    PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    76    PUBLIC   mpp_lnk_2d_9 , mpp_lnk_2d_multiple  
    77    PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     91!!gm   PUBLIC   mpp_lnk_2d_9  
     92!!gm   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    7893   PUBLIC   mppscatter, mppgather 
    7994   PUBLIC   mpp_ini_ice, mpp_ini_znl 
     
    8196   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    8297   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    83    PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
    8498   PUBLIC   mpprank 
    85  
    86    TYPE arrayptr 
    87       REAL , DIMENSION (:,:),  POINTER :: pt2d 
    88    END TYPE arrayptr 
    89    PUBLIC   arrayptr 
    9099    
    91100   !! * Interfaces 
     
    101110   INTERFACE mpp_sum 
    102111      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   & 
    103                        mppsum_realdd, mppsum_a_realdd 
     112         &             mppsum_realdd, mppsum_a_realdd 
    104113   END INTERFACE 
    105    INTERFACE mpp_lbc_north 
    106       MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
    107    END INTERFACE 
     114!!gm   INTERFACE mpp_lbc_north 
     115!!gm      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
     116!!gm   END INTERFACE 
    108117   INTERFACE mpp_minloc 
    109118      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 
     
    112121      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
    113122   END INTERFACE 
    114  
    115123   INTERFACE mpp_max_multiple 
    116124      MODULE PROCEDURE mppmax_real_multiple 
     
    137145 
    138146   ! variables used in case of sea-ice 
    139    INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd) 
    140    INTEGER ::   ngrp_iworld     !  group ID for the world processors (for rheology) 
    141    INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology) 
    142    INTEGER ::   ndim_rank_ice   !  number of 'ice' processors 
    143    INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm 
     147   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in icethd) 
     148   INTEGER         ::   ngrp_iworld     !  group ID for the world processors (for rheology) 
     149   INTEGER         ::   ngrp_ice        !  group ID for the ice processors (for rheology) 
     150   INTEGER         ::   ndim_rank_ice   !  number of 'ice' processors 
     151   INTEGER         ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm 
    144152   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice 
    145153 
    146154   ! variables used for zonal integration 
    147155   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average 
    148    LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row 
    149    INTEGER ::   ngrp_znl        ! group ID for the znl processors 
    150    INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average 
     156   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row 
     157   INTEGER         ::   ngrp_znl        ! group ID for the znl processors 
     158   INTEGER         ::   ndim_rank_znl   ! number of processors on the same zonal average 
    151159   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
    152160 
    153161   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) 
    154    INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors 
    155    INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors 
    156    INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold) 
    157    INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north 
    158    INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !) 
    159    INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line 
    160    INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm 
    161    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC ::   nrank_north   ! dimension ndim_rank_north 
     162   INTEGER, PUBLIC ::   ngrp_world        !: group ID for the world processors 
     163   INTEGER, PUBLIC ::   ngrp_opa          !: group ID for the opa processors 
     164   INTEGER, PUBLIC ::   ngrp_north        !: group ID for the northern processors (to be fold) 
     165   INTEGER, PUBLIC ::   ncomm_north       !: communicator made by the processors belonging to ngrp_north 
     166   INTEGER, PUBLIC ::   ndim_rank_north   !: number of 'sea' processor in the northern line (can be /= jpni !) 
     167   INTEGER, PUBLIC ::   njmppmax          !: value of njmpp for the processors of the northern line 
     168   INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm 
     169   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north 
    162170 
    163171   ! Type of send : standard, buffered, immediate 
    164    CHARACTER(len=1), PUBLIC ::   cn_mpi_send   ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    165    LOGICAL, PUBLIC          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
    166    INTEGER, PUBLIC          ::   nn_buffer     ! size of the buffer in case of mpi_bsend 
    167  
    168    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend 
    169  
    170    LOGICAL, PUBLIC                                  ::   ln_nnogather       ! namelist control of northfold comms 
    171    LOGICAL, PUBLIC                                  ::   l_north_nogather = .FALSE.  ! internal control of northfold comms 
    172    INTEGER, PUBLIC                                  ::   ityp 
    173    !!---------------------------------------------------------------------- 
    174    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     172   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend) 
     173   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I') 
     174   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend 
     175 
     176   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
     177 
     178   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms 
     179   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms 
     180 
     181   !!---------------------------------------------------------------------- 
     182   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    175183   !! $Id$ 
    176184   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    178186CONTAINS 
    179187 
    180  
    181    FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 
     188   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm ) 
    182189      !!---------------------------------------------------------------------- 
    183190      !!                  ***  routine mynode  *** 
     
    204211      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1 
    205212      ! 
    206  
    207213      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables 
    208214      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901) 
    209215901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp ) 
    210  
     216      ! 
    211217      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables 
    212218      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 
    213219902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 
    214  
     220      ! 
    215221      !                              ! control print 
    216222      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1 
    217223      WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1 
    218224      WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1 
    219  
     225      ! 
    220226#if defined key_agrif 
    221227      IF( .NOT. Agrif_Root() ) THEN 
     
    225231      ENDIF 
    226232#endif 
    227  
    228       IF(jpnij < 1)THEN 
    229          ! If jpnij is not specified in namelist then we calculate it - this 
    230          ! means there will be no land cutting out. 
    231          jpnij = jpni * jpnj 
    232       END IF 
    233  
    234       IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
     233      ! 
     234      IF( jpnij < 1 ) THEN         ! If jpnij is not specified in namelist then we calculate it 
     235         jpnij = jpni * jpnj       ! this means there will be no land cutting out. 
     236      ENDIF 
     237 
     238      IF( jpni < 1 .OR. jpnj < 1  ) THEN 
    235239         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij will be calculated automatically' ;   ii = ii + 1 
    236240      ELSE 
     
    238242         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1 
    239243         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij      ;   ii = ii + 1 
    240       END IF 
     244      ENDIF 
    241245 
    242246      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1 
     
    268272            kstop = kstop + 1 
    269273         END SELECT 
    270       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     274         ! 
     275      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN 
    271276         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1 
    272277         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1 
     
    309314 
    310315#if defined key_agrif 
    311       IF (Agrif_Root()) THEN 
     316      IF( Agrif_Root() ) THEN 
    312317         CALL Agrif_MPI_Init(mpi_comm_opa) 
    313318      ELSE 
     
    329334   END FUNCTION mynode 
    330335 
    331  
    332    SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    333       !!---------------------------------------------------------------------- 
    334       !!                  ***  routine mpp_lnk_3d  *** 
    335       !! 
    336       !! ** Purpose :   Message passing manadgement 
    337       !! 
    338       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    339       !!      between processors following neighboring subdomains. 
    340       !!            domain parameters 
    341       !!                    nlci   : first dimension of the local subdomain 
    342       !!                    nlcj   : second dimension of the local subdomain 
    343       !!                    nbondi : mark for "east-west local boundary" 
    344       !!                    nbondj : mark for "north-south local boundary" 
    345       !!                    noea   : number for local neighboring processors 
    346       !!                    nowe   : number for local neighboring processors 
    347       !!                    noso   : number for local neighboring processors 
    348       !!                    nono   : number for local neighboring processors 
    349       !! 
    350       !! ** Action  :   ptab with update value at its periphery 
    351       !! 
    352       !!---------------------------------------------------------------------- 
    353       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    354       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    355       !                                                             ! = T , U , V , F , W points 
    356       REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    357       !                                                             ! =  1. , the sign is kept 
    358       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    359       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    360       ! 
    361       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    362       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    363       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    364       REAL(wp) ::   zland 
    365       INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend 
    366       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
    367       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    368       !!---------------------------------------------------------------------- 
    369        
    370       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    371          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    372  
    373       ! 
    374       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    375       ELSE                         ;   zland = 0._wp     ! zero by default 
    376       ENDIF 
    377  
    378       ! 1. standard boundary treatment 
    379       ! ------------------------------ 
    380       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    381          ! 
    382          ! WARNING ptab is defined only between nld and nle 
    383          DO jk = 1, jpk 
    384             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    385                ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk) 
    386                ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk) 
    387                ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk) 
    388             END DO 
    389             DO ji = nlci+1, jpi                 ! added column(s) (full) 
    390                ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk) 
    391                ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk) 
    392                ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk) 
    393             END DO 
    394          END DO 
    395          ! 
    396       ELSE                              ! standard close or cyclic treatment 
    397          ! 
    398          !                                   ! East-West boundaries 
    399          !                                        !* Cyclic east-west 
    400          IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    401             ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    402             ptab(jpi,:,:) = ptab(  2  ,:,:) 
    403          ELSE                                     !* closed 
    404             IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    405                                          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    406          ENDIF 
    407                                           ! North-south cyclic 
    408          IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude 
    409             ptab(:,1 , :) = ptab(:, jpjm1,:) 
    410             ptab(:,jpj,:) = ptab(:,     2,:) 
    411          ELSE   !                                   ! North-South boundaries (closed) 
    412             IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    413                                          ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    414          ENDIF 
    415          ! 
    416       ENDIF 
    417  
    418       ! 2. East and west directions exchange 
    419       ! ------------------------------------ 
    420       ! we play with the neigbours AND the row number because of the periodicity 
    421       ! 
    422       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    423       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    424          iihom = nlci-nreci 
    425          DO jl = 1, jpreci 
    426             zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
    427             zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    428          END DO 
    429       END SELECT 
    430       ! 
    431       !                           ! Migrations 
    432       imigr = jpreci * jpj * jpk 
    433       ! 
    434       SELECT CASE ( nbondi ) 
    435       CASE ( -1 ) 
    436          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
    437          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    438          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    439       CASE ( 0 ) 
    440          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    441          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 
    442          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    443          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    444          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    445          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    446       CASE ( 1 ) 
    447          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    448          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    449          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    450       END SELECT 
    451       ! 
    452       !                           ! Write Dirichlet lateral conditions 
    453       iihom = nlci-jpreci 
    454       ! 
    455       SELECT CASE ( nbondi ) 
    456       CASE ( -1 ) 
    457          DO jl = 1, jpreci 
    458             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    459          END DO 
    460       CASE ( 0 ) 
    461          DO jl = 1, jpreci 
    462             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    463             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    464          END DO 
    465       CASE ( 1 ) 
    466          DO jl = 1, jpreci 
    467             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    468          END DO 
    469       END SELECT 
    470  
    471       ! 3. North and south directions 
    472       ! ----------------------------- 
    473       ! always closed : we play only with the neigbours 
    474       ! 
    475       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    476          ijhom = nlcj-nrecj 
    477          DO jl = 1, jprecj 
    478             zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
    479             zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
    480          END DO 
    481       ENDIF 
    482       ! 
    483       !                           ! Migrations 
    484       imigr = jprecj * jpi * jpk 
    485       ! 
    486       SELECT CASE ( nbondj ) 
    487       CASE ( -1 ) 
    488          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    489          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    490          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    491       CASE ( 0 ) 
    492          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    493          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 
    494          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    495          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    496          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    497          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    498       CASE ( 1 ) 
    499          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    500          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    501          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    502       END SELECT 
    503       ! 
    504       !                           ! Write Dirichlet lateral conditions 
    505       ijhom = nlcj-jprecj 
    506       ! 
    507       SELECT CASE ( nbondj ) 
    508       CASE ( -1 ) 
    509          DO jl = 1, jprecj 
    510             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    511          END DO 
    512       CASE ( 0 ) 
    513          DO jl = 1, jprecj 
    514             ptab(:,jl      ,:) = zt3sn(:,jl,:,2) 
    515             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    516          END DO 
    517       CASE ( 1 ) 
    518          DO jl = 1, jprecj 
    519             ptab(:,jl,:) = zt3sn(:,jl,:,2) 
    520          END DO 
    521       END SELECT 
    522  
    523       ! 4. north fold treatment 
    524       ! ----------------------- 
    525       ! 
    526       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    527          ! 
    528          SELECT CASE ( jpni ) 
    529          CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
    530          CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
    531          END SELECT 
    532          ! 
    533       ENDIF 
    534       ! 
    535       DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    536       ! 
    537    END SUBROUTINE mpp_lnk_3d 
    538  
    539  
    540    SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) 
    541       !!---------------------------------------------------------------------- 
    542       !!                  ***  routine mpp_lnk_2d_multiple  *** 
    543       !! 
    544       !! ** Purpose :   Message passing management for multiple 2d arrays 
    545       !! 
    546       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    547       !!      between processors following neighboring subdomains. 
    548       !!            domain parameters 
    549       !!                    nlci   : first dimension of the local subdomain 
    550       !!                    nlcj   : second dimension of the local subdomain 
    551       !!                    nbondi : mark for "east-west local boundary" 
    552       !!                    nbondj : mark for "north-south local boundary" 
    553       !!                    noea   : number for local neighboring processors 
    554       !!                    nowe   : number for local neighboring processors 
    555       !!                    noso   : number for local neighboring processors 
    556       !!                    nono   : number for local neighboring processors 
    557       !!---------------------------------------------------------------------- 
    558       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
    559       !                                                               ! = T , U , V , F , W and I points 
    560       REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
    561       !                                                               ! =  1. , the sign is kept 
    562       CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only 
    563       REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries) 
    564       !! 
    565       INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    566       INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
    567       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    568       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    569       INTEGER :: num_fields 
    570       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    571       REAL(wp) ::   zland 
    572       INTEGER , DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat       ! for key_mpi_isend 
    573       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    574       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    575  
    576       !!---------------------------------------------------------------------- 
    577       ! 
    578       ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  & 
    579          &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   ) 
    580       ! 
    581       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    582       ELSE                         ;   zland = 0._wp     ! zero by default 
    583       ENDIF 
    584  
    585       ! 1. standard boundary treatment 
    586       ! ------------------------------ 
    587       ! 
    588       !First Array 
    589       DO ii = 1 , num_fields 
    590          IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    591             ! 
    592             ! WARNING pt2d is defined only between nld and nle 
    593             DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    594                pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej) 
    595                pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej) 
    596                pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej)  
    597             END DO 
    598             DO ji = nlci+1, jpi                 ! added column(s) (full) 
    599                pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej) 
    600                pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     ) 
    601                pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej) 
    602             END DO 
    603             ! 
    604          ELSE                              ! standard close or cyclic treatment 
    605             ! 
    606             !                                   ! East-West boundaries 
    607             IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
    608                &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    609                pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west 
    610                pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east 
    611             ELSE                                     ! closed 
    612                IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point 
    613                                                    pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north 
    614             ENDIF 
    615                                                 ! Noth-South boundaries 
    616             IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
    617                pt2d_array(ii)%pt2d(:, 1   ) =   pt2d_array(ii)%pt2d(:, jpjm1 ) 
    618                pt2d_array(ii)%pt2d(:, jpj ) =   pt2d_array(ii)%pt2d(:, 2 )           
    619             ELSE   !              
    620                !                                   ! North-South boundaries (closed) 
    621                IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point 
    622                                                    pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north 
    623             ! 
    624             ENDIF 
    625           ENDIF 
    626       END DO 
    627  
    628       ! 2. East and west directions exchange 
    629       ! ------------------------------------ 
    630       ! we play with the neigbours AND the row number because of the periodicity 
    631       ! 
    632       DO ii = 1 , num_fields 
    633          SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    634          CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    635             iihom = nlci-nreci 
    636             DO jl = 1, jpreci 
    637                zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : ) 
    638                zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : ) 
    639             END DO 
    640          END SELECT 
    641       END DO 
    642       ! 
    643       !                           ! Migrations 
    644       imigr = jpreci * jpj 
    645       ! 
    646       SELECT CASE ( nbondi ) 
    647       CASE ( -1 ) 
    648          CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 ) 
    649          CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 
    650          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    651       CASE ( 0 ) 
    652          CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 
    653          CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 ) 
    654          CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 
    655          CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 
    656          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    657          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    658       CASE ( 1 ) 
    659          CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 
    660          CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 
    661          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    662       END SELECT 
    663       ! 
    664       !                           ! Write Dirichlet lateral conditions 
    665       iihom = nlci - jpreci 
    666       ! 
    667  
    668       DO ii = 1 , num_fields 
    669          SELECT CASE ( nbondi ) 
    670          CASE ( -1 ) 
    671             DO jl = 1, jpreci 
    672                pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 
    673             END DO 
    674          CASE ( 0 ) 
    675             DO jl = 1, jpreci 
    676                pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii) 
    677                pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 
    678             END DO 
    679          CASE ( 1 ) 
    680             DO jl = 1, jpreci 
    681                pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii) 
    682             END DO 
    683          END SELECT 
    684       END DO 
    685        
    686       ! 3. North and south directions 
    687       ! ----------------------------- 
    688       ! always closed : we play only with the neigbours 
    689       ! 
    690       !First Array 
    691       DO ii = 1 , num_fields 
    692          IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    693             ijhom = nlcj-nrecj 
    694             DO jl = 1, jprecj 
    695                zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl ) 
    696                zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl ) 
    697             END DO 
    698          ENDIF 
    699       END DO 
    700       ! 
    701       !                           ! Migrations 
    702       imigr = jprecj * jpi 
    703       ! 
    704       SELECT CASE ( nbondj ) 
    705       CASE ( -1 ) 
    706          CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 ) 
    707          CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 
    708          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    709       CASE ( 0 ) 
    710          CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 
    711          CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 ) 
    712          CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 
    713          CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 
    714          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    715          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    716       CASE ( 1 ) 
    717          CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 
    718          CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 
    719          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    720       END SELECT 
    721       ! 
    722       !                           ! Write Dirichlet lateral conditions 
    723       ijhom = nlcj - jprecj 
    724       ! 
    725  
    726       DO ii = 1 , num_fields 
    727          !First Array 
    728          SELECT CASE ( nbondj ) 
    729          CASE ( -1 ) 
    730             DO jl = 1, jprecj 
    731                pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii ) 
    732             END DO 
    733          CASE ( 0 ) 
    734             DO jl = 1, jprecj 
    735                pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii) 
    736                pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii ) 
    737             END DO 
    738          CASE ( 1 ) 
    739             DO jl = 1, jprecj 
    740                pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii ) 
    741             END DO 
    742          END SELECT 
    743       END DO 
    744        
    745       ! 4. north fold treatment 
    746       ! ----------------------- 
    747       ! 
    748          !First Array 
    749       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    750          ! 
    751          SELECT CASE ( jpni ) 
    752          CASE ( 1 )     ;    
    753              DO ii = 1 , num_fields   
    754                        CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp 
    755              END DO 
    756          CASE DEFAULT   ;   CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields )   ! for all northern procs. 
    757          END SELECT 
    758          ! 
    759       ENDIF 
    760         ! 
    761       ! 
    762       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    763       ! 
    764    END SUBROUTINE mpp_lnk_2d_multiple 
    765  
    766     
    767    SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields ) 
    768       !!--------------------------------------------------------------------- 
    769       REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied 
    770       CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points 
    771       REAL(wp)                            , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary 
    772       TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
    773       CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
    774       REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
    775       INTEGER                            , INTENT (inout) :: num_fields  
    776       !!--------------------------------------------------------------------- 
    777       num_fields = num_fields + 1 
    778       pt2d_array(num_fields)%pt2d => pt2d 
    779       type_array(num_fields)      =  cd_type 
    780       psgn_array(num_fields)      =  psgn 
    781    END SUBROUTINE load_array 
     336   !!---------------------------------------------------------------------- 
     337   !!                   ***  routine mpp_lnk_(2,3,4)d  *** 
     338   !! 
     339   !!   * Argument : dummy argument use in mpp_lnk_... routines 
     340   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
     341   !!                cd_nat :   nature of array grid-points 
     342   !!                psgn   :   sign used across the north fold boundary 
     343   !!                kfld   :   optional, number of pt3d arrays 
     344   !!                cd_mpp :   optional, fill the overlap area only 
     345   !!                pval   :   optional, background value (used at closed boundaries) 
     346   !!---------------------------------------------------------------------- 
     347   ! 
     348   !                       !==  2D array and array of 2D pointer  ==! 
     349   ! 
     350#  define DIM_2d 
     351#     define ROUTINE_LNK           mpp_lnk_2d 
     352#     include "mpp_lnk_generic.h90" 
     353#     undef ROUTINE_LNK 
     354#     define MULTI 
     355#     define ROUTINE_LNK           mpp_lnk_2d_ptr 
     356#     include "mpp_lnk_generic.h90" 
     357#     undef ROUTINE_LNK 
     358#     undef MULTI 
     359#  undef DIM_2d 
     360   ! 
     361   !                       !==  3D array and array of 3D pointer  ==! 
     362   ! 
     363#  define DIM_3d 
     364#     define ROUTINE_LNK           mpp_lnk_3d 
     365#     include "mpp_lnk_generic.h90" 
     366#     undef ROUTINE_LNK 
     367#     define MULTI 
     368#     define ROUTINE_LNK           mpp_lnk_3d_ptr 
     369#     include "mpp_lnk_generic.h90" 
     370#     undef ROUTINE_LNK 
     371#     undef MULTI 
     372#  undef DIM_3d 
     373   ! 
     374   !                       !==  4D array and array of 4D pointer  ==! 
     375   ! 
     376#  define DIM_4d 
     377#     define ROUTINE_LNK           mpp_lnk_4d 
     378#     include "mpp_lnk_generic.h90" 
     379#     undef ROUTINE_LNK 
     380#     define MULTI 
     381#     define ROUTINE_LNK           mpp_lnk_4d_ptr 
     382#     include "mpp_lnk_generic.h90" 
     383#     undef ROUTINE_LNK 
     384#     undef MULTI 
     385#  undef DIM_4d 
     386 
     387   !!---------------------------------------------------------------------- 
     388   !!                   ***  routine mpp_nfd_(2,3,4)d  *** 
     389   !! 
     390   !!   * Argument : dummy argument use in mpp_nfd_... routines 
     391   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
     392   !!                cd_nat :   nature of array grid-points 
     393   !!                psgn   :   sign used across the north fold boundary 
     394   !!                kfld   :   optional, number of pt3d arrays 
     395   !!                cd_mpp :   optional, fill the overlap area only 
     396   !!                pval   :   optional, background value (used at closed boundaries) 
     397   !!---------------------------------------------------------------------- 
     398   ! 
     399   !                       !==  2D array and array of 2D pointer  ==! 
     400   ! 
     401#  define DIM_2d 
     402#     define ROUTINE_NFD           mpp_nfd_2d 
     403#     include "mpp_nfd_generic.h90" 
     404#     undef ROUTINE_NFD 
     405#     define MULTI 
     406#     define ROUTINE_NFD           mpp_nfd_2d_ptr 
     407#     include "mpp_nfd_generic.h90" 
     408#     undef ROUTINE_NFD 
     409#     undef MULTI 
     410#  undef DIM_2d 
     411   ! 
     412   !                       !==  3D array and array of 3D pointer  ==! 
     413   ! 
     414#  define DIM_3d 
     415#     define ROUTINE_NFD           mpp_nfd_3d 
     416#     include "mpp_nfd_generic.h90" 
     417#     undef ROUTINE_NFD 
     418#     define MULTI 
     419#     define ROUTINE_NFD           mpp_nfd_3d_ptr 
     420#     include "mpp_nfd_generic.h90" 
     421#     undef ROUTINE_NFD 
     422#     undef MULTI 
     423#  undef DIM_3d 
     424   ! 
     425   !                       !==  4D array and array of 4D pointer  ==! 
     426   ! 
     427#  define DIM_4d 
     428#     define ROUTINE_NFD           mpp_nfd_4d 
     429#     include "mpp_nfd_generic.h90" 
     430#     undef ROUTINE_NFD 
     431#     define MULTI 
     432#     define ROUTINE_NFD           mpp_nfd_4d_ptr 
     433#     include "mpp_nfd_generic.h90" 
     434#     undef ROUTINE_NFD 
     435#     undef MULTI 
     436#  undef DIM_4d 
     437 
     438 
     439   !!---------------------------------------------------------------------- 
     440   !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  *** 
     441   !! 
     442   !!   * Argument : dummy argument use in mpp_lnk_... routines 
     443   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
     444   !!                cd_nat :   nature of array grid-points 
     445   !!                psgn   :   sign used across the north fold boundary 
     446   !!                kb_bdy :   BDY boundary set 
     447   !!                kfld   :   optional, number of pt3d arrays 
     448   !!---------------------------------------------------------------------- 
     449   ! 
     450   !                       !==  2D array and array of 2D pointer  ==! 
     451   ! 
     452#  define DIM_2d 
     453#     define ROUTINE_BDY           mpp_lnk_bdy_2d 
     454#     include "mpp_bdy_generic.h90" 
     455#     undef ROUTINE_BDY 
     456#     define MULTI 
     457#     define ROUTINE_BDY           mpp_lnk_bdy_2d_ptr 
     458#     include "mpp_bdy_generic.h90" 
     459#     undef ROUTINE_BDY 
     460#     undef MULTI 
     461#  undef DIM_2d 
     462   ! 
     463   !                       !==  3D array and array of 3D pointer  ==! 
     464   ! 
     465#  define DIM_3d 
     466#     define ROUTINE_BDY           mpp_lnk_bdy_3d 
     467#     include "mpp_bdy_generic.h90" 
     468#     undef ROUTINE_BDY 
     469#     define MULTI 
     470#     define ROUTINE_BDY           mpp_lnk_bdy_3d_ptr 
     471#     include "mpp_bdy_generic.h90" 
     472#     undef ROUTINE_BDY 
     473#     undef MULTI 
     474#  undef DIM_3d 
     475   ! 
     476   !                       !==  4D array and array of 4D pointer  ==! 
     477   ! 
     478!!#  define DIM_4d 
     479!!#     define ROUTINE_BDY           mpp_lnk_bdy_4d 
     480!!#     include "mpp_bdy_generic.h90" 
     481!!#     undef ROUTINE_BDY 
     482!!#     define MULTI 
     483!!#     define ROUTINE_BDY           mpp_lnk_bdy_4d_ptr 
     484!!#     include "mpp_bdy_generic.h90" 
     485!!#     undef ROUTINE_BDY 
     486!!#     undef MULTI 
     487!!#  undef DIM_4d 
     488 
     489   !!---------------------------------------------------------------------- 
     490   !! 
     491   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D 
    782492    
    783493    
    784    SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
    785       &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
    786       &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
    787       !!--------------------------------------------------------------------- 
    788       ! Second 2D array on which the boundary condition is applied 
    789       REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA     
    790       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
    791       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI  
    792       ! define the nature of ptab array grid-points 
    793       CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
    794       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
    795       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
    796       ! =-1 the sign change across the north fold boundary 
    797       REAL(wp)                                      , INTENT(in   ) ::   psgnA     
    798       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
    799       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI    
    800       CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    801       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    802       !! 
    803       TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array  
    804       CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points 
    805       !                                                         ! = T , U , V , F , W and I points 
    806       REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary 
    807       INTEGER :: num_fields 
    808       !!--------------------------------------------------------------------- 
    809       ! 
    810       num_fields = 0 
    811       ! 
    812       ! Load the first array 
    813       CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields ) 
    814       ! 
    815       ! Look if more arrays are added 
    816       IF( PRESENT(psgnB) )   CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 
    817       IF( PRESENT(psgnC) )   CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 
    818       IF( PRESENT(psgnD) )   CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 
    819       IF( PRESENT(psgnE) )   CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 
    820       IF( PRESENT(psgnF) )   CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 
    821       IF( PRESENT(psgnG) )   CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 
    822       IF( PRESENT(psgnH) )   CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 
    823       IF( PRESENT(psgnI) )   CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 
    824       ! 
    825       CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval ) 
    826       ! 
    827    END SUBROUTINE mpp_lnk_2d_9 
    828  
    829  
    830    SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    831       !!---------------------------------------------------------------------- 
    832       !!                  ***  routine mpp_lnk_2d  *** 
    833       !! 
    834       !! ** Purpose :   Message passing manadgement for 2d array 
    835       !! 
    836       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    837       !!      between processors following neighboring subdomains. 
    838       !!            domain parameters 
    839       !!                    nlci   : first dimension of the local subdomain 
    840       !!                    nlcj   : second dimension of the local subdomain 
    841       !!                    nbondi : mark for "east-west local boundary" 
    842       !!                    nbondj : mark for "north-south local boundary" 
    843       !!                    noea   : number for local neighboring processors 
    844       !!                    nowe   : number for local neighboring processors 
    845       !!                    noso   : number for local neighboring processors 
    846       !!                    nono   : number for local neighboring processors 
    847       !! 
    848       !!---------------------------------------------------------------------- 
    849       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
    850       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    851       !                                                         ! = T , U , V , F , W and I points 
    852       REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    853       !                                                         ! =  1. , the sign is kept 
    854       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    855       REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    856       !! 
    857       INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    858       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    859       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    860       REAL(wp) ::   zland 
    861       INTEGER, DIMENSION(MPI_STATUS_SIZE)     ::   ml_stat       ! for key_mpi_isend 
    862       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    863       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    864       !!---------------------------------------------------------------------- 
    865       ! 
    866       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
    867          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    868       ! 
    869       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    870       ELSE                         ;   zland = 0._wp     ! zero by default 
    871       ENDIF 
    872  
    873       ! 1. standard boundary treatment 
    874       ! ------------------------------ 
    875       ! 
    876       IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values 
    877          ! 
    878          ! WARNING pt2d is defined only between nld and nle 
    879          DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    880             pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej) 
    881             pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej) 
    882             pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej) 
    883          END DO 
    884          DO ji = nlci+1, jpi                 ! added column(s) (full) 
    885             pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej) 
    886             pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     ) 
    887             pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej) 
    888          END DO 
    889          ! 
    890       ELSE                              ! standard close or cyclic treatment 
    891          ! 
    892          !                                   ! East-West boundaries 
    893          IF( nbondi == 2 .AND.   &                ! Cyclic east-west 
    894             &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    895             pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west 
    896             pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east 
    897          ELSE                                     ! closed 
    898             IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point 
    899                                          pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    900          ENDIF 
    901                                             ! North-South boudaries 
    902          IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
    903             pt2d(:,  1 ) = pt2d(:,jpjm1) 
    904             pt2d(:, jpj) = pt2d(:,    2) 
    905          ELSE     
    906          !                                   ! North-South boundaries (closed) 
    907             IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point 
    908                                          pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    909          ENDIF      
    910       ENDIF 
    911  
    912       ! 2. East and west directions exchange 
    913       ! ------------------------------------ 
    914       ! we play with the neigbours AND the row number because of the periodicity 
    915       ! 
    916       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    917       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    918          iihom = nlci-nreci 
    919          DO jl = 1, jpreci 
    920             zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 
    921             zt2we(:,jl,1) = pt2d(iihom +jl,:) 
    922          END DO 
    923       END SELECT 
    924       ! 
    925       !                           ! Migrations 
    926       imigr = jpreci * jpj 
    927       ! 
    928       SELECT CASE ( nbondi ) 
    929       CASE ( -1 ) 
    930          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    931          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    932          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    933       CASE ( 0 ) 
    934          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    935          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    936          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    937          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    938          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    939          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    940       CASE ( 1 ) 
    941          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    942          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    943          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    944       END SELECT 
    945       ! 
    946       !                           ! Write Dirichlet lateral conditions 
    947       iihom = nlci - jpreci 
    948       ! 
    949       SELECT CASE ( nbondi ) 
    950       CASE ( -1 ) 
    951          DO jl = 1, jpreci 
    952             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    953          END DO 
    954       CASE ( 0 ) 
    955          DO jl = 1, jpreci 
    956             pt2d(jl      ,:) = zt2we(:,jl,2) 
    957             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    958          END DO 
    959       CASE ( 1 ) 
    960          DO jl = 1, jpreci 
    961             pt2d(jl      ,:) = zt2we(:,jl,2) 
    962          END DO 
    963       END SELECT 
    964  
    965  
    966       ! 3. North and south directions 
    967       ! ----------------------------- 
    968       ! always closed : we play only with the neigbours 
    969       ! 
    970       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    971          ijhom = nlcj-nrecj 
    972          DO jl = 1, jprecj 
    973             zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 
    974             zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 
    975          END DO 
    976       ENDIF 
    977       ! 
    978       !                           ! Migrations 
    979       imigr = jprecj * jpi 
    980       ! 
    981       SELECT CASE ( nbondj ) 
    982       CASE ( -1 ) 
    983          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    984          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    985          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    986       CASE ( 0 ) 
    987          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    988          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    989          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    990          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    991          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    992          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    993       CASE ( 1 ) 
    994          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    995          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    996          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    997       END SELECT 
    998       ! 
    999       !                           ! Write Dirichlet lateral conditions 
    1000       ijhom = nlcj - jprecj 
    1001       ! 
    1002       SELECT CASE ( nbondj ) 
    1003       CASE ( -1 ) 
    1004          DO jl = 1, jprecj 
    1005             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1006          END DO 
    1007       CASE ( 0 ) 
    1008          DO jl = 1, jprecj 
    1009             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    1010             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1011          END DO 
    1012       CASE ( 1 ) 
    1013          DO jl = 1, jprecj 
    1014             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    1015          END DO 
    1016       END SELECT 
    1017  
    1018  
    1019       ! 4. north fold treatment 
    1020       ! ----------------------- 
    1021       ! 
    1022       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    1023          ! 
    1024          SELECT CASE ( jpni ) 
    1025          CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp 
    1026          CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs. 
    1027          END SELECT 
    1028          ! 
    1029       ENDIF 
    1030       ! 
    1031       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    1032       ! 
    1033    END SUBROUTINE mpp_lnk_2d 
    1034  
    1035  
    1036    SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn ) 
    1037       !!---------------------------------------------------------------------- 
    1038       !!                  ***  routine mpp_lnk_3d_gather  *** 
    1039       !! 
    1040       !! ** Purpose :   Message passing manadgement for two 3D arrays 
    1041       !! 
    1042       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    1043       !!      between processors following neighboring subdomains. 
    1044       !!            domain parameters 
    1045       !!                    nlci   : first dimension of the local subdomain 
    1046       !!                    nlcj   : second dimension of the local subdomain 
    1047       !!                    nbondi : mark for "east-west local boundary" 
    1048       !!                    nbondj : mark for "north-south local boundary" 
    1049       !!                    noea   : number for local neighboring processors 
    1050       !!                    nowe   : number for local neighboring processors 
    1051       !!                    noso   : number for local neighboring processors 
    1052       !!                    nono   : number for local neighboring processors 
    1053       !! 
    1054       !! ** Action  :   ptab1 and ptab2  with update value at its periphery 
    1055       !! 
    1056       !!---------------------------------------------------------------------- 
    1057       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
    1058       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied 
    1059       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
    1060       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points 
    1061       REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary 
    1062       !!                                                             ! =  1. , the sign is kept 
    1063       INTEGER  ::   jl   ! dummy loop indices 
    1064       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    1065       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    1066       INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   ml_stat   ! for key_mpi_isend 
    1067       REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north 
    1068       REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east 
    1069       !!---------------------------------------------------------------------- 
    1070       ! 
    1071       ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    & 
    1072          &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 
    1073       ! 
    1074       ! 1. standard boundary treatment 
    1075       ! ------------------------------ 
    1076       !                                      ! East-West boundaries 
    1077       !                                           !* Cyclic east-west 
    1078       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1079          ptab1( 1 ,:,:) = ptab1(jpim1,:,:) 
    1080          ptab1(jpi,:,:) = ptab1(  2  ,:,:) 
    1081          ptab2( 1 ,:,:) = ptab2(jpim1,:,:) 
    1082          ptab2(jpi,:,:) = ptab2(  2  ,:,:) 
    1083       ELSE                                        !* closed 
    1084          IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point 
    1085          IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0 
    1086                                        ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north 
    1087                                        ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0 
    1088       ENDIF 
    1089                                             ! North-South boundaries 
    1090       IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
    1091          ptab1(:,     1       ,:) = ptab1(: ,  jpjm1 , :) 
    1092          ptab1(:,   jpj       ,:) = ptab1(: ,      2 , :) 
    1093          ptab2(:,     1       ,:) = ptab2(: ,  jpjm1 , :) 
    1094          ptab2(:,   jpj       ,:) = ptab2(: ,      2 , :) 
    1095       ELSE      
    1096       !                                      ! North-South boundaries closed 
    1097       IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point 
    1098       IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0 
    1099                                     ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north 
    1100                                     ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0 
    1101       ENDIF      
    1102  
    1103       ! 2. East and west directions exchange 
    1104       ! ------------------------------------ 
    1105       ! we play with the neigbours AND the row number because of the periodicity 
    1106       ! 
    1107       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    1108       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    1109          iihom = nlci-nreci 
    1110          DO jl = 1, jpreci 
    1111             zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 
    1112             zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 
    1113             zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 
    1114             zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 
    1115          END DO 
    1116       END SELECT 
    1117       ! 
    1118       !                           ! Migrations 
    1119       imigr = jpreci * jpj * jpk *2 
    1120       ! 
    1121       SELECT CASE ( nbondi ) 
    1122       CASE ( -1 ) 
    1123          CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 ) 
    1124          CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 
    1125          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1126       CASE ( 0 ) 
    1127          CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
    1128          CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 ) 
    1129          CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 
    1130          CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 
    1131          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1132          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    1133       CASE ( 1 ) 
    1134          CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 
    1135          CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 
    1136          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1137       END SELECT 
    1138       ! 
    1139       !                           ! Write Dirichlet lateral conditions 
    1140       iihom = nlci - jpreci 
    1141       ! 
    1142       SELECT CASE ( nbondi ) 
    1143       CASE ( -1 ) 
    1144          DO jl = 1, jpreci 
    1145             ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 
    1146             ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 
    1147          END DO 
    1148       CASE ( 0 ) 
    1149          DO jl = 1, jpreci 
    1150             ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2) 
    1151             ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 
    1152             ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2) 
    1153             ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 
    1154          END DO 
    1155       CASE ( 1 ) 
    1156          DO jl = 1, jpreci 
    1157             ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2) 
    1158             ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2) 
    1159          END DO 
    1160       END SELECT 
    1161  
    1162  
    1163       ! 3. North and south directions 
    1164       ! ----------------------------- 
    1165       ! always closed : we play only with the neigbours 
    1166       ! 
    1167       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1168          ijhom = nlcj - nrecj 
    1169          DO jl = 1, jprecj 
    1170             zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:) 
    1171             zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:) 
    1172             zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:) 
    1173             zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:) 
    1174          END DO 
    1175       ENDIF 
    1176       ! 
    1177       !                           ! Migrations 
    1178       imigr = jprecj * jpi * jpk * 2 
    1179       ! 
    1180       SELECT CASE ( nbondj ) 
    1181       CASE ( -1 ) 
    1182          CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 
    1183          CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 
    1184          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1185       CASE ( 0 ) 
    1186          CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
    1187          CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 
    1188          CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 
    1189          CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 
    1190          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1191          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    1192       CASE ( 1 ) 
    1193          CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 
    1194          CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 
    1195          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1196       END SELECT 
    1197       ! 
    1198       !                           ! Write Dirichlet lateral conditions 
    1199       ijhom = nlcj - jprecj 
    1200       ! 
    1201       SELECT CASE ( nbondj ) 
    1202       CASE ( -1 ) 
    1203          DO jl = 1, jprecj 
    1204             ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 
    1205             ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 
    1206          END DO 
    1207       CASE ( 0 ) 
    1208          DO jl = 1, jprecj 
    1209             ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2) 
    1210             ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 
    1211             ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2) 
    1212             ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 
    1213          END DO 
    1214       CASE ( 1 ) 
    1215          DO jl = 1, jprecj 
    1216             ptab1(:,jl,:) = zt4sn(:,jl,:,1,2) 
    1217             ptab2(:,jl,:) = zt4sn(:,jl,:,2,2) 
    1218          END DO 
    1219       END SELECT 
    1220  
    1221  
    1222       ! 4. north fold treatment 
    1223       ! ----------------------- 
    1224       IF( npolj /= 0 ) THEN 
    1225          ! 
    1226          SELECT CASE ( jpni ) 
    1227          CASE ( 1 ) 
    1228             CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs. 
    1229             CALL lbc_nfd      ( ptab2, cd_type2, psgn ) 
    1230          CASE DEFAULT 
    1231             CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs. 
    1232             CALL mpp_lbc_north (ptab2, cd_type2, psgn) 
    1233          END SELECT 
    1234          ! 
    1235       ENDIF 
    1236       ! 
    1237       DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we ) 
    1238       ! 
    1239    END SUBROUTINE mpp_lnk_3d_gather 
     494   !!    mpp_lnk_2d_e     utilisé dans ICB  
     495 
     496 
     497   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!! 
     498    
     499    
     500   !!---------------------------------------------------------------------- 
    1240501 
    1241502 
     
    1284545 
    1285546 
    1286       ! 1. standard boundary treatment 
     547      ! 1. standard boundary treatment   (CAUTION: the order matters Here !!!! ) 
    1287548      ! ------------------------------ 
    1288       ! Order matters Here !!!! 
    1289       ! 
    1290                                            ! North-South cyclic 
    1291       IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south 
    1292          pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1) 
     549      !                                !== North-South boundaries 
     550      !                                      !* cyclic 
     551      IF( nbondj == 2 .AND. jperio == 7 ) THEN 
     552         pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1 ) 
    1293553         pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj) 
    1294       ELSE 
    1295          
    1296       !                                      !* North-South boundaries (closed) 
    1297       IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0.e0    ! south except at F-point 
    1298                                    pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0    ! north 
    1299       ENDIF 
    1300                                  
    1301       !                                      ! East-West boundaries 
    1302       !                                           !* Cyclic east-west 
     554      ELSE                                   !* closed 
     555         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0._wp     ! south except at F-point 
     556                                      pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0._wp     ! north 
     557      ENDIF 
     558      !                                !== East-West boundaries 
     559      !                                      !* Cyclic east-west 
    1303560      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1304          pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east 
    1305          pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west 
    1306          ! 
    1307       ELSE                                        !* closed 
    1308          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point 
    1309                                       pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north 
    1310       ENDIF 
    1311       ! 
    1312  
     561         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)              ! east 
     562         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)              ! west 
     563      ELSE                                   !* closed 
     564         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp  ! south except at F-point 
     565                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp  ! north 
     566      ENDIF 
     567      ! 
    1313568      ! north fold treatment 
    1314       ! ----------------------- 
     569      ! -------------------- 
    1315570      IF( npolj /= 0 ) THEN 
    1316571         ! 
    1317572         SELECT CASE ( jpni ) 
    1318          CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
    1319          CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               ) 
     573!!gm ERROR        CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
     574!!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                  , cd_type, psgn             ) 
    1320575         END SELECT 
    1321576         ! 
     
    1375630      END SELECT 
    1376631 
    1377  
    1378632      ! 3. North and south directions 
    1379633      ! ----------------------------- 
     
    1430684   END SUBROUTINE mpp_lnk_2d_e 
    1431685 
    1432    SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval ) 
    1433       !!---------------------------------------------------------------------- 
    1434       !!                  ***  routine mpp_lnk_sum_3d  *** 
    1435       !! 
    1436       !! ** Purpose :   Message passing manadgement (sum the overlap region) 
    1437       !! 
    1438       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    1439       !!      between processors following neighboring subdomains. 
    1440       !!            domain parameters 
    1441       !!                    nlci   : first dimension of the local subdomain 
    1442       !!                    nlcj   : second dimension of the local subdomain 
    1443       !!                    nbondi : mark for "east-west local boundary" 
    1444       !!                    nbondj : mark for "north-south local boundary" 
    1445       !!                    noea   : number for local neighboring processors 
    1446       !!                    nowe   : number for local neighboring processors 
    1447       !!                    noso   : number for local neighboring processors 
    1448       !!                    nono   : number for local neighboring processors 
    1449       !! 
    1450       !! ** Action  :   ptab with update value at its periphery 
    1451       !! 
    1452       !!---------------------------------------------------------------------- 
    1453       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    1454       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    1455       !                                                             ! = T , U , V , F , W points 
    1456       REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    1457       !                                                             ! =  1. , the sign is kept 
    1458       CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    1459       REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    1460       !! 
    1461       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    1462       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    1463       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    1464       REAL(wp) ::   zland 
    1465       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    1466       ! 
    1467       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
    1468       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    1469  
    1470       !!---------------------------------------------------------------------- 
    1471        
    1472       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    1473          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    1474  
    1475       ! 
    1476       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    1477       ELSE                         ;   zland = 0.e0      ! zero by default 
    1478       ENDIF 
    1479  
    1480       ! 1. standard boundary treatment 
    1481       ! ------------------------------ 
    1482       ! 2. East and west directions exchange 
    1483       ! ------------------------------------ 
    1484       ! we play with the neigbours AND the row number because of the periodicity 
    1485       ! 
    1486       SELECT CASE ( nbondi )      ! Read lateral conditions 
    1487       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    1488       iihom = nlci-jpreci 
    1489          DO jl = 1, jpreci 
    1490             zt3ew(:,jl,:,1) = ptab(jl      ,:,:) ; ptab(jl      ,:,:) = 0.0_wp 
    1491             zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp  
    1492          END DO 
    1493       END SELECT 
    1494       ! 
    1495       !                           ! Migrations 
    1496       imigr = jpreci * jpj * jpk 
    1497       ! 
    1498       SELECT CASE ( nbondi ) 
    1499       CASE ( -1 ) 
    1500          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
    1501          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    1502          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1503       CASE ( 0 ) 
    1504          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    1505          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 
    1506          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    1507          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    1508          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1509          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    1510       CASE ( 1 ) 
    1511          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    1512          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    1513          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1514       END SELECT 
    1515       ! 
    1516       !                           ! Write lateral conditions 
    1517       iihom = nlci-nreci 
    1518       ! 
    1519       SELECT CASE ( nbondi ) 
    1520       CASE ( -1 ) 
    1521          DO jl = 1, jpreci 
    1522             ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2) 
    1523          END DO 
    1524       CASE ( 0 ) 
    1525          DO jl = 1, jpreci 
    1526             ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2) 
    1527             ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2) 
    1528          END DO 
    1529       CASE ( 1 ) 
    1530          DO jl = 1, jpreci 
    1531             ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2) 
    1532          END DO 
    1533       END SELECT 
    1534  
    1535  
    1536       ! 3. North and south directions 
    1537       ! ----------------------------- 
    1538       ! always closed : we play only with the neigbours 
    1539       ! 
    1540       IF( nbondj /= 2 ) THEN      ! Read lateral conditions 
    1541          ijhom = nlcj-jprecj 
    1542          DO jl = 1, jprecj 
    1543             zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp 
    1544             zt3ns(:,jl,:,1) = ptab(:,jl      ,:) ; ptab(:,jl      ,:) = 0.0_wp 
    1545          END DO 
    1546       ENDIF 
    1547       ! 
    1548       !                           ! Migrations 
    1549       imigr = jprecj * jpi * jpk 
    1550       ! 
    1551       SELECT CASE ( nbondj ) 
    1552       CASE ( -1 ) 
    1553          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    1554          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    1555          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1556       CASE ( 0 ) 
    1557          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    1558          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 
    1559          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    1560          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    1561          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1562          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    1563       CASE ( 1 ) 
    1564          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    1565          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    1566          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    1567       END SELECT 
    1568       ! 
    1569       !                           ! Write lateral conditions 
    1570       ijhom = nlcj-nrecj 
    1571       ! 
    1572       SELECT CASE ( nbondj ) 
    1573       CASE ( -1 ) 
    1574          DO jl = 1, jprecj 
    1575             ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2) 
    1576          END DO 
    1577       CASE ( 0 ) 
    1578          DO jl = 1, jprecj 
    1579             ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2) 
    1580             ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2) 
    1581          END DO 
    1582       CASE ( 1 ) 
    1583          DO jl = 1, jprecj 
    1584             ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl   ,:,2) 
    1585          END DO 
    1586       END SELECT 
    1587  
    1588  
    1589       ! 4. north fold treatment 
    1590       ! ----------------------- 
    1591       ! 
    1592       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    1593          ! 
    1594          SELECT CASE ( jpni ) 
    1595          CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
    1596          CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
    1597          END SELECT 
    1598          ! 
    1599       ENDIF 
    1600       ! 
    1601       DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 
    1602       ! 
    1603    END SUBROUTINE mpp_lnk_sum_3d 
    1604  
    1605    SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    1606       !!---------------------------------------------------------------------- 
    1607       !!                  ***  routine mpp_lnk_sum_2d  *** 
    1608       !! 
    1609       !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region) 
    1610       !! 
    1611       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    1612       !!      between processors following neighboring subdomains. 
    1613       !!            domain parameters 
    1614       !!                    nlci   : first dimension of the local subdomain 
    1615       !!                    nlcj   : second dimension of the local subdomain 
    1616       !!                    nbondi : mark for "east-west local boundary" 
    1617       !!                    nbondj : mark for "north-south local boundary" 
    1618       !!                    noea   : number for local neighboring processors 
    1619       !!                    nowe   : number for local neighboring processors 
    1620       !!                    noso   : number for local neighboring processors 
    1621       !!                    nono   : number for local neighboring processors 
    1622       !! 
    1623       !!---------------------------------------------------------------------- 
    1624       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied 
    1625       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    1626       !                                                         ! = T , U , V , F , W and I points 
    1627       REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    1628       !                                                         ! =  1. , the sign is kept 
    1629       CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    1630       REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    1631       !! 
    1632       INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    1633       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    1634       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    1635       REAL(wp) ::   zland 
    1636       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    1637       ! 
    1638       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    1639       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    1640  
    1641       !!---------------------------------------------------------------------- 
    1642  
    1643       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
    1644          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    1645  
    1646       ! 
    1647       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value 
    1648       ELSE                         ;   zland = 0.e0      ! zero by default 
    1649       ENDIF 
    1650  
    1651       ! 1. standard boundary treatment 
    1652       ! ------------------------------ 
    1653       ! 2. East and west directions exchange 
    1654       ! ------------------------------------ 
    1655       ! we play with the neigbours AND the row number because of the periodicity 
    1656       ! 
    1657       SELECT CASE ( nbondi )      ! Read lateral conditions 
    1658       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    1659          iihom = nlci - jpreci 
    1660          DO jl = 1, jpreci 
    1661             zt2ew(:,jl,1) = pt2d(jl       ,:) ; pt2d(jl       ,:) = 0.0_wp 
    1662             zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp 
    1663          END DO 
    1664       END SELECT 
    1665       ! 
    1666       !                           ! Migrations 
    1667       imigr = jpreci * jpj 
    1668       ! 
    1669       SELECT CASE ( nbondi ) 
    1670       CASE ( -1 ) 
    1671          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    1672          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    1673          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1674       CASE ( 0 ) 
    1675          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1676          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    1677          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    1678          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    1679          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1680          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    1681       CASE ( 1 ) 
    1682          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    1683          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    1684          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1685       END SELECT 
    1686       ! 
    1687       !                           ! Write lateral conditions 
    1688       iihom = nlci-nreci 
    1689       ! 
    1690       SELECT CASE ( nbondi ) 
    1691       CASE ( -1 ) 
    1692          DO jl = 1, jpreci 
    1693             pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2) 
    1694          END DO 
    1695       CASE ( 0 ) 
    1696          DO jl = 1, jpreci 
    1697             pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2) 
    1698             pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2) 
    1699          END DO 
    1700       CASE ( 1 ) 
    1701          DO jl = 1, jpreci 
    1702             pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2) 
    1703          END DO 
    1704       END SELECT 
    1705  
    1706  
    1707       ! 3. North and south directions 
    1708       ! ----------------------------- 
    1709       ! always closed : we play only with the neigbours 
    1710       ! 
    1711       IF( nbondj /= 2 ) THEN      ! Read lateral conditions 
    1712          ijhom = nlcj - jprecj 
    1713          DO jl = 1, jprecj 
    1714             zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp 
    1715             zt2ns(:,jl,1) = pt2d(:,jl       ) ; pt2d(:,jl       ) = 0.0_wp 
    1716          END DO 
    1717       ENDIF 
    1718       ! 
    1719       !                           ! Migrations 
    1720       imigr = jprecj * jpi 
    1721       ! 
    1722       SELECT CASE ( nbondj ) 
    1723       CASE ( -1 ) 
    1724          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    1725          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    1726          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1727       CASE ( 0 ) 
    1728          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    1729          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    1730          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    1731          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    1732          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1733          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    1734       CASE ( 1 ) 
    1735          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    1736          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    1737          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    1738       END SELECT 
    1739       ! 
    1740       !                           ! Write lateral conditions 
    1741       ijhom = nlcj-nrecj 
    1742       ! 
    1743       SELECT CASE ( nbondj ) 
    1744       CASE ( -1 ) 
    1745          DO jl = 1, jprecj 
    1746             pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2) 
    1747          END DO 
    1748       CASE ( 0 ) 
    1749          DO jl = 1, jprecj 
    1750             pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2) 
    1751             pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2) 
    1752          END DO 
    1753       CASE ( 1 ) 
    1754          DO jl = 1, jprecj 
    1755             pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2) 
    1756          END DO 
    1757       END SELECT 
    1758  
    1759  
    1760       ! 4. north fold treatment 
    1761       ! ----------------------- 
    1762       ! 
    1763       IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 
    1764          ! 
    1765          SELECT CASE ( jpni ) 
    1766          CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp 
    1767          CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs. 
    1768          END SELECT 
    1769          ! 
    1770       ENDIF 
    1771       ! 
    1772       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 
    1773       ! 
    1774    END SUBROUTINE mpp_lnk_sum_2d 
    1775686 
    1776687   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req ) 
     
    1874785   END SUBROUTINE mppscatter 
    1875786 
    1876  
     787   !!---------------------------------------------------------------------- 
     788   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  *** 
     789   !!    
     790   !!---------------------------------------------------------------------- 
     791   !! 
    1877792   SUBROUTINE mppmax_a_int( ktab, kdim, kcom ) 
    1878       !!---------------------------------------------------------------------- 
    1879       !!                  ***  routine mppmax_a_int  *** 
    1880       !! 
    1881       !! ** Purpose :   Find maximum value in an integer layout array 
    1882       !! 
    1883793      !!---------------------------------------------------------------------- 
    1884794      INTEGER , INTENT(in   )                  ::   kdim   ! size of array 
    1885795      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array 
    1886796      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
    1887       ! 
    1888       INTEGER :: ierror, localcomm   ! temporary integer 
     797      INTEGER :: ierror, ilocalcomm   ! temporary integer 
    1889798      INTEGER, DIMENSION(kdim) ::   iwork 
    1890799      !!---------------------------------------------------------------------- 
    1891       ! 
    1892       localcomm = mpi_comm_opa 
    1893       IF( PRESENT(kcom) )   localcomm = kcom 
    1894       ! 
    1895       CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror ) 
    1896       ! 
     800      ilocalcomm = mpi_comm_opa 
     801      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     802      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, ilocalcomm, ierror ) 
    1897803      ktab(:) = iwork(:) 
    1898       ! 
    1899804   END SUBROUTINE mppmax_a_int 
    1900  
    1901  
     805   !! 
    1902806   SUBROUTINE mppmax_int( ktab, kcom ) 
    1903       !!---------------------------------------------------------------------- 
    1904       !!                  ***  routine mppmax_int  *** 
    1905       !! 
    1906       !! ** Purpose :   Find maximum value in an integer layout array 
    1907       !! 
    1908807      !!---------------------------------------------------------------------- 
    1909808      INTEGER, INTENT(inout)           ::   ktab   ! ??? 
    1910809      INTEGER, INTENT(in   ), OPTIONAL ::   kcom   ! ??? 
    1911       ! 
    1912       INTEGER ::   ierror, iwork, localcomm   ! temporary integer 
    1913       !!---------------------------------------------------------------------- 
    1914       ! 
    1915       localcomm = mpi_comm_opa 
    1916       IF( PRESENT(kcom) )   localcomm = kcom 
    1917       ! 
    1918       CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror ) 
    1919       ! 
     810      INTEGER ::   ierror, iwork, ilocalcomm   ! temporary integer 
     811      !!---------------------------------------------------------------------- 
     812      ilocalcomm = mpi_comm_opa 
     813      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     814      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, ilocalcomm, ierror ) 
    1920815      ktab = iwork 
    1921       ! 
    1922816   END SUBROUTINE mppmax_int 
    1923  
    1924  
     817   !! 
     818   SUBROUTINE mppmax_a_real( ptab, kdim, kcom ) 
     819      !!---------------------------------------------------------------------- 
     820      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab 
     821      INTEGER                  , INTENT(in   ) ::   kdim 
     822      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom 
     823      INTEGER :: ierror, ilocalcomm 
     824      REAL(wp), DIMENSION(kdim) ::  zwork 
     825      !!---------------------------------------------------------------------- 
     826      ilocalcomm = mpi_comm_opa 
     827      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     828      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror ) 
     829      ptab(:) = zwork(:) 
     830   END SUBROUTINE mppmax_a_real 
     831   !! 
     832   SUBROUTINE mppmax_real( ptab, kcom ) 
     833      !!---------------------------------------------------------------------- 
     834      REAL(wp), INTENT(inout)           ::   ptab   ! ??? 
     835      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ??? 
     836      INTEGER  ::   ierror, ilocalcomm 
     837      REAL(wp) ::   zwork 
     838      !!---------------------------------------------------------------------- 
     839      ilocalcomm = mpi_comm_opa 
     840      IF( PRESENT(kcom) )   ilocalcomm = kcom! 
     841      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, ilocalcomm, ierror ) 
     842      ptab = zwork 
     843   END SUBROUTINE mppmax_real 
     844 
     845 
     846   !!---------------------------------------------------------------------- 
     847   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  *** 
     848   !!    
     849   !!---------------------------------------------------------------------- 
     850   !! 
    1925851   SUBROUTINE mppmin_a_int( ktab, kdim, kcom ) 
    1926       !!---------------------------------------------------------------------- 
    1927       !!                  ***  routine mppmin_a_int  *** 
    1928       !! 
    1929       !! ** Purpose :   Find minimum value in an integer layout array 
    1930       !! 
    1931852      !!---------------------------------------------------------------------- 
    1932853      INTEGER , INTENT( in  )                  ::   kdim   ! size of array 
     
    1934855      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom   ! input array 
    1935856      !! 
    1936       INTEGER ::   ierror, localcomm   ! temporary integer 
     857      INTEGER ::   ierror, ilocalcomm   ! temporary integer 
    1937858      INTEGER, DIMENSION(kdim) ::   iwork 
    1938859      !!---------------------------------------------------------------------- 
    1939       ! 
    1940       localcomm = mpi_comm_opa 
    1941       IF( PRESENT(kcom) )   localcomm = kcom 
    1942       ! 
    1943       CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror ) 
    1944       ! 
     860      ilocalcomm = mpi_comm_opa 
     861      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     862      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, ilocalcomm, ierror ) 
    1945863      ktab(:) = iwork(:) 
    1946       ! 
    1947864   END SUBROUTINE mppmin_a_int 
    1948  
    1949  
     865   !! 
    1950866   SUBROUTINE mppmin_int( ktab, kcom ) 
    1951       !!---------------------------------------------------------------------- 
    1952       !!                  ***  routine mppmin_int  *** 
    1953       !! 
    1954       !! ** Purpose :   Find minimum value in an integer layout array 
    1955       !! 
    1956867      !!---------------------------------------------------------------------- 
    1957868      INTEGER, INTENT(inout) ::   ktab      ! ??? 
    1958869      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array 
    1959870      !! 
    1960       INTEGER ::  ierror, iwork, localcomm 
    1961       !!---------------------------------------------------------------------- 
    1962       ! 
    1963       localcomm = mpi_comm_opa 
    1964       IF( PRESENT(kcom) )   localcomm = kcom 
    1965       ! 
    1966       CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 
    1967       ! 
     871      INTEGER ::  ierror, iwork, ilocalcomm 
     872      !!---------------------------------------------------------------------- 
     873      ilocalcomm = mpi_comm_opa 
     874      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     875      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, ilocalcomm, ierror ) 
    1968876      ktab = iwork 
    1969       ! 
    1970877   END SUBROUTINE mppmin_int 
    1971  
    1972  
    1973    SUBROUTINE mppsum_a_int( ktab, kdim ) 
    1974       !!---------------------------------------------------------------------- 
    1975       !!                  ***  routine mppsum_a_int  *** 
    1976       !! 
    1977       !! ** Purpose :   Global integer sum, 1D array case 
    1978       !! 
    1979       !!---------------------------------------------------------------------- 
    1980       INTEGER, INTENT(in   )                   ::   kdim   ! ??? 
    1981       INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ??? 
    1982       ! 
    1983       INTEGER :: ierror 
    1984       INTEGER, DIMENSION (kdim) ::  iwork 
    1985       !!---------------------------------------------------------------------- 
    1986       ! 
    1987       CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 
    1988       ! 
    1989       ktab(:) = iwork(:) 
    1990       ! 
    1991    END SUBROUTINE mppsum_a_int 
    1992  
    1993  
    1994    SUBROUTINE mppsum_int( ktab ) 
    1995       !!---------------------------------------------------------------------- 
    1996       !!                 ***  routine mppsum_int  *** 
    1997       !! 
    1998       !! ** Purpose :   Global integer sum 
    1999       !! 
    2000       !!---------------------------------------------------------------------- 
    2001       INTEGER, INTENT(inout) ::   ktab 
    2002       !! 
    2003       INTEGER :: ierror, iwork 
    2004       !!---------------------------------------------------------------------- 
    2005       ! 
    2006       CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 
    2007       ! 
    2008       ktab = iwork 
    2009       ! 
    2010    END SUBROUTINE mppsum_int 
    2011  
    2012  
    2013    SUBROUTINE mppmax_a_real( ptab, kdim, kcom ) 
    2014       !!---------------------------------------------------------------------- 
    2015       !!                 ***  routine mppmax_a_real  *** 
    2016       !! 
    2017       !! ** Purpose :   Maximum 
    2018       !! 
     878   !! 
     879   SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 
    2019880      !!---------------------------------------------------------------------- 
    2020881      INTEGER , INTENT(in   )                  ::   kdim 
    2021882      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
    2022883      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom 
    2023       ! 
    2024       INTEGER :: ierror, localcomm 
    2025       REAL(wp), DIMENSION(kdim) ::  zwork 
    2026       !!---------------------------------------------------------------------- 
    2027       ! 
    2028       localcomm = mpi_comm_opa 
    2029       IF( PRESENT(kcom) ) localcomm = kcom 
    2030       ! 
    2031       CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror ) 
    2032       ptab(:) = zwork(:) 
    2033       ! 
    2034    END SUBROUTINE mppmax_a_real 
    2035  
    2036  
    2037    SUBROUTINE mppmax_real( ptab, kcom ) 
    2038       !!---------------------------------------------------------------------- 
    2039       !!                  ***  routine mppmax_real  *** 
    2040       !! 
    2041       !! ** Purpose :   Maximum 
    2042       !! 
    2043       !!---------------------------------------------------------------------- 
    2044       REAL(wp), INTENT(inout)           ::   ptab   ! ??? 
    2045       INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ??? 
    2046       !! 
    2047       INTEGER  ::   ierror, localcomm 
    2048       REAL(wp) ::   zwork 
    2049       !!---------------------------------------------------------------------- 
    2050       ! 
    2051       localcomm = mpi_comm_opa 
    2052       IF( PRESENT(kcom) )   localcomm = kcom 
    2053       ! 
    2054       CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror ) 
    2055       ptab = zwork 
    2056       ! 
    2057    END SUBROUTINE mppmax_real 
    2058  
    2059    SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom  ) 
    2060       !!---------------------------------------------------------------------- 
    2061       !!                  ***  routine mppmax_real  *** 
    2062       !! 
    2063       !! ** Purpose :   Maximum 
    2064       !! 
    2065       !!---------------------------------------------------------------------- 
    2066       REAL(wp), DIMENSION(:) ,  INTENT(inout)           ::   ptab   ! ??? 
    2067       INTEGER , INTENT(in   )           ::   NUM 
    2068       INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ??? 
    2069       !! 
    2070       INTEGER  ::   ierror, localcomm 
    2071       REAL(wp) , POINTER , DIMENSION(:) ::   zwork 
    2072       !!---------------------------------------------------------------------- 
    2073       ! 
    2074       CALL wrk_alloc(NUM , zwork) 
    2075       localcomm = mpi_comm_opa 
    2076       IF( PRESENT(kcom) )   localcomm = kcom 
    2077       ! 
    2078       CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror ) 
    2079       ptab = zwork 
    2080       CALL wrk_dealloc(NUM , zwork) 
    2081       ! 
    2082    END SUBROUTINE mppmax_real_multiple 
    2083  
    2084  
    2085    SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 
    2086       !!---------------------------------------------------------------------- 
    2087       !!                 ***  routine mppmin_a_real  *** 
    2088       !! 
    2089       !! ** Purpose :   Minimum of REAL, array case 
    2090       !! 
    2091       !!----------------------------------------------------------------------- 
    2092       INTEGER , INTENT(in   )                  ::   kdim 
    2093       REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab 
    2094       INTEGER , INTENT(in   ), OPTIONAL        ::   kcom 
    2095       !! 
    2096       INTEGER :: ierror, localcomm 
     884      INTEGER :: ierror, ilocalcomm 
    2097885      REAL(wp), DIMENSION(kdim) ::   zwork 
    2098886      !!----------------------------------------------------------------------- 
    2099       ! 
    2100       localcomm = mpi_comm_opa 
    2101       IF( PRESENT(kcom) ) localcomm = kcom 
    2102       ! 
    2103       CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror ) 
     887      ilocalcomm = mpi_comm_opa 
     888      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     889      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, ilocalcomm, ierror ) 
    2104890      ptab(:) = zwork(:) 
    2105       ! 
    2106891   END SUBROUTINE mppmin_a_real 
    2107  
    2108  
     892   !! 
    2109893   SUBROUTINE mppmin_real( ptab, kcom ) 
    2110       !!---------------------------------------------------------------------- 
    2111       !!                  ***  routine mppmin_real  *** 
    2112       !! 
    2113       !! ** Purpose :   minimum of REAL, scalar case 
    2114       !! 
    2115894      !!----------------------------------------------------------------------- 
    2116895      REAL(wp), INTENT(inout)           ::   ptab        ! 
    2117896      INTEGER , INTENT(in   ), OPTIONAL :: kcom 
    2118       !! 
    2119       INTEGER  ::   ierror 
    2120       REAL(wp) ::   zwork 
    2121       INTEGER :: localcomm 
    2122       !!----------------------------------------------------------------------- 
    2123       ! 
    2124       localcomm = mpi_comm_opa 
    2125       IF( PRESENT(kcom) )   localcomm = kcom 
    2126       ! 
    2127       CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror ) 
    2128       ptab = zwork 
    2129       ! 
    2130    END SUBROUTINE mppmin_real 
    2131  
    2132  
    2133    SUBROUTINE mppsum_a_real( ptab, kdim, kcom ) 
    2134       !!---------------------------------------------------------------------- 
    2135       !!                  ***  routine mppsum_a_real  *** 
    2136       !! 
    2137       !! ** Purpose :   global sum, REAL ARRAY argument case 
    2138       !! 
    2139       !!----------------------------------------------------------------------- 
    2140       INTEGER , INTENT( in )                     ::   kdim      ! size of ptab 
    2141       REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array 
    2142       INTEGER , INTENT( in ), OPTIONAL           :: kcom 
    2143       !! 
    2144       INTEGER                   ::   ierror    ! temporary integer 
    2145       INTEGER                   ::   localcomm 
    2146       REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
    2147       !!----------------------------------------------------------------------- 
    2148       ! 
    2149       localcomm = mpi_comm_opa 
    2150       IF( PRESENT(kcom) )   localcomm = kcom 
    2151       ! 
    2152       CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror ) 
    2153       ptab(:) = zwork(:) 
    2154       ! 
    2155    END SUBROUTINE mppsum_a_real 
    2156  
    2157  
    2158    SUBROUTINE mppsum_real( ptab, kcom ) 
    2159       !!---------------------------------------------------------------------- 
    2160       !!                  ***  routine mppsum_real  *** 
    2161       !! 
    2162       !! ** Purpose :   global sum, SCALAR argument case 
    2163       !! 
    2164       !!----------------------------------------------------------------------- 
    2165       REAL(wp), INTENT(inout)           ::   ptab   ! input scalar 
    2166       INTEGER , INTENT(in   ), OPTIONAL ::   kcom 
    2167       !! 
    2168       INTEGER  ::   ierror, localcomm 
     897      INTEGER  ::   ierror, ilocalcomm 
    2169898      REAL(wp) ::   zwork 
    2170899      !!----------------------------------------------------------------------- 
    2171       ! 
    2172       localcomm = mpi_comm_opa 
    2173       IF( PRESENT(kcom) ) localcomm = kcom 
    2174       ! 
    2175       CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror ) 
     900      ilocalcomm = mpi_comm_opa 
     901      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     902      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, ilocalcomm, ierror ) 
    2176903      ptab = zwork 
    2177       ! 
     904   END SUBROUTINE mppmin_real 
     905 
     906 
     907   !!---------------------------------------------------------------------- 
     908   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  *** 
     909   !!    
     910   !!   Global sum of 1D array or a variable (integer, real or complex) 
     911   !!---------------------------------------------------------------------- 
     912   !! 
     913   SUBROUTINE mppsum_a_int( ktab, kdim ) 
     914      !!---------------------------------------------------------------------- 
     915      INTEGER, INTENT(in   )                   ::   kdim   ! ??? 
     916      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab   ! ??? 
     917      INTEGER :: ierror 
     918      INTEGER, DIMENSION (kdim) ::  iwork 
     919      !!---------------------------------------------------------------------- 
     920      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 
     921      ktab(:) = iwork(:) 
     922   END SUBROUTINE mppsum_a_int 
     923   !! 
     924   SUBROUTINE mppsum_int( ktab ) 
     925      !!---------------------------------------------------------------------- 
     926      INTEGER, INTENT(inout) ::   ktab 
     927      INTEGER :: ierror, iwork 
     928      !!---------------------------------------------------------------------- 
     929      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 
     930      ktab = iwork 
     931   END SUBROUTINE mppsum_int 
     932   !! 
     933   SUBROUTINE mppsum_a_real( ptab, kdim, kcom ) 
     934      !!----------------------------------------------------------------------- 
     935      INTEGER                  , INTENT(in   ) ::   kdim   ! size of ptab 
     936      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   ptab   ! input array 
     937      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! specific communicator 
     938      INTEGER  ::   ierror, ilocalcomm    ! local integer 
     939      REAL(wp) ::   zwork(kdim)           ! local workspace 
     940      !!----------------------------------------------------------------------- 
     941      ilocalcomm = mpi_comm_opa 
     942      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     943      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, ilocalcomm, ierror ) 
     944      ptab(:) = zwork(:) 
     945   END SUBROUTINE mppsum_a_real 
     946   !! 
     947   SUBROUTINE mppsum_real( ptab, kcom ) 
     948      !!----------------------------------------------------------------------- 
     949      REAL(wp)          , INTENT(inout)           ::   ptab   ! input scalar 
     950      INTEGER , OPTIONAL, INTENT(in   ) ::   kcom 
     951      INTEGER  ::   ierror, ilocalcomm 
     952      REAL(wp) ::   zwork 
     953      !!----------------------------------------------------------------------- 
     954      ilocalcomm = mpi_comm_opa 
     955      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     956      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, ilocalcomm, ierror ) 
     957      ptab = zwork 
    2178958   END SUBROUTINE mppsum_real 
    2179  
    2180  
     959   !! 
    2181960   SUBROUTINE mppsum_realdd( ytab, kcom ) 
    2182       !!---------------------------------------------------------------------- 
    2183       !!                  ***  routine mppsum_realdd *** 
    2184       !! 
    2185       !! ** Purpose :   global sum in Massively Parallel Processing 
    2186       !!                SCALAR argument case for double-double precision 
    2187       !! 
    2188961      !!----------------------------------------------------------------------- 
    2189       COMPLEX(wp), INTENT(inout)           ::   ytab    ! input scalar 
    2190       INTEGER    , INTENT(in   ), OPTIONAL ::   kcom 
    2191       ! 
    2192       INTEGER     ::   ierror 
    2193       INTEGER     ::   localcomm 
     962      COMPLEX(wp)          , INTENT(inout) ::   ytab    ! input scalar 
     963      INTEGER    , OPTIONAL, INTENT(in   ) ::   kcom 
     964      INTEGER     ::   ierror, ilocalcomm 
    2194965      COMPLEX(wp) ::   zwork 
    2195966      !!----------------------------------------------------------------------- 
    2196       ! 
    2197       localcomm = mpi_comm_opa 
    2198       IF( PRESENT(kcom) )   localcomm = kcom 
    2199       ! 
    2200       ! reduce local sums into global sum 
    2201       CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 
     967      ilocalcomm = mpi_comm_opa 
     968      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     969      CALL MPI_ALLREDUCE( ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror ) 
    2202970      ytab = zwork 
    2203       ! 
    2204971   END SUBROUTINE mppsum_realdd 
    2205  
    2206  
     972   !! 
    2207973   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 
    2208974      !!---------------------------------------------------------------------- 
    2209       !!                  ***  routine mppsum_a_realdd  *** 
    2210       !! 
    2211       !! ** Purpose :   global sum in Massively Parallel Processing 
    2212       !!                COMPLEX ARRAY case for double-double precision 
    2213       !! 
    2214       !!----------------------------------------------------------------------- 
    2215975      INTEGER                     , INTENT(in   ) ::   kdim   ! size of ytab 
    2216976      COMPLEX(wp), DIMENSION(kdim), INTENT(inout) ::   ytab   ! input array 
    2217977      INTEGER    , OPTIONAL       , INTENT(in   ) ::   kcom 
    2218       ! 
    2219       INTEGER:: ierror, localcomm    ! local integer 
     978      INTEGER:: ierror, ilocalcomm    ! local integer 
    2220979      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace 
    2221980      !!----------------------------------------------------------------------- 
    2222       ! 
    2223       localcomm = mpi_comm_opa 
    2224       IF( PRESENT(kcom) )   localcomm = kcom 
    2225       ! 
    2226       CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 
     981      ilocalcomm = mpi_comm_opa 
     982      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     983      CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror ) 
    2227984      ytab(:) = zwork(:) 
    2228       ! 
    2229985   END SUBROUTINE mppsum_a_realdd 
     986    
     987 
     988   SUBROUTINE mppmax_real_multiple( pt1d, kdim, kcom  ) 
     989      !!---------------------------------------------------------------------- 
     990      !!                  ***  routine mppmax_real  *** 
     991      !! 
     992      !! ** Purpose :   Maximum across processor of each element of a 1D arrays 
     993      !! 
     994      !!---------------------------------------------------------------------- 
     995      REAL(wp), DIMENSION(kdim), INTENT(inout) ::   pt1d   ! 1D arrays 
     996      INTEGER                  , INTENT(in   ) ::   kdim 
     997      INTEGER , OPTIONAL       , INTENT(in   ) ::   kcom   ! local communicator 
     998      !! 
     999      INTEGER  ::   ierror, ilocalcomm 
     1000      REAL(wp), DIMENSION(kdim) ::  zwork 
     1001      !!---------------------------------------------------------------------- 
     1002      ilocalcomm = mpi_comm_opa 
     1003      IF( PRESENT(kcom) )   ilocalcomm = kcom 
     1004      ! 
     1005      CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror ) 
     1006      pt1d(:) = zwork(:) 
     1007      ! 
     1008   END SUBROUTINE mppmax_real_multiple 
    22301009 
    22311010 
     
    22431022      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask 
    22441023      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    2245       INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame 
     1024      INTEGER                      , INTENT(  out) ::   ki, kj  ! index of minimum in global frame 
    22461025      ! 
    22471026      INTEGER :: ierror 
     
    22511030      !!----------------------------------------------------------------------- 
    22521031      ! 
    2253       zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 ) 
    2254       ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 ) 
     1032      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1._wp ) 
     1033      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1._wp ) 
    22551034      ! 
    22561035      ki = ilocs(1) + nimpp - 1 
     
    22791058      !! 
    22801059      !!-------------------------------------------------------------------------- 
    2281       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array 
    2282       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask 
    2283       REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab 
    2284       INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame 
    2285       !! 
     1060      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array 
     1061      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pmask        ! Local mask 
     1062      REAL(wp)                  , INTENT(  out) ::   pmin         ! Global minimum of ptab 
     1063      INTEGER                   , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame 
     1064      ! 
    22861065      INTEGER  ::   ierror 
    22871066      REAL(wp) ::   zmin     ! local minimum 
     
    22901069      !!----------------------------------------------------------------------- 
    22911070      ! 
    2292       zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 ) 
    2293       ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 ) 
     1071      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1._wp ) 
     1072      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1._wp ) 
    22941073      ! 
    22951074      ki = ilocs(1) + nimpp - 1 
     
    22971076      kk = ilocs(3) 
    22981077      ! 
    2299       zain(1,:)=zmin 
    2300       zain(2,:)=ki+10000.*kj+100000000.*kk 
     1078      zain(1,:) = zmin 
     1079      zain(2,:) = ki + 10000.*kj + 100000000.*kk 
    23011080      ! 
    23021081      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror) 
     
    23311110      !!----------------------------------------------------------------------- 
    23321111      ! 
    2333       zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 ) 
    2334       ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 ) 
     1112      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1._wp ) 
     1113      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1._wp ) 
    23351114      ! 
    23361115      ki = ilocs(1) + nimpp - 1 
     
    23591138      !! 
    23601139      !!-------------------------------------------------------------------------- 
    2361       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array 
    2362       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask 
    2363       REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab 
    2364       INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame 
    2365       !! 
    2366       REAL(wp) :: zmax   ! local maximum 
     1140      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   ptab         ! Local 2D array 
     1141      REAL(wp), DIMENSION (:,:,:), INTENT(in   ) ::   pmask        ! Local mask 
     1142      REAL(wp)                   , INTENT(  out) ::   pmax         ! Global maximum of ptab 
     1143      INTEGER                    , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame 
     1144      ! 
     1145      INTEGER  ::   ierror   ! local integer 
     1146      REAL(wp) ::   zmax     ! local maximum 
    23671147      REAL(wp), DIMENSION(2,1) ::   zain, zaout 
    23681148      INTEGER , DIMENSION(3)   ::   ilocs 
    2369       INTEGER :: ierror 
    23701149      !!----------------------------------------------------------------------- 
    23711150      ! 
    2372       zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 ) 
    2373       ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 ) 
     1151      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1._wp ) 
     1152      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1._wp ) 
    23741153      ! 
    23751154      ki = ilocs(1) + nimpp - 1 
     
    23771156      kk = ilocs(3) 
    23781157      ! 
    2379       zain(1,:)=zmax 
    2380       zain(2,:)=ki+10000.*kj+100000000.*kk 
     1158      zain(1,:) = zmax 
     1159      zain(2,:) = ki + 10000.*kj + 100000000.*kk 
    23811160      ! 
    23821161      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror) 
     
    24221201 
    24231202   SUBROUTINE mpp_comm_free( kcom ) 
    2424       !!---------------------------------------------------------------------- 
    24251203      !!---------------------------------------------------------------------- 
    24261204      INTEGER, INTENT(in) ::   kcom 
     
    26801458 
    26811459 
    2682    SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn ) 
    2683       !!--------------------------------------------------------------------- 
    2684       !!                   ***  routine mpp_lbc_north_3d  *** 
    2685       !! 
    2686       !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    2687       !!              in mpp configuration in case of jpn1 > 1 
    2688       !! 
    2689       !! ** Method  :   North fold condition and mpp with more than one proc 
    2690       !!              in i-direction require a specific treatment. We gather 
    2691       !!              the 4 northern lines of the global domain on 1 processor 
    2692       !!              and apply lbc north-fold on this sub array. Then we 
    2693       !!              scatter the north fold array back to the processors. 
    2694       !! 
    2695       !!---------------------------------------------------------------------- 
    2696       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied 
    2697       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    2698       !                                                              !   = T ,  U , V , F or W  gridpoints 
    2699       REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
    2700       !!                                                             ! =  1. , the sign is kept 
    2701       INTEGER ::   ji, jj, jr, jk 
    2702       INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    2703       INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2704       INTEGER, DIMENSION (jpmaxngh)          ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather 
    2705       INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    2706       INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    2707       !                                                              ! Workspace for message transfers avoiding mpi_allgather 
    2708       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab 
    2709       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk       
    2710       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio 
    2711       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr 
    2712  
    2713       INTEGER :: istatus(mpi_status_size) 
    2714       INTEGER :: iflag 
    2715       !!---------------------------------------------------------------------- 
    2716       ! 
    2717       ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) ) 
    2718       ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) )  
    2719  
    2720       ijpj   = 4 
    2721       ijpjm1 = 3 
    2722       ! 
    2723       znorthloc(:,:,:) = 0 
    2724       DO jk = 1, jpk 
    2725          DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
    2726             ij = jj - nlcj + ijpj 
    2727             znorthloc(:,ij,jk) = pt3d(:,jj,jk) 
    2728          END DO 
    2729       END DO 
    2730       ! 
    2731       !                                     ! Build in procs of ncomm_north the znorthgloio 
    2732       itaille = jpi * jpk * ijpj 
    2733  
    2734       IF ( l_north_nogather ) THEN 
    2735          ! 
    2736         ztabr(:,:,:) = 0 
    2737         ztabl(:,:,:) = 0 
    2738  
    2739         DO jk = 1, jpk 
    2740            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    2741               ij = jj - nlcj + ijpj 
    2742               DO ji = nfsloop, nfeloop 
    2743                  ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 
    2744               END DO 
    2745            END DO 
    2746         END DO 
    2747  
    2748          DO jr = 1,nsndto 
    2749             IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
    2750               CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
    2751             ENDIF 
    2752          END DO 
    2753          DO jr = 1,nsndto 
    2754             iproc = nfipproc(isendto(jr),jpnj) 
    2755             IF(iproc .ne. -1) THEN 
    2756                ilei = nleit (iproc+1) 
    2757                ildi = nldit (iproc+1) 
    2758                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    2759             ENDIF 
    2760             IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
    2761               CALL mpprecv(5, zfoldwk, itaille, iproc) 
    2762               DO jk = 1, jpk 
    2763                  DO jj = 1, ijpj 
    2764                     DO ji = ildi, ilei 
    2765                        ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 
    2766                     END DO 
    2767                  END DO 
    2768               END DO 
    2769            ELSE IF (iproc .eq. (narea-1)) THEN 
    2770               DO jk = 1, jpk 
    2771                  DO jj = 1, ijpj 
    2772                     DO ji = ildi, ilei 
    2773                        ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
    2774                     END DO 
    2775                  END DO 
    2776               END DO 
    2777            ENDIF 
    2778          END DO 
    2779          IF (l_isend) THEN 
    2780             DO jr = 1,nsndto 
    2781                IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
    2782                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    2783                ENDIF     
    2784             END DO 
    2785          ENDIF 
    2786          CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2787          DO jk = 1, jpk 
    2788             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    2789                ij = jj - nlcj + ijpj 
    2790                DO ji= 1, nlci 
    2791                   pt3d(ji,jj,jk) = ztabl(ji,ij,jk) 
    2792                END DO 
    2793             END DO 
    2794          END DO 
    2795          ! 
    2796  
    2797       ELSE 
    2798          CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                & 
    2799             &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    2800          ! 
    2801          ztab(:,:,:) = 0.e0 
    2802          DO jr = 1, ndim_rank_north         ! recover the global north array 
    2803             iproc = nrank_north(jr) + 1 
    2804             ildi  = nldit (iproc) 
    2805             ilei  = nleit (iproc) 
    2806             iilb  = nimppt(iproc) 
    2807             DO jk = 1, jpk 
    2808                DO jj = 1, ijpj 
    2809                   DO ji = ildi, ilei 
    2810                     ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr) 
    2811                   END DO 
    2812                END DO 
    2813             END DO 
    2814          END DO 
    2815          CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition 
    2816          ! 
    2817          DO jk = 1, jpk 
    2818             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    2819                ij = jj - nlcj + ijpj 
    2820                DO ji= 1, nlci 
    2821                   pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk) 
    2822                END DO 
    2823             END DO 
    2824          END DO 
    2825          ! 
    2826       ENDIF 
    2827       ! 
    2828       ! The ztab array has been either: 
    2829       !  a. Fully populated by the mpi_allgather operation or 
    2830       !  b. Had the active points for this domain and northern neighbours populated 
    2831       !     by peer to peer exchanges 
    2832       ! Either way the array may be folded by lbc_nfd and the result for the span of 
    2833       ! this domain will be identical. 
    2834       ! 
    2835       DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 
    2836       DEALLOCATE( ztabl, ztabr )  
    2837       ! 
    2838    END SUBROUTINE mpp_lbc_north_3d 
    2839  
    2840  
    2841    SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn) 
    2842       !!--------------------------------------------------------------------- 
    2843       !!                   ***  routine mpp_lbc_north_2d  *** 
    2844       !! 
    2845       !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    2846       !!              in mpp configuration in case of jpn1 > 1 (for 2d array ) 
    2847       !! 
    2848       !! ** Method  :   North fold condition and mpp with more than one proc 
    2849       !!              in i-direction require a specific treatment. We gather 
    2850       !!              the 4 northern lines of the global domain on 1 processor 
    2851       !!              and apply lbc north-fold on this sub array. Then we 
    2852       !!              scatter the north fold array back to the processors. 
    2853       !! 
    2854       !!---------------------------------------------------------------------- 
    2855       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the b.c. is applied 
    2856       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points 
    2857       !                                                          !   = T ,  U , V , F or W  gridpoints 
    2858       REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
    2859       !!                                                             ! =  1. , the sign is kept 
    2860       INTEGER ::   ji, jj, jr 
    2861       INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    2862       INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2863       INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather 
    2864       INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    2865       INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    2866       !                                                              ! Workspace for message transfers avoiding mpi_allgather 
    2867       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab 
    2868       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk       
    2869       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio 
    2870       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztabl, ztabr 
    2871       INTEGER :: istatus(mpi_status_size) 
    2872       INTEGER :: iflag 
    2873       !!---------------------------------------------------------------------- 
    2874       ! 
    2875       ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) ) 
    2876       ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) )  
    2877       ! 
    2878       ijpj   = 4 
    2879       ijpjm1 = 3 
    2880       ! 
    2881       DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
    2882          ij = jj - nlcj + ijpj 
    2883          znorthloc(:,ij) = pt2d(:,jj) 
    2884       END DO 
    2885  
    2886       !                                     ! Build in procs of ncomm_north the znorthgloio 
    2887       itaille = jpi * ijpj 
    2888       IF ( l_north_nogather ) THEN 
    2889          ! 
    2890          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
    2891          ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    2892          ! 
    2893          ztabr(:,:) = 0 
    2894          ztabl(:,:) = 0 
    2895  
    2896          DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    2897             ij = jj - nlcj + ijpj 
    2898               DO ji = nfsloop, nfeloop 
    2899                ztabl(ji,ij) = pt2d(ji,jj) 
    2900             END DO 
    2901          END DO 
    2902  
    2903          DO jr = 1,nsndto 
    2904             IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
    2905                CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
    2906             ENDIF 
    2907          END DO 
    2908          DO jr = 1,nsndto 
    2909             iproc = nfipproc(isendto(jr),jpnj) 
    2910             IF(iproc .ne. -1) THEN 
    2911                ilei = nleit (iproc+1) 
    2912                ildi = nldit (iproc+1) 
    2913                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    2914             ENDIF 
    2915             IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
    2916               CALL mpprecv(5, zfoldwk, itaille, iproc) 
    2917               DO jj = 1, ijpj 
    2918                  DO ji = ildi, ilei 
    2919                     ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 
    2920                  END DO 
    2921               END DO 
    2922             ELSE IF (iproc .eq. (narea-1)) THEN 
    2923               DO jj = 1, ijpj 
    2924                  DO ji = ildi, ilei 
    2925                     ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
    2926                  END DO 
    2927               END DO 
    2928             ENDIF 
    2929          END DO 
    2930          IF (l_isend) THEN 
    2931             DO jr = 1,nsndto 
    2932                IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
    2933                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    2934                ENDIF 
    2935             END DO 
    2936          ENDIF 
    2937          CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2938          ! 
    2939          DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
    2940             ij = jj - nlcj + ijpj 
    2941             DO ji = 1, nlci 
    2942                pt2d(ji,jj) = ztabl(ji,ij) 
    2943             END DO 
    2944          END DO 
    2945          ! 
    2946       ELSE 
    2947          CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        & 
    2948             &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    2949          ! 
    2950          ztab(:,:) = 0.e0 
    2951          DO jr = 1, ndim_rank_north            ! recover the global north array 
    2952             iproc = nrank_north(jr) + 1 
    2953             ildi = nldit (iproc) 
    2954             ilei = nleit (iproc) 
    2955             iilb = nimppt(iproc) 
    2956             DO jj = 1, ijpj 
    2957                DO ji = ildi, ilei 
    2958                   ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr) 
    2959                END DO 
    2960             END DO 
    2961          END DO 
    2962          CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition 
    2963          ! 
    2964          DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
    2965             ij = jj - nlcj + ijpj 
    2966             DO ji = 1, nlci 
    2967                pt2d(ji,jj) = ztab(ji+nimpp-1,ij) 
    2968             END DO 
    2969          END DO 
    2970          ! 
    2971       ENDIF 
    2972       DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 
    2973       DEALLOCATE( ztabl, ztabr )  
    2974       ! 
    2975    END SUBROUTINE mpp_lbc_north_2d 
    2976  
    2977    SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields) 
    2978       !!--------------------------------------------------------------------- 
    2979       !!                   ***  routine mpp_lbc_north_2d  *** 
    2980       !! 
    2981       !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    2982       !!              in mpp configuration in case of jpn1 > 1 
    2983       !!              (for multiple 2d arrays ) 
    2984       !! 
    2985       !! ** Method  :   North fold condition and mpp with more than one proc 
    2986       !!              in i-direction require a specific treatment. We gather 
    2987       !!              the 4 northern lines of the global domain on 1 processor 
    2988       !!              and apply lbc north-fold on this sub array. Then we 
    2989       !!              scatter the north fold array back to the processors. 
    2990       !! 
    2991       !!---------------------------------------------------------------------- 
    2992       INTEGER ,  INTENT (in   ) ::   num_fields  ! number of variables contained in pt2d 
    2993       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    2994       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_type   ! nature of pt2d grid-points 
    2995       !                                                          !   = T ,  U , V , F or W  gridpoints 
    2996       REAL(wp), DIMENSION(:), INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold  
    2997       !!                                                             ! =  1. , the sign is kept 
    2998       INTEGER ::   ji, jj, jr, jk 
    2999       INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    3000       INTEGER ::   ijpj, ijpjm1, ij, iproc 
    3001       INTEGER, DIMENSION (jpmaxngh)      ::   ml_req_nf          !for mpi_isend when avoiding mpi_allgather 
    3002       INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather 
    3003       INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather 
    3004       !                                                              ! Workspace for message transfers avoiding mpi_allgather 
    3005       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab 
    3006       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk 
    3007       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio 
    3008       REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztabl, ztabr 
    3009       INTEGER :: istatus(mpi_status_size) 
    3010       INTEGER :: iflag 
    3011       !!---------------------------------------------------------------------- 
    3012       ! 
    3013       ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields),   & 
    3014             &   znorthgloio(jpi,4,num_fields,jpni) )   ! expanded to 3 dimensions 
    3015       ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 
    3016       ! 
    3017       ijpj   = 4 
    3018       ijpjm1 = 3 
    3019       ! 
    3020        
    3021       DO jk = 1, num_fields 
    3022          DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d (for every variable) 
    3023             ij = jj - nlcj + ijpj 
    3024             znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj) 
    3025          END DO 
    3026       END DO 
    3027       !                                     ! Build in procs of ncomm_north the znorthgloio 
    3028       itaille = jpi * ijpj 
    3029                                                                    
    3030       IF ( l_north_nogather ) THEN 
    3031          ! 
    3032          ! Avoid the use of mpi_allgather by exchanging only with the processes already identified  
    3033          ! (in nemo_northcomms) as being  involved in this process' northern boundary exchange 
    3034          ! 
    3035          ztabr(:,:,:) = 0 
    3036          ztabl(:,:,:) = 0 
    3037  
    3038          DO jk = 1, num_fields 
    3039             DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    3040                ij = jj - nlcj + ijpj 
    3041                DO ji = nfsloop, nfeloop 
    3042                   ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj) 
    3043                END DO 
    3044             END DO 
    3045          END DO 
    3046  
    3047          DO jr = 1,nsndto 
    3048             IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
    3049                CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times 
    3050             ENDIF 
    3051          END DO 
    3052          DO jr = 1,nsndto 
    3053             iproc = nfipproc(isendto(jr),jpnj) 
    3054             IF(iproc .ne. -1) THEN 
    3055                ilei = nleit (iproc+1) 
    3056                ildi = nldit (iproc+1) 
    3057                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    3058             ENDIF 
    3059             IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
    3060               CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times 
    3061               DO jk = 1 , num_fields 
    3062                  DO jj = 1, ijpj 
    3063                     DO ji = ildi, ilei 
    3064                        ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)       ! Modified to 3D 
    3065                     END DO 
    3066                  END DO 
    3067               END DO 
    3068             ELSE IF (iproc .eq. (narea-1)) THEN 
    3069               DO jk = 1, num_fields 
    3070                  DO jj = 1, ijpj 
    3071                     DO ji = ildi, ilei 
    3072                           ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj)       ! Modified to 3D 
    3073                     END DO 
    3074                  END DO 
    3075               END DO 
    3076             ENDIF 
    3077          END DO 
    3078          IF (l_isend) THEN 
    3079             DO jr = 1,nsndto 
    3080                IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
    3081                   CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    3082                ENDIF 
    3083             END DO 
    3084          ENDIF 
    3085          ! 
    3086          DO ji = 1, num_fields     ! Loop to manage 3D variables 
    3087             CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) )  ! North fold boundary condition 
    3088          END DO 
    3089          ! 
    3090          DO jk = 1, num_fields 
    3091             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
    3092                ij = jj - nlcj + ijpj 
    3093                DO ji = 1, nlci 
    3094                   pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk)       ! Modified to 3D 
    3095                END DO 
    3096             END DO 
    3097          END DO 
    3098           
    3099          ! 
    3100       ELSE 
    3101          ! 
    3102          CALL MPI_ALLGATHER( znorthloc  , itaille*num_fields, MPI_DOUBLE_PRECISION,        & 
    3103             &                znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    3104          ! 
    3105          ztab(:,:,:) = 0.e0 
    3106          DO jk = 1, num_fields 
    3107             DO jr = 1, ndim_rank_north            ! recover the global north array 
    3108                iproc = nrank_north(jr) + 1 
    3109                ildi = nldit (iproc) 
    3110                ilei = nleit (iproc) 
    3111                iilb = nimppt(iproc) 
    3112                DO jj = 1, ijpj 
    3113                   DO ji = ildi, ilei 
    3114                      ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr) 
    3115                   END DO 
    3116                END DO 
    3117             END DO 
    3118          END DO 
    3119           
    3120          DO ji = 1, num_fields 
    3121             CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) )   ! North fold boundary condition 
    3122          END DO 
    3123          ! 
    3124          DO jk = 1, num_fields 
    3125             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d 
    3126                ij = jj - nlcj + ijpj 
    3127                DO ji = 1, nlci 
    3128                   pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk) 
    3129                END DO 
    3130             END DO 
    3131          END DO 
    3132          ! 
    3133          ! 
    3134       ENDIF 
    3135       DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio ) 
    3136       DEALLOCATE( ztabl, ztabr ) 
    3137       ! 
    3138    END SUBROUTINE mpp_lbc_north_2d_multiple 
    3139  
    31401460   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn) 
    31411461      !!--------------------------------------------------------------------- 
     
    31551475      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    31561476      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points 
    3157       !                                                                                         !   = T ,  U , V , F or W -points 
    3158       REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the 
    3159       !!                                                                                        ! north fold, =  1. otherwise 
     1477      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! sign used across the north fold 
     1478      ! 
    31601479      INTEGER ::   ji, jj, jr 
    31611480      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    31621481      INTEGER ::   ijpj, ij, iproc 
    3163       ! 
    31641482      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e 
    31651483      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e 
    3166  
    31671484      !!---------------------------------------------------------------------- 
    31681485      ! 
    31691486      ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 
    3170  
    31711487      ! 
    31721488      ijpj=4 
    3173       ztab_e(:,:) = 0.e0 
    3174  
    3175       ij=0 
     1489      ztab_e(:,:) = 0._wp 
     1490 
     1491      ij = 0 
    31761492      ! put in znorthloc_e the last 4 jlines of pt2d 
    31771493      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 
    31781494         ij = ij + 1 
    31791495         DO ji = 1, jpi 
    3180             znorthloc_e(ji,ij)=pt2d(ji,jj) 
     1496            znorthloc_e(ji,ij) = pt2d(ji,jj) 
    31811497         END DO 
    31821498      END DO 
    31831499      ! 
    31841500      itaille = jpi * ( ijpj + 2 * jpr2dj ) 
    3185       CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    & 
     1501      CALL MPI_ALLGATHER( znorthloc_e(1,1)    , itaille, MPI_DOUBLE_PRECISION,    & 
    31861502         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    31871503      ! 
    31881504      DO jr = 1, ndim_rank_north            ! recover the global north array 
    31891505         iproc = nrank_north(jr) + 1 
    3190          ildi = nldit (iproc) 
    3191          ilei = nleit (iproc) 
    3192          iilb = nimppt(iproc) 
     1506         ildi  = nldit (iproc) 
     1507         ilei  = nleit (iproc) 
     1508         iilb  = nimppt(iproc) 
    31931509         DO jj = 1, ijpj+2*jpr2dj 
    31941510            DO ji = ildi, ilei 
     
    31981514      END DO 
    31991515 
    3200  
    32011516      ! 2. North-Fold boundary conditions 
    32021517      ! ---------------------------------- 
    3203       CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 
     1518!!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 
    32041519 
    32051520      ij = jpr2dj 
     
    32151530      ! 
    32161531   END SUBROUTINE mpp_lbc_north_e 
    3217  
    3218  
    3219    SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy ) 
    3220       !!---------------------------------------------------------------------- 
    3221       !!                  ***  routine mpp_lnk_bdy_3d  *** 
    3222       !! 
    3223       !! ** Purpose :   Message passing management 
    3224       !! 
    3225       !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries  
    3226       !!      between processors following neighboring subdomains. 
    3227       !!            domain parameters 
    3228       !!                    nlci   : first dimension of the local subdomain 
    3229       !!                    nlcj   : second dimension of the local subdomain 
    3230       !!                    nbondi_bdy : mark for "east-west local boundary" 
    3231       !!                    nbondj_bdy : mark for "north-south local boundary" 
    3232       !!                    noea   : number for local neighboring processors  
    3233       !!                    nowe   : number for local neighboring processors 
    3234       !!                    noso   : number for local neighboring processors 
    3235       !!                    nono   : number for local neighboring processors 
    3236       !! 
    3237       !! ** Action  :   ptab with update value at its periphery 
    3238       !! 
    3239       !!---------------------------------------------------------------------- 
    3240       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    3241       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    3242       !                                                             ! = T , U , V , F , W points 
    3243       REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    3244       !                                                             ! =  1. , the sign is kept 
    3245       INTEGER                         , INTENT(in   ) ::   ib_bdy   ! BDY boundary set 
    3246       ! 
    3247       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices 
    3248       INTEGER  ::   imigr, iihom, ijhom        ! local integers 
    3249       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    3250       REAL(wp) ::   zland                      ! local scalar 
    3251       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    3252       ! 
    3253       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north 
    3254       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east 
    3255       !!---------------------------------------------------------------------- 
    3256       ! 
    3257       ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   & 
    3258          &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  ) 
    3259  
    3260       zland = 0._wp 
    3261  
    3262       ! 1. standard boundary treatment 
    3263       ! ------------------------------ 
    3264       !                                   ! East-West boundaries 
    3265       !                                        !* Cyclic east-west 
    3266       IF( nbondi == 2) THEN 
    3267          IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 
    3268             ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    3269             ptab(jpi,:,:) = ptab(  2  ,:,:) 
    3270          ELSE 
    3271             IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point 
    3272             ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north 
    3273          ENDIF 
    3274       ELSEIF(nbondi == -1) THEN 
    3275          IF( .NOT. cd_type == 'F' )   ptab(1:jpreci,:,:) = zland    ! south except F-point 
    3276       ELSEIF(nbondi == 1) THEN 
    3277          ptab(nlci-jpreci+1:jpi,:,:) = zland    ! north 
    3278       ENDIF                                     !* closed 
    3279  
    3280       IF (nbondj == 2 .OR. nbondj == -1) THEN 
    3281         IF( .NOT. cd_type == 'F' )   ptab(:,1:jprecj,:) = zland       ! south except F-point 
    3282       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
    3283         ptab(:,nlcj-jprecj+1:jpj,:) = zland       ! north 
    3284       ENDIF 
    3285       ! 
    3286       ! 2. East and west directions exchange 
    3287       ! ------------------------------------ 
    3288       ! we play with the neigbours AND the row number because of the periodicity  
    3289       ! 
    3290       SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions 
    3291       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    3292          iihom = nlci-nreci 
    3293          DO jl = 1, jpreci 
    3294             zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
    3295             zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    3296          END DO 
    3297       END SELECT 
    3298       ! 
    3299       !                           ! Migrations 
    3300       imigr = jpreci * jpj * jpk 
    3301       ! 
    3302       SELECT CASE ( nbondi_bdy(ib_bdy) ) 
    3303       CASE ( -1 ) 
    3304          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 
    3305       CASE ( 0 ) 
    3306          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    3307          CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 
    3308       CASE ( 1 ) 
    3309          CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 
    3310       END SELECT 
    3311       ! 
    3312       SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
    3313       CASE ( -1 ) 
    3314          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    3315       CASE ( 0 ) 
    3316          CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 
    3317          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    3318       CASE ( 1 ) 
    3319          CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 
    3320       END SELECT 
    3321       ! 
    3322       SELECT CASE ( nbondi_bdy(ib_bdy) ) 
    3323       CASE ( -1 ) 
    3324          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3325       CASE ( 0 ) 
    3326          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3327          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    3328       CASE ( 1 ) 
    3329          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3330       END SELECT 
    3331       ! 
    3332       !                           ! Write Dirichlet lateral conditions 
    3333       iihom = nlci-jpreci 
    3334       ! 
    3335       SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
    3336       CASE ( -1 ) 
    3337          DO jl = 1, jpreci 
    3338             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    3339          END DO 
    3340       CASE ( 0 ) 
    3341          DO jl = 1, jpreci 
    3342             ptab(      jl,:,:) = zt3we(:,jl,:,2) 
    3343             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    3344          END DO 
    3345       CASE ( 1 ) 
    3346          DO jl = 1, jpreci 
    3347             ptab(      jl,:,:) = zt3we(:,jl,:,2) 
    3348          END DO 
    3349       END SELECT 
    3350  
    3351  
    3352       ! 3. North and south directions 
    3353       ! ----------------------------- 
    3354       ! always closed : we play only with the neigbours 
    3355       ! 
    3356       IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    3357          ijhom = nlcj-nrecj 
    3358          DO jl = 1, jprecj 
    3359             zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
    3360             zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
    3361          END DO 
    3362       ENDIF 
    3363       ! 
    3364       !                           ! Migrations 
    3365       imigr = jprecj * jpi * jpk 
    3366       ! 
    3367       SELECT CASE ( nbondj_bdy(ib_bdy) ) 
    3368       CASE ( -1 ) 
    3369          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 
    3370       CASE ( 0 ) 
    3371          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    3372          CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 
    3373       CASE ( 1 ) 
    3374          CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 
    3375       END SELECT 
    3376       ! 
    3377       SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
    3378       CASE ( -1 ) 
    3379          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    3380       CASE ( 0 ) 
    3381          CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 
    3382          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    3383       CASE ( 1 ) 
    3384          CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 
    3385       END SELECT 
    3386       ! 
    3387       SELECT CASE ( nbondj_bdy(ib_bdy) ) 
    3388       CASE ( -1 ) 
    3389          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3390       CASE ( 0 ) 
    3391          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3392          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    3393       CASE ( 1 ) 
    3394          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3395       END SELECT 
    3396       ! 
    3397       !                           ! Write Dirichlet lateral conditions 
    3398       ijhom = nlcj-jprecj 
    3399       ! 
    3400       SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
    3401       CASE ( -1 ) 
    3402          DO jl = 1, jprecj 
    3403             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    3404          END DO 
    3405       CASE ( 0 ) 
    3406          DO jl = 1, jprecj 
    3407             ptab(:,jl      ,:) = zt3sn(:,jl,:,2) 
    3408             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    3409          END DO 
    3410       CASE ( 1 ) 
    3411          DO jl = 1, jprecj 
    3412             ptab(:,jl,:) = zt3sn(:,jl,:,2) 
    3413          END DO 
    3414       END SELECT 
    3415  
    3416  
    3417       ! 4. north fold treatment 
    3418       ! ----------------------- 
    3419       ! 
    3420       IF( npolj /= 0) THEN 
    3421          ! 
    3422          SELECT CASE ( jpni ) 
    3423          CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
    3424          CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
    3425          END SELECT 
    3426          ! 
    3427       ENDIF 
    3428       ! 
    3429       DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  ) 
    3430       ! 
    3431    END SUBROUTINE mpp_lnk_bdy_3d 
    3432  
    3433  
    3434    SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy ) 
    3435       !!---------------------------------------------------------------------- 
    3436       !!                  ***  routine mpp_lnk_bdy_2d  *** 
    3437       !! 
    3438       !! ** Purpose :   Message passing management 
    3439       !! 
    3440       !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries  
    3441       !!      between processors following neighboring subdomains. 
    3442       !!            domain parameters 
    3443       !!                    nlci   : first dimension of the local subdomain 
    3444       !!                    nlcj   : second dimension of the local subdomain 
    3445       !!                    nbondi_bdy : mark for "east-west local boundary" 
    3446       !!                    nbondj_bdy : mark for "north-south local boundary" 
    3447       !!                    noea   : number for local neighboring processors  
    3448       !!                    nowe   : number for local neighboring processors 
    3449       !!                    noso   : number for local neighboring processors 
    3450       !!                    nono   : number for local neighboring processors 
    3451       !! 
    3452       !! ** Action  :   ptab with update value at its periphery 
    3453       !! 
    3454       !!---------------------------------------------------------------------- 
    3455       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied 
    3456       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points 
    3457       !                                                         ! = T , U , V , F , W points 
    3458       REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary 
    3459       !                                                         ! =  1. , the sign is kept 
    3460       INTEGER                     , INTENT(in   ) ::   ib_bdy   ! BDY boundary set 
    3461       ! 
    3462       INTEGER  ::   ji, jj, jl             ! dummy loop indices 
    3463       INTEGER  ::   imigr, iihom, ijhom        ! local integers 
    3464       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    3465       REAL(wp) ::   zland 
    3466       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    3467       ! 
    3468       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north 
    3469       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east 
    3470       !!---------------------------------------------------------------------- 
    3471  
    3472       ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  & 
    3473          &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   ) 
    3474  
    3475       zland = 0._wp 
    3476  
    3477       ! 1. standard boundary treatment 
    3478       ! ------------------------------ 
    3479       !                                   ! East-West boundaries 
    3480       !                                      !* Cyclic east-west 
    3481       IF( nbondi == 2 ) THEN 
    3482          IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 
    3483             ptab( 1 ,:) = ptab(jpim1,:) 
    3484             ptab(jpi,:) = ptab(  2  ,:) 
    3485          ELSE 
    3486             IF(.NOT.cd_type == 'F' )  ptab(     1       :jpreci,:) = zland    ! south except F-point 
    3487                                       ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    3488          ENDIF 
    3489       ELSEIF(nbondi == -1) THEN 
    3490          IF( .NOT.cd_type == 'F' )    ptab(     1       :jpreci,:) = zland    ! south except F-point 
    3491       ELSEIF(nbondi == 1) THEN 
    3492                                       ptab(nlci-jpreci+1:jpi   ,:) = zland    ! north 
    3493       ENDIF 
    3494       !                                      !* closed 
    3495       IF( nbondj == 2 .OR. nbondj == -1 ) THEN 
    3496          IF( .NOT.cd_type == 'F' )    ptab(:,     1       :jprecj) = zland    ! south except F-point 
    3497       ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 
    3498                                       ptab(:,nlcj-jprecj+1:jpj   ) = zland    ! north 
    3499       ENDIF 
    3500       ! 
    3501       ! 2. East and west directions exchange 
    3502       ! ------------------------------------ 
    3503       ! we play with the neigbours AND the row number because of the periodicity  
    3504       ! 
    3505       SELECT CASE ( nbondi_bdy(ib_bdy) )      ! Read Dirichlet lateral conditions 
    3506       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    3507          iihom = nlci-nreci 
    3508          DO jl = 1, jpreci 
    3509             zt2ew(:,jl,1) = ptab(jpreci+jl,:) 
    3510             zt2we(:,jl,1) = ptab(iihom +jl,:) 
    3511          END DO 
    3512       END SELECT 
    3513       ! 
    3514       !                           ! Migrations 
    3515       imigr = jpreci * jpj 
    3516       ! 
    3517       SELECT CASE ( nbondi_bdy(ib_bdy) ) 
    3518       CASE ( -1 ) 
    3519          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 
    3520       CASE ( 0 ) 
    3521          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    3522          CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 
    3523       CASE ( 1 ) 
    3524          CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 
    3525       END SELECT 
    3526       ! 
    3527       SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
    3528       CASE ( -1 ) 
    3529          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    3530       CASE ( 0 ) 
    3531          CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 
    3532          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    3533       CASE ( 1 ) 
    3534          CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 
    3535       END SELECT 
    3536       ! 
    3537       SELECT CASE ( nbondi_bdy(ib_bdy) ) 
    3538       CASE ( -1 ) 
    3539          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3540       CASE ( 0 ) 
    3541          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3542          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    3543       CASE ( 1 ) 
    3544          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3545       END SELECT 
    3546       ! 
    3547       !                           ! Write Dirichlet lateral conditions 
    3548       iihom = nlci-jpreci 
    3549       ! 
    3550       SELECT CASE ( nbondi_bdy_b(ib_bdy) ) 
    3551       CASE ( -1 ) 
    3552          DO jl = 1, jpreci 
    3553             ptab(iihom+jl,:) = zt2ew(:,jl,2) 
    3554          END DO 
    3555       CASE ( 0 ) 
    3556          DO jl = 1, jpreci 
    3557             ptab(jl      ,:) = zt2we(:,jl,2) 
    3558             ptab(iihom+jl,:) = zt2ew(:,jl,2) 
    3559          END DO 
    3560       CASE ( 1 ) 
    3561          DO jl = 1, jpreci 
    3562             ptab(jl      ,:) = zt2we(:,jl,2) 
    3563          END DO 
    3564       END SELECT 
    3565  
    3566  
    3567       ! 3. North and south directions 
    3568       ! ----------------------------- 
    3569       ! always closed : we play only with the neigbours 
    3570       ! 
    3571       IF( nbondj_bdy(ib_bdy) /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    3572          ijhom = nlcj-nrecj 
    3573          DO jl = 1, jprecj 
    3574             zt2sn(:,jl,1) = ptab(:,ijhom +jl) 
    3575             zt2ns(:,jl,1) = ptab(:,jprecj+jl) 
    3576          END DO 
    3577       ENDIF 
    3578       ! 
    3579       !                           ! Migrations 
    3580       imigr = jprecj * jpi 
    3581       ! 
    3582       SELECT CASE ( nbondj_bdy(ib_bdy) ) 
    3583       CASE ( -1 ) 
    3584          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 
    3585       CASE ( 0 ) 
    3586          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    3587          CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 
    3588       CASE ( 1 ) 
    3589          CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 
    3590       END SELECT 
    3591       ! 
    3592       SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
    3593       CASE ( -1 ) 
    3594          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    3595       CASE ( 0 ) 
    3596          CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 
    3597          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    3598       CASE ( 1 ) 
    3599          CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 
    3600       END SELECT 
    3601       ! 
    3602       SELECT CASE ( nbondj_bdy(ib_bdy) ) 
    3603       CASE ( -1 ) 
    3604          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3605       CASE ( 0 ) 
    3606          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3607          IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 
    3608       CASE ( 1 ) 
    3609          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 
    3610       END SELECT 
    3611       ! 
    3612       !                           ! Write Dirichlet lateral conditions 
    3613       ijhom = nlcj-jprecj 
    3614       ! 
    3615       SELECT CASE ( nbondj_bdy_b(ib_bdy) ) 
    3616       CASE ( -1 ) 
    3617          DO jl = 1, jprecj 
    3618             ptab(:,ijhom+jl) = zt2ns(:,jl,2) 
    3619          END DO 
    3620       CASE ( 0 ) 
    3621          DO jl = 1, jprecj 
    3622             ptab(:,jl      ) = zt2sn(:,jl,2) 
    3623             ptab(:,ijhom+jl) = zt2ns(:,jl,2) 
    3624          END DO 
    3625       CASE ( 1 ) 
    3626          DO jl = 1, jprecj 
    3627             ptab(:,jl) = zt2sn(:,jl,2) 
    3628          END DO 
    3629       END SELECT 
    3630  
    3631  
    3632       ! 4. north fold treatment 
    3633       ! ----------------------- 
    3634       ! 
    3635       IF( npolj /= 0) THEN 
    3636          ! 
    3637          SELECT CASE ( jpni ) 
    3638          CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp 
    3639          CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs. 
    3640          END SELECT 
    3641          ! 
    3642       ENDIF 
    3643       ! 
    3644       DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  ) 
    3645       ! 
    3646    END SUBROUTINE mpp_lnk_bdy_2d 
    36471532 
    36481533 
     
    37061591   END SUBROUTINE mpi_init_opa 
    37071592 
    3708    SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 
     1593 
     1594   SUBROUTINE DDPDD_MPI( ydda, yddb, ilen, itype ) 
    37091595      !!--------------------------------------------------------------------- 
    37101596      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD 
     
    37131599      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i) 
    37141600      !!--------------------------------------------------------------------- 
    3715       INTEGER, INTENT(in)                         :: ilen, itype 
    3716       COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda 
    3717       COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb 
     1601      INTEGER                     , INTENT(in)    ::  ilen, itype 
     1602      COMPLEX(wp), DIMENSION(ilen), INTENT(in)    ::  ydda 
     1603      COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::  yddb 
    37181604      ! 
    37191605      REAL(wp) :: zerr, zt1, zt2    ! local work variables 
    3720       INTEGER :: ji, ztmp           ! local scalar 
    3721  
     1606      INTEGER  :: ji, ztmp           ! local scalar 
     1607      !!--------------------------------------------------------------------- 
     1608      ! 
    37221609      ztmp = itype   ! avoid compilation warning 
    3723  
     1610      ! 
    37241611      DO ji=1,ilen 
    37251612      ! Compute ydda + yddb using Knuth's trick. 
     
    37321619         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp ) 
    37331620      END DO 
    3734  
     1621      ! 
    37351622   END SUBROUTINE DDPDD_MPI 
    37361623 
     
    38021689      END DO 
    38031690 
    3804  
    38051691      ! 2. North-Fold boundary conditions 
    38061692      ! ---------------------------------- 
    3807       CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 
     1693!!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 
    38081694 
    38091695      ij = ipr2dj 
     
    38411727      !!                    nono   : number for local neighboring processors 
    38421728      !!---------------------------------------------------------------------- 
     1729      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
     1730      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
     1731      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! sign used across the north fold 
    38431732      INTEGER                                             , INTENT(in   ) ::   jpri 
    38441733      INTEGER                                             , INTENT(in   ) ::   jprj 
    3845       REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    3846       CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
    3847       !                                                                                 ! = T , U , V , F , W and I points 
    3848       REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the 
    3849       !!                                                                                ! north boundary, =  1. otherwise 
     1734      ! 
    38501735      INTEGER  ::   jl   ! dummy loop indices 
    3851       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    3852       INTEGER  ::   ipreci, iprecj             ! temporary integers 
     1736      INTEGER  ::   imigr, iihom, ijhom        ! local integers 
     1737      INTEGER  ::   ipreci, iprecj             !   -       - 
    38531738      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    38541739      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    38551740      !! 
    3856       REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 
    3857       REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 
    3858       REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 
    3859       REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 
     1741      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) ::   r2dns, r2dsn 
     1742      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) ::   r2dwe, r2dew 
    38601743      !!---------------------------------------------------------------------- 
    38611744 
     
    38751758         ! 
    38761759      ELSE                                        !* closed 
    3877          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point 
    3878                                       pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north 
     1760         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp    ! south except at F-point 
     1761                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp    ! north 
    38791762      ENDIF 
    38801763      ! 
     
    38851768         ! 
    38861769         SELECT CASE ( jpni ) 
    3887          CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
    3888          CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  ) 
     1770!!gm ERROR         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
     1771!!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  ) 
    38891772         END SELECT 
    38901773         ! 
     
    39961879         END DO 
    39971880      END SELECT 
    3998  
     1881      ! 
    39991882   END SUBROUTINE mpp_lnk_2d_icb 
    40001883    
     
    40201903      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 
    40211904   END INTERFACE 
     1905   INTERFACE mpp_max_multiple 
     1906      MODULE PROCEDURE mppmax_real_multiple 
     1907   END INTERFACE 
    40221908 
    40231909   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag 
     
    41912077      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom 
    41922078   END SUBROUTINE mpp_comm_free 
     2079    
     2080   SUBROUTINE mppmax_real_multiple( ptab, kdim , kcom  ) 
     2081      REAL, DIMENSION(:) ::   ptab   !  
     2082      INTEGER            ::   kdim   !  
     2083      INTEGER, OPTIONAL  ::   kcom   !  
     2084      WRITE(*,*) 'mppmax_real_multiple: You should not have seen this print! error?', ptab(1), kdim 
     2085   END SUBROUTINE mppmax_real_multiple 
     2086 
    41932087#endif 
    41942088 
     
    42252119                               CALL FLUSH(numout    ) 
    42262120      IF( numstp     /= -1 )   CALL FLUSH(numstp    ) 
    4227       IF( numsol     /= -1 )   CALL FLUSH(numsol    ) 
     2121      IF( numrun     /= -1 )   CALL FLUSH(numrun    ) 
    42282122      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice) 
    42292123      ! 
     
    43322226            WRITE(kout,*) 
    43332227         ENDIF 
    4334          CALL FLUSH(kout)  
     2228         CALL FLUSH( kout )  
    43352229         STOP 'ctl_opn bad opening' 
    43362230      ENDIF 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r8733 r8738  
    291291            END DO 
    292292         ENDIF 
    293 #if defined key_lim2 || defined key_lim3 
     293#if defined key_lim3 
    294294         IF (ln_sic) THEN 
    295295            jtype = jtype + 1 
     
    539539#if defined  key_lim3 
    540540      USE ice, ONLY : &            ! LIM3 Ice model variables 
    541          & frld 
    542 #endif 
    543 #if defined key_lim2 
    544       USE ice_2, ONLY : &          ! LIM2 Ice model variables 
    545          & frld 
     541         & at_i 
    546542#endif 
    547543      IMPLICIT NONE 
     
    567563         & zgphi1,    &            ! Model latitudes for prof variable 1 
    568564         & zgphi2                  ! Model latitudes for prof variable 2 
    569 #if ! defined key_lim2 && ! defined key_lim3 
    570       REAL(wp), POINTER, DIMENSION(:,:) :: frld 
     565#if ! defined key_lim3 
     566      REAL(wp), POINTER, DIMENSION(:,:) :: at_i 
    571567#endif 
    572568      LOGICAL :: llnightav        ! Logical for calculating night-time average 
     
    582578      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
    583579      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    584 #if ! defined key_lim2 && ! defined key_lim3 
    585       CALL wrk_alloc(jpi,jpj,frld)  
     580#if ! defined key_lim3 
     581      CALL wrk_alloc(jpi,jpj,at_i)  
    586582#endif 
    587583 
     
    595591 
    596592      !----------------------------------------------------------------------- 
    597       ! No LIM => frld == 0.0_wp 
    598       !----------------------------------------------------------------------- 
    599 #if ! defined key_lim2 && ! defined key_lim3 
    600       frld(:,:) = 0.0_wp 
     593      ! No LIM => at_i == 0.0_wp 
     594      !----------------------------------------------------------------------- 
     595#if ! defined key_lim3 
     596      at_i(:,:) = 0.0_wp 
    601597#endif 
    602598      !----------------------------------------------------------------------- 
     
    665661               zsurfvar(:,:) = sshn(:,:) 
    666662               llnightav = .FALSE. 
    667 #if defined key_lim2 || defined key_lim3 
     663#if defined key_lim3 
    668664            CASE('sic') 
    669665               IF ( kstp == 0 ) THEN 
     
    678674                  CYCLE 
    679675               ELSE 
    680                   zsurfvar(:,:) = 1._wp - frld(:,:) 
     676                  zsurfvar(:,:) = at_i(:,:) 
    681677               ENDIF 
    682678 
     
    702698      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
    703699      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    704 #if ! defined key_lim2 && ! defined key_lim3 
    705       CALL wrk_dealloc(jpi,jpj,frld) 
     700#if ! defined key_lim3 
     701      CALL wrk_dealloc(jpi,jpj,at_i) 
    706702#endif 
    707703 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r8733 r8738  
    116116   END TYPE WGT 
    117117 
    118    INTEGER,     PARAMETER             ::   tot_wgts = 10 
     118   INTEGER,     PARAMETER             ::   tot_wgts = 20 
    119119   TYPE( WGT ), DIMENSION(tot_wgts)   ::   ref_wgts     ! array of wgts 
    120120   INTEGER                            ::   nxt_wgt = 1  ! point to next available space in ref_wgts array 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r8733 r8738  
    99   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_lim3 || defined key_lim2 || defined key_cice 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model 
     11#if defined key_lim3 || defined key_cice 
     12   !!---------------------------------------------------------------------- 
     13   !!   'key_lim3' :            LIM-3 sea-ice model 
    1414   !!---------------------------------------------------------------------- 
    1515   USE par_oce          ! ocean parameters 
     
    1818   USE ice              ! LIM-3 parameters 
    1919# endif 
    20 # if defined key_lim2 
    21    USE par_ice_2        ! LIM-2 parameters 
    22    USE ice_2 
    23 # endif 
    2420# if defined key_cice 
    2521   USE ice_domain_size, only: ncat  
     
    3127   PRIVATE 
    3228 
    33    PUBLIC sbc_ice_alloc ! called in iceini(_2).F90 
    34  
    35 # if defined  key_lim2 
    36    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    37    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
    38    LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
    39 #  if defined key_lim2_vp 
    40    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner) 
    41 #  else 
    42    CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: EVP: 'C'-grid ice-velocity 
    43 #  endif 
    44 # endif 
     29   PUBLIC sbc_ice_alloc ! called in sbcmod.F90 
     30 
    4531# if defined  key_lim3 
    46    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    4732   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model 
    4833   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  
     
    5035# endif 
    5136# if defined  key_cice 
    52    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 
    5337   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 
    5438   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .TRUE.   !: CICE ice model 
     
    8367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   qprec_ice      !: enthalpy of precip over ice                 [J/m3] 
    8468   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
    85 #endif 
    86 #if defined key_lim3 || defined key_lim2 
    8769   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
    8870#endif 
     
    10688   INTEGER , PUBLIC, PARAMETER ::   jpl = ncat 
    10789   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice          ! jpi, jpj 
    108 #endif 
    10990    
    110 #if defined key_lim2 || defined key_cice 
    11191   ! already defined in ice.F90 for LIM3 
    11292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i 
    113    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
    114 #endif 
    115  
    116 #if defined key_cice 
     93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  h_i, h_s 
     94 
    11795   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice       !: air temperature [K] 
    11896#endif 
    11997 
    12098   REAL(wp), PUBLIC, SAVE ::   cldf_ice = 0.81    !: cloud fraction over sea ice, summer CLIO value   [-] 
     99 
     100   !! arrays relating to embedding ice in the ocean 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
    121104 
    122105   !!---------------------------------------------------------------------- 
     
    131114      !!                     ***  FUNCTION sbc_ice_alloc  *** 
    132115      !!---------------------------------------------------------------------- 
    133       INTEGER :: ierr(5) 
     116      INTEGER :: ierr(4) 
    134117      !!---------------------------------------------------------------------- 
    135118      ierr(:) = 0 
    136119 
    137 #if defined key_lim3 || defined key_lim2 
     120      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 
     121 
     122#if defined key_lim3 
    138123      ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) ,     & 
    139124         &      qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) ,     & 
     
    141126         &      utau_ice(jpi,jpj)     , vtau_ice(jpi,jpj)     , wndm_ice(jpi,jpj)     ,   & 
    142127         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     & 
    143 #if defined key_lim2 
    144          &      a_i(jpi,jpj,jpl)      ,                             & 
    145 #endif 
    146 #if defined key_lim3 
    147128         &      evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) ,   & 
    148129         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) ,   & 
    149130         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce (jpi,jpj)  ,   & 
    150 #endif 
    151          &      emp_ice(jpi,jpj)      ,  STAT= ierr(1) ) 
     131         &      emp_ice(jpi,jpj)      ,  STAT= ierr(2) ) 
    152132#endif 
    153133 
     
    158138                ss_iov(jpi,jpj)       , fr_iu(jpi,jpj)        , fr_iv(jpi,jpj)        , & 
    159139                a_i(jpi,jpj,ncat)     , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 
    160                 STAT= ierr(1) ) 
     140                STAT= ierr(2) ) 
    161141      IF( ln_cpl )   ALLOCATE( u_ice(jpi,jpj)        , fr1_i0(jpi,jpj)       , tn_ice (jpi,jpj,1)    , & 
    162142         &                     v_ice(jpi,jpj)        , fr2_i0(jpi,jpj)       , alb_ice(jpi,jpj,1)    , & 
    163143         &                     emp_ice(jpi,jpj)      , qns_ice(jpi,jpj,1)    , dqns_ice(jpi,jpj,1)   , & 
    164          &                     STAT= ierr(2) ) 
    165        
    166 #endif 
    167          ! 
    168 #if defined key_cice || defined key_lim2 
    169       IF( ln_cpl )   ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 
     144         &                     STAT= ierr(3) )       
     145      IF( ln_cpl )   ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) ) 
    170146#endif 
    171147 
     
    177153#else 
    178154   !!---------------------------------------------------------------------- 
    179    !!   Default option                      NO LIM 2.0 or 3.0 or CICE sea-ice model 
    180    !!---------------------------------------------------------------------- 
     155   !!   Default option                      NO LIM3 or CICE sea-ice model 
     156   !!---------------------------------------------------------------------- 
     157   USE lib_mpp          ! MPP library 
    181158   USE in_out_manager   ! I/O manager 
    182    LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model 
     159 
     160   IMPLICIT NONE 
     161   PRIVATE 
     162 
     163   PUBLIC sbc_ice_alloc 
     164 
    183165   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model 
    184166   LOGICAL         , PUBLIC, PARAMETER ::   lk_cice    = .FALSE.  !: no CICE  ice model 
     
    191173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice 
    192174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    193    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i, ht_s 
     175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   h_i, h_s 
    194176   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt, botmelt 
     177   ! 
     178   !! arrays relating to embedding ice in the ocean. These arrays need to be declared  
     179   !! even if no ice model is required. In the no ice model or traditional levitating  
     180   !! ice cases they contain only zeros 
     181   !! --------------------- 
     182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
     183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
     184   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
     185 
     186CONTAINS 
     187   INTEGER FUNCTION sbc_ice_alloc() 
     188      !!---------------------------------------------------------------------- 
     189      !!                     ***  FUNCTION sbc_ice_alloc  *** 
     190      !!---------------------------------------------------------------------- 
     191      INTEGER :: ierr(1) 
     192      !!---------------------------------------------------------------------- 
     193      ierr(:) = 0 
     194      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 
     195      sbc_ice_alloc = MAXVAL( ierr ) 
     196      IF( lk_mpp            )   CALL mpp_sum ( sbc_ice_alloc ) 
     197      IF( sbc_ice_alloc > 0 )   CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed') 
     198   END FUNCTION sbc_ice_alloc 
    195199#endif 
    196200 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r8733 r8738  
    4747   LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice) 
    4848   INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3) 
    49    INTEGER , PUBLIC ::   nn_ice_embd    !: flag for levitating/embedding sea-ice in the ocean 
    50    !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect) 
    51    !                                             !: =1 levitating ice with mass and salt exchange but no presure effect 
    52    !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 
     49   LOGICAL , PUBLIC ::   ln_ice_embd    !: flag for levitating/embedding sea-ice in the ocean 
     50   !                                             !: =F levitating ice with mass and salt exchange but no presure effect 
     51   !                                             !: =T embedded sea-ice (full salt and mass exchanges and pressure) 
    5352   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)  
    54    INTEGER , PUBLIC ::   nn_limflx      !: LIM3 Multi-category heat flux formulation 
    55    !                                             !: =-1  Use of per-category fluxes 
    56    !                                             !: = 0  Average per-category fluxes 
    57    !                                             !: = 1  Average then redistribute per-category fluxes 
    58    !                                             !: = 2  Redistribute a single flux over categories 
    5953   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:  
    6054   !                                             !:  = 0 unchecked  
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r8733 r8738  
    4040   USE lib_fortran    ! to use key_nosignedzero 
    4141#if defined key_lim3 
    42    USE ice     , ONLY :   u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b 
    43    USE limthd_dh      ! for CALL lim_thd_snwblow 
    44 #elif defined key_lim2 
    45    USE ice_2   , ONLY :   u_ice, v_ice 
    46    USE par_ice_2      ! LIM-2 parameters 
     42   USE ice     , ONLY :   u_ice, v_ice, jpl, a_i_b, at_i_b, tm_su 
     43   USE icethd_dh      ! for CALL ice_thd_snwblow 
    4744#endif 
    4845   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)  
     
    6461   PUBLIC   sbc_blk_init  ! called in sbcmod 
    6562   PUBLIC   sbc_blk       ! called in sbcmod 
    66 #if defined key_lim2 || defined key_lim3 
    67    PUBLIC   blk_ice_tau   ! routine called in sbc_ice_lim module 
    68    PUBLIC   blk_ice_flx   ! routine called in sbc_ice_lim module 
     63#if defined key_lim3 
     64   PUBLIC   blk_ice_tau   ! routine called in icestp module 
     65   PUBLIC   blk_ice_flx   ! routine called in icestp module 
    6966#endif 
    7067 
     
    9693   REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation 
    9794   REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant 
    98    REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! iovi 1.63e-3     ! transfer coefficient over ice 
     95   REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice 
    9996   REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant 
    10097   ! 
     
    111108   REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements 
    112109   REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements 
    113    LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012) 
     110   LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012) 
     111   LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015) 
    114112   ! 
    115    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_oce   ! air-ocean drag (clem) 
     113   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau) 
     114   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens) 
     115   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat) 
     116   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme) 
     117   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme) 
     118   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme 
    116119 
    117120   INTEGER  ::   nblk           ! choice of the bulk algorithm 
     
    135138      !!             ***  ROUTINE sbc_blk_alloc *** 
    136139      !!------------------------------------------------------------------- 
    137       ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_alloc ) 
     140      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 
     141         &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
    138142      ! 
    139143      IF( lk_mpp             )   CALL mpp_sum ( sbc_blk_alloc ) 
     
    167171         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    168172         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         &  
    169          &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12 
     173         &                 rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15 
    170174      !!--------------------------------------------------------------------- 
    171175      ! 
     
    258262         WRITE(numout,*) '      factor applied on ocean/ice velocity                rn_vfac      = ', rn_vfac 
    259263         WRITE(numout,*) '         (form absolute (=0) to relative winds(=1))' 
     264         WRITE(numout,*) '      use ice-atm drag from Lupkes2012                    ln_Cd_L12    = ', ln_Cd_L12 
     265         WRITE(numout,*) '      use ice-atm drag from Lupkes2015                    ln_Cd_L15    = ', ln_Cd_L15 
    260266         ! 
    261267         WRITE(numout,*) 
     
    364370      REAL(wp), DIMENSION(:,:), POINTER ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
    365371      REAL(wp), DIMENSION(:,:), POINTER ::   zqla, zevap       ! latent heat fluxes and evaporation 
    366       REAL(wp), DIMENSION(:,:), POINTER ::   Cd                ! transfer coefficient for momentum      (tau) 
    367       REAL(wp), DIMENSION(:,:), POINTER ::   Ch                ! transfer coefficient for sensible heat (Q_sens) 
    368       REAL(wp), DIMENSION(:,:), POINTER ::   Ce                ! tansfert coefficient for evaporation   (Q_lat) 
    369372      REAL(wp), DIMENSION(:,:), POINTER ::   zst               ! surface temperature in Kelvin 
    370       REAL(wp), DIMENSION(:,:), POINTER ::   zt_zu             ! air temperature at wind speed height 
    371       REAL(wp), DIMENSION(:,:), POINTER ::   zq_zu             ! air spec. hum.  at wind speed height 
    372373      REAL(wp), DIMENSION(:,:), POINTER ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    373374      REAL(wp), DIMENSION(:,:), POINTER ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
     
    378379      ! 
    379380      CALL wrk_alloc( jpi,jpj,   zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap ) 
    380       CALL wrk_alloc( jpi,jpj,   Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    381       CALL wrk_alloc( jpi,jpj,   zU_zu, ztpot, zrhoa ) 
     381      CALL wrk_alloc( jpi,jpj,   zst, zU_zu, ztpot, zrhoa ) 
    382382      ! 
    383383 
     
    426426      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    427427 
    428  
    429  
    430428      ! ----------------------------------------------------------------------------- ! 
    431429      !     II    Turbulent FLUXES                                                    ! 
     
    443441      ! 
    444442      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2 
    445          &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     443         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    446444      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0 
    447          &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     445         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    448446      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5 
    449          &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     447         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    450448      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF 
    451          &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     449         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    452450      CASE DEFAULT 
    453451         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
     
    456454      !                          ! Compute true air density : 
    457455      IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...) 
    458          zrhoa(:,:) = rho_air( zt_zu(:,:)             , zq_zu(:,:)             , sf(jp_slp)%fnow(:,:,1) ) 
     456         zrhoa(:,:) = rho_air( t_zu(:,:)              , q_zu(:,:)              , sf(jp_slp)%fnow(:,:,1) ) 
    459457      ELSE                                      ! At zt: 
    460458         zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    461459      END IF 
    462460 
    463       Cd_oce(:,:) = Cd(:,:)  ! record value of pure ocean-atm. drag (clem) 
     461!!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef. 
     462!!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef. 
    464463 
    465464      DO jj = 1, jpj             ! tau module, i and j component 
    466465         DO ji = 1, jpi 
    467             zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd(ji,jj)   ! using bulk wind speed 
     466            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd_atm(ji,jj)   ! using bulk wind speed 
    468467            taum  (ji,jj) = zztmp * wndm  (ji,jj) 
    469468            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
     
    500499      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
    501500         !! q_air and t_air are given at 10m (wind reference height) 
    502          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 
    503          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed 
     501         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 
     502         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed 
    504503      ELSE 
    505504         !! q_air and t_air are not given at 10m (wind reference height) 
    506505         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
    507          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed 
    508          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) )   ! Sensible Heat ! using bulk wind speed 
     506         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed 
     507         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) )   ! Sensible Heat, using bulk wind speed 
    509508      ENDIF 
    510509 
     
    513512 
    514513      IF(ln_ctl) THEN 
    515          CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce , clinfo2=' Ce  : ' ) 
    516          CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch , clinfo2=' Ch  : ' ) 
     514         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce: zqla   : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce  : ' ) 
     515         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce: zqsb   : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce  : ' ) 
    517516         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
    518517         CALL prt_ctl( tab2d_1=zsq   , clinfo1=' blk_oce: zsq    : ', tab2d_2=zst, clinfo2=' zst : ' ) 
     
    566565      ! 
    567566      CALL wrk_dealloc( jpi,jpj,   zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap ) 
    568       CALL wrk_dealloc( jpi,jpj,   Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    569       CALL wrk_dealloc( jpi,jpj,   zU_zu, ztpot, zrhoa ) 
     567      CALL wrk_dealloc( jpi,jpj,   zst, zU_zu, ztpot, zrhoa ) 
    570568      ! 
    571569      IF( nn_timing == 1 )  CALL timing_stop('blk_oce') 
     
    573571   END SUBROUTINE blk_oce 
    574572 
    575 #if defined key_lim2 || defined key_lim3 
     573#if defined key_lim3 
    576574 
    577575   SUBROUTINE blk_ice_tau 
     
    591589      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f               ! relative wind module and components at F-point 
    592590      REAL(wp) ::             zwndi_t , zwndj_t               ! relative wind components at T-point 
    593       REAL(wp), DIMENSION(:,:), POINTER ::   Cd               ! transfer coefficient for momentum      (tau) 
    594591      !!--------------------------------------------------------------------- 
    595592      ! 
     
    597594      ! 
    598595      CALL wrk_alloc( jpi,jpj, zrhoa ) 
    599       CALL wrk_alloc( jpi,jpj, Cd ) 
    600  
    601       Cd(:,:) = Cd_ice 
    602  
    603       ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 
    604 #if defined key_lim3 
    605       IF( ln_Cd_L12 ) THEN 
    606          CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 
    607       ENDIF 
    608 #endif 
    609  
    610       ! local scalars ( place there for vector optimisation purposes) 
    611       ! Computing density of air! Way denser that 1.2 over sea-ice !!! 
    612       !! 
    613       zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
    614  
    615       !!gm brutal.... 
    616       utau_ice  (:,:) = 0._wp 
    617       vtau_ice  (:,:) = 0._wp 
    618       wndm_ice  (:,:) = 0._wp 
    619       !!gm end 
    620  
    621       ! ----------------------------------------------------------------------------- ! 
    622       !    Wind components and module relative to the moving ocean ( U10m - U_ice )   ! 
    623       ! ----------------------------------------------------------------------------- ! 
     596 
     597      ! set transfer coefficients to default sea-ice values 
     598      Cd_atm(:,:) = Cd_ice 
     599      Ch_atm(:,:) = Cd_ice 
     600      Ce_atm(:,:) = Cd_ice 
     601 
     602      wndm_ice(:,:) = 0._wp      !!gm brutal.... 
     603 
     604      ! ------------------------------------------------------------ ! 
     605      !    Wind module relative to the moving ice ( U10m - U_ice )   ! 
     606      ! ------------------------------------------------------------ ! 
    624607      SELECT CASE( cp_ice_msh ) 
    625608      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
     
    627610         DO jj = 2, jpjm1 
    628611            DO ji = 2, jpim1   ! B grid : NO vector opt 
    629                ! ... scalar wind at I-point (fld being at T-point) 
    630                zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    631                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj) 
    632                zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    633                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
    634                zwnorm_f = zrhoa(ji,jj) * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    635                ! ... ice stress at I-point 
    636                utau_ice(ji,jj) = zwnorm_f * zwndi_f 
    637                vtau_ice(ji,jj) = zwnorm_f * zwndj_f 
    638612               ! ... scalar wind at T-point (fld being at T-point) 
    639613               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   & 
     
    644618            END DO 
    645619         END DO 
    646          CALL lbc_lnk( utau_ice, 'I', -1. ) 
    647          CALL lbc_lnk( vtau_ice, 'I', -1. ) 
    648620         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    649621         ! 
    650622      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    651          DO jj = 2, jpj 
    652             DO ji = fs_2, jpi   ! vect. opt. 
     623         DO jj = 2, jpjm1 
     624            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    653625               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
    654626               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     
    656628            END DO 
    657629         END DO 
     630         CALL lbc_lnk( wndm_ice, 'T',  1. ) 
     631         ! 
     632      END SELECT 
     633 
     634      ! Make ice-atm. drag dependent on ice concentration 
     635      IF    ( ln_Cd_L12 ) THEN   ! calculate new drag from Lupkes(2012) equations 
     636         CALL Cdn10_Lupkes2012( Cd_atm ) 
     637         Ch_atm(:,:) = Cd_atm(:,:)       ! momentum and heat transfer coef. are considered identical 
     638      ELSEIF( ln_Cd_L15 ) THEN   ! calculate new drag from Lupkes(2015) equations 
     639         CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm )  
     640      ENDIF 
     641 
     642!!      CALL iom_put( "Cd_ice", Cd_atm)  ! output value of pure ice-atm. transfer coef. 
     643!!      CALL iom_put( "Ch_ice", Ch_atm)  ! output value of pure ice-atm. transfer coef. 
     644 
     645      ! local scalars ( place there for vector optimisation purposes) 
     646      ! Computing density of air! Way denser that 1.2 over sea-ice !!! 
     647      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
     648 
     649      !!gm brutal.... 
     650      utau_ice  (:,:) = 0._wp 
     651      vtau_ice  (:,:) = 0._wp 
     652      !!gm end 
     653 
     654      ! ------------------------------------------------------------ ! 
     655      !    Wind stress relative to the moving ice ( U10m - U_ice )   ! 
     656      ! ------------------------------------------------------------ ! 
     657      SELECT CASE( cp_ice_msh ) 
     658      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
     659         DO jj = 2, jpjm1 
     660            DO ji = 2, jpim1   ! B grid : NO vector opt 
     661               ! ... scalar wind at I-point (fld being at T-point) 
     662               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
     663                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj) 
     664               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
     665                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
     666               ! ... ice stress at I-point 
     667               zwnorm_f = zrhoa(ji,jj) * Cd_atm(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
     668               utau_ice(ji,jj) = zwnorm_f * zwndi_f 
     669               vtau_ice(ji,jj) = zwnorm_f * zwndj_f 
     670            END DO 
     671         END DO 
     672         CALL lbc_lnk( utau_ice, 'I', -1. ) 
     673         CALL lbc_lnk( vtau_ice, 'I', -1. ) 
     674         ! 
     675      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    658676         DO jj = 2, jpjm1 
    659677            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    660                utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
     678               utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )            & 
    661679                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
    662                vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
     680               vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )            & 
    663681                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
    664682            END DO 
     
    666684         CALL lbc_lnk( utau_ice, 'U', -1. ) 
    667685         CALL lbc_lnk( vtau_ice, 'V', -1. ) 
    668          CALL lbc_lnk( wndm_ice, 'T',  1. ) 
    669686         ! 
    670687      END SELECT 
     
    705722      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (LIM3) 
    706723      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa 
    707       REAL(wp), DIMENSION(:,:)  , POINTER ::   Cd            ! transfer coefficient for momentum      (tau) 
    708724      !!--------------------------------------------------------------------- 
    709725      ! 
     
    711727      ! 
    712728      CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    713       CALL wrk_alloc( jpi,jpj,       zrhoa) 
    714       CALL wrk_alloc( jpi,jpj, Cd ) 
    715  
    716       Cd(:,:) = Cd_ice 
    717  
    718       ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al.  2012) (clem) 
    719 #if defined key_lim3 
    720       IF( ln_Cd_L12 ) THEN 
    721          CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 
    722       ENDIF 
    723 #endif 
    724  
    725       ! 
    726       ! local scalars ( place there for vector optimisation purposes) 
     729      CALL wrk_alloc( jpi,jpj,       zrhoa ) 
     730      ! 
     731      ! local scalars 
    727732      zcoef_dqlw   = 4.0 * 0.95 * Stef 
    728733      zcoef_dqla   = -Ls * 11637800. * (-5897.8) 
     
    752757               ! ----------------------------! 
    753758 
    754                ! ... turbulent heat fluxes 
     759               ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau 
    755760               ! Sensible Heat 
    756                z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
     761               z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1)) 
    757762               ! Latent Heat 
    758                qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Cd(ji,jj) * wndm_ice(ji,jj)   & 
    759                   &                         * (  11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) ) 
     763               qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls  * Ch_atm(ji,jj) * wndm_ice(ji,jj) *  & 
     764                  &                ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) ) 
    760765               ! Latent heat sensitivity for ice (Dqla/Dt) 
    761766               IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 
    762                   dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Cd(ji,jj) * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 
     767                  dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) / zst2 * EXP(-5897.8 / ptsu(ji,jj,jl)) 
    763768               ELSE 
    764769                  dqla_ice(ji,jj,jl) = 0._wp 
     
    766771 
    767772               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    768                z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Cd(ji,jj) * wndm_ice(ji,jj) 
     773               z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) 
    769774 
    770775               ! ----------------------------! 
     
    786791      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
    787792 
    788 #if defined  key_lim3 
    789793      CALL wrk_alloc( jpi,jpj,   zevap, zsnw ) 
    790794 
     
    797801      ! --- evaporation minus precipitation --- ! 
    798802      zsnw(:,:) = 0._wp 
    799       CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
    800       emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
     803      CALL ice_thd_snwblow( (1.-at_i_b(:,:)), zsnw )  ! snow distribution over ice after wind blowing 
     804      emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
    801805      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
    802806      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
    803807 
    804808      ! --- heat flux associated with emp --- ! 
    805       qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst 
     809      qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp                  & ! evap at sst 
    806810         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
    807811         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
     
    811815 
    812816      ! --- total solar and non solar fluxes --- ! 
    813       qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
    814       qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     817      qns_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 )  & 
     818         &           + qemp_ice(:,:) + qemp_oce(:,:) 
     819      qsr_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
    815820 
    816821      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     
    824829 
    825830      CALL wrk_dealloc( jpi,jpj,   zevap, zsnw ) 
    826 #endif 
    827831 
    828832      !-------------------------------------------------------------------- 
     
    846850      CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    847851      CALL wrk_dealloc( jpi,jpj,       zrhoa ) 
    848       CALL wrk_dealloc( jpi,jpj, Cd ) 
    849852      ! 
    850853      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_flx') 
     
    973976 
    974977#if defined key_lim3 
     978 
    975979   SUBROUTINE Cdn10_Lupkes2012( Cd ) 
    976980      !!---------------------------------------------------------------------- 
     
    10221026       
    10231027   END SUBROUTINE Cdn10_Lupkes2012 
     1028 
     1029 
     1030   SUBROUTINE Cdn10_Lupkes2015( Cd, Ch ) 
     1031      !!---------------------------------------------------------------------- 
     1032      !!                      ***  ROUTINE  Cdn10_Lupkes2015  *** 
     1033      !! 
     1034      !! ** pUrpose :    1lternative turbulent transfert coefficients formulation 
     1035      !!                 between sea-ice and atmosphere with distinct momentum  
     1036      !!                 and heat coefficients depending on sea-ice concentration  
     1037      !!                 and atmospheric stability (no meltponds effect for now). 
     1038      !!                 
     1039      !! ** Method :     The parameterization is adapted from Lupkes et al. (2015) 
     1040      !!                 and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme, 
     1041      !!                 it considers specific skin and form drags (Andreas et al. 2010) 
     1042      !!                 to compute neutral transfert coefficients for both heat and  
     1043      !!                 momemtum fluxes. Atmospheric stability effect on transfert 
     1044      !!                 coefficient is also taken into account following Louis (1979). 
     1045      !! 
     1046      !! ** References : Lupkes et al. JGR 2015 (theory) 
     1047      !!                 Lupkes et al. ECHAM6 documentation 2015 (implementation) 
     1048      !! 
     1049      !!---------------------------------------------------------------------- 
     1050      ! 
     1051      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Cd 
     1052      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   Ch 
     1053      REAL(wp), DIMENSION(jpi,jpj)            ::   zst, zqo_sat, zqi_sat 
     1054      ! 
     1055      ! ECHAM6 constants 
     1056      REAL(wp), PARAMETER ::   z0_skin_ice  = 0.69e-3_wp  ! Eq. 43 [m] 
     1057      REAL(wp), PARAMETER ::   z0_form_ice  = 0.57e-3_wp  ! Eq. 42 [m] 
     1058      REAL(wp), PARAMETER ::   z0_ice       = 1.00e-3_wp  ! Eq. 15 [m] 
     1059      REAL(wp), PARAMETER ::   zce10        = 2.80e-3_wp  ! Eq. 41 
     1060      REAL(wp), PARAMETER ::   zbeta        = 1.1_wp      ! Eq. 41 
     1061      REAL(wp), PARAMETER ::   zc           = 5._wp       ! Eq. 13 
     1062      REAL(wp), PARAMETER ::   zc2          = zc * zc 
     1063      REAL(wp), PARAMETER ::   zam          = 2. * zc     ! Eq. 14 
     1064      REAL(wp), PARAMETER ::   zah          = 3. * zc     ! Eq. 30 
     1065      REAL(wp), PARAMETER ::   z1_alpha     = 1._wp / 0.2_wp  ! Eq. 51 
     1066      REAL(wp), PARAMETER ::   z1_alphaf    = z1_alpha    ! Eq. 56 
     1067      REAL(wp), PARAMETER ::   zbetah       = 1.e-3_wp    ! Eq. 26 
     1068      REAL(wp), PARAMETER ::   zgamma       = 1.25_wp     ! Eq. 26 
     1069      REAL(wp), PARAMETER ::   z1_gamma     = 1._wp / zgamma 
     1070      REAL(wp), PARAMETER ::   r1_3         = 1._wp / 3._wp 
     1071      ! 
     1072      INTEGER  ::   ji, jj         ! dummy loop indices 
     1073      REAL(wp) ::   zthetav_os, zthetav_is, zthetav_zu 
     1074      REAL(wp) ::   zrib_o, zrib_i 
     1075      REAL(wp) ::   zCdn_skin_ice, zCdn_form_ice, zCdn_ice 
     1076      REAL(wp) ::   zChn_skin_ice, zChn_form_ice 
     1077      REAL(wp) ::   z0w, z0i, zfmi, zfmw, zfhi, zfhw 
     1078      REAL(wp) ::   zCdn_form_tmp 
     1079      !!---------------------------------------------------------------------- 
     1080 
     1081      ! Momentum Neutral Transfert Coefficients (should be a constant) 
     1082      zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2   ! Eq. 40 
     1083      zCdn_skin_ice = ( vkarmn                                      / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2   ! Eq. 7 
     1084      zCdn_ice      = zCdn_skin_ice   ! Eq. 7 (cf Lupkes email for details) 
     1085      !zCdn_ice     = 1.89e-3         ! old ECHAM5 value (cf Eq. 32) 
     1086 
     1087      ! Heat Neutral Transfert Coefficients 
     1088      zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) )   ! Eq. 50 + Eq. 52 (cf Lupkes email for details) 
     1089      
     1090      ! Atmospheric and Surface Variables 
     1091      zst(:,:)     = sst_m(:,:) + rt0                                       ! convert SST from Celcius to Kelvin 
     1092      zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:)  , sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ocean [kg/kg] 
     1093      zqi_sat(:,:) = 0.98_wp * q_sat( tm_su(:,:), sf(jp_slp)%fnow(:,:,1) )  ! saturation humidity over ice   [kg/kg] 
     1094      ! 
     1095!!      DO jj = 2, jpjm1 
     1096!!         DO ji = fs_2, fs_jpim1 
     1097      DO jj = 1, jpj 
     1098         DO ji = 1, jpi 
     1099            ! Virtual potential temperature [K] 
     1100            zthetav_os = zst(ji,jj)   * ( 1._wp + rctv0 * zqo_sat(ji,jj) )   ! over ocean 
     1101            zthetav_is = tm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) )   ! ocean ice 
     1102            zthetav_zu = t_zu (ji,jj) * ( 1._wp + rctv0 * q_zu(ji,jj)    )   ! at zu 
     1103             
     1104            ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead) 
     1105            zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj)     )**2   ! over ocean 
     1106            zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2   ! over ice 
     1107             
     1108            ! Momentum and Heat Neutral Transfert Coefficients 
     1109            zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta  ! Eq. 40 
     1110            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53  
     1111                        
     1112            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead) 
     1113            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
     1114            z0i = z0_skin_ice                                             ! over ice (cf Lupkes email for details) 
     1115            IF( zrib_o <= 0._wp ) THEN 
     1116               zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) )  ! Eq. 10 
     1117               zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) )   &     ! Eq. 26 
     1118                  &             )**zgamma )**z1_gamma 
     1119            ELSE 
     1120               zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 12 
     1121               zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) )   ! Eq. 28 
     1122            ENDIF 
     1123             
     1124            IF( zrib_i <= 0._wp ) THEN 
     1125               zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq.  9 
     1126               zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp)))   ! Eq. 25 
     1127            ELSE 
     1128               zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 11 
     1129               zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) )   ! Eq. 27 
     1130            ENDIF 
     1131             
     1132            ! Momentum Transfert Coefficients (Eq. 38) 
     1133            Cd(ji,jj) = zCdn_skin_ice *   zfmi +  & 
     1134               &        zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
     1135             
     1136            ! Heat Transfert Coefficients (Eq. 49) 
     1137            Ch(ji,jj) = zChn_skin_ice *   zfhi +  & 
     1138               &        zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 
     1139            ! 
     1140         END DO 
     1141      END DO 
     1142!!      CALL lbc_lnk_multi( Cd, 'T',  1., Ch, 'T', 1. ) 
     1143      ! 
     1144   END SUBROUTINE Cdn10_Lupkes2015 
     1145 
    10241146#endif 
    1025     
    10261147 
    10271148   !!====================================================================== 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90

    r7646 r8738  
    5252   !! COARE own values for given constants: 
    5353   REAL(wp), PARAMETER :: & 
    54       &   zi0     = 600.,  &   !: scale height of the atmospheric boundary layer...1 
     54      &   zi0     = 600., &   !: scale height of the atmospheric boundary layer...1 
    5555      &  Beta0    = 1.25, &   !: gustiness parameter 
    5656      &  rctv0    = 0.608     !: constant to obtain virtual temperature... 
     
    6060 
    6161   SUBROUTINE turb_coare( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
    62       &                   Cd, Ch, Ce, t_zu, q_zu, U_blk ) 
     62      &                   Cd, Ch, Ce, t_zu, q_zu, U_blk,      & 
     63      &                   Cdn, Chn, Cen                       ) 
     64 
    6365      !!---------------------------------------------------------------------- 
    6466      !!                      ***  ROUTINE  turb_coare  *** 
     
    106108      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    107109      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     110      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    108111      ! 
    109112      INTEGER :: j_itt 
     
    246249      Ce   = ztmp0*q_star/dq_zu 
    247250      ! 
     251      ztmp1 = zu + z0 
     252      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
     253      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
     254      Cen = Chn 
     255      ! 
    248256      CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu ) 
    249257      CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90

    r7646 r8738  
    5858CONTAINS 
    5959 
    60    SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
    61       &                   Cd, Ch, Ce, t_zu, q_zu, U_blk ) 
     60   SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu,  & 
     61      &                      Cd, Ch, Ce, t_zu, q_zu, U_blk,       & 
     62      &                      Cdn, Chn, Cen                        ) 
     63 
    6264      !!---------------------------------------------------------------------------------- 
    6365      !!                      ***  ROUTINE  turb_coare3p5  *** 
     
    105107      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu             [kg/kg] 
    106108      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     109      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    107110      ! 
    108111      INTEGER :: j_itt 
     
    252255      Ce   = ztmp0*q_star/dq_zu 
    253256      ! 
     257      ztmp1 = zu + z0 
     258      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
     259      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
     260      Cen = Chn 
     261      ! 
    254262      CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu ) 
    255263      CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90

    r7646 r8738  
    6464 
    6565   SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu,   & 
    66       &                   Cd, Ch, Ce , t_zu, q_zu, U_blk ) 
     66      &                   Cd, Ch, Ce , t_zu, q_zu, U_blk,         & 
     67      &                   Cdn, Chn, Cen                           ) 
    6768      !!---------------------------------------------------------------------------------- 
    6869      !!                      ***  ROUTINE  turb_ecmwf  *** 
     
    112113      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    113114      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     115      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114116      ! 
    115117      INTEGER :: j_itt 
     
    266268            dt_zu = t_zu - sst ;  dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu ) 
    267269            dq_zu = q_zu - ssq ;  dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu ) 
     270 
    268271         END IF 
    269272 
     
    271274         ztmp1 = zu + z0 
    272275         ztmp0 = ztmp1*Linv 
    273          func_m = log(ztmp1) - LOG(z0) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv) 
     276         func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv) 
    274277         func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 
    275278 
     
    280283      ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv)   ! func_q 
    281284      Ce = vkarmn*vkarmn/(func_m*ztmp1) 
     285 
     286      ztmp1 = zu + z0 
     287      Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 
     288      Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 
     289      Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q)) 
    282290 
    283291      CALL wrk_dealloc( jpi,jpj,   u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90

    r7753 r8738  
    4848   !                              ! NCAR own values for given constants: 
    4949   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature... 
    50     
    5150   !!---------------------------------------------------------------------- 
    5251CONTAINS 
    5352 
    5453   SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 
    55       &                  Cd, Ch, Ce, t_zu, q_zu, U_blk ) 
     54      &                  Cd, Ch, Ce, t_zu, q_zu, U_blk,      & 
     55      &                  Cdn, Chn, Cen                       ) 
     56 
    5657      !!---------------------------------------------------------------------------------- 
    5758      !!                      ***  ROUTINE  turb_ncar  *** 
     
    112113      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    113114      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
     115      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cdn, Chn, Cen ! neutral transfer coefficients 
    114116      ! 
    115117      INTEGER ::   j_itt 
     
    199201            ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 
    200202            ztmp0 = cd_neutral_10m(ztmp0)                                               ! Cd_n10 
     203            Cdn(:,:) = ztmp0 
    201204            sqrt_Cd_n10 = sqrt(ztmp0) 
    202205 
    203206            stab    = 0.5 + sign(0.5,zeta_u)                           ! update stability 
    204207            Cx_n10  = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab))  ! L&Y 2004 eq. (6c-6d)    (Cx_n10 == Ch_n10) 
     208            Chn(:,:) = Cx_n10 
    205209 
    206210            !! Update of transfer coefficients: 
     
    216220 
    217221         Cx_n10  = 1.e-3 * (34.6 * sqrt_Cd_n10)  ! L&Y 2004 eq. (6b)    ! Cx_n10 == Ce_n10 
     222         Cen(:,:) = Cx_n10 
    218223         ztmp1 = 1. + Cx_n10*ztmp0 
    219224         Ce  = Cx_n10*ztmp2 / ztmp1  ! L&Y 2004 eq. (10c) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8733 r8738  
    2929   USE ice            ! ice variables 
    3030#endif 
    31 #if defined key_lim2 
    32    USE par_ice_2      ! ice parameters 
    33    USE ice_2          ! ice variables 
    34 #endif 
    3531   USE cpl_oasis3     ! OASIS3 coupling 
    3632   USE geo2ocean      !  
    3733   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 
    38    USE albedo         !  
     34   USE albedooce      !  
    3935   USE eosbn2         !  
    4036   USE sbcrnf, ONLY : l_rnfcpl 
     
    4440#endif 
    4541#if defined key_lim3 
    46    USE limthd_dh      ! for CALL lim_thd_snwblow 
     42   USE icethd_dh      ! for CALL ice_thd_snwblow 
    4743#endif 
    4844   ! 
     
    5854 
    5955   PUBLIC   sbc_cpl_init      ! routine called by sbcmod.F90 
    60    PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90 
     56   PUBLIC   sbc_cpl_rcv       ! routine called by icestp.F90 
    6157   PUBLIC   sbc_cpl_snd       ! routine called by step.F90 
    62    PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90 
    63    PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90 
     58   PUBLIC   sbc_cpl_ice_tau   ! routine called by icestp.F90 
     59   PUBLIC   sbc_cpl_ice_flx   ! routine called by icestp.F90 
    6460   PUBLIC   sbc_cpl_alloc     ! routine called in sbcice_cice.F90 
    6561 
     
    207203      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) ) 
    208204       
    209 #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 
     205#if ! defined key_lim3 && ! defined key_cice 
    210206      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    211207#endif 
     
    504500      ! 
    505501      ! non solar sensitivity mandatory for LIM ice model 
    506       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 
     502      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 3 .AND. nn_components /= jp_iam_sas ) & 
    507503         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 
    508504      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
     
    12181214      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
    12191215         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
    1220          ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1216         ub (:,:,1) = ssu_m(:,:)                             ! will be used in icestp in the call of lim_sbc_tau 
    12211217         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
    12221218         CALL iom_put( 'ssu_m', ssu_m ) 
     
    12241220      IF( srcv(jpr_ocy1)%laction ) THEN 
    12251221         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
    1226          vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1222         vb (:,:,1) = ssv_m(:,:)                             ! will be used in icestp in the call of lim_sbc_tau 
    12271223         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
    12281224         CALL iom_put( 'ssv_m', ssv_m ) 
     
    15281524    
    15291525 
    1530    SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 
     1526   SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist ) 
    15311527      !!---------------------------------------------------------------------- 
    15321528      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
     
    15611557      !! 
    15621558      !! ** Details 
    1563       !!             qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice   => provided 
     1559      !!             qns_tot = (1-a) * qns_oce + a * qns_ice               => provided 
    15641560      !!                     + qemp_oce + qemp_ice                         => recalculated and added up to qns 
    15651561      !! 
    1566       !!             qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice   => provided 
     1562      !!             qsr_tot = (1-a) * qsr_oce + a * qsr_ice               => provided 
    15671563      !! 
    15681564      !!             emp_tot = emp_oce + emp_ice                           => calving is provided and added to emp_tot (and emp_oce). 
     
    15781574      !!                   sprecip           solid precipitation over the ocean   
    15791575      !!---------------------------------------------------------------------- 
    1580       REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
     1576      REAL(wp), INTENT(in), DIMENSION(:,:)             ::   picefr     ! ice fraction                [0 to 1] 
    15811577      ! optional arguments, used only in 'mixed oce-ice' case 
    1582       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
    1583       REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
    1584       REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
     1578      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   palbi      ! all skies ice albedo  
     1579      REAL(wp), INTENT(in), DIMENSION(:,:  ), OPTIONAL ::   psst       ! sea surface temperature     [Celsius] 
     1580      REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL ::   pist       ! ice surface temperature     [Kelvin] 
    15851581      ! 
    15861582      INTEGER ::   jl         ! dummy loop index 
    1587       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw 
     1583      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 
    15881584      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 
    15891585      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 
     
    15931589      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx') 
    15941590      ! 
    1595       CALL wrk_alloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
     1591      CALL wrk_alloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 
    15961592      CALL wrk_alloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    15971593      CALL wrk_alloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
     
    15991595 
    16001596      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
    1601       zicefr(:,:) = 1.- p_frld(:,:) 
     1597      ziceld(:,:) = 1. - picefr(:,:) 
    16021598      zcptn(:,:) = rcp * sst_m(:,:) 
    16031599      ! 
     
    16151611         ztprecip(:,:) =   frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:)  ! May need to ensure positive here 
    16161612         zemp_tot(:,:) =   frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    1617          zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 
     1613         zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 
    16181614      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    1619          zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    1620          zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 
     1615         zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1616         zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 
    16211617         zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 
    16221618         ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 
     
    16241620 
    16251621#if defined key_lim3 
    1626       ! zsnw = snow fraction over ice after wind blowing (=zicefr if no blowing) 
    1627       zsnw(:,:) = 0._wp  ;  CALL lim_thd_snwblow( p_frld, zsnw ) 
     1622      ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 
     1623      zsnw(:,:) = 0._wp  ;  CALL ice_thd_snwblow( ziceld, zsnw ) 
    16281624       
    16291625      ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 
    1630       zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip 
     1626      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) )  ! emp_ice = A * sublimation - zsnw * sprecip 
    16311627      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:)                                ! emp_oce = emp_tot - emp_ice 
    16321628 
    16331629      ! --- evaporation over ocean (used later for qemp) --- ! 
    1634       zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
     1630      zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 
    16351631 
    16361632      ! --- evaporation over ice (kg/m2/s) --- ! 
     
    16791675 
    16801676#else 
    1681       zsnw(:,:) = zicefr(:,:) 
     1677      zsnw(:,:) = picefr(:,:) 
    16821678      ! --- Continental fluxes --- ! 
    16831679      IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
     
    17181714      IF( iom_use('snow_ao_cea') )  CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) )                  )  ! Snow over ice-free ocean  (cell average) 
    17191715      IF( iom_use('snow_ai_cea') )  CALL iom_put( 'snow_ai_cea' , sprecip(:,:) *           zsnw(:,:)                    )  ! Snow over sea-ice         (cell average) 
    1720       IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
     1716      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) )  ! Sublimation over sea-ice (cell average) 
    17211717      IF( iom_use('evap_ao_cea') )  CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1)  & 
    1722          &                                                        - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
     1718         &                                                        - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )  ! ice-free oce evap (cell average) 
    17231719      ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 
    17241720      ! 
     
    17381734         ENDIF 
    17391735      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes 
    1740          zqns_tot(:,:) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1736         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    17411737         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    17421738            DO jl=1,jpl 
     
    17451741            ENDDO 
    17461742         ELSE 
    1747             qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1743            qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17481744            DO jl=1,jpl 
    1749                zqns_tot(:,:   ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1745               zqns_tot(:,:   ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
    17501746               zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
    17511747            ENDDO 
     
    17551751         zqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    17561752         zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    1757             &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
    1758             &                                           + pist(:,:,1) * zicefr(:,:) ) ) 
     1753            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * ziceld(:,:)   & 
     1754            &                                           + pist(:,:,1) * picefr(:,:) ) ) 
    17591755      END SELECT 
    17601756      !                                      
     
    17671763#if defined key_lim3       
    17681764      ! --- non solar flux over ocean --- ! 
    1769       !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1765      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax 
    17701766      zqns_oce = 0._wp 
    1771       WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
     1767      WHERE( ziceld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 
    17721768 
    17731769      ! Heat content per unit mass of snow (J/kg) 
     
    17761772      ENDWHERE 
    17771773      ! Heat content per unit mass of rain (J/kg) 
    1778       zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )  
     1774      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) )  
    17791775 
    17801776      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     
    17911787         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus )   ! solid precip over ocean + snow melting 
    17921788      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * ( zcptsnw (:,:) - lfus )   ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
    1793 !!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
     1789!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * picefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
    17941790!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 
    17951791       
     
    18241820      ! clem: this formulation is certainly wrong... but better than it was... 
    18251821      zqns_tot(:,:) = zqns_tot(:,:)                            &          ! zqns_tot update over free ocean with: 
    1826          &          - (  p_frld(:,:) * zsprecip(:,:) * lfus )  &          ! remove the latent heat flux of solid precip. melting 
     1822         &          - (  ziceld(:,:) * zsprecip(:,:) * lfus )  &          ! remove the latent heat flux of solid precip. melting 
    18271823         &          - (  zemp_tot(:,:)                         &          ! remove the heat content of mass flux (assumed to be at SST) 
    18281824         &             - zemp_ice(:,:) ) * zcptn(:,:)  
    18291825 
    18301826     IF( ln_mixcpl ) THEN 
    1831          qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1827         qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
    18321828         qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) +  zqns_tot(:,:)* zmsk(:,:) 
    18331829         DO jl=1,jpl 
     
    18451841      IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea',  sprecip(:,:) * ( zcptsnw(:,:) - Lfus )                           ) ! heat flux from snow (cell average) 
    18461842      IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:)                    ) ! heat flux from rain (cell average) 
    1847       IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average) 
     1843      IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average) 
    18481844         &                                                        ) * zcptn(:,:) * tmask(:,:,1) ) 
    18491845      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:))   ) ! heat flux from snow (over ocean) 
     
    18691865         zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    18701866      CASE( 'oce and ice' ) 
    1871          zqsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1867         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    18721868         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    18731869            DO jl=1,jpl 
     
    18761872            ENDDO 
    18771873         ELSE 
    1878             qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1874            qsr_tot(:,:   ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    18791875            DO jl=1,jpl 
    1880                zqsr_tot(:,:   ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1876               zqsr_tot(:,:   ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
    18811877               zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
    18821878            ENDDO 
     
    18881884!       ( see OASIS3 user guide, 5th edition, p39 ) 
    18891885         zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    1890             &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       & 
    1891             &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
     1886            &            / (  1.- ( albedo_oce_mix(:,:  ) * ziceld(:,:)       & 
     1887            &                     + palbi         (:,:,1) * picefr(:,:) ) ) 
    18921888      END SELECT 
    18931889      IF( ln_dm2dc .AND. ln_cpl ) THEN   ! modify qsr to include the diurnal cycle 
     
    19001896#if defined key_lim3 
    19011897      ! --- solar flux over ocean --- ! 
    1902       !         note: p_frld cannot be = 0 since we limit the ice concentration to amax 
     1898      !         note: ziceld cannot be = 0 since we limit the ice concentration to amax 
    19031899      zqsr_oce = 0._wp 
    1904       WHERE( p_frld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:) 
     1900      WHERE( ziceld /= 0._wp )  zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 
    19051901 
    19061902      IF( ln_mixcpl ) THEN   ;   qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) +  zqsr_oce(:,:)* zmsk(:,:) 
     
    19091905 
    19101906      IF( ln_mixcpl ) THEN 
    1911          qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
     1907         qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 )   ! total flux from blk 
    19121908         qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) +  zqsr_tot(:,:)* zmsk(:,:) 
    19131909         DO jl=1,jpl 
     
    19501946 
    19511947      ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 
    1952       ! Used for LIM2 and LIM3 
     1948      ! Used for LIM3 
    19531949      ! Coupled case: since cloud cover is not received from atmosphere  
    19541950      !               ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
     
    19561952      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    19571953 
    1958       CALL wrk_dealloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
     1954      CALL wrk_dealloc( jpi,jpj,     zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 
    19591955      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    19601956      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
     
    20021998            ! we must send the surface potential temperature  
    20031999            IF( l_useCT )  THEN    ;   ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    2004             ELSE                    ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
     2000            ELSE                   ;   ztmp1(:,:) = tsn(:,:,1,jp_tem) 
    20052001            ENDIF 
    20062002            ! 
     
    21152111            SELECT CASE( sn_snd_thick%clcat ) 
    21162112            CASE( 'yes' )    
    2117                ztmp3(:,:,1:jpl) =  ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
    2118                ztmp4(:,:,1:jpl) =  ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2113               ztmp3(:,:,1:jpl) =  h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 
     2114               ztmp4(:,:,1:jpl) =  h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 
    21192115            CASE( 'no' ) 
    21202116               ztmp3(:,:,:) = 0.0   ;  ztmp4(:,:,:) = 0.0 
    21212117               DO jl=1,jpl 
    2122                   ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 
    2123                   ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 
     2118                  ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl) 
     2119                  ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl) 
    21242120               ENDDO 
    21252121            CASE default                  ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
     
    21282124            SELECT CASE( sn_snd_thick%clcat ) 
    21292125            CASE( 'yes' ) 
    2130                ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 
    2131                ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 
     2126               ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) 
     2127               ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) 
    21322128            CASE( 'no' ) 
    21332129               WHERE( SUM( a_i, dim=3 ) /= 0. ) 
    2134                   ztmp3(:,:,1) = SUM( ht_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
    2135                   ztmp4(:,:,1) = SUM( ht_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     2130                  ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     2131                  ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
    21362132               ELSEWHERE 
    21372133                 ztmp3(:,:,1) = 0. 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r8733 r8738  
    1717   USE dom_oce        ! ocean space and time domain 
    1818   USE sbc_oce        ! surface ocean boundary condition 
     19   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass 
    1920   USE phycst         ! physical constants 
    2021   USE sbcrnf         ! ocean runoffs 
     
    9495         ! and in case of no melt, it can generate HSSW. 
    9596         ! 
    96 #if ! defined key_lim2 &&  ! defined key_lim3 && ! defined key_cice 
     97#if ! defined key_lim3 && ! defined key_cice 
    9798         snwice_mass_b(:,:) = 0.e0               ! no sea-ice model is being used : no snow+ice mass 
    9899         snwice_mass  (:,:) = 0.e0 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r8733 r8738  
    137137            CALL cice_sbc_force(kt) 
    138138         ELSE IF ( ksbc == jp_purecpl ) THEN 
    139             CALL sbc_cpl_ice_flx( 1.0-fr_i ) 
     139            CALL sbc_cpl_ice_flx( fr_i ) 
    140140         ENDIF 
    141141 
     
    230230      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
    231231 
    232       !                                      ! embedded sea ice 
    233       IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    234          CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
    235          CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
    236          snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
    237          snwice_mass_b(:,:) = snwice_mass(:,:) 
    238       ELSE 
    239          snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
    240          snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
    241       ENDIF 
     232      ! set the snow+ice mass 
     233      CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     234      CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     235      snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     236      snwice_mass_b(:,:) = snwice_mass(:,:) 
     237 
    242238      IF( .NOT.ln_rstart ) THEN 
    243          IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
     239         IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    244240            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    245241            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     
    473469      CALL nemo2cice(ztmp,vocn,'F', -1. ) 
    474470 
    475       IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
     471      IF( ln_ice_embd ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
    476472          ! 
    477473          ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
     
    676672      CALL lbc_lnk ( fr_iv , 'V', 1. ) 
    677673 
    678       !                                      ! embedded sea ice 
    679       IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    680          CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
    681          CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
    682          snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
    683          snwice_mass_b(:,:) = snwice_mass(:,:) 
    684          snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 
    685       ENDIF 
     674      ! set the snow+ice mass 
     675      CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
     676      CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     677      snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
     678      snwice_mass_b(:,:) = snwice_mass(:,:) 
     679      snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 
    686680 
    687681! Release work space 
     
    727721 
    728722      DO jl = 1,ncat 
    729          CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 
    730          CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
     723         CALL cice2nemo(vsnon(:,:,jl,:),h_s(:,:,jl),'T', 1. ) 
     724         CALL cice2nemo(vicen(:,:,jl,:),h_i(:,:,jl),'T', 1. ) 
    731725      ENDDO 
    732726      ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r8733 r8738  
    3333   USE sbcblk         ! surface boundary condition: bulk formulation 
    3434   USE sbcice_if      ! surface boundary condition: ice-if sea-ice model 
    35    USE sbcice_lim     ! surface boundary condition: LIM 3.0 sea-ice model 
    36    USE sbcice_lim_2   ! surface boundary condition: LIM 2.0 sea-ice model 
     35#if defined key_lim3 
     36   USE icestp         ! surface boundary condition: LIM 3.0 sea-ice model 
     37#endif 
    3738   USE sbcice_cice    ! surface boundary condition: CICE    sea-ice model 
    3839   USE sbcisf         ! surface boundary condition: ice-shelf 
     
    9091      NAMELIST/namsbc/ nn_fsbc  ,                                                    & 
    9192         &             ln_usr   , ln_flx   , ln_blk       ,                          & 
    92          &             ln_cpl   , ln_mixcpl, nn_components, nn_limflx,               & 
    93          &             nn_ice   , nn_ice_embd,                                       & 
     93         &             ln_cpl   , ln_mixcpl, nn_components,                          & 
     94         &             nn_ice   , ln_ice_embd,                                       & 
    9495         &             ln_traqsr, ln_dm2dc ,                                         & 
    9596         &             ln_rnf   , nn_fwb   , ln_ssr   , ln_isf    , ln_apr_dyn ,     & 
     
    117118#if defined key_agrif 
    118119      IF( Agrif_Root() ) THEN                ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 
    119          IF( lk_lim2 )   nn_ice      = 2 
    120          IF( lk_lim3 )   nn_ice      = 3 
    121          IF( lk_cice )   nn_ice      = 4 
     120         IF( lk_lim3 )   nn_ice      = 2 
     121         IF( lk_cice )   nn_ice      = 3 
    122122      ENDIF 
    123123#else 
    124       IF( lk_lim2 )   nn_ice      = 2 
    125       IF( lk_lim3 )   nn_ice      = 3 
    126       IF( lk_cice )   nn_ice      = 4 
     124      IF( lk_lim3 )   nn_ice      = 2 
     125      IF( lk_cice )   nn_ice      = 3 
    127126#endif 
    128127      ! 
     
    140139         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
    141140         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components 
    142          WRITE(numout,*) '         Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
    143141         WRITE(numout,*) '      Sea-ice : ' 
    144142         WRITE(numout,*) '         ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice 
    145          WRITE(numout,*) '         ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
     143         WRITE(numout,*) '         ice embedded into ocean                    ln_ice_embd   = ', ln_ice_embd 
    146144         WRITE(numout,*) '      Misc. options of sbc : ' 
    147145         WRITE(numout,*) '         Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
     
    201199      CASE( 0 )                        !- no ice in the domain 
    202200      CASE( 1 )                        !- Ice-cover climatology ("Ice-if" model)   
    203       CASE( 2 )                        !- LIM2 ice model 
    204          IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : LIM2 sea-ice model requires ln_blk or ln_cpl = T' ) 
    205       CASE( 3 )                        !- LIM3 ice model 
    206          IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : LIM3 sea-ice models require nn_ice_embd = 1 or 2' ) 
    207       CASE( 4 )                        !- CICE ice model 
     201      CASE( 2 )                        !- LIM3 ice model 
     202      CASE( 3 )                        !- CICE ice model 
    208203         IF( .NOT.( ln_blk .OR. ln_cpl ) )   CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' ) 
    209          IF( nn_ice_embd == 0            )   CALL ctl_stop( 'sbc_init : CICE sea-ice models require nn_ice_embd = 1 or 2' ) 
    210204         IF( lk_agrif                    )   CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' )  
    211205      CASE DEFAULT                     !- not supported 
    212206      END SELECT 
    213207      ! 
    214       IF( nn_ice == 3 ) THEN           !- LIM3 case: multi-category flux option 
    215          IF(lwp) WRITE(numout,*) 
    216          SELECT CASE( nn_limflx )         ! LIM3 Multi-category heat flux formulation 
    217          CASE ( -1 ) 
    218             IF(lwp) WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) ' 
    219             IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    220          CASE ( 0  ) 
    221             IF(lwp) WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) ' 
    222          CASE ( 1  ) 
    223             IF(lwp) WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
    224             IF( ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 
    225          CASE ( 2  ) 
    226             IF(lwp) WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
    227             IF( .NOT.ln_cpl )   CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 
    228          CASE DEFAULT 
    229             CALL ctl_stop( 'sbcmod: LIM3 option, nn_limflx, should be between -1 and 2' ) 
    230          END SELECT 
    231       ELSE                             ! other sea-ice model 
    232          IF( nn_limflx >= 0  )   CALL ctl_warn( 'sbc_init : multi-category flux option (nn_limflx) only available in LIM3' ) 
    233       ENDIF 
    234       ! 
    235208      !                       !**  allocate and set required variables 
    236209      ! 
    237210      !                             !* allocate sbc arrays 
    238211      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' ) 
     212#if ! defined key_lim3 && ! defined key_cice 
     213      IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop( 'sbc_init : unable to allocate sbc_ice arrays' ) 
     214#endif 
    239215      ! 
    240216      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero 
     
    328304      IF( ln_ssr      )   CALL sbc_ssr_init            ! Sea-Surface Restoring initialization 
    329305      ! 
    330       IF( ln_isf      )   CALL sbc_isf_init               ! Compute iceshelves 
     306      IF( ln_isf      )   CALL sbc_isf_init            ! Compute iceshelves 
    331307      ! 
    332308                          CALL sbc_rnf_init            ! Runof initialization 
    333309      ! 
    334       IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization 
    335       ! 
    336       IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )   ! CICE initialization 
    337       ! 
    338       IF( ln_wave     )   CALL sbc_wave_init              ! surface wave initialisation 
     310#if defined key_lim3 
     311           IF    ( lk_agrif .AND. nn_ice == 0 ) THEN 
     312                          IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' )  ! clem2017: allocate ice arrays in case agrif + lim + no-ice in child grid 
     313           ELSEIF( nn_ice == 2 ) THEN 
     314                          CALL ice_init                ! LIM3 initialization 
     315           ENDIF 
     316#endif 
     317      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc )   ! CICE initialization 
     318      ! 
     319      IF( ln_wave     )   CALL sbc_wave_init           ! surface wave initialisation 
    339320      ! 
    340321   END SUBROUTINE sbc_init 
     
    425406      ! 
    426407      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas 
    427       CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model) 
    428       CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model 
    429       CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model 
    430       CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model 
     408      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )             ! Ice-cover climatology ("Ice-if" model) 
     409#if defined key_lim3 
     410      CASE(  2 )   ;         CALL ice_stp  ( kt, nsbc )           ! LIM-3 ice model 
     411#endif 
     412      CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model 
    431413      END SELECT 
    432414 
     
    536518      !!--------------------------------------------------------------------- 
    537519      ! 
    538       IF( nn_ice == 4 )   CALL cice_sbc_final 
     520      IF( nn_ice == 3 )   CALL cice_sbc_final 
    539521      ! 
    540522   END SUBROUTINE sbc_final 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r8733 r8738  
    236236      ENDIF 
    237237      ! 
    238       IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by lim_istate 
     238      IF( .NOT. l_ssm_mean ) THEN   ! default initialisation. needed by iceistate 
    239239         ! 
    240240         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays' 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r8733 r8738  
    137137         END DO 
    138138      END DO    
    139       CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. ) 
     139!!gm      CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. ) 
     140      CALL lbc_lnk( usd(:,:,:), 'U', -1. ) 
     141      CALL lbc_lnk( vsd(:,:,:), 'V', -1. ) 
     142 
     143 
    140144      ! 
    141145      !                       !==  vertical Stokes Drift 3D velocity  ==! 
     
    152156      END DO 
    153157      ! 
    154       IF( .NOT. AGRIF_Root() ) THEN 
    155          IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh(nlci-1,   :  ,:) = 0._wp      ! east 
    156          IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh(  2   ,   :  ,:) = 0._wp      ! west 
    157          IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh(  :   ,nlcj-1,:) = 0._wp      ! north 
    158          IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh(  :   ,  2   ,:) = 0._wp      ! south 
    159       ENDIF 
     158#if defined key_agrif 
     159      IF( .NOT. Agrif_Root() ) THEN 
     160         IF( nbondi == -1 .OR. nbondi == 2 )   ze3divh( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
     161         IF( nbondi ==  1 .OR. nbondi == 2 )   ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
     162         IF( nbondj == -1 .OR. nbondj == 2 )   ze3divh( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
     163         IF( nbondj ==  1 .OR. nbondj == 2 )   ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
     164      ENDIF 
     165#endif 
    160166      ! 
    161167      CALL lbc_lnk( ze3divh, 'T', 1. ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r8733 r8738  
    4848   LOGICAL , PUBLIC ::   ln_qsr_2bd   !: 2 band         light absorption flag 
    4949   LOGICAL , PUBLIC ::   ln_qsr_bio   !: bio-model      light absorption flag 
    50    LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem) 
    5150   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0) 
    5251   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands) 
     
    269268      END DO 
    270269      ! 
    271       IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient 
    272          DO jj = 2, jpjm1  
    273             DO ji = fs_2, fs_jpim1   ! vector opt. 
    274                IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
    275                ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
    276                ENDIF 
    277             END DO 
    278          END DO 
    279          ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere 
    280          CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp ) 
    281       ENDIF 
     270      ! sea-ice: store the 1st ocean level attenuation coefficient 
     271      DO jj = 2, jpjm1  
     272         DO ji = fs_2, fs_jpim1   ! vector opt. 
     273            IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     274            ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
     275            ENDIF 
     276         END DO 
     277      END DO 
     278      CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp ) 
    282279      ! 
    283280      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
     
    336333      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    337334      !! 
    338       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice, & 
     335      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, & 
    339336         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    340337      !!---------------------------------------------------------------------- 
     
    359356         WRITE(numout,*) '      2 band               light penetration       ln_qsr_2bd = ', ln_qsr_2bd 
    360357         WRITE(numout,*) '      bio-model            light penetration       ln_qsr_bio = ', ln_qsr_bio 
    361          WRITE(numout,*) '      light penetration for ice-model (LIM3)       ln_qsr_ice = ', ln_qsr_ice 
    362358         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)        nn_chldta  = ', nn_chldta 
    363359         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs     = ', rn_abs 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90

    r7753 r8738  
    2727 
    2828   PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module 
    29    PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics 
    30    PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo 
     29   PUBLIC   usrdef_sbc_ice_tau  ! routine called by icestp.F90 for ice dynamics 
     30   PUBLIC   usrdef_sbc_ice_flx  ! routine called by icestp.F90 for ice thermo 
    3131 
    3232   !! * Substitutions 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8733 r8738  
    140140      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    141141# endif 
    142 # if defined key_lim2 
    143       CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM2 
    144 # endif 
    145142# if defined key_lim3 
    146143      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3 
     
    622619      ! 
    623620      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file 
    624       IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file 
     621      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file 
    625622      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist 
    626623      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r8733 r8738  
    6565   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy 
    6666 
    67    !! arrays relating to embedding ice in the ocean. These arrays need to be declared  
    68    !! even if no ice model is required. In the no ice model or traditional levitating  
    69    !! ice cases they contain only zeros 
    70    !! --------------------- 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2] 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2] 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s] 
    74  
    7567   !! Energy budget of the leads (open water embedded in sea ice) 
    7668   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
     
    8779      !!                   ***  FUNCTION oce_alloc  *** 
    8880      !!---------------------------------------------------------------------- 
    89       INTEGER :: ierr(7) 
     81      INTEGER :: ierr(6) 
    9082      !!---------------------------------------------------------------------- 
    9183      ! 
     
    110102         &     riceload(jpi,jpj),                             STAT=ierr(2) ) 
    111103         ! 
    112       ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 
    113          ! 
    114       ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 
     104      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(3) ) 
    115105         ! 
    116106      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 
    117107         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), & 
    118108         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), & 
    119          &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(5) ) 
     109         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(4) ) 
    120110         ! 
    121       ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(6) ) 
     111      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj)                                      , STAT=ierr(5) ) 
    122112#if defined key_agrif 
    123       ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(7) ) 
     113      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(6) ) 
    124114#endif 
    125115         ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step.F90

    r8733 r8738  
    6161      !!                     ***  ROUTINE stp  *** 
    6262      !! 
    63       !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.) 
    64       !!              - Time stepping of LIM (dynamic and thermodynamic eqs.) 
    65       !!              - Tme stepping  of TRC (passive tracer eqs.) 
     63      !! ** Purpose : - Time stepping of OPA  (momentum and active tracer eqs.) 
     64      !!              - Time stepping of ESIM (dynamic and thermodynamic eqs.) 
     65      !!              - Time stepping of TRC (passive tracer eqs.) 
    6666      !! 
    6767      !! ** Method  : -1- Update forcings and data 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r8733 r8738  
    99   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    1010   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
     11   !!            3.7  ! 2016-09  (G. Madec)  Remove solver 
     12   !!            4.0  ! 2017-04  (G. Madec)  regroup global communications 
    1113   !!---------------------------------------------------------------------- 
    1214 
     
    2123   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2224   USE lib_mpp         ! distributed memory computing 
    23    USE lib_fortran     ! Fortran routines library  
    2425 
    2526   IMPLICIT NONE 
     
    2829   PUBLIC stp_ctl           ! routine called by step.F90 
    2930   !!---------------------------------------------------------------------- 
    30    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     31   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    3132   !! $Id$ 
    3233   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    4243      !! ** Method  : - Save the time step in numstp 
    4344      !!              - Print it each 50 time steps 
    44       !!              - Stop the run IF problem ( indic < 0 ) 
     45      !!              - Stop the run IF problem encountered by setting indic=-3 
     46      !!                Problems checked: |ssh| maximum larger than 10 m 
     47      !!                                  |U|   maximum larger than 10 m/s  
     48      !!                                  negative sea surface salinity 
    4549      !! 
    46       !! ** Actions :   'time.step' file containing the last ocean time-step 
    47       !!                 
     50      !! ** Actions :   "time.step" file = last ocean time-step 
     51      !!                "run.stat"  file = run statistics 
    4852      !!---------------------------------------------------------------------- 
    4953      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     
    5155      !! 
    5256      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    53       INTEGER  ::   ii, ij, ik             ! local integers 
    54       REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars 
    55       INTEGER, DIMENSION(3) ::   ilocu     !  
    56       INTEGER, DIMENSION(2) ::   ilocs     !  
     57      INTEGER  ::   iih, ijh               ! local integers 
     58      INTEGER  ::   iiu, iju, iku          !   -       - 
     59      INTEGER  ::   iis, ijs               !   -       - 
     60      REAL(wp) ::   zzz                    ! local real  
     61      INTEGER , DIMENSION(3) ::   ilocu 
     62      INTEGER , DIMENSION(2) ::   ilocs, iloch 
     63      REAL(wp), DIMENSION(3) ::   zmax 
    5764      !!---------------------------------------------------------------------- 
    5865      ! 
     
    6168         WRITE(numout,*) 'stp_ctl : time-stepping control' 
    6269         WRITE(numout,*) '~~~~~~~' 
    63          ! open time.step file 
     70         !                                ! open time.step file 
    6471         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     72         !                                ! open run.stat file 
     73         CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    6574      ENDIF 
    6675      ! 
    67       IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
    68       IF(lwp) REWIND( numstp )                       !  -------------------------- 
     76      IF(lwp) THEN                        !==  current time step  ==!   ("time.step" file) 
     77         WRITE ( numstp, '(1x, i8)' )   kt 
     78         REWIND( numstp ) 
     79      ENDIF 
    6980      ! 
    70       !                                              !* Test maximum of velocity (zonal only) 
    71       !                                              !  ------------------------ 
    72       !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5 
    73       zumax = 0.e0 
    74       DO jk = 1, jpk 
    75          DO jj = 1, jpj 
    76             DO ji = 1, jpi 
    77                zumax = MAX(zumax,ABS(un(ji,jj,jk))) 
    78           END DO  
    79         END DO  
    80       END DO         
    81       IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain 
     81      !                                   !==  test of extrema  ==! 
     82      zmax(1) = MAXVAL(  ABS( sshn(:,:) )  )                                  ! ssh max 
     83      zmax(2) = MAXVAL(  ABS( un(:,:,:) )  )                                  ! velocity max (zonal only) 
     84      zmax(3) = MAXVAL( -tsn(:,:,1,jp_sal) , mask = tmask(:,:,1) == 1._wp )   ! minus surface salinity max 
    8285      ! 
    83       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax 
     86      IF( lk_mpp )   CALL mpp_max_multiple( zmax(:), 3 ) ! max over the global domain 
    8487      ! 
    85       IF( zumax > 20.e0 ) THEN 
     88      IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 
     89         WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ',   zmax(1), ' |U| max: ', zmax(2),   & 
     90            &                                     ' SSS min: '  , - zmax(3) 
     91      ENDIF 
     92      ! 
     93      IF ( zmax(1) > 10._wp .OR.   &                     ! too large sea surface height ( > 10 m) 
     94         & zmax(2) > 10._wp .OR.   &                     ! too large velocity ( > 10 m/s) 
     95         & zmax(3) >  0._wp ) THEN                       ! negative sea surface salinity 
    8696         IF( lk_mpp ) THEN 
    87             CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik) 
     97            CALL mpp_maxloc( ABS(sshn)        , tmask(:,:,1), zzz, iih, ijh ) 
     98            CALL mpp_maxloc( ABS(un)          , umask       , zzz, iiu, iju, iku ) 
     99            CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs ) 
    88100         ELSE 
     101            iloch = MINLOC( ABS( sshn(:,:) ) ) 
    89102            ilocu = MAXLOC( ABS( un(:,:,:) ) ) 
    90             ii = ilocu(1) + nimpp - 1 
    91             ij = ilocu(2) + njmpp - 1 
    92             ik = ilocu(3) 
     103            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp ) 
     104            iih = iloch(1) + nimpp - 1   ;   ijh = iloch(2) + njmpp - 1 
     105            iiu = ilocu(1) + nimpp - 1   ;   iju = ilocu(2) + njmpp - 1   ;   iku = ilocu(3) 
     106            iis = ilocs(1) + nimpp - 1   ;   ijs = ilocs(2) + njmpp - 1 
    93107         ENDIF 
    94108         IF(lwp) THEN 
    95109            WRITE(numout,cform_err) 
    96             WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s' 
     110            WRITE(numout,*) ' stpctl: |ssh| > 10 m   or   |U| > 10 m/s   or   SSS < 0' 
    97111            WRITE(numout,*) ' ====== ' 
    98             WRITE(numout,9400) kt, zumax, ii, ij, ik 
     112            WRITE(numout,9100) kt,   zmax(1), iih, ijh 
     113            WRITE(numout,9200) kt,   zmax(2), iiu, iju, iku 
     114            WRITE(numout,9300) kt, - zmax(3), iis, ijs 
    99115            WRITE(numout,*) 
    100             WRITE(numout,*) '          output of last fields in numwso' 
     116            WRITE(numout,*) '          output of last computed fields in output.abort.nc file' 
    101117         ENDIF 
    102118         kindic = -3 
    103119      ENDIF 
    104 9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5) 
     1209100  FORMAT (' kt=',i8,'   |ssh| max: ',1pg11.4,', at  i j  : ',2i5) 
     1219200  FORMAT (' kt=',i8,'   |U|   max: ',1pg11.4,', at  i j k: ',3i5) 
     1229300  FORMAT (' kt=',i8,'   SSS   min: ',1pg11.4,', at  i j  : ',2i5) 
    105123      ! 
    106       !                                              !* Test minimum of salinity 
    107       !                                              !  ------------------------ 
    108       !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5 
    109       zsmin = 100._wp 
    110       DO jj = 2, jpjm1 
    111          DO ji = 1, jpi 
    112             IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal)) 
    113          END DO 
    114       END DO 
    115       IF( lk_mpp )   CALL mpp_min( zsmin )                ! min over the global domain 
     124      !                                            !==  run statistics  ==!   ("run.stat" file) 
     125      IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3) 
    116126      ! 
    117       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin 
    118       ! 
    119       IF( zsmin < 0.) THEN  
    120          IF (lk_mpp) THEN 
    121             CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij ) 
    122          ELSE 
    123             ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 ) 
    124             ii = ilocs(1) + nimpp - 1 
    125             ij = ilocs(2) + njmpp - 1 
    126          ENDIF 
    127          ! 
    128          IF(lwp) THEN 
    129             WRITE(numout,cform_err) 
    130             WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity' 
    131             WRITE(numout,*) '======= ' 
    132             WRITE(numout,9500) kt, zsmin, ii, ij 
    133             WRITE(numout,*) 
    134             WRITE(numout,*) '          output of last fields in numwso' 
    135          ENDIF 
    136          kindic = -3 
    137       ENDIF 
    138 9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 
    139       ! 
    140       ! 
    141       IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration 
    142  
    143       ! log file (ssh statistics) 
    144       ! --------                                   !* ssh statistics (and others...) 
    145       IF( kt == nit000 .AND. lwp ) THEN   ! open ssh statistics file (put in solver.stat file) 
    146          CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    147       ENDIF 
    148       ! 
    149       zsshmax = 0.e0 
    150       DO jj = 1, jpj 
    151          DO ji = 1, jpi 
    152             IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) ) 
    153          END DO 
    154       END DO 
    155       IF( lk_mpp )   CALL mpp_max( zsshmax )                ! min over the global domain 
    156       ! 
    157       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax 
    158       ! 
    159       IF( zsshmax > 10.e0 ) THEN  
    160          IF (lk_mpp) THEN 
    161             CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij) 
    162          ELSE 
    163             ilocs = MAXLOC( ABS(sshn(:,:)) ) 
    164             ii = ilocs(1) + nimpp - 1 
    165             ij = ilocs(2) + njmpp - 1 
    166          ENDIF 
    167          ! 
    168          IF(lwp) THEN 
    169             WRITE(numout,cform_err) 
    170             WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m' 
    171             WRITE(numout,*) '======= ' 
    172             WRITE(numout,9600) kt, zsshmax, ii, ij 
    173             WRITE(numout,*) 
    174             WRITE(numout,*) '          output of last fields in numwso' 
    175          ENDIF 
    176          kindic = -3 
    177       ENDIF 
    178 9600  FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5) 
    179       ! 
    180       zssh2 = glob_sum( sshn(:,:) * sshn(:,:) ) 
    181       ! 
    182       IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics 
    183       ! 
    184 9700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16) 
     1279400  FORMAT(' it :', i8, '    |ssh|_max: ', e16.10, ' |U|_max: ',e16.10,' SSS_min: ',e16.10) 
    185128      ! 
    186129   END SUBROUTINE stp_ctl 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/diawri.F90

    r8733 r8738  
    3838   USE iom 
    3939   USE ioipsl 
    40 #if defined key_lim2 
    41    USE limwri_2  
    42 #elif defined key_lim3 
    43    USE limwri 
     40#if defined key_lim3 
     41   USE icewri 
    4442#endif 
    4543   USE lib_mpp         ! MPP library 
     
    397395         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    398396 
    399 #if defined key_lim2 
    400       CALL lim_wri_state_2( kt, id_i, nh_i ) 
    401 #elif defined key_lim3 
    402       CALL lim_wri_state( kt, id_i, nh_i ) 
     397#if defined key_lim3 
     398      IF( nn_ice == 2 ) THEN   ! clem2017: condition in case agrif + lim but no-ice in child grid 
     399         CALL ice_wri_state( kt, id_i, nh_i ) 
     400      ENDIF 
    403401#else 
    404402      CALL histend( id_i, snc4chunks=snc4set ) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r8733 r8738  
    8686      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    8787# endif 
    88 # if defined key_lim2 
    89       CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
    90 # endif 
    9188# if defined key_lim3 
    9289      CALL Agrif_Declare_Var_lim3  !  "      "   "   "      "  LIM3 
     
    134131      ! 
    135132#if defined key_agrif 
    136       IF( .NOT. Agrif_Root() ) THEN 
     133!!clem2017      IF( .NOT. Agrif_Root() ) THEN 
    137134         CALL Agrif_ParentGrid_To_ChildGrid() 
    138135         IF( nn_timing == 1 )   CALL timing_finalize 
    139136         CALL Agrif_ChildGrid_To_ParentGrid() 
    140       ENDIF 
     137!!clem2017      ENDIF 
    141138#endif 
    142139      IF( nn_timing == 1 )   CALL timing_finalize 
     
    513510      ierr =        dia_wri_alloc   () 
    514511      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    515       ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or lim3 and bdy 
     512      ierr = ierr + oce_alloc       ()          ! (tsn...) needed for agrif and/or ESIM and bdy 
    516513      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization) 
    517514      ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r8733 r8738  
    115115      ELSE 
    116116         sst_m(:,:) = 0._wp 
    117          sss_m(:,:) = 0._wp 
     117         sss_m(:,:) = 35._wp 
    118118         ssu_m(:,:) = 0._wp 
    119119         ssv_m(:,:) = 0._wp 
     
    313313   ENDIF 
    314314  
    315       CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in limistate 
     315      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate 
    316316      l_initdone = .TRUE. 
    317317      ! 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/step.F90

    r8733 r8738  
    2424   USE diawri           ! Standard run outputs             (dia_wri routine) 
    2525   USE bdy_oce   , ONLY: ln_bdy 
    26    USE bdydta           ! clem: mandatory for LIM3 
     26   USE bdydta           ! clem: mandatory for ESIM 
    2727   USE stpctl           ! time stepping control            (stp_ctl routine) 
    2828   ! 
     
    8989                             CALL iom_setkt( kstp - nit000 + 1, cxios_context )   ! tell iom we are at time step kstp 
    9090 
    91       ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from   
     91      ! ==> clem: open boundaries is mandatory for ESIM because ice BDY is not decoupled from   
    9292      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 
    9393      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.   
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r8733 r8738  
    6363      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices 
    6464      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars 
    65       REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars 
     65      REAL(wp) ::   zftra, zcd, zdtra, ztfx, ztra                  ! temporary scalars 
    6666      CHARACTER (len=22) :: charout 
    6767      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx 
     
    7777      ! 
    7878      zrtrn = 1.e-15_wp 
    79  
    80       SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option 
    81          CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only 
    82          CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                 
    83       !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure 
    84       END SELECT 
    8579 
    8680      IF( kt == nittrc000 ) THEN 
     
    145139                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
    146140                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
    147                   ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange) 
     141                  ztfx  = zftra                             ! net tracer flux 
    148142    
    149143                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r8733 r8738  
    6363   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths 
    6464   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1) 
    65    USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean 
    6665   USE sbc_oce , ONLY :   atm_co2    =>    atm_co2    !  atmospheric pCO2 
    6766   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r8733 r8738  
    172172   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers 
    173173   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping 
     174!$AGRIF_DO_NOT_TREAT 
    174175   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 
    175176   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process) 
    176    ! 
    177  
     177!$AGRIF_END_DO_NOT_TREAT 
    178178   !!---------------------------------------------------------------------- 
    179179   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA

    r7715 r8738  
    1111# @ total_tasks = NPROCS 
    1212# time 
    13 # @ wall_clock_limit = 1:30:00 
     13# @ wall_clock_limit = 00:59:00 
    1414# @ queue 
    1515 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS

    r7646 r8738  
    88module load intel/compiler/64/14.0/2013_sp1.2.144 
    99module load openmpi/intel/64/1.6.5 
    10 module load slurm/2.5.7 
     10module load slurm/16.05.8 
    1111 
    1212# 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/README

    r7646 r8738  
    4545               INPUT_DIR         : directory in which store input files (tar file) 
    4646               TMPDIR            : temporary directory NEEDED ONLY FOR IBM machines (put EXP00 directory) 
    47           NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, solver.stat, tracer.stat and ocean.output files in 
     47          NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, run.stat, tracer.stat and ocean.output files in 
    4848                            tree NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE) 
    4949 in fcm_job.sh : 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/all_functions.sh

    r8733 r8738  
    219219    fi 
    220220    # Save output & debug files in NEMO_VALIDATION tree 
    221     echo "saving ocean & ice output, solver.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette 
     221    echo "saving ocean & ice output, run.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette 
    222222    echo "            " >> ${SETTE_DIR}/output.sette 
    223223    [ -f ${EXE_DIR}/ocean.output ] && cp ${EXE_DIR}/*ocean.output ${NEMO_VALID}/. 
    224     [ -f ${EXE_DIR}/solver.stat ] && cp ${EXE_DIR}/*solver.stat ${NEMO_VALID}/. 
     224    [ -f ${EXE_DIR}/run.stat ] && cp ${EXE_DIR}/*run.stat ${NEMO_VALID}/. 
    225225    [ -f ${EXE_DIR}/output.namelist.dyn ] && cp ${EXE_DIR}/*output.nam* ${NEMO_VALID}/. 
    226226    [ -f ${EXE_DIR}/tracer.stat ] && cp ${EXE_DIR}/*tracer.stat ${NEMO_VALID}/. 
    227227 
    228     if [ -n "$(ls ${NEMO_VALID}/*solver*)" ] ; then 
    229    echo "moved solver.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette 
    230    echo "moved solver.stat in ${NEMO_VALID} directory"   
     228    if [ -n "$(ls ${NEMO_VALID}/*run*)" ] ; then 
     229   echo "moved run.stat in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette 
     230   echo "moved run.stat in ${NEMO_VALID} directory"   
    231231    else 
    232    echo "problem in looking for solver.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette 
    233    echo "solver.stat IS NOT in ${NEMO_VALID} directory"  
     232   echo "problem in looking for run.stat file in ${NEMO_VALID} directory"  >> ${SETTE_DIR}/output.sette 
     233   echo "run.stat IS NOT in ${NEMO_VALID} directory"  
    234234    fi 
    235235    if [ -n "$(ls ${NEMO_VALID}/*ocean.output*)" ] ; then 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette.sh

    r7756 r8738  
    5656#   set_namelist     : function declared in all_functions that sets namelist parameters  
    5757#   post_test_tidyup : creates validation storage directory and copies required output files  
    58 #                      (solver.stat and ocean.output) in it after execution of test. 
     58#                      (run.stat and ocean.output) in it after execution of test. 
    5959# 
    6060#  VALIDATION tree is: 
     
    137137# ORCA2_OFF_PISCES  :  5 &  6 
    138138# AMM12             :  7 &  8  
    139 # SAS               :  9     fos SAS there is no solver so is useless to test REPRO 
     139# SAS               :  9     fos SAS there is no run.stat so is useless to test REPRO 
    140140# ISOMIP            : 10 & 11 
    141141# ORCA2_LIM3_OBS    : 12 
     
    143143#                     15 & 16  
    144144 
    145 for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 
     145for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16  
    146146 
    147147do 
     
    312312    set_namelist namelist_cfg jpnj 8 
    313313    set_namelist namelist_cfg jpnij 32 
     314    set_namelist namelist_ice_cfg ln_icediachk .true. 
     315##    set_namelist namelist_ice_cfg ln_icediahsb .true. 
    314316    set_namelist namelist_top_cfg ln_trcdta .false. 
    315317    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 
     
    350352    set_namelist namelist_cfg jpnj 8 
    351353    set_namelist namelist_cfg jpnij 32 
     354    set_namelist namelist_ice_cfg ln_icediachk .true. 
     355##    set_namelist namelist_ice_cfg ln_icediahsb .true. 
    352356    set_namelist namelist_top_cfg ln_rsttr .true. 
    353357    set_namelist namelist_top_cfg nn_rsttr 2 
     
    411415    set_namelist namelist_cfg jpnj 8 
    412416    set_namelist namelist_cfg jpnij 32 
     417    set_namelist namelist_ice_cfg ln_icediachk .true. 
     418    set_namelist namelist_ice_cfg ln_icediahsb .true. 
    413419    set_namelist namelist_top_cfg ln_trcdta .false. 
    414420    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 
     
    452458    set_namelist namelist_cfg jpnj 4 
    453459    set_namelist namelist_cfg jpnij 32 
     460    set_namelist namelist_ice_cfg ln_icediachk .true. 
     461    set_namelist namelist_ice_cfg ln_icediahsb .true. 
    454462    set_namelist namelist_top_cfg ln_trcdta .false. 
    455463    # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false 
     
    661669    export TEST_NAME="LONG" 
    662670    cd ${CONFIG_DIR0} 
    663     . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide" del_key ${DEL_KEYS} 
     671    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 del_key ${DEL_KEYS} 
    664672    cd ${SETTE_DIR} 
    665673    . ./param.cfg 
     
    810818    set_namelist namelist_cfg jpnj 8 
    811819    set_namelist namelist_cfg jpnij 32 
     820    set_namelist namelist_ice_cfg ln_icediachk .true. 
    812821    if [ ${USING_MPMD} == "yes" ] ; then 
    813822       set_xio_using_server iodef.xml true 
     
    835844    set_namelist namelist_cfg ln_rstart .true. 
    836845    set_namelist namelist_cfg nn_rstctl 2 
     846    set_namelist namelist_ice_cfg ln_icediachk .true. 
    837847    set_namelist namelist_ice_cfg cn_icerst_in \"SAS_00000050_restart_ice\" 
    838848    if [ ${USING_MPMD} == "yes" ] ; then 
     
    11211131    set_namelist 1_namelist_cfg nn_it000 1 
    11221132    set_namelist 1_namelist_cfg nn_itend 150 
     1133    set_namelist 1_namelist_cfg nn_fsbc 1 
    11231134    set_namelist 1_namelist_cfg ln_ctl .false. 
    11241135    set_namelist 1_namelist_cfg ln_clobber .true. 
     
    12191230    export TEST_NAME="LONG" 
    12201231    cd ${CONFIG_DIR0} 
    1221     . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top" 
     1232    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif key_zdftmx" del_key "key_zdftmx_new key_top" 
    12221233    cd ${SETTE_DIR} 
    12231234    . ./param.cfg 
     
    12451256    set_namelist 1_namelist_cfg nn_itend 300 
    12461257    set_namelist 1_namelist_cfg nn_stock 150 
     1258    set_namelist 1_namelist_cfg nn_fsbc 1 
    12471259    set_namelist 1_namelist_cfg ln_ctl .false. 
    12481260    set_namelist 1_namelist_cfg ln_clobber .true. 
     
    12831295    set_namelist 1_namelist_cfg nn_itend 300 
    12841296    set_namelist 1_namelist_cfg nn_stock 150 
     1297    set_namelist 1_namelist_cfg nn_fsbc 1 
    12851298    set_namelist 1_namelist_cfg ln_rstart .true. 
    12861299    set_namelist 1_namelist_cfg nn_rstctl 2 
     
    12931306    set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\" 
    12941307    set_namelist 1_namelist_cfg cn_ocerst_in \"O2LP_LONG_00000150_restart\" 
     1308    set_namelist 1_namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000150_restart_ice\" 
    12951309 
    12961310    for (( i=1; i<=$NPROC; i++)) ; do 
     
    13001314        ln -sf ../LONG/O2LP_LONG_00000075_restart_ice_${L_NPROC}.nc . 
    13011315        ln -sf ../LONG/1_O2LP_LONG_00000150_restart_${L_NPROC}.nc . 
     1316        ln -sf ../LONG/1_O2LP_LONG_00000150_restart_ice_${L_NPROC}.nc . 
    13021317    done 
    13031318    if [ ${USING_MPMD} == "yes" ] ; then 
     
    13161331    export TEST_NAME="REPRO_4_4" 
    13171332    cd ${CONFIG_DIR0} 
    1318     . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif" del_key "key_zdftmx key_top" 
     1333    . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif key_zdftmx" del_key "key_zdftmx_new key_top" 
    13191334    cd ${SETTE_DIR} 
    13201335    . ./param.cfg 
     
    13391354    set_namelist 1_namelist_cfg nn_it000 1 
    13401355    set_namelist 1_namelist_cfg nn_itend 150 
     1356    set_namelist 1_namelist_cfg nn_fsbc 1 
    13411357    set_namelist 1_namelist_cfg ln_ctl .false. 
    13421358    set_namelist 1_namelist_cfg ln_clobber .true. 
     
    13781394    set_namelist 1_namelist_cfg nn_itend 150 
    13791395    set_namelist 1_namelist_cfg ln_ctl .false. 
     1396    set_namelist 1_namelist_cfg nn_fsbc 1 
    13801397    set_namelist 1_namelist_cfg ln_clobber .true. 
    13811398    set_namelist 1_namelist_cfg ln_read_cfg .true. 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_beginner.sh

    r4796 r8738  
    5555#   set_namelist     : function declared in all_functions that sets namelist parameters  
    5656#   post_test_tidyup : creates validation storage directory and copies required output files  
    57 #                      (solver.stat and ocean.output) in it after execution of test. 
     57#                      (run.stat and ocean.output) in it after execution of test. 
    5858# 
    5959#  VALIDATION tree is: 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_rpt.sh

    r7715 r8738  
    11#!/bin/bash -f 
    22# 
     3# set -vx 
    34# simple SETTE report generator. 
    45# 
     
    2324    dorv=`echo $dorv | sed -e 's:.*/::'` 
    2425    f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output 
    25     f1s=$vdir/$nam/$mach/$dorv/LONG/solver.stat 
     26    f1s=$vdir/$nam/$mach/$dorv/LONG/run.stat 
    2627    f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat 
    2728    f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output 
    28     f2s=$vdir/$nam/$mach/$dorv/SHORT/solver.stat 
     29    f2s=$vdir/$nam/$mach/$dorv/SHORT/run.stat 
    2930    f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat 
    3031 
     
    4647      if [ $? == 0 ]; then 
    4748        if [ $pass == 0 ]; then  
    48           printf "%-20s %s %s\n" $nam  " solver.stat restartability  passed : " $dorv 
    49         fi 
    50       else 
    51         printf "%-20s %s %s\n" $nam  " solver.stat restartability  FAILED : " $dorv  
    52 # 
    53 # Offer view of differences on the second pass 
    54 # 
    55         if [ $pass == 1 ]; then 
    56           echo "<return> to view solver.stat differences" 
     49          printf "%-20s %s %s\n" $nam  " run.stat    restartability  passed : " $dorv 
     50        fi 
     51      else 
     52        printf "%-20s %s %s\n" $nam  " run.stat    restartability  FAILED : " $dorv  
     53# 
     54# Offer view of differences on the second pass 
     55# 
     56        if [ $pass == 1 ]; then 
     57          echo "<return> to view run.stat differences" 
    5758          read y 
    5859          sdiff f1.tmp$$ $f2s 
     
    118119    rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l` 
    119120    f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output 
    120     f1s=$vdir/$nam/$mach/$dorv/$rep1/solver.stat 
     121    f1s=$vdir/$nam/$mach/$dorv/$rep1/run.stat 
    121122    f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat 
    122123    f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output 
    123     f2s=$vdir/$nam/$mach/$dorv/$rep2/solver.stat 
     124    f2s=$vdir/$nam/$mach/$dorv/$rep2/run.stat 
    124125    f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat 
    125126 
     
    139140      if [ $? == 0 ]; then 
    140141        if [ $pass == 0 ]; then  
    141           printf "%-20s %s %s\n" $nam  " solver.stat reproducibility passed : " $dorv 
    142         fi 
    143       else 
    144         printf "%-20s %s %s\n" $nam  " solver.stat reproducibility FAILED : " $dorv  
    145 # 
    146 # Offer view of differences on the second pass 
    147 # 
    148         if [ $pass == 1 ]; then 
    149           echo "<return> to view solver.stat differences" 
     142          printf "%-20s %s %s\n" $nam  " run.stat    reproducibility passed : " $dorv 
     143        fi 
     144      else 
     145        printf "%-20s %s %s\n" $nam  " run.stat    reproducibility FAILED : " $dorv  
     146# 
     147# Offer view of differences on the second pass 
     148# 
     149        if [ $pass == 1 ]; then 
     150          echo "<return> to view run.stat differences" 
    150151          read y 
    151152          sdiff f1.tmp$$ $f2s 
     
    199200  mach=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'` 
    200201  NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'` 
     202  NEMO_VALID=`eval "echo $NEMO_VALID"` 
    201203# 
    202204  if [ ! -d $NEMO_VALID ]; then 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_xios.sh

    r4990 r8738  
    5252#   set_namelist     : function declared in all_functions that sets namelist parameters  
    5353#   post_test_tidyup : creates validation storage directory and copies required output files  
    54 #                      (solver.stat and ocean.output) in it after execution of test. 
     54#                      (run.stat and ocean.output) in it after execution of test. 
    5555# 
    5656#  VALIDATION tree is: 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh

    r7646 r8738  
    6565 echo "Adding keys in : ${NEW_CONF}"  
    6666 for i in ${list_add_key} ; do 
    67    if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then 
     67   if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "\<$i\>" )" -ne 0 ] ; then 
    6868      echo "key $i already present in cpp_${NEW_CONF}.fcm"  
    6969   else 
  • branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref

    r7200 r8738  
    278278                           !  = 2  Redistribute a single flux over categories (coupled mode only) 
    279279                     ! Sea-ice : 
    280    nn_ice      = 2         !  =0 no ice boundary condition   , 
     280   nn_ice      = 3         !  =0 no ice boundary condition   , 
    281281                           !  =1 use observed ice-cover      , 
    282                            !  =2 ice-model used                         ("key_lim3", "key_lim2", "key_cice") 
     282                           !  =3-4 ice-model used                         ("key_lim3", "key_cice") 
    283283   nn_ice_embd = 1         !  =0 levitating ice (no mass exchange, concentration/dilution effect) 
    284284                           !  =1 levitating ice with mass and salt exchange but no presure effect 
     
    670670   bn_tem      = 'amm12_bdyT_tra',         24        , 'votemper',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    671671   bn_sal      = 'amm12_bdyT_tra',         24        , 'vosaline',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    672 ! for lim2 
    673 !   bn_frld    = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    674 !   bn_hicif   = 'amm12_bdyT_ice',         24        , 'iicethic',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    675 !   bn_hsnif   = 'amm12_bdyT_ice',         24        , 'isnowthi',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
    676672! for lim3 
    677673!   bn_a_i     = 'amm12_bdyT_ice',         24        , 'ileadfra',    .true.   , .false. ,  'daily'  ,    ''    ,   ''     ,     '' 
Note: See TracChangeset for help on using the changeset viewer.