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 14021 for NEMO – NEMO

Changeset 14021 for NEMO


Ignore:
Timestamp:
2020-12-02T20:53:00+01:00 (3 years ago)
Author:
laurent
Message:

Caught up with trunk rev 14020...

Location:
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice
Files:
50 added
63 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r13558 r14021  
    9090   !                       !    =2 annual global mean of e-p-r set to zero 
    9191   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave) 
    92    ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 
    93    ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave)  
    94    nn_sdrift   =  0        !  Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 
    95       !                    !   = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    96       !                    !   = 1 Phillips:                      v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))] 
    97       !                    !   = 2 Phillips as (1) but using the wave frequency from a wave model 
    98    ln_tauwoc   = .false.   !  Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave) 
    99    ln_tauw     = .false.   !  Activate ocean stress components from wave model 
    100    ln_stcor    = .false.   !  Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 
    10192/ 
    10293!----------------------------------------------------------------------- 
    … …  
    167158&namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
    168159!----------------------------------------------------------------------- 
     160   ln_sdw      = .false.    !  get the 2D Surf Stokes Drift & Compute the 3D stokes drift 
     161   ln_stcor    = .false.    !  add Stokes Coriolis and tracer advection terms 
     162   ln_cdgw     = .false.    !  Neutral drag coefficient read from wave model 
     163   ln_tauoc    = .false.    !  ocean stress is modified by wave induced stress 
     164   ln_wave_test= .false.    !  Test case with constant wave fields 
     165! 
     166   ln_charn    = .false.     !  Charnock coefficient read from wave model (IFS only) 
     167   ln_taw      = .false.     !  ocean stress is modified by wave induced stress (coupled mode) 
     168   ln_phioc    = .false.     !  TKE flux from wave model 
     169   ln_bern_srfc= .false.     ! wave induced pressure. Bernoulli head J term 
     170   ln_breivikFV_2016 = .false. ! breivik 2016 vertical stokes profile 
     171   ln_vortex_force = .false. 
     172! 
     173   cn_dir      = './'      !  root directory for the waves data location 
     174   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
     175   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
     176   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
     177   sn_cdg      =  'sdw_ecwaves_orca2'    ,        6.         , 'drag_coeff' ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     178   sn_usd      =  'sdw_ecwaves_orca2'    ,        6.         , 'u_sd2d'     ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     179   sn_vsd      =  'sdw_ecwaves_orca2'    ,        6.         , 'v_sd2d'     ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     180   sn_hsw      =  'sdw_ecwaves_orca2'    ,        6.         , 'hs'         ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     181   sn_wmp      =  'sdw_ecwaves_orca2'    ,        6.         , 'wmp'        ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     182   sn_wnum     =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_num'   ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    169183/ 
    170184!----------------------------------------------------------------------- 
    … …  
    378392                               !        = 2 add a tke source just at the base of the ML 
    379393                               !        = 3 as = 1 applied on HF part of the stress           (ln_cpl=T) 
     394      ln_mxhsw    = .false.   !  surface mixing length scale = F(wave height) 
    380395/ 
    381396!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/axis_def_nemo.xml

    r12377 r14021  
    11<!-- 
    2 ============================================================================================================ 
    3 = Axis definition = = DO NOT CHANGE = 
    4 ============================================================================================================ 
    5     --> 
     2    ============================================================================================================ 
     3    = Axis definition = = DO NOT CHANGE = 
     4    ============================================================================================================ 
     5--> 
    66 
    7     <axis_definition> 
    8       <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 
    9       <!--   Vertical zoom for a 31-levels ORCA2 grid for eORCA1 300m corresponds to n=35 --> 
    10       <axis id="deptht300" axis_ref="deptht" > 
    11          <zoom_axis begin="0" n="19" /> 
    12       </axis> 
    13       <axis id="depthu"  long_name="Vertical U levels" unit="m" positive="down" /> 
    14       <axis id="depthv"  long_name="Vertical V levels" unit="m" positive="down" /> 
    15       <axis id="depthw"  long_name="Vertical W levels" unit="m" positive="down" /> 
    16       <axis id="nfloat"  long_name="Float number"      unit="-"                 /> 
    17       <axis id="icbcla"  long_name="Iceberg class"      unit="1"               /> 
    18       <axis id="ncatice" long_name="Ice category"       unit="1"               /> 
    19       <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            /> 
    20       <axis id="iax_26C" long_name="26 degC isotherm"   unit="degC"            /> 
    21       <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            /> 
    22       <axis id="basin"   long_name="Sub-basin mask (1=Global 2=Atlantic 3=Indo-Pacific 4=Indian, 5=Pacific)"  unit="1" /> 
    23       <axis id="nstrait" long_name="Number of straits" unit="1" /> 
    24       <!-- ABL vertical axis definition --> 
    25       <axis id="ght_abl" long_name="ABL Vertical T levels" unit="m" positive="up"   /> 
    26       <axis id="ghw_abl" long_name="ABL Vertical W levels" unit="m" positive="up"   /> 
    27       <axis id="section"     n_glo="16" /> 
    28       <axis id="section_ice" n_glo="4" /> 
    29       <axis id="gau" /> 
    30     </axis_definition> 
     7<axis_definition> 
     8  <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 
     9  <!--   Vertical zoom for a 31-levels ORCA2 grid for eORCA1 300m corresponds to n=35 --> 
     10  <axis id="deptht300" axis_ref="deptht" > 
     11    <zoom_axis begin="0" n="19" /> 
     12  </axis> 
     13  <axis id="depthu"  long_name="Vertical U levels" unit="m" positive="down" /> 
     14  <axis id="depthv"  long_name="Vertical V levels" unit="m" positive="down" /> 
     15  <axis id="depthw"  long_name="Vertical W levels" unit="m" positive="down" /> 
     16  <axis id="nfloat"  long_name="Float number"      unit="-"                 /> 
     17  <axis id="icbcla"  long_name="Iceberg class"      unit="1"               /> 
     18  <axis id="ncatice" long_name="Ice category"       unit="1"               /> 
     19  <axis id="iax_20C" long_name="20 degC isotherm"   unit="degC"            /> 
     20  <axis id="iax_26C" long_name="26 degC isotherm"   unit="degC"            /> 
     21  <axis id="iax_28C" long_name="28 degC isotherm"   unit="degC"            /> 
     22  <axis id="basin"   long_name="Sub-basin mask (1=Global 2=Atlantic 3=Indo-Pacific 4=Indian, 5=Pacific)"  unit="1" /> 
     23  <axis id="nstrait" long_name="Number of straits" unit="1" /> 
     24  <!-- ABL vertical axis definition --> 
     25  <axis id="ght_abl" long_name="ABL Vertical T levels" unit="m" positive="up"   /> 
     26  <axis id="ghw_abl" long_name="ABL Vertical W levels" unit="m" positive="up"   /> 
     27  <axis id="section"     n_glo="16" /> 
     28  <axis id="section_ice" n_glo="4" /> 
     29  <axis id="gau" /> 
     30</axis_definition> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/domain_def_nemo.xml

    r12276 r14021  
    11 
    2    <domain_definition> 
     2<domain_definition> 
    33 
    4      <!--   T grid   --> 
    5      <domain id="grid_T" long_name="grid T"/> 
    6       
    7      <!--   My zoom: example of hand defined zoom   --> 
    8      <domain id="myzoomT" domain_ref="grid_T" > 
    9        <zoom_domain ibegin="1" jbegin="1" ni="2" nj="3"/> 
    10      </domain> 
     4  <!--   T grid   --> 
     5  <domain id="grid_T" long_name="grid T"/> 
    116 
    12       <domain id="1point" domain_ref="grid_T" > 
    13          <zoom_domain ibegin="139" jbegin="119" ni="1" nj="1"/> 
    14       </domain> 
     7  <!--   My zoom: example of hand defined zoom   --> 
     8  <domain id="myzoomT" domain_ref="grid_T" > 
     9    <zoom_domain ibegin="1" jbegin="1" ni="2" nj="3"/> 
     10  </domain> 
     11 
     12  <domain id="1point" domain_ref="grid_T" > 
     13    <zoom_domain ibegin="139" jbegin="119" ni="1" nj="1"/> 
     14  </domain> 
    1515 
    1616 
    17      <!--   Eq section --> 
    18      <domain id="EqT" domain_ref="grid_T" > <zoom_domain id="EqT"/> </domain> 
    19      <!--   TAO : see example above   --> 
    20      <!--   137e   --> 
    21      <domain id="2n137eT" domain_ref="grid_T" > <zoom_domain id="2n137eT"/> </domain> 
    22      <domain id="5n137eT" domain_ref="grid_T" > <zoom_domain id="5n137eT"/> </domain> 
    23      <domain id="8n137eT" domain_ref="grid_T" > <zoom_domain id="8n137eT"/> </domain> 
    24      <!-- <\!--   147e   -\-> --> 
    25      <domain id="0n147eT" domain_ref="grid_T" > <zoom_domain id="0n147eT"/> </domain> 
    26      <domain id="2n147eT" domain_ref="grid_T" > <zoom_domain id="2n147eT"/> </domain> 
    27      <domain id="5n147eT" domain_ref="grid_T" > <zoom_domain id="5n147eT"/> </domain> 
    28      <!-- <\!--   156e   -\-> --> 
    29      <domain id="5s156eT" domain_ref="grid_T" > <zoom_domain id="5s156eT"/> </domain> 
    30      <domain id="2s156eT" domain_ref="grid_T" > <zoom_domain id="2s156eT"/> </domain> 
    31      <domain id="0n156eT" domain_ref="grid_T" > <zoom_domain id="0n156eT"/> </domain> 
    32      <domain id="2n156eT" domain_ref="grid_T" > <zoom_domain id="2n156eT"/> </domain> 
    33      <domain id="5n156eT" domain_ref="grid_T" > <zoom_domain id="5n156eT"/> </domain> 
    34      <domain id="8n156eT" domain_ref="grid_T" > <zoom_domain id="8n156eT"/> </domain> 
    35      <!-- <\!--   165e   -\-> --> 
    36      <domain id="8s165eT" domain_ref="grid_T" > <zoom_domain id="8s165eT"/> </domain> 
    37      <domain id="5s165eT" domain_ref="grid_T" > <zoom_domain id="5s165eT"/> </domain> 
    38      <domain id="2s165eT" domain_ref="grid_T" > <zoom_domain id="2s165eT"/> </domain> 
    39      <domain id="0n165eT" domain_ref="grid_T" > <zoom_domain id="0n165eT"/> </domain> 
    40      <domain id="2n165eT" domain_ref="grid_T" > <zoom_domain id="2n165eT"/> </domain> 
    41      <domain id="5n165eT" domain_ref="grid_T" > <zoom_domain id="5n165eT"/> </domain> 
    42      <domain id="8n165eT" domain_ref="grid_T" > <zoom_domain id="8n165eT"/> </domain> 
    43      <!-- <\!--   180w   -\-> --> 
    44      <domain id="8s180wT" domain_ref="grid_T" > <zoom_domain id="8s180wT"/> </domain> 
    45      <domain id="5s180wT" domain_ref="grid_T" > <zoom_domain id="5s180wT"/> </domain> 
    46      <domain id="2s180wT" domain_ref="grid_T" > <zoom_domain id="2s180wT"/> </domain> 
    47      <domain id="0n180wT" domain_ref="grid_T" > <zoom_domain id="0n180wT"/> </domain> 
    48      <domain id="2n180wT" domain_ref="grid_T" > <zoom_domain id="2n180wT"/> </domain> 
    49      <domain id="5n180wT" domain_ref="grid_T" > <zoom_domain id="5n180wT"/> </domain> 
    50      <domain id="8n180wT" domain_ref="grid_T" > <zoom_domain id="8n180wT"/> </domain> 
    51      <!-- <\!--   170w   -\-> --> 
    52      <domain id="8s170wT" domain_ref="grid_T" > <zoom_domain id="8s170wT"/> </domain> 
    53      <domain id="5s170wT" domain_ref="grid_T" > <zoom_domain id="5s170wT"/> </domain> 
    54      <domain id="2s170wT" domain_ref="grid_T" > <zoom_domain id="2s170wT"/> </domain> 
    55      <domain id="0n170wT" domain_ref="grid_T" > <zoom_domain id="0n170wT"/> </domain> 
    56      <domain id="2n170wT" domain_ref="grid_T" > <zoom_domain id="2n170wT"/> </domain> 
    57      <domain id="5n170wT" domain_ref="grid_T" > <zoom_domain id="5n170wT"/> </domain> 
    58      <domain id="8n170wT" domain_ref="grid_T" > <zoom_domain id="8n170wT"/> </domain> 
    59      <!-- <\!--   155w   -\-> --> 
    60      <domain id="8s155wT" domain_ref="grid_T" > <zoom_domain id="8s155wT"/> </domain> 
    61      <domain id="5s155wT" domain_ref="grid_T" > <zoom_domain id="5s155wT"/> </domain> 
    62      <domain id="2s155wT" domain_ref="grid_T" > <zoom_domain id="2s155wT"/> </domain> 
    63      <domain id="0n155wT" domain_ref="grid_T" > <zoom_domain id="0n155wT"/> </domain> 
    64      <domain id="2n155wT" domain_ref="grid_T" > <zoom_domain id="2n155wT"/> </domain> 
    65      <domain id="5n155wT" domain_ref="grid_T" > <zoom_domain id="5n155wT"/> </domain> 
    66      <domain id="8n155wT" domain_ref="grid_T" > <zoom_domain id="8n155wT"/> </domain> 
    67      <!-- <\!--   140w   -\-> --> 
    68      <domain id="8s140wT" domain_ref="grid_T" > <zoom_domain id="8s140wT"/> </domain> 
    69      <domain id="5s140wT" domain_ref="grid_T" > <zoom_domain id="5s140wT"/> </domain> 
    70      <domain id="2s140wT" domain_ref="grid_T" > <zoom_domain id="2s140wT"/> </domain> 
    71      <domain id="0n140wT" domain_ref="grid_T" > <zoom_domain id="0n140wT"/> </domain> 
    72      <domain id="2n140wT" domain_ref="grid_T" > <zoom_domain id="2n140wT"/> </domain> 
    73      <domain id="5n140wT" domain_ref="grid_T" > <zoom_domain id="5n140wT"/> </domain> 
    74      <domain id="8n140wT" domain_ref="grid_T" > <zoom_domain id="8n140wT"/> </domain> 
    75      <!-- <\!--   125w   -\-> --> 
    76      <domain id="8s125wT" domain_ref="grid_T" > <zoom_domain id="8s125wT"/> </domain> 
    77      <domain id="5s125wT" domain_ref="grid_T" > <zoom_domain id="5s125wT"/> </domain> 
    78      <domain id="2s125wT" domain_ref="grid_T" > <zoom_domain id="2s125wT"/> </domain> 
    79      <domain id="0n125wT" domain_ref="grid_T" > <zoom_domain id="0n125wT"/> </domain> 
    80      <domain id="2n125wT" domain_ref="grid_T" > <zoom_domain id="2n125wT"/> </domain> 
    81      <domain id="5n125wT" domain_ref="grid_T" > <zoom_domain id="5n125wT"/> </domain> 
    82      <domain id="8n125wT" domain_ref="grid_T" > <zoom_domain id="8n125wT"/> </domain> 
    83      <!-- <\!--   110w   -\-> --> 
    84      <domain id="8s110wT" domain_ref="grid_T" > <zoom_domain id="8s110wT"/> </domain> 
    85      <domain id="5s110wT" domain_ref="grid_T" > <zoom_domain id="5s110wT"/> </domain> 
    86      <domain id="2s110wT" domain_ref="grid_T" > <zoom_domain id="2s110wT"/> </domain> 
    87      <domain id="0n110wT" domain_ref="grid_T" > <zoom_domain id="0n110wT"/> </domain> 
    88      <domain id="2n110wT" domain_ref="grid_T" > <zoom_domain id="2n110wT"/> </domain> 
    89      <domain id="5n110wT" domain_ref="grid_T" > <zoom_domain id="5n110wT"/> </domain> 
    90      <domain id="8n110wT" domain_ref="grid_T" > <zoom_domain id="8n110wT"/> </domain> 
    91      <!-- <\!--   95w   -\-> --> 
    92      <domain id="8s95wT" domain_ref="grid_T" > <zoom_domain id="8s95wT"/> </domain> 
    93      <domain id="5s95wT" domain_ref="grid_T" > <zoom_domain id="5s95wT"/> </domain> 
    94      <domain id="2s95wT" domain_ref="grid_T" > <zoom_domain id="2s95wT"/> </domain> 
    95      <domain id="0n95wT" domain_ref="grid_T" > <zoom_domain id="0n95wT"/> </domain> 
    96      <domain id="2n95wT" domain_ref="grid_T" > <zoom_domain id="2n95wT"/> </domain> 
    97      <domain id="5n95wT" domain_ref="grid_T" > <zoom_domain id="5n95wT"/> </domain> 
    98      <domain id="8n95wT" domain_ref="grid_T" > <zoom_domain id="8n95wT"/> </domain> 
    99      <!-- <\!--   RAMA   -\-> --> 
    100      <!-- <\!--   55e   -\-> --> 
    101      <domain id="16s55eT"    domain_ref="grid_T" > <zoom_domain id="16s55eT"   /> </domain> 
    102      <domain id="12s55eT"    domain_ref="grid_T" > <zoom_domain id="12s55eT"   /> </domain> 
    103      <domain id="8s55eT"     domain_ref="grid_T" > <zoom_domain id="8s55eT"    /> </domain> 
    104      <domain id="4s55eT"     domain_ref="grid_T" > <zoom_domain id="4s55eT"    /> </domain> 
    105      <domain id="1.5s55eT"   domain_ref="grid_T" > <zoom_domain id="1.5s55eT"  /> </domain> 
    106      <domain id="0n55eT"     domain_ref="grid_T" > <zoom_domain id="0n55eT"    /> </domain> 
    107      <domain id="1.5n55eT"   domain_ref="grid_T" > <zoom_domain id="1.5n55eT"  /> </domain> 
    108      <domain id="4n55eT"     domain_ref="grid_T" > <zoom_domain id="4n55eT"    /> </domain> 
    109      <!--    <\!--   65e   -\-> --> 
    110      <domain id="15n65eT"    domain_ref="grid_T" > <zoom_domain id="15n65eT"   /> </domain> 
    111      <!--    <\!--   67e   -\-> --> 
    112      <domain id="16s67eT"    domain_ref="grid_T" > <zoom_domain id="16s67eT"   /> </domain> 
    113      <domain id="12s67eT"    domain_ref="grid_T" > <zoom_domain id="12s67eT"   /> </domain> 
    114      <domain id="8s67eT"     domain_ref="grid_T" > <zoom_domain id="8s67eT"    /> </domain> 
    115      <domain id="4s67eT"     domain_ref="grid_T" > <zoom_domain id="4s67eT"    /> </domain> 
    116      <domain id="1.5s67eT"   domain_ref="grid_T" > <zoom_domain id="1.5s67eT"  /> </domain> 
    117      <domain id="0n67eT"     domain_ref="grid_T" > <zoom_domain id="0n67eT"    /> </domain> 
    118      <domain id="1.5n67eT"   domain_ref="grid_T" > <zoom_domain id="1.5n67eT"  /> </domain> 
    119      <domain id="4n67eT"     domain_ref="grid_T" > <zoom_domain id="4n67eT"    /> </domain> 
    120      <domain id="8n67eT"     domain_ref="grid_T" > <zoom_domain id="8n67eT"    /> </domain> 
    121      <!-- <\!--   80.5e   -\-> --> 
    122      <domain id="16s80.5eT"  domain_ref="grid_T" > <zoom_domain id="16s80.5eT" /> </domain> 
    123      <domain id="12s80.5eT"  domain_ref="grid_T" > <zoom_domain id="12s80.5eT" /> </domain> 
    124      <domain id="8s80.5eT"   domain_ref="grid_T" > <zoom_domain id="8s80.5eT"  /> </domain> 
    125      <domain id="4s80.5eT"   domain_ref="grid_T" > <zoom_domain id="4s80.5eT"  /> </domain> 
    126      <domain id="1.5s80.5eT" domain_ref="grid_T" > <zoom_domain id="1.5s80.5eT"/> </domain> 
    127      <domain id="0n80.5eT"   domain_ref="grid_T" > <zoom_domain id="0n80.5eT"  /> </domain> 
    128      <domain id="1.5n80.5eT" domain_ref="grid_T" > <zoom_domain id="1.5n80.5eT"/> </domain> 
    129      <domain id="4n80.5eT"   domain_ref="grid_T" > <zoom_domain id="4n80.5eT"  /> </domain> 
    130      <!-- <\!--   90e   -\-> --> 
    131      <domain id="1.5s90eT"   domain_ref="grid_T" > <zoom_domain id="1.5s90eT"  /> </domain> 
    132      <domain id="0n90eT"     domain_ref="grid_T" > <zoom_domain id="0n90eT"    /> </domain> 
    133      <domain id="1.5n90eT"   domain_ref="grid_T" > <zoom_domain id="1.5n90eT"  /> </domain> 
    134      <domain id="4n90eT"     domain_ref="grid_T" > <zoom_domain id="4n90eT"    /> </domain> 
    135      <domain id="8n90eT"     domain_ref="grid_T" > <zoom_domain id="8n90eT"    /> </domain> 
    136      <domain id="12n90eT"    domain_ref="grid_T" > <zoom_domain id="12n90eT"   /> </domain> 
    137      <domain id="15n90eT"    domain_ref="grid_T" > <zoom_domain id="15n90eT"   /> </domain> 
    138      <!-- <\!--   95e   -\-> --> 
    139      <domain id="16s95eT"    domain_ref="grid_T" > <zoom_domain id="16s95eT"   /> </domain> 
    140      <domain id="12s95eT"    domain_ref="grid_T" > <zoom_domain id="12s95eT"   /> </domain> 
    141      <domain id="8s95eT"     domain_ref="grid_T" > <zoom_domain id="8s95eT"    /> </domain> 
    142      <domain id="5s95eT"     domain_ref="grid_T" > <zoom_domain id="5s95eT"    /> </domain> 
    143      <!-- <\!--   PIRATA   -\-> --> 
    144      <!-- <\!--   38w-30w   -\-> --> 
    145      <domain id="19s34wT" domain_ref="grid_T" > <zoom_domain id="19s34wT"/> </domain> 
    146      <domain id="14s32wT" domain_ref="grid_T" > <zoom_domain id="14s32wT"/> </domain> 
    147      <domain id="8s30wT"  domain_ref="grid_T" > <zoom_domain id="8s30wT" /> </domain> 
    148      <domain id="0n35wT"  domain_ref="grid_T" > <zoom_domain id="0n35wT" /> </domain> 
    149      <domain id="4n38wT"  domain_ref="grid_T" > <zoom_domain id="4n38wT" /> </domain> 
    150      <domain id="8n38wT"  domain_ref="grid_T" > <zoom_domain id="8n38wT" /> </domain> 
    151      <domain id="12n38wT" domain_ref="grid_T" > <zoom_domain id="12n38wT"/> </domain> 
    152      <domain id="15n38wT" domain_ref="grid_T" > <zoom_domain id="15n38wT"/> </domain> 
    153      <domain id="20n38wT" domain_ref="grid_T" > <zoom_domain id="20n38wT"/> </domain> 
    154      <!-- <\!--   23w   -\-> --> 
    155      <domain id="0n23wT"  domain_ref="grid_T" > <zoom_domain id="0n23wT" /> </domain> 
    156      <domain id="4n23wT"  domain_ref="grid_T" > <zoom_domain id="4n23wT" /> </domain> 
    157      <domain id="12n23wT" domain_ref="grid_T" > <zoom_domain id="12n23wT"/> </domain> 
    158      <domain id="21n23wT" domain_ref="grid_T" > <zoom_domain id="21n23wT"/> </domain> 
    159      <!-- <\!--   10w   -\-> --> 
    160      <domain id="10s10wT" domain_ref="grid_T" > <zoom_domain id="10s10wT"/> </domain> 
    161      <domain id="6s10wT"  domain_ref="grid_T" > <zoom_domain id="6s10wT" /> </domain> 
    162      <domain id="0n10wT"  domain_ref="grid_T" > <zoom_domain id="0n10wT" /> </domain> 
    163      <!-- <\!--   0e   -\-> --> 
    164      <domain id="0n0eT"   domain_ref="grid_T" > <zoom_domain id="0n0eT"  /> </domain> 
     17  <!--   Eq section --> 
     18  <domain id="EqT" domain_ref="grid_T" > <zoom_domain id="EqT"/> </domain> 
     19  <!--   TAO : see example above   --> 
     20  <!--   137e   --> 
     21  <domain id="2n137eT" domain_ref="grid_T" > <zoom_domain id="2n137eT"/> </domain> 
     22  <domain id="5n137eT" domain_ref="grid_T" > <zoom_domain id="5n137eT"/> </domain> 
     23  <domain id="8n137eT" domain_ref="grid_T" > <zoom_domain id="8n137eT"/> </domain> 
     24  <!-- <\!--   147e   -\-> --> 
     25  <domain id="0n147eT" domain_ref="grid_T" > <zoom_domain id="0n147eT"/> </domain> 
     26  <domain id="2n147eT" domain_ref="grid_T" > <zoom_domain id="2n147eT"/> </domain> 
     27  <domain id="5n147eT" domain_ref="grid_T" > <zoom_domain id="5n147eT"/> </domain> 
     28  <!-- <\!--   156e   -\-> --> 
     29  <domain id="5s156eT" domain_ref="grid_T" > <zoom_domain id="5s156eT"/> </domain> 
     30  <domain id="2s156eT" domain_ref="grid_T" > <zoom_domain id="2s156eT"/> </domain> 
     31  <domain id="0n156eT" domain_ref="grid_T" > <zoom_domain id="0n156eT"/> </domain> 
     32  <domain id="2n156eT" domain_ref="grid_T" > <zoom_domain id="2n156eT"/> </domain> 
     33  <domain id="5n156eT" domain_ref="grid_T" > <zoom_domain id="5n156eT"/> </domain> 
     34  <domain id="8n156eT" domain_ref="grid_T" > <zoom_domain id="8n156eT"/> </domain> 
     35  <!-- <\!--   165e   -\-> --> 
     36  <domain id="8s165eT" domain_ref="grid_T" > <zoom_domain id="8s165eT"/> </domain> 
     37  <domain id="5s165eT" domain_ref="grid_T" > <zoom_domain id="5s165eT"/> </domain> 
     38  <domain id="2s165eT" domain_ref="grid_T" > <zoom_domain id="2s165eT"/> </domain> 
     39  <domain id="0n165eT" domain_ref="grid_T" > <zoom_domain id="0n165eT"/> </domain> 
     40  <domain id="2n165eT" domain_ref="grid_T" > <zoom_domain id="2n165eT"/> </domain> 
     41  <domain id="5n165eT" domain_ref="grid_T" > <zoom_domain id="5n165eT"/> </domain> 
     42  <domain id="8n165eT" domain_ref="grid_T" > <zoom_domain id="8n165eT"/> </domain> 
     43  <!-- <\!--   180w   -\-> --> 
     44  <domain id="8s180wT" domain_ref="grid_T" > <zoom_domain id="8s180wT"/> </domain> 
     45  <domain id="5s180wT" domain_ref="grid_T" > <zoom_domain id="5s180wT"/> </domain> 
     46  <domain id="2s180wT" domain_ref="grid_T" > <zoom_domain id="2s180wT"/> </domain> 
     47  <domain id="0n180wT" domain_ref="grid_T" > <zoom_domain id="0n180wT"/> </domain> 
     48  <domain id="2n180wT" domain_ref="grid_T" > <zoom_domain id="2n180wT"/> </domain> 
     49  <domain id="5n180wT" domain_ref="grid_T" > <zoom_domain id="5n180wT"/> </domain> 
     50  <domain id="8n180wT" domain_ref="grid_T" > <zoom_domain id="8n180wT"/> </domain> 
     51  <!-- <\!--   170w   -\-> --> 
     52  <domain id="8s170wT" domain_ref="grid_T" > <zoom_domain id="8s170wT"/> </domain> 
     53  <domain id="5s170wT" domain_ref="grid_T" > <zoom_domain id="5s170wT"/> </domain> 
     54  <domain id="2s170wT" domain_ref="grid_T" > <zoom_domain id="2s170wT"/> </domain> 
     55  <domain id="0n170wT" domain_ref="grid_T" > <zoom_domain id="0n170wT"/> </domain> 
     56  <domain id="2n170wT" domain_ref="grid_T" > <zoom_domain id="2n170wT"/> </domain> 
     57  <domain id="5n170wT" domain_ref="grid_T" > <zoom_domain id="5n170wT"/> </domain> 
     58  <domain id="8n170wT" domain_ref="grid_T" > <zoom_domain id="8n170wT"/> </domain> 
     59  <!-- <\!--   155w   -\-> --> 
     60  <domain id="8s155wT" domain_ref="grid_T" > <zoom_domain id="8s155wT"/> </domain> 
     61  <domain id="5s155wT" domain_ref="grid_T" > <zoom_domain id="5s155wT"/> </domain> 
     62  <domain id="2s155wT" domain_ref="grid_T" > <zoom_domain id="2s155wT"/> </domain> 
     63  <domain id="0n155wT" domain_ref="grid_T" > <zoom_domain id="0n155wT"/> </domain> 
     64  <domain id="2n155wT" domain_ref="grid_T" > <zoom_domain id="2n155wT"/> </domain> 
     65  <domain id="5n155wT" domain_ref="grid_T" > <zoom_domain id="5n155wT"/> </domain> 
     66  <domain id="8n155wT" domain_ref="grid_T" > <zoom_domain id="8n155wT"/> </domain> 
     67  <!-- <\!--   140w   -\-> --> 
     68  <domain id="8s140wT" domain_ref="grid_T" > <zoom_domain id="8s140wT"/> </domain> 
     69  <domain id="5s140wT" domain_ref="grid_T" > <zoom_domain id="5s140wT"/> </domain> 
     70  <domain id="2s140wT" domain_ref="grid_T" > <zoom_domain id="2s140wT"/> </domain> 
     71  <domain id="0n140wT" domain_ref="grid_T" > <zoom_domain id="0n140wT"/> </domain> 
     72  <domain id="2n140wT" domain_ref="grid_T" > <zoom_domain id="2n140wT"/> </domain> 
     73  <domain id="5n140wT" domain_ref="grid_T" > <zoom_domain id="5n140wT"/> </domain> 
     74  <domain id="8n140wT" domain_ref="grid_T" > <zoom_domain id="8n140wT"/> </domain> 
     75  <!-- <\!--   125w   -\-> --> 
     76  <domain id="8s125wT" domain_ref="grid_T" > <zoom_domain id="8s125wT"/> </domain> 
     77  <domain id="5s125wT" domain_ref="grid_T" > <zoom_domain id="5s125wT"/> </domain> 
     78  <domain id="2s125wT" domain_ref="grid_T" > <zoom_domain id="2s125wT"/> </domain> 
     79  <domain id="0n125wT" domain_ref="grid_T" > <zoom_domain id="0n125wT"/> </domain> 
     80  <domain id="2n125wT" domain_ref="grid_T" > <zoom_domain id="2n125wT"/> </domain> 
     81  <domain id="5n125wT" domain_ref="grid_T" > <zoom_domain id="5n125wT"/> </domain> 
     82  <domain id="8n125wT" domain_ref="grid_T" > <zoom_domain id="8n125wT"/> </domain> 
     83  <!-- <\!--   110w   -\-> --> 
     84  <domain id="8s110wT" domain_ref="grid_T" > <zoom_domain id="8s110wT"/> </domain> 
     85  <domain id="5s110wT" domain_ref="grid_T" > <zoom_domain id="5s110wT"/> </domain> 
     86  <domain id="2s110wT" domain_ref="grid_T" > <zoom_domain id="2s110wT"/> </domain> 
     87  <domain id="0n110wT" domain_ref="grid_T" > <zoom_domain id="0n110wT"/> </domain> 
     88  <domain id="2n110wT" domain_ref="grid_T" > <zoom_domain id="2n110wT"/> </domain> 
     89  <domain id="5n110wT" domain_ref="grid_T" > <zoom_domain id="5n110wT"/> </domain> 
     90  <domain id="8n110wT" domain_ref="grid_T" > <zoom_domain id="8n110wT"/> </domain> 
     91  <!-- <\!--   95w   -\-> --> 
     92  <domain id="8s95wT" domain_ref="grid_T" > <zoom_domain id="8s95wT"/> </domain> 
     93  <domain id="5s95wT" domain_ref="grid_T" > <zoom_domain id="5s95wT"/> </domain> 
     94  <domain id="2s95wT" domain_ref="grid_T" > <zoom_domain id="2s95wT"/> </domain> 
     95  <domain id="0n95wT" domain_ref="grid_T" > <zoom_domain id="0n95wT"/> </domain> 
     96  <domain id="2n95wT" domain_ref="grid_T" > <zoom_domain id="2n95wT"/> </domain> 
     97  <domain id="5n95wT" domain_ref="grid_T" > <zoom_domain id="5n95wT"/> </domain> 
     98  <domain id="8n95wT" domain_ref="grid_T" > <zoom_domain id="8n95wT"/> </domain> 
     99  <!-- <\!--   RAMA   -\-> --> 
     100  <!-- <\!--   55e   -\-> --> 
     101  <domain id="16s55eT"    domain_ref="grid_T" > <zoom_domain id="16s55eT"   /> </domain> 
     102  <domain id="12s55eT"    domain_ref="grid_T" > <zoom_domain id="12s55eT"   /> </domain> 
     103  <domain id="8s55eT"     domain_ref="grid_T" > <zoom_domain id="8s55eT"    /> </domain> 
     104  <domain id="4s55eT"     domain_ref="grid_T" > <zoom_domain id="4s55eT"    /> </domain> 
     105  <domain id="1.5s55eT"   domain_ref="grid_T" > <zoom_domain id="1.5s55eT"  /> </domain> 
     106  <domain id="0n55eT"     domain_ref="grid_T" > <zoom_domain id="0n55eT"    /> </domain> 
     107  <domain id="1.5n55eT"   domain_ref="grid_T" > <zoom_domain id="1.5n55eT"  /> </domain> 
     108  <domain id="4n55eT"     domain_ref="grid_T" > <zoom_domain id="4n55eT"    /> </domain> 
     109  <!--    <\!--   65e   -\-> --> 
     110  <domain id="15n65eT"    domain_ref="grid_T" > <zoom_domain id="15n65eT"   /> </domain> 
     111  <!--    <\!--   67e   -\-> --> 
     112  <domain id="16s67eT"    domain_ref="grid_T" > <zoom_domain id="16s67eT"   /> </domain> 
     113  <domain id="12s67eT"    domain_ref="grid_T" > <zoom_domain id="12s67eT"   /> </domain> 
     114  <domain id="8s67eT"     domain_ref="grid_T" > <zoom_domain id="8s67eT"    /> </domain> 
     115  <domain id="4s67eT"     domain_ref="grid_T" > <zoom_domain id="4s67eT"    /> </domain> 
     116  <domain id="1.5s67eT"   domain_ref="grid_T" > <zoom_domain id="1.5s67eT"  /> </domain> 
     117  <domain id="0n67eT"     domain_ref="grid_T" > <zoom_domain id="0n67eT"    /> </domain> 
     118  <domain id="1.5n67eT"   domain_ref="grid_T" > <zoom_domain id="1.5n67eT"  /> </domain> 
     119  <domain id="4n67eT"     domain_ref="grid_T" > <zoom_domain id="4n67eT"    /> </domain> 
     120  <domain id="8n67eT"     domain_ref="grid_T" > <zoom_domain id="8n67eT"    /> </domain> 
     121  <!-- <\!--   80.5e   -\-> --> 
     122  <domain id="16s80.5eT"  domain_ref="grid_T" > <zoom_domain id="16s80.5eT" /> </domain> 
     123  <domain id="12s80.5eT"  domain_ref="grid_T" > <zoom_domain id="12s80.5eT" /> </domain> 
     124  <domain id="8s80.5eT"   domain_ref="grid_T" > <zoom_domain id="8s80.5eT"  /> </domain> 
     125  <domain id="4s80.5eT"   domain_ref="grid_T" > <zoom_domain id="4s80.5eT"  /> </domain> 
     126  <domain id="1.5s80.5eT" domain_ref="grid_T" > <zoom_domain id="1.5s80.5eT"/> </domain> 
     127  <domain id="0n80.5eT"   domain_ref="grid_T" > <zoom_domain id="0n80.5eT"  /> </domain> 
     128  <domain id="1.5n80.5eT" domain_ref="grid_T" > <zoom_domain id="1.5n80.5eT"/> </domain> 
     129  <domain id="4n80.5eT"   domain_ref="grid_T" > <zoom_domain id="4n80.5eT"  /> </domain> 
     130  <!-- <\!--   90e   -\-> --> 
     131  <domain id="1.5s90eT"   domain_ref="grid_T" > <zoom_domain id="1.5s90eT"  /> </domain> 
     132  <domain id="0n90eT"     domain_ref="grid_T" > <zoom_domain id="0n90eT"    /> </domain> 
     133  <domain id="1.5n90eT"   domain_ref="grid_T" > <zoom_domain id="1.5n90eT"  /> </domain> 
     134  <domain id="4n90eT"     domain_ref="grid_T" > <zoom_domain id="4n90eT"    /> </domain> 
     135  <domain id="8n90eT"     domain_ref="grid_T" > <zoom_domain id="8n90eT"    /> </domain> 
     136  <domain id="12n90eT"    domain_ref="grid_T" > <zoom_domain id="12n90eT"   /> </domain> 
     137  <domain id="15n90eT"    domain_ref="grid_T" > <zoom_domain id="15n90eT"   /> </domain> 
     138  <!-- <\!--   95e   -\-> --> 
     139  <domain id="16s95eT"    domain_ref="grid_T" > <zoom_domain id="16s95eT"   /> </domain> 
     140  <domain id="12s95eT"    domain_ref="grid_T" > <zoom_domain id="12s95eT"   /> </domain> 
     141  <domain id="8s95eT"     domain_ref="grid_T" > <zoom_domain id="8s95eT"    /> </domain> 
     142  <domain id="5s95eT"     domain_ref="grid_T" > <zoom_domain id="5s95eT"    /> </domain> 
     143  <!-- <\!--   PIRATA   -\-> --> 
     144  <!-- <\!--   38w-30w   -\-> --> 
     145  <domain id="19s34wT" domain_ref="grid_T" > <zoom_domain id="19s34wT"/> </domain> 
     146  <domain id="14s32wT" domain_ref="grid_T" > <zoom_domain id="14s32wT"/> </domain> 
     147  <domain id="8s30wT"  domain_ref="grid_T" > <zoom_domain id="8s30wT" /> </domain> 
     148  <domain id="0n35wT"  domain_ref="grid_T" > <zoom_domain id="0n35wT" /> </domain> 
     149  <domain id="4n38wT"  domain_ref="grid_T" > <zoom_domain id="4n38wT" /> </domain> 
     150  <domain id="8n38wT"  domain_ref="grid_T" > <zoom_domain id="8n38wT" /> </domain> 
     151  <domain id="12n38wT" domain_ref="grid_T" > <zoom_domain id="12n38wT"/> </domain> 
     152  <domain id="15n38wT" domain_ref="grid_T" > <zoom_domain id="15n38wT"/> </domain> 
     153  <domain id="20n38wT" domain_ref="grid_T" > <zoom_domain id="20n38wT"/> </domain> 
     154  <!-- <\!--   23w   -\-> --> 
     155  <domain id="0n23wT"  domain_ref="grid_T" > <zoom_domain id="0n23wT" /> </domain> 
     156  <domain id="4n23wT"  domain_ref="grid_T" > <zoom_domain id="4n23wT" /> </domain> 
     157  <domain id="12n23wT" domain_ref="grid_T" > <zoom_domain id="12n23wT"/> </domain> 
     158  <domain id="21n23wT" domain_ref="grid_T" > <zoom_domain id="21n23wT"/> </domain> 
     159  <!-- <\!--   10w   -\-> --> 
     160  <domain id="10s10wT" domain_ref="grid_T" > <zoom_domain id="10s10wT"/> </domain> 
     161  <domain id="6s10wT"  domain_ref="grid_T" > <zoom_domain id="6s10wT" /> </domain> 
     162  <domain id="0n10wT"  domain_ref="grid_T" > <zoom_domain id="0n10wT" /> </domain> 
     163  <!-- <\!--   0e   -\-> --> 
     164  <domain id="0n0eT"   domain_ref="grid_T" > <zoom_domain id="0n0eT"  /> </domain> 
    165165 
    166       
    167      <!--   U grid   --> 
    168      <domain id="grid_U" long_name="grid U"/> 
    169      <!--   Eq section   --> 
    170      <domain id="EqU" domain_ref="grid_U" > <zoom_domain id="EqU"/> </domain> 
    171166 
    172        
    173      <!--   V grid   --> 
    174      <domain id="grid_V" long_name="grid V"/> 
    175      <!--   Eq section : no V point on the Equator...   --> 
     167  <!--   U grid   --> 
     168  <domain id="grid_U" long_name="grid U"/> 
     169  <!--   Eq section   --> 
     170  <domain id="EqU" domain_ref="grid_U" > <zoom_domain id="EqU"/> </domain> 
    176171 
    177       
    178      <!--   W grid   --> 
    179      <domain id="grid_W" long_name="grid W"/> 
    180      <!--   Eq section   --> 
    181      <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain> 
    182172 
    183               <!--   zonal mean grid   --> 
    184      <domain_group id="gznl"> 
    185         <domain id="gznl" long_name="gznl"/> 
    186         <domain id="ptr" domain_ref="gznl" >  
    187             <zoom_domain id="ptr" ibegin="0000" jbegin="0" ni="1" nj="0000" />  
    188         </domain> 
    189       </domain_group> 
     173  <!--   V grid   --> 
     174  <domain id="grid_V" long_name="grid V"/> 
     175  <!--   Eq section : no V point on the Equator...   --> 
    190176 
    191       
    192      <!--   other grids   --> 
    193      <domain id="scalarpoint" long_name="scalar"/> 
    194        
    195177 
    196    </domain_definition>     
    197   
     178  <!--   W grid   --> 
     179  <domain id="grid_W" long_name="grid W"/> 
     180  <!--   Eq section   --> 
     181  <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain> 
     182 
     183  <!--   zonal mean grid   --> 
     184  <domain_group id="gznl"> 
     185    <domain id="gznl" long_name="gznl"/> 
     186    <domain id="ptr" domain_ref="gznl" > 
     187      <zoom_domain id="ptr" ibegin="0000" jbegin="0" ni="1" nj="0000" /> 
     188    </domain> 
     189  </domain_group> 
     190 
     191 
     192  <!--   other grids   --> 
     193  <domain id="scalarpoint" long_name="scalar"/> 
     194 
     195 
     196</domain_definition> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-ice.xml

    r14017 r14021  
    5151      <field id="icehlid"      long_name="melt pond lid depth"                                     standard_name="sea_ice_meltpondlid_depth"                 unit="m" /> 
    5252      <field id="icevlid"      long_name="melt pond lid volume"                                    standard_name="sea_ice_meltpondlid_volume"                unit="m" /> 
     53      <field id="dvpn_mlt"     long_name="pond volume tendency due to surface melt"                standard_name="sea_ice_pondvolume_tendency_melt"          unit="kg/m2/s" /> 
     54      <field id="dvpn_lid"     long_name="pond volume tendency due to exchanges with lid"          standard_name="sea_ice_pondvolume_tendency_lids"          unit="kg/m2/s" /> 
     55      <field id="dvpn_rnf"     long_name="pond volume tendency due to runoff"                      standard_name="sea_ice_pondvolume_tendency_runoff"        unit="kg/m2/s" /> 
     56      <field id="dvpn_drn"     long_name="pond volume tendency due to drainage"                    standard_name="sea_ice_pondvolume_tendency_drainage"      unit="kg/m2/s" /> 
    5357 
    5458      <!-- heat --> 
    … …  
    309313      <field id="snwtemp_cat"  long_name="Snow temperature per category"                     unit="degC"    detect_missing_value="true" /> 
    310314      <field id="icettop_cat"  long_name="Ice/snow surface temperature per category"         unit="degC"    detect_missing_value="true" /> 
    311       <field id="iceapnd_cat"  long_name="Ice melt pond concentration per category"          unit=""        /> 
     315      <field id="iceapnd_cat"  long_name="Ice melt pond grid fraction per category"          unit=""        /> 
     316      <field id="icevpnd_cat"  long_name="Ice melt pond volume per grid area per category"   unit="m"       /> 
    312317      <field id="icehpnd_cat"  long_name="Ice melt pond thickness per category"              unit="m"       detect_missing_value="true" /> 
    313318      <field id="icehlid_cat"  long_name="Ice melt pond lid thickness per category"          unit="m"       detect_missing_value="true" /> 
    314       <field id="iceafpnd_cat" long_name="Ice melt pond fraction per category"               unit=""        /> 
     319      <field id="iceafpnd_cat" long_name="Ice melt pond ice fraction per category"           unit=""        /> 
    315320      <field id="iceaepnd_cat" long_name="Ice melt pond effective fraction per category"     unit=""        /> 
    316321      <field id="icemask_cat"  long_name="Fraction of time step with sea ice (per category)" unit=""        /> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-innerttrc.xml

    r9539 r14021  
    1 <?xml version="1.0"?>  
    2     <!-- $id$ --> 
    3      
    4     <!--  
     1<?xml version="1.0"?> 
     2<!-- $id$ --> 
     3 
     4<!-- 
    55============================================================================================================ 
    66=                                  definition of all existing variables                                    = 
    77=                                            DO NOT CHANGE                                                 = 
    88============================================================================================================ 
    9     --> 
    10    <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined --> 
     9--> 
     10<field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined --> 
    1111 
    12     <!--  
    13 ============================================================================================================ 
    14                                      Inert tracers variables 
    15 ============================================================================================================ 
    16     --> 
     12  <!-- 
     13      ============================================================================================================ 
     14      Inert tracers variables 
     15      ============================================================================================================ 
     16  --> 
    1717 
    1818 
    19      <field_group id="inerttrc" grid_ref="grid_T_2D"> 
     19  <field_group id="inerttrc" grid_ref="grid_T_2D"> 
    2020 
    21        <!-- CFC11 : variables available with ln_cfc11 --> 
    22        <field id="CFC11"        long_name="Chlorofluoro carbon11 Concentration"      unit="umol/m3"   grid_ref="grid_T_3D" /> 
    23        <field id="CFC11_e3t"    long_name="CFC11 * e3t"                              unit="umol/m2"   grid_ref="grid_T_3D"  > CFC11 * e3t </field > 
    24        <field id="qtr_CFC11"    long_name="Air-sea flux of CFC-11"                   unit="mol/m2/s"   /> 
    25        <field id="qint_CFC11"   long_name="Cumulative air-sea flux of CFC-11"        unit="mol/m2"     /> 
     21    <!-- CFC11 : variables available with ln_cfc11 --> 
     22    <field id="CFC11"        long_name="Chlorofluoro carbon11 Concentration"      unit="umol/m3"   grid_ref="grid_T_3D" /> 
     23    <field id="CFC11_e3t"    long_name="CFC11 * e3t"                              unit="umol/m2"   grid_ref="grid_T_3D"  > CFC11 * e3t </field > 
     24    <field id="qtr_CFC11"    long_name="Air-sea flux of CFC-11"                   unit="mol/m2/s"   /> 
     25    <field id="qint_CFC11"   long_name="Cumulative air-sea flux of CFC-11"        unit="mol/m2"     /> 
    2626 
    27        <!-- CFC12 : variables available with ln_cfc12 --> 
    28        <field id="CFC12"        long_name="Chlorofluoro carbon12 Concentration"      unit="umol/m3"   grid_ref="grid_T_3D" /> 
    29        <field id="CFC12_e3t"    long_name="CFC12 * e3t"                              unit="umol/m2"   grid_ref="grid_T_3D"  > CFC12 * e3t </field > 
    30        <field id="qtr_CFC12"    long_name="Air-sea flux of CFC12"                    unit="mol/m2/s"   /> 
    31        <field id="qint_CFC12"   long_name="Cumulative air-sea flux of CFC12"         unit="mol/m2"     /> 
     27    <!-- CFC12 : variables available with ln_cfc12 --> 
     28    <field id="CFC12"        long_name="Chlorofluoro carbon12 Concentration"      unit="umol/m3"   grid_ref="grid_T_3D" /> 
     29    <field id="CFC12_e3t"    long_name="CFC12 * e3t"                              unit="umol/m2"   grid_ref="grid_T_3D"  > CFC12 * e3t </field > 
     30    <field id="qtr_CFC12"    long_name="Air-sea flux of CFC12"                    unit="mol/m2/s"   /> 
     31    <field id="qint_CFC12"   long_name="Cumulative air-sea flux of CFC12"         unit="mol/m2"     /> 
    3232 
    33        <!-- SF6 : variables available with ln_sf6 --> 
    34        <field id="SF6"          long_name="Sulfur hexafluoride Concentration"        unit="umol/m3"   grid_ref="grid_T_3D" /> 
    35        <field id="SF6_e3t"      long_name="SF6 * e3t"                                unit="umol/m2"   grid_ref="grid_T_3D"  > SF6 * e3t </field > 
    36        <field id="qtr_SF6"      long_name="Air-sea flux of SF6"                      unit="mol/m2/s"   /> 
    37        <field id="qint_SF6"     long_name="Cumulative air-sea flux of SF6"           unit="mol/m2"     /> 
     33    <!-- SF6 : variables available with ln_sf6 --> 
     34    <field id="SF6"          long_name="Sulfur hexafluoride Concentration"        unit="umol/m3"   grid_ref="grid_T_3D" /> 
     35    <field id="SF6_e3t"      long_name="SF6 * e3t"                                unit="umol/m2"   grid_ref="grid_T_3D"  > SF6 * e3t </field > 
     36    <field id="qtr_SF6"      long_name="Air-sea flux of SF6"                      unit="mol/m2/s"   /> 
     37    <field id="qint_SF6"     long_name="Cumulative air-sea flux of SF6"           unit="mol/m2"     /> 
    3838 
    39        <!-- C14 : variables available with ln_c14 --> 
    40        <field id="RC14"         long_name="Radiocarbon ratio"                        unit="-"         grid_ref="grid_T_3D"  /> 
    41        <field id="RC14_e3t"     long_name="RC14 * e3t"                               unit="m"         grid_ref="grid_T_3D"   > RC14 * e3t </field > 
    42        <field id="DeltaC14"     long_name="Delta C14"                                unit="permil"    grid_ref="grid_T_3D"  /> 
    43        <field id="C14Age"       long_name="Radiocarbon age"                          unit="yr"        grid_ref="grid_T_3D"  /> 
    44        <field id="RAge"         long_name="Reservoir Age"                            unit="yr"       /> 
    45        <field id="qtr_C14"      long_name="Air-sea flux of C14"                      unit="1/m2/s"   /> 
    46        <field id="qint_C14"     long_name="Cumulative air-sea flux of C14"           unit="1/m2"     /> 
    47        <field id="AtmCO2"       long_name="Global atmospheric CO2"                   unit="ppm"      /> 
    48        <field id="AtmC14"       long_name="Global atmospheric DeltaC14"              unit="permil"   /> 
    49        <field id="K_C14"        long_name="Global 14C/C exchange velocity"           unit="m/yr"     /> 
    50        <field id="K_CO2"        long_name="Global CO2 piston velocity"               unit="cm/h"     /> 
    51        <field id="C14Inv"       long_name="global Radiocarbon ocean inventory"       unit="10^26 atoms"   /> 
     39    <!-- C14 : variables available with ln_c14 --> 
     40    <field id="RC14"         long_name="Radiocarbon ratio"                        unit="-"         grid_ref="grid_T_3D"  /> 
     41    <field id="RC14_e3t"     long_name="RC14 * e3t"                               unit="m"         grid_ref="grid_T_3D"   > RC14 * e3t </field > 
     42    <field id="DeltaC14"     long_name="Delta C14"                                unit="permil"    grid_ref="grid_T_3D"  /> 
     43    <field id="C14Age"       long_name="Radiocarbon age"                          unit="yr"        grid_ref="grid_T_3D"  /> 
     44    <field id="RAge"         long_name="Reservoir Age"                            unit="yr"       /> 
     45    <field id="qtr_C14"      long_name="Air-sea flux of C14"                      unit="1/m2/s"   /> 
     46    <field id="qint_C14"     long_name="Cumulative air-sea flux of C14"           unit="1/m2"     /> 
     47    <field id="AtmCO2"       long_name="Global atmospheric CO2"                   unit="ppm"      /> 
     48    <field id="AtmC14"       long_name="Global atmospheric DeltaC14"              unit="permil"   /> 
     49    <field id="K_C14"        long_name="Global 14C/C exchange velocity"           unit="m/yr"     /> 
     50    <field id="K_CO2"        long_name="Global CO2 piston velocity"               unit="cm/h"     /> 
     51    <field id="C14Inv"       long_name="global Radiocarbon ocean inventory"       unit="10^26 atoms"   /> 
    5252 
    53        <!-- AGE : variables available with ln_age --> 
    54        <field id="Age"          long_name="Sea water age since surface contact"      unit="yr"        grid_ref="grid_T_3D"  /> 
    55        <field id="Age_e3t"      long_name="Age * e3t"                                unit="yr * m"   grid_ref="grid_T_3D"    > Age * e3t </field > 
     53    <!-- AGE : variables available with ln_age --> 
     54    <field id="Age"          long_name="Sea water age since surface contact"      unit="yr"        grid_ref="grid_T_3D"  /> 
     55    <field id="Age_e3t"      long_name="Age * e3t"                                unit="yr * m"   grid_ref="grid_T_3D"    > Age * e3t </field > 
    5656 
    57      </field_group> 
     57  </field_group> 
    5858 
    59    </field_definition> 
     59</field_definition> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-oce.xml

    r13981 r14021  
    234234    <field id="cfl_cw"       long_name="w-courant number"   unit="#" /> 
    235235 
     236    <!-- variables available with ln_zdfmfc=.true. --> 
     237    <field id="mf_Tp"       long_name="plume_temperature"      standard_name="plume_temperature"     unit="degC"   grid_ref="grid_T_3D" /> 
     238    <field id="mf_Sp"       long_name="plume_salinity"         standard_name="plume_salinity"        unit="1e-3"   grid_ref="grid_T_3D" /> 
     239    <field id="mf_mf"       long_name="mass flux"              standard_name="mf_mass_flux"          unit="m"      grid_ref="grid_T_3D" /> 
     240 
    236241  </field_group> <!-- grid_T --> 
    237242 
    … …  
    651656    <field id="avm_evd"      long_name="convective enhancement of vertical viscosity"   standard_name="ocean_vertical_momentum_diffusivity_due_to_convection"   unit="m2/s" /> 
    652657 
     658    <!-- mf_app and mf_wp: available with ln_zdfmfc --> 
     659    <field id="mf_app"      long_name="convective area"        standard_name="mf_convective_area"    unit="%"      grid_ref="grid_W_3D" /> 
     660    <field id="mf_wp"       long_name="convective velocity"    standard_name="mf_convective_velo"    unit="m/s"    grid_ref="grid_W_3D" /> 
     661 
     662 
    653663    <!-- avt_tide: available with ln_zdfiwm=T --> 
    654664    <field id="av_ratio"     long_name="S over T diffusivity ratio"                     standard_name="salinity_over_temperature_diffusivity_ratio"                     unit="1"    /> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/field_def_nemo-pisces.xml

    r12377 r14021  
    1 <?xml version="1.0"?>  
    2     <!-- $id$ --> 
    3      
    4     <!--  
     1<?xml version="1.0"?> 
     2<!-- $id$ --> 
     3 
     4<!-- 
    55============================================================================================================ 
    66=                                  definition of all existing variables                                    = 
    77=                                            DO NOT CHANGE                                                 = 
    88============================================================================================================ 
    9     --> 
    10    <field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined --> 
    11  
    12     <!--  
    13 ============================================================================================================ 
    14                                      Biogeochemistry model variables 
    15 ============================================================================================================ 
    16     --> 
    17  
    18       <!-- ptrc on T grid --> 
    19  
    20      <field_group id="ptrc_T" grid_ref="grid_T_3D"> 
    21        <!-- PISCES standard : variables available with ln_p4z  --> 
    22        <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" /> 
    23        <field id="DIC_e3t"      long_name="DIC * e3t"                                unit="mmol/m2" > DIC * e3t </field > 
    24        <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" /> 
    25        <field id="Alkalini_e3t" long_name="Alkalini * e3t"                           unit="mmol/m2"  > Alkalini * e3t </field > 
    26        <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" /> 
    27        <field id="O2_e3t"       long_name="O2 * e3t"                                 unit="mmol/m2"  > O2 * e3t </field > 
    28        <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" /> 
    29        <field id="CaCO3_e3t"    long_name="CaCO3 * e3t"                              unit="mmol/m2"  > CaCO3 * e3t </field > 
    30        <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" /> 
    31        <field id="PO4_e3t"      long_name="PO4 * e3t"                                unit="mmol/m2"  > PO4 * e3t </field > 
    32        <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" /> 
    33        <field id="POC_e3t"      long_name="POC * e3t"                                unit="mmol/m2"  > POC * e3t </field > 
    34        <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" /> 
    35        <field id="Si_e3t"       long_name="Si * e3t"                                 unit="mmol/m2"  > Si * e3t </field > 
    36        <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" /> 
    37        <field id="PHY_e3t"      long_name="PHY * e3t"                                unit="mmol/m2"  > PHY * e3t </field > 
    38        <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" /> 
    39        <field id="ZOO_e3t"      long_name="ZOO2 * e3t"                               unit="mmol/m2"  > ZOO * e3t </field > 
    40        <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" /> 
    41        <field id="DOC_e3t"      long_name="DOC * e3t"                                unit="mmol/m2"  > DOC * e3t </field > 
    42        <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" /> 
    43        <field id="PHY2_e3t"     long_name="PHY2 * e3t"                               unit="mmol/m2"  > PHY2 * e3t </field > 
    44        <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" /> 
    45        <field id="ZOO2_e3t"     long_name="ZOO2 * e3t"                               unit="mmol/m2"  > ZOO2 * e3t </field > 
    46        <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" /> 
    47        <field id="DSi_e3t"      long_name="Dsi * e3t"                                unit="mmol/m2"  > DSi * e3t </field > 
    48        <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" /> 
    49        <field id="Fer_e3t"      long_name="Fer * e3t"                                unit="mmol/m2"  > Fer * e3t </field > 
    50        <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" /> 
    51        <field id="BFe_e3t"      long_name="BFe * e3t"                                unit="mmol/m2"  > BFe * e3t </field > 
    52        <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" /> 
    53        <field id="GOC_e3t"      long_name="GOC * e3t"                                unit="mmol/m2"  > GOC * e3t </field > 
    54        <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" /> 
    55        <field id="SFe_e3t"      long_name="SFe * e3t"                                unit="mmol/m2"  > SFe * e3t </field > 
    56        <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" /> 
    57        <field id="DFe_e3t"      long_name="DFe * e3t"                                unit="mmol/m2"  > DFe * e3t </field > 
    58        <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" /> 
    59        <field id="GSi_e3t"      long_name="GSi * e3t"                                unit="mmol/m2"  > GSi * e3t </field > 
    60        <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" /> 
    61        <field id="NFe_e3t"      long_name="NFe * e3t"                                unit="mmol/m2"  > NFe * e3t </field > 
    62        <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="gChl/m3"   /> 
    63        <field id="NCHL_e3t"     long_name="NCHL * e3t"                               unit="mmol/m2"  > NCHL * e3t </field > 
    64        <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="gChl/m3"   /> 
    65        <field id="DCHL_e3t"     long_name="DCHL * e3t"                               unit="mmol/m2"  > DCHL * e3t </field > 
    66        <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" /> 
    67        <field id="NO3_e3t"      long_name="NO3 * e3t"                                unit="mmol/m2"  > NO3 * e3t </field > 
    68        <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" /> 
    69        <field id="NH4_e3t"      long_name="NH4 * e3t"                                unit="mmol/m2"  > NH4 * e3t </field > 
    70  
    71        <!-- PISCES quota : variables available with ln_p5z  --> 
    72  
    73        <field id="DON"          long_name="Dissolved organic N Concentration"        unit="mmol/m3" /> 
    74        <field id="DON_e3t"      long_name="DON * e3t"                                unit="mmol/m2"  > DON * e3t </field > 
    75        <field id="DOP"          long_name="Dissolved organic P Concentration"        unit="mmol/m3" /> 
    76        <field id="DOP_e3t"      long_name="DOP * e3t"                                unit="mmol/m2"  > DOP * e3t </field > 
    77        <field id="PON"          long_name="Small PON Concentration"                  unit="mmol/m3" /> 
    78        <field id="PON_e3t"      long_name="PON * e3t"                                unit="mmol/m2"  > PON * e3t </field > 
    79        <field id="POP"          long_name="Small POP Concentration"                  unit="mmol/m3" /> 
    80        <field id="POP_e3t"      long_name="POP * e3t"                                unit="mmol/m2"  > POP * e3t </field > 
    81        <field id="GON"          long_name="Big PON Concentration"                    unit="mmol/m3" /> 
    82        <field id="GON_e3t"      long_name="GON * e3t"                                unit="mmol/m2"  > GON * e3t </field > 
    83        <field id="GOP"          long_name="Big POP Concentration"                    unit="mmol/m3" /> 
    84        <field id="GOP_e3t"      long_name="GOP * e3t"                                unit="mmol/m2"  > GOP * e3t </field > 
    85        <field id="PHYN"         long_name="Nanophytoplankton N biomass"              unit="mmol/m3" /> 
    86        <field id="PHYN_e3t"     long_name="PHYN * e3t"                               unit="mmol/m2"  > PHYN * e3t </field > 
    87        <field id="PHYP"         long_name="Nanophytoplankton P biomass"              unit="mmol/m3" /> 
    88        <field id="PHYP_e3t"     long_name="PHYP * e3t"                               unit="mmol/m2"  > PHYP * e3t </field > 
    89        <field id="DIAN"         long_name="Diatoms N biomass"                        unit="mmol/m3" /> 
    90        <field id="DIAN_e3t"     long_name="DIAN * e3t"                               unit="mmol/m2"  > DIAN * e3t </field > 
    91        <field id="DIAP"         long_name="Diatoms P biomass"                        unit="mmol/m3" /> 
    92        <field id="DIAP_e3t"     long_name="DIAP * e3t"                               unit="mmol/m2"  > DIAP * e3t </field > 
    93        <field id="PIC"          long_name="Picophytoplankton C biomass"              unit="mmol/m3" /> 
    94        <field id="PIC_e3t"      long_name="PIC * e3t"                                unit="mmol/m2"  > PIC * e3t </field > 
    95        <field id="PICN"         long_name="Picophytoplankton N biomass"              unit="mmol/m3" /> 
    96        <field id="PICN_e3t"     long_name="PICN * e3t"                               unit="mmol/m2"  > PICN * e3t </field > 
    97        <field id="PICP"         long_name="Picophytoplankton P biomass"              unit="mmol/m3" /> 
    98        <field id="PICP_e3t"     long_name="PICP * e3t"                               unit="mmol/m2"  > PICP * e3t </field > 
    99        <field id="PFe"          long_name="Picophytoplankton Fe biomass"             unit="mmol/m3" /> 
    100        <field id="PFe_e3t"      long_name="PFe * e3t"                                unit="mmol/m2"  > PFe * e3t </field > 
    101        <field id="PCHL"         long_name="Picophytoplankton Chl biomass"            unit="gChl/m3" /> 
    102        <field id="PCHL_e3t"     long_name="PCHL * e3t"                               unit="mmol/m2"  > PCHL * e3t </field > 
    103  
    104       <!-- PISCES with ligand parametisation : variables available namelist paramter ln_ligand --> 
    105        <field id="LGW"         long_name="Weak ligands concentration"                unit="mmol/m3" /> 
    106        <field id="LGW_e3t"     long_name="LGW * e3t"                                 unit="mmol/m2"  > LGW * e3t </field > 
    107  
    108        <!-- PISCES light : variables available with ln_p2z  --> 
    109        <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" /> 
    110        <field id="DET_e3t"     long_name="DET * e3t"                                unit="mmol-N/m2"  > DET * e3t </field > 
    111        <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" /> 
    112        <field id="DOM_e3t"     long_name="DOM * e3t"                                unit="mmol-N/m2"  > DOM * e3t </field > 
    113  
    114      </field_group> 
    115  
    116      <!-- SEDIMENT variables on T sediment grid  --> 
    117      <field_group id="sed_T" grid_ref="grid_T_3DS"> 
    118        <field id="SedDIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" /> 
    119        <field id="SedAlkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" /> 
    120        <field id="SedO2"           long_name="Oxygen Concentration"                     unit="mmol/m3" /> 
    121        <field id="SedCaCO3"        long_name="Calcite Concentration"                    unit="%" /> 
    122        <field id="SedPOS"          long_name="Semi-ref POC Concentration"               unit="%" /> 
    123        <field id="SedPOR"          long_name="Refractory POC Concentration"             unit="%" /> 
    124        <field id="SedPO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" /> 
    125        <field id="SedPOC"          long_name="Labile POC Concentration"                 unit="%" /> 
    126        <field id="SedSil"          long_name="Silicate Concentration"                   unit="mmol/m3" /> 
    127        <field id="SedFe2"          long_name="Fe2+ Concentration"                       unit="mmol/m3" /> 
    128        <field id="SedBSi"          long_name="Biogenic Silicate Concentration"          unit="%" /> 
    129        <field id="SedNO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" /> 
    130        <field id="SedNH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" /> 
    131        <field id="SedH2S"          long_name="H2S Concentration"                        unit="mmol/m3" /> 
    132        <field id="SedSO4"          long_name="SO4 Concentration"                        unit="mmol/m3" /> 
    133        <field id="SedClay"         long_name="Clay Concentration"                       unit="%" /> 
    134        <field id="SedFeO"          long_name="Fe(OH)3 Concentration"                    unit="%" /> 
    135        <field id="SedFeS"          long_name="FeS Concentration"                        unit="%" /> 
    136        <field id="SedpH"           long_name="PH"                                       unit="1"          /> 
    137        <field id="SedCO3por"       long_name="Bicarbonates"                             unit="mol/m3" /> 
    138      </field_group> 
    139  
    140      <!-- SEDIMENT additional variables on T sediment grid  --> 
    141      <field_group id="Diag_S" grid_ref="grid_T_2D"> 
    142        <field id="FlxSi"       long_name="Si sediment flux"                        unit="mol/cm2/s"     /> 
    143        <field id="FlxO2"       long_name="O2 sediment flux"                        unit="mol/cm2/s"     /> 
    144        <field id="FlxDIC"      long_name="DIC sediment flux"                       unit="mol/cm2/s"     /> 
    145        <field id="FlxNO3"      long_name="NO3 sediment flux"                       unit="mol/cm2/s"     /> 
    146        <field id="FlxPO4"      long_name="PO4 sediment flux"                       unit="mol/cm2/s"     /> 
    147        <field id="FlxAlkalini" long_name="Alkalinity sediment flux"                unit="mol/cm2/s"     /> 
    148        <field id="FlxNH4"      long_name="Ammonium sediment flux"                  unit="mol/cm2/s"     /> 
    149        <field id="FlxH2S"      long_name="H2S sediment flux"                       unit="mol/cm2/s"     /> 
    150        <field id="FlxSO4"      long_name="SO4 sediment flux"                       unit="mol/cm2/s"     /> 
    151        <field id="FlxFe2"      long_name="Fe2+ sediment flux"                      unit="mol/cm2/s"     /> 
    152        <field id="Flxtot"      long_name="Sediment net burial rate"                unit="cm/s"     /> 
    153        <field id="dzdep"       long_name="Sedimentation rate"                      unit="cm/s"     /> 
    154        <field id="sflxclay"    long_name="Clay sedimentation rate"                 unit="g/m2/s"     /> 
    155        <field id="sflxcal"     long_name="Calcite sedimentation rate"              unit="mol/m2/s"     /> 
    156        <field id="sflxbsi"     long_name="BSi Sedimentation rate"                  unit="mol/m2/s"     /> 
    157        <field id="sflxpoc"     long_name="POC Sedimentation rate"                  unit="mol/m2/s"     /> 
    158        <field id="sflxfeo"     long_name="Fe(OH)3 Sedimentation rate"              unit="mol/m2/s"     /> 
    159 </field_group> 
    160  
    161      <!-- PISCES additional diagnostics on T grid  --> 
    162  
    163      <field_group id="diad_T" grid_ref="grid_T_2D"> 
    164        <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" /> 
    165        <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" /> 
    166        <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" /> 
    167        <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" /> 
    168        <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" /> 
    169        <field id="PPPHYN"      long_name="Primary production of nanophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    170        <field id="PPPHYP"      long_name="Primary production of picophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    171        <field id="PPPHYD"      long_name="Primary production of diatoms"           unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    172        <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    173        <field id="PPNEWP"      long_name="New Primary production of picophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    174        <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    175        <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    176        <field id="PFeN"        long_name="Primary production of nano iron"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    177        <field id="PFeP"        long_name="Primary production of pico iron"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
    178        <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    179        <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" /> 
    180        <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    181        <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    182        <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    183        <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    184        <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    185        <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    186        <field id="REMINP"       long_name="Oxic remineralization rate of POC"      unit="d-1"        grid_ref="grid_T_3D" /> 
    187        <field id="REMING"       long_name="Oxic remineralization rate of GOC"      unit="d-1"        grid_ref="grid_T_3D" /> 
    188        <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
    189        <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" /> 
    190        <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" /> 
    191        <field id="MuP"         long_name="Realized growth rate for picophyto"      unit="s-1"        grid_ref="grid_T_3D" /> 
    192        <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" /> 
    193        <field id="MunetN"      long_name="Net growth rate for nanophyto"           unit="s-1"        grid_ref="grid_T_3D" /> 
    194        <field id="MunetP"      long_name="Net growth rate for picophyto"           unit="s-1"        grid_ref="grid_T_3D" /> 
    195        <field id="MunetD"      long_name="Net growth rate for diatomes"            unit="s-1"        grid_ref="grid_T_3D" /> 
    196        <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" /> 
    197        <field id="LPnut"       long_name="Nutrient limitation term in Picophyto"   unit="-"          grid_ref="grid_T_3D" /> 
    198        <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" /> 
    199        <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" /> 
    200        <field id="LPFe"        long_name="Iron limitation term in Picophyto"       unit="-"          grid_ref="grid_T_3D" /> 
    201        <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" /> 
    202        <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" /> 
    203        <field id="LPlight"     long_name="Light limitation term in Picophyto"      unit="-"          grid_ref="grid_T_3D" /> 
    204        <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" /> 
    205        <field id="SIZEN"       long_name="Mean relative size of nanophyto."        unit="-"          grid_ref="grid_T_3D" /> 
    206        <field id="SIZEP"       long_name="Mean relative size of picophyto."        unit="-"          grid_ref="grid_T_3D" /> 
    207        <field id="SIZED"       long_name="Mean relative size of diatoms"           unit="-"          grid_ref="grid_T_3D" /> 
    208        <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    209        <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    210        <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    211        <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            /> 
    212        <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    213        <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/m3"    grid_ref="grid_T_3D" /> 
    214        <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="mol/m2/s"                        /> 
    215        <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="mol/m2/s"                        /> 
    216        <field id="SedCal"      long_name="Calcite burial in the sediments"         unit="molC/m2/s"                       /> 
    217        <field id="SedSi"       long_name="Silicon burial in the sediments"         unit="molSi/m2/s"                      /> 
    218        <field id="SedC"        long_name="Organic C burial in the sediments"       unit="molC/m2/s"                       /> 
    219        <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
    220        <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        /> 
    221        <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        /> 
    222        <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        /> 
    223        <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        /> 
    224        <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
    225        <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
    226        <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
    227        <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
    228        <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        /> 
    229        <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        /> 
    230        <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   /> 
    231        <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            /> 
    232        <field id="pCO2sea"     long_name="surface ocean pCO2"                      unit="uatm"                            /> 
    233        <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            /> 
    234        <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               /> 
    235        <field id="AtmCo2"      long_name="Atmospheric CO2 concentration"           unit="ppm"                               /> 
    236        <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        /> 
    237        <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
    238        <field id="FESCAV"      long_name="Scavenging of Iron"                      unit="mmol-Fe/m3/s"   grid_ref="grid_T_3D" /> 
    239        <field id="FECOLL"      long_name="Colloidal Pumping of FeL"                unit="mmol-FeL/m3/s"  grid_ref="grid_T_3D" /> 
    240        <field id="LGWCOLL"     long_name="Coagulation loss of ligands"             unit="mmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    241        <field id="REMINF"      long_name="Oxic remineralization suppy of Fe"       unit="mmol-Fe/m3/s"  grid_ref="grid_T_3D" /> 
    242        <field id="BACT"        long_name="Bacterial Biomass"                       unit="mmol/m3"  grid_ref="grid_T_3D" /> 
    243        <field id="FEBACT"      long_name="Bacterial uptake of Fe"                  unit="molFe/m3/s"  grid_ref="grid_T_3D" /> 
    244        <field id="LPRODR"      long_name="OM remineralisation ligand production rate" unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    245        <field id="LPRODP"      long_name="phytoplankton ligand production rate"    unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    246        <field id="LIGREM"      long_name="Remineralisation loss of ligands"        unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    247        <field id="LIGPR"       long_name="Photochemical loss of ligands"           unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    248        <field id="LDETP"       long_name="Ligand destruction during phytoplankton uptake" unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    249        <field id="LPRODZ2"     long_name="mesozooplankton ligand production rate"  unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    250        <field id="LPRODZ"      long_name="microzooplankton ligand production rate" unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
    251        <field id="FEZOO"       long_name="microzooplankton iron recycling rate"    unit="nmol-FeL/m3/s"  grid_ref="grid_T_3D" /> 
    252        <field id="FEZOO2"      long_name="mesozooplankton iron recycling rate"     unit="nmol-FeL/m3/s"  grid_ref="grid_T_3D" /> 
    253  
    254        <!-- PISCES tracers trends --> 
    255        <field id="INTdtAlk"    long_name="Vertically int. of change of alkalinity"             unit="mol/m2/s"                       /> 
    256        <field id="INTdtDIC"    long_name="Vertically int. of change of dissic    "             unit="mol/m2/s"                       /> 
    257        <field id="INTdtFer"    long_name="Vertically int. of change of iron      "             unit="mol/m2/s"                       /> 
    258        <field id="INTdtDIN"    long_name="Vertically int. of change of nitrogen  "             unit="mol/m2/s"                       /> 
    259        <field id="INTdtDIP"    long_name="Vertically int. of change of phophate  "             unit="mol/m2/s"                       /> 
    260        <field id="INTdtSil"    long_name="Vertically int. of change of silicon   "             unit="mol/m2/s"                       /> 
    261  
    262  
    263        <!-- dbio_T on T grid : variables available with diaar5 --> 
    264        <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" /> 
    265        <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" /> 
    266        <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" /> 
    267        <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          /> 
    268        <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          /> 
    269        <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              /> 
    270        <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > Nfix * e3t </field > 
    271        <field id="INTPPPHYN"   long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PPPHYN * e3t </field > 
    272        <field id="INTPPPHYD"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PPPHYD * e3t </field >                     
    273        <field id="INTPPPHYP"   long_name="Vertically integrated primary production by picophy" unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PPPHYP * e3t </field >                     
    274        <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > TPP * e3t </field >                             
    275        <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > TPNEW * e3t </field >                 
    276        <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > TPBFE * e3t </field >                            
    277        <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PBSi * e3t </field >                            
    278  
    279        <!-- PISCES light : variables available with key_pisces_reduced --> 
    280        <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" />  
    281        <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" />  
    282        <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" />  
    283        <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  />  
    284        <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  />  
    285        <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  />  
    286        <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  />  
    287        <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  />  
    288        <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  />  
    289        <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  />  
    290        <field id="TZOODET"     long_name="TZOODET"                                 unit=""  />  
    291        <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  />  
    292        <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  />  
    293        <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  />  
    294        <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  />  
    295        <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  />  
    296        <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  />  
    297        <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  />  
    298        <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  />  
    299        <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  />  
    300        <field id="TDETSED"     long_name="TDETSED"                                 unit=""  />  
    301      </field_group> 
    302  
    303      <field_group id="tracer_scalar"  grid_ref="grid_scalar"  > 
    304      <!-- PISCES scalar  --> 
    305        <field id="pno3tot"         long_name="Global mean nitrate concentration"                  unit="mol/m3"   /> 
    306        <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   /> 
    307        <field id="psiltot"         long_name="Global mean silicate concentration"                 unit="mol/m3"   /> 
    308        <field id="palktot"         long_name="Global mean alkalinity concentration"               unit="mol/m3"   /> 
    309        <field id="pfertot"         long_name="Global mean iron concentration"                     unit="mol/m3"   /> 
    310        <field id="tcflx"           long_name="Total Flux of Carbon out of the ocean"              unit="mol/s"   /> 
    311        <field id="tcflxcum"        long_name="Cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   /> 
    312        <field id="tcexp"           long_name="Total Carbon export at 100m"                        unit="mol/s"   /> 
    313        <field id="tintpp"          long_name="Global total integrated primary production"         unit="mol/s"   /> 
    314        <field id="tnfix"           long_name="Global total nitrogen fixation"                     unit="mol/s"   /> 
    315        <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   /> 
    316      </field_group> 
    317  
    318    </field_definition> 
     9--> 
     10<field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" > <!-- time step automaticaly defined --> 
     11 
     12  <!-- 
     13      ============================================================================================================ 
     14      Biogeochemistry model variables 
     15      ============================================================================================================ 
     16  --> 
     17 
     18  <!-- ptrc on T grid --> 
     19 
     20  <field_group id="ptrc_T" grid_ref="grid_T_3D"> 
     21    <!-- PISCES standard : variables available with ln_p4z  --> 
     22    <field id="DIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" /> 
     23    <field id="DIC_e3t"      long_name="DIC * e3t"                                unit="mmol/m2" > DIC * e3t </field > 
     24    <field id="Alkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" /> 
     25    <field id="Alkalini_e3t" long_name="Alkalini * e3t"                           unit="mmol/m2"  > Alkalini * e3t </field > 
     26    <field id="O2"           long_name="Oxygen Concentration"                     unit="mmol/m3" /> 
     27    <field id="O2_e3t"       long_name="O2 * e3t"                                 unit="mmol/m2"  > O2 * e3t </field > 
     28    <field id="CaCO3"        long_name="Calcite Concentration"                    unit="mmol/m3" /> 
     29    <field id="CaCO3_e3t"    long_name="CaCO3 * e3t"                              unit="mmol/m2"  > CaCO3 * e3t </field > 
     30    <field id="PO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" /> 
     31    <field id="PO4_e3t"      long_name="PO4 * e3t"                                unit="mmol/m2"  > PO4 * e3t </field > 
     32    <field id="POC"          long_name="Small organic carbon Concentration"       unit="mmol/m3" /> 
     33    <field id="POC_e3t"      long_name="POC * e3t"                                unit="mmol/m2"  > POC * e3t </field > 
     34    <field id="Si"           long_name="Silicate Concentration"                   unit="mmol/m3" /> 
     35    <field id="Si_e3t"       long_name="Si * e3t"                                 unit="mmol/m2"  > Si * e3t </field > 
     36    <field id="PHY"          long_name="(Nano)Phytoplankton Concentration"        unit="mmol/m3" /> 
     37    <field id="PHY_e3t"      long_name="PHY * e3t"                                unit="mmol/m2"  > PHY * e3t </field > 
     38    <field id="ZOO"          long_name="(Micro)Zooplankton Concentration"         unit="mmol/m3" /> 
     39    <field id="ZOO_e3t"      long_name="ZOO2 * e3t"                               unit="mmol/m2"  > ZOO * e3t </field > 
     40    <field id="DOC"          long_name="Dissolved organic Concentration"          unit="mmol/m3" /> 
     41    <field id="DOC_e3t"      long_name="DOC * e3t"                                unit="mmol/m2"  > DOC * e3t </field > 
     42    <field id="PHY2"         long_name="Diatoms Concentration"                    unit="mmol/m3" /> 
     43    <field id="PHY2_e3t"     long_name="PHY2 * e3t"                               unit="mmol/m2"  > PHY2 * e3t </field > 
     44    <field id="ZOO2"         long_name="Mesozooplankton Concentration"            unit="mmol/m3" /> 
     45    <field id="ZOO2_e3t"     long_name="ZOO2 * e3t"                               unit="mmol/m2"  > ZOO2 * e3t </field > 
     46    <field id="DSi"          long_name="Diatoms Silicate Concentration"           unit="mmol/m3" /> 
     47    <field id="DSi_e3t"      long_name="Dsi * e3t"                                unit="mmol/m2"  > DSi * e3t </field > 
     48    <field id="Fer"          long_name="Dissolved Iron Concentration"             unit="mmol/m3" /> 
     49    <field id="Fer_e3t"      long_name="Fer * e3t"                                unit="mmol/m2"  > Fer * e3t </field > 
     50    <field id="BFe"          long_name="Big iron particles Concentration"         unit="mmol/m3" /> 
     51    <field id="BFe_e3t"      long_name="BFe * e3t"                                unit="mmol/m2"  > BFe * e3t </field > 
     52    <field id="GOC"          long_name="Big organic carbon Concentration"         unit="mmol/m3" /> 
     53    <field id="GOC_e3t"      long_name="GOC * e3t"                                unit="mmol/m2"  > GOC * e3t </field > 
     54    <field id="SFe"          long_name="Small iron particles Concentration"       unit="mmol/m3" /> 
     55    <field id="SFe_e3t"      long_name="SFe * e3t"                                unit="mmol/m2"  > SFe * e3t </field > 
     56    <field id="DFe"          long_name="Diatoms iron  Concentration"              unit="mmol/m3" /> 
     57    <field id="DFe_e3t"      long_name="DFe * e3t"                                unit="mmol/m2"  > DFe * e3t </field > 
     58    <field id="GSi"          long_name="Sinking biogenic Silicate Concentration"  unit="mmol/m3" /> 
     59    <field id="GSi_e3t"      long_name="GSi * e3t"                                unit="mmol/m2"  > GSi * e3t </field > 
     60    <field id="NFe"          long_name="Nano iron Concentration"                  unit="mmol/m3" /> 
     61    <field id="NFe_e3t"      long_name="NFe * e3t"                                unit="mmol/m2"  > NFe * e3t </field > 
     62    <field id="NCHL"         long_name="Nano chlorophyl Concentration"            unit="gChl/m3"   /> 
     63    <field id="NCHL_e3t"     long_name="NCHL * e3t"                               unit="mmol/m2"  > NCHL * e3t </field > 
     64    <field id="DCHL"         long_name="Diatoms chlorophyl Concentration"         unit="gChl/m3"   /> 
     65    <field id="DCHL_e3t"     long_name="DCHL * e3t"                               unit="mmol/m2"  > DCHL * e3t </field > 
     66    <field id="NO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" /> 
     67    <field id="NO3_e3t"      long_name="NO3 * e3t"                                unit="mmol/m2"  > NO3 * e3t </field > 
     68    <field id="NH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" /> 
     69    <field id="NH4_e3t"      long_name="NH4 * e3t"                                unit="mmol/m2"  > NH4 * e3t </field > 
     70 
     71    <!-- PISCES quota : variables available with ln_p5z  --> 
     72 
     73    <field id="DON"          long_name="Dissolved organic N Concentration"        unit="mmol/m3" /> 
     74    <field id="DON_e3t"      long_name="DON * e3t"                                unit="mmol/m2"  > DON * e3t </field > 
     75    <field id="DOP"          long_name="Dissolved organic P Concentration"        unit="mmol/m3" /> 
     76    <field id="DOP_e3t"      long_name="DOP * e3t"                                unit="mmol/m2"  > DOP * e3t </field > 
     77    <field id="PON"          long_name="Small PON Concentration"                  unit="mmol/m3" /> 
     78    <field id="PON_e3t"      long_name="PON * e3t"                                unit="mmol/m2"  > PON * e3t </field > 
     79    <field id="POP"          long_name="Small POP Concentration"                  unit="mmol/m3" /> 
     80    <field id="POP_e3t"      long_name="POP * e3t"                                unit="mmol/m2"  > POP * e3t </field > 
     81    <field id="GON"          long_name="Big PON Concentration"                    unit="mmol/m3" /> 
     82    <field id="GON_e3t"      long_name="GON * e3t"                                unit="mmol/m2"  > GON * e3t </field > 
     83    <field id="GOP"          long_name="Big POP Concentration"                    unit="mmol/m3" /> 
     84    <field id="GOP_e3t"      long_name="GOP * e3t"                                unit="mmol/m2"  > GOP * e3t </field > 
     85    <field id="PHYN"         long_name="Nanophytoplankton N biomass"              unit="mmol/m3" /> 
     86    <field id="PHYN_e3t"     long_name="PHYN * e3t"                               unit="mmol/m2"  > PHYN * e3t </field > 
     87    <field id="PHYP"         long_name="Nanophytoplankton P biomass"              unit="mmol/m3" /> 
     88    <field id="PHYP_e3t"     long_name="PHYP * e3t"                               unit="mmol/m2"  > PHYP * e3t </field > 
     89    <field id="DIAN"         long_name="Diatoms N biomass"                        unit="mmol/m3" /> 
     90    <field id="DIAN_e3t"     long_name="DIAN * e3t"                               unit="mmol/m2"  > DIAN * e3t </field > 
     91    <field id="DIAP"         long_name="Diatoms P biomass"                        unit="mmol/m3" /> 
     92    <field id="DIAP_e3t"     long_name="DIAP * e3t"                               unit="mmol/m2"  > DIAP * e3t </field > 
     93    <field id="PIC"          long_name="Picophytoplankton C biomass"              unit="mmol/m3" /> 
     94    <field id="PIC_e3t"      long_name="PIC * e3t"                                unit="mmol/m2"  > PIC * e3t </field > 
     95    <field id="PICN"         long_name="Picophytoplankton N biomass"              unit="mmol/m3" /> 
     96    <field id="PICN_e3t"     long_name="PICN * e3t"                               unit="mmol/m2"  > PICN * e3t </field > 
     97    <field id="PICP"         long_name="Picophytoplankton P biomass"              unit="mmol/m3" /> 
     98    <field id="PICP_e3t"     long_name="PICP * e3t"                               unit="mmol/m2"  > PICP * e3t </field > 
     99    <field id="PFe"          long_name="Picophytoplankton Fe biomass"             unit="mmol/m3" /> 
     100    <field id="PFe_e3t"      long_name="PFe * e3t"                                unit="mmol/m2"  > PFe * e3t </field > 
     101    <field id="PCHL"         long_name="Picophytoplankton Chl biomass"            unit="gChl/m3" /> 
     102    <field id="PCHL_e3t"     long_name="PCHL * e3t"                               unit="mmol/m2"  > PCHL * e3t </field > 
     103 
     104    <!-- PISCES with ligand parametisation : variables available namelist paramter ln_ligand --> 
     105    <field id="LGW"         long_name="Weak ligands concentration"                unit="mmol/m3" /> 
     106    <field id="LGW_e3t"     long_name="LGW * e3t"                                 unit="mmol/m2"  > LGW * e3t </field > 
     107 
     108    <!-- PISCES light : variables available with ln_p2z  --> 
     109    <field id="DET"         long_name="Detritus"                                 unit="mmol-N/m3" /> 
     110    <field id="DET_e3t"     long_name="DET * e3t"                                unit="mmol-N/m2"  > DET * e3t </field > 
     111    <field id="DOM"         long_name="Dissolved Organic Matter"                 unit="mmol-N/m3" /> 
     112    <field id="DOM_e3t"     long_name="DOM * e3t"                                unit="mmol-N/m2"  > DOM * e3t </field > 
     113 
     114  </field_group> 
     115 
     116  <!-- SEDIMENT variables on T sediment grid  --> 
     117  <field_group id="sed_T" grid_ref="grid_T_3DS"> 
     118    <field id="SedDIC"          long_name="Dissolved inorganic Concentration"        unit="mmol/m3" /> 
     119    <field id="SedAlkalini"     long_name="Total Alkalinity Concentration"           unit="mmol/m3" /> 
     120    <field id="SedO2"           long_name="Oxygen Concentration"                     unit="mmol/m3" /> 
     121    <field id="SedCaCO3"        long_name="Calcite Concentration"                    unit="%" /> 
     122    <field id="SedPOS"          long_name="Semi-ref POC Concentration"               unit="%" /> 
     123    <field id="SedPOR"          long_name="Refractory POC Concentration"             unit="%" /> 
     124    <field id="SedPO4"          long_name="Phosphate Concentration"                  unit="mmol/m3" /> 
     125    <field id="SedPOC"          long_name="Labile POC Concentration"                 unit="%" /> 
     126    <field id="SedSil"          long_name="Silicate Concentration"                   unit="mmol/m3" /> 
     127    <field id="SedFe2"          long_name="Fe2+ Concentration"                       unit="mmol/m3" /> 
     128    <field id="SedBSi"          long_name="Biogenic Silicate Concentration"          unit="%" /> 
     129    <field id="SedNO3"          long_name="Nitrate Concentration"                    unit="mmol/m3" /> 
     130    <field id="SedNH4"          long_name="Ammonium Concentration"                   unit="mmol/m3" /> 
     131    <field id="SedH2S"          long_name="H2S Concentration"                        unit="mmol/m3" /> 
     132    <field id="SedSO4"          long_name="SO4 Concentration"                        unit="mmol/m3" /> 
     133    <field id="SedClay"         long_name="Clay Concentration"                       unit="%" /> 
     134    <field id="SedFeO"          long_name="Fe(OH)3 Concentration"                    unit="%" /> 
     135    <field id="SedFeS"          long_name="FeS Concentration"                        unit="%" /> 
     136    <field id="SedpH"           long_name="PH"                                       unit="1"          /> 
     137    <field id="SedCO3por"       long_name="Bicarbonates"                             unit="mol/m3" /> 
     138  </field_group> 
     139 
     140  <!-- SEDIMENT additional variables on T sediment grid  --> 
     141  <field_group id="Diag_S" grid_ref="grid_T_2D"> 
     142    <field id="FlxSi"       long_name="Si sediment flux"                        unit="mol/cm2/s"     /> 
     143    <field id="FlxO2"       long_name="O2 sediment flux"                        unit="mol/cm2/s"     /> 
     144    <field id="FlxDIC"      long_name="DIC sediment flux"                       unit="mol/cm2/s"     /> 
     145    <field id="FlxNO3"      long_name="NO3 sediment flux"                       unit="mol/cm2/s"     /> 
     146    <field id="FlxPO4"      long_name="PO4 sediment flux"                       unit="mol/cm2/s"     /> 
     147    <field id="FlxAlkalini" long_name="Alkalinity sediment flux"                unit="mol/cm2/s"     /> 
     148    <field id="FlxNH4"      long_name="Ammonium sediment flux"                  unit="mol/cm2/s"     /> 
     149    <field id="FlxH2S"      long_name="H2S sediment flux"                       unit="mol/cm2/s"     /> 
     150    <field id="FlxSO4"      long_name="SO4 sediment flux"                       unit="mol/cm2/s"     /> 
     151    <field id="FlxFe2"      long_name="Fe2+ sediment flux"                      unit="mol/cm2/s"     /> 
     152    <field id="Flxtot"      long_name="Sediment net burial rate"                unit="cm/s"     /> 
     153    <field id="dzdep"       long_name="Sedimentation rate"                      unit="cm/s"     /> 
     154    <field id="sflxclay"    long_name="Clay sedimentation rate"                 unit="g/m2/s"     /> 
     155    <field id="sflxcal"     long_name="Calcite sedimentation rate"              unit="mol/m2/s"     /> 
     156    <field id="sflxbsi"     long_name="BSi Sedimentation rate"                  unit="mol/m2/s"     /> 
     157    <field id="sflxpoc"     long_name="POC Sedimentation rate"                  unit="mol/m2/s"     /> 
     158    <field id="sflxfeo"     long_name="Fe(OH)3 Sedimentation rate"              unit="mol/m2/s"     /> 
     159  </field_group> 
     160 
     161  <!-- PISCES additional diagnostics on T grid  --> 
     162 
     163  <field_group id="diad_T" grid_ref="grid_T_2D"> 
     164    <field id="PH"          long_name="PH"                                      unit="1"          grid_ref="grid_T_3D" /> 
     165    <field id="CO3"         long_name="Bicarbonates"                            unit="mol/m3"     grid_ref="grid_T_3D" /> 
     166    <field id="CO3sat"      long_name="CO3 saturation"                          unit="mol/m3"     grid_ref="grid_T_3D" /> 
     167    <field id="PAR"         long_name="Photosynthetically Available Radiation"  unit="W/m2"       grid_ref="grid_T_3D" /> 
     168    <field id="PARDM"       long_name="Daily mean PAR"                          unit="W/m2"       grid_ref="grid_T_3D" /> 
     169    <field id="PPPHYN"      long_name="Primary production of nanophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     170    <field id="PPPHYP"      long_name="Primary production of picophyto"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     171    <field id="PPPHYD"      long_name="Primary production of diatoms"           unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     172    <field id="PPNEWN"      long_name="New Primary production of nanophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     173    <field id="PPNEWP"      long_name="New Primary production of picophyto"     unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     174    <field id="PPNEWD"      long_name="New Primary production of diatoms"       unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     175    <field id="PBSi"        long_name="Primary production of Si diatoms"        unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     176    <field id="PFeN"        long_name="Primary production of nano iron"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     177    <field id="PFeP"        long_name="Primary production of pico iron"         unit="molC/m3/s"  grid_ref="grid_T_3D" /> 
     178    <field id="PFeD"        long_name="Primary production of diatoms iron"      unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     179    <field id="xfracal"     long_name="Calcifying fraction"                     unit="1"          grid_ref="grid_T_3D" /> 
     180    <field id="PCAL"        long_name="Calcite production"                      unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     181    <field id="DCAL"        long_name="Calcite dissolution"                     unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     182    <field id="GRAZ1"       long_name="Grazing by microzooplankton"             unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     183    <field id="GRAZ2"       long_name="Grazing by mesozooplankton"              unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     184    <field id="REMIN"       long_name="Oxic remineralization of OM"             unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     185    <field id="DENIT"       long_name="Anoxic remineralization of OM"           unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     186    <field id="REMINP"       long_name="Oxic remineralization rate of POC"      unit="d-1"        grid_ref="grid_T_3D" /> 
     187    <field id="REMING"       long_name="Oxic remineralization rate of GOC"      unit="d-1"        grid_ref="grid_T_3D" /> 
     188    <field id="Nfix"        long_name="Nitrogen fixation"                       unit="mol/m3/s"   grid_ref="grid_T_3D" /> 
     189    <field id="Mumax"       long_name="Maximum growth rate"                     unit="s-1"        grid_ref="grid_T_3D" /> 
     190    <field id="MuN"         long_name="Realized growth rate for nanophyto"      unit="s-1"        grid_ref="grid_T_3D" /> 
     191    <field id="MuP"         long_name="Realized growth rate for picophyto"      unit="s-1"        grid_ref="grid_T_3D" /> 
     192    <field id="MuD"         long_name="Realized growth rate for diatomes"       unit="s-1"        grid_ref="grid_T_3D" /> 
     193    <field id="MunetN"      long_name="Net growth rate for nanophyto"           unit="s-1"        grid_ref="grid_T_3D" /> 
     194    <field id="MunetP"      long_name="Net growth rate for picophyto"           unit="s-1"        grid_ref="grid_T_3D" /> 
     195    <field id="MunetD"      long_name="Net growth rate for diatomes"            unit="s-1"        grid_ref="grid_T_3D" /> 
     196    <field id="LNnut"       long_name="Nutrient limitation term in Nanophyto"   unit=""           grid_ref="grid_T_3D" /> 
     197    <field id="LPnut"       long_name="Nutrient limitation term in Picophyto"   unit="-"          grid_ref="grid_T_3D" /> 
     198    <field id="LDnut"       long_name="Nutrient limitation term in Diatoms"     unit=""           grid_ref="grid_T_3D" /> 
     199    <field id="LNFe"        long_name="Iron limitation term in Nanophyto"       unit=""           grid_ref="grid_T_3D" /> 
     200    <field id="LPFe"        long_name="Iron limitation term in Picophyto"       unit="-"          grid_ref="grid_T_3D" /> 
     201    <field id="LDFe"        long_name="Iron limitation term in Diatoms"         unit=""           grid_ref="grid_T_3D" /> 
     202    <field id="LNlight"     long_name="Light limitation term in Nanophyto"      unit=""           grid_ref="grid_T_3D" /> 
     203    <field id="LPlight"     long_name="Light limitation term in Picophyto"      unit="-"          grid_ref="grid_T_3D" /> 
     204    <field id="LDlight"     long_name="Light limitation term in Diatoms"        unit=""           grid_ref="grid_T_3D" /> 
     205    <field id="SIZEN"       long_name="Mean relative size of nanophyto."        unit="-"          grid_ref="grid_T_3D" /> 
     206    <field id="SIZEP"       long_name="Mean relative size of picophyto."        unit="-"          grid_ref="grid_T_3D" /> 
     207    <field id="SIZED"       long_name="Mean relative size of diatoms"           unit="-"          grid_ref="grid_T_3D" /> 
     208    <field id="Fe3"         long_name="Iron III concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" /> 
     209    <field id="FeL1"        long_name="Complexed Iron concentration with L1"    unit="nmol/m3"    grid_ref="grid_T_3D" /> 
     210    <field id="TL1"         long_name="Total L1 concentration"                  unit="nmol/m3"    grid_ref="grid_T_3D" /> 
     211    <field id="pdust"       long_name="dust concentration"                      unit="g/m3"                            /> 
     212    <field id="Totlig"      long_name="Total ligand concentation"               unit="nmol/m3"    grid_ref="grid_T_3D" /> 
     213    <field id="Biron"       long_name="Bioavailable iron"                       unit="nmol/m3"    grid_ref="grid_T_3D" /> 
     214    <field id="Sdenit"      long_name="Nitrate reduction in the sediments"      unit="mol/m2/s"                        /> 
     215    <field id="Ironice"     long_name="Iron input/uptake due to sea ice"        unit="mol/m2/s"                        /> 
     216    <field id="SedCal"      long_name="Calcite burial in the sediments"         unit="molC/m2/s"                       /> 
     217    <field id="SedSi"       long_name="Silicon burial in the sediments"         unit="molSi/m2/s"                      /> 
     218    <field id="SedC"        long_name="Organic C burial in the sediments"       unit="molC/m2/s"                       /> 
     219    <field id="HYDR"        long_name="Iron input from hydrothemal vents"       unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
     220    <field id="EPC100"      long_name="Export of carbon particles at 100 m"     unit="mol/m2/s"                        /> 
     221    <field id="EPFE100"     long_name="Export of biogenic iron at 100 m"        unit="mol/m2/s"                        /> 
     222    <field id="EPSI100"     long_name="Export of Silicate at 100 m"             unit="mol/m2/s"                        /> 
     223    <field id="EPCAL100"    long_name="Export of Calcite at 100 m"              unit="mol/m2/s"                        /> 
     224    <field id="EXPC"        long_name="Export of carbon"                        unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
     225    <field id="EXPFE"       long_name="Export of biogenic iron"                 unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
     226    <field id="EXPSI"       long_name="Export of Silicate"                      unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
     227    <field id="EXPCAL"      long_name="Export of Calcite"                       unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
     228    <field id="Cflx"        long_name="DIC flux"                                unit="mol/m2/s"                        /> 
     229    <field id="Oflx"        long_name="Oxygen flux"                             unit="mol/m2/s"                        /> 
     230    <field id="Kg"          long_name="Gas transfer"                            unit="mol/m2/s/uatm"                   /> 
     231    <field id="Dpco2"       long_name="Delta CO2"                               unit="uatm"                            /> 
     232    <field id="pCO2sea"     long_name="surface ocean pCO2"                      unit="uatm"                            /> 
     233    <field id="Dpo2"        long_name="Delta O2"                                unit="uatm"                            /> 
     234    <field id="Heup"        long_name="Euphotic layer depth"                    unit="m"                               /> 
     235    <field id="AtmCo2"      long_name="Atmospheric CO2 concentration"           unit="ppm"                               /> 
     236    <field id="Irondep"     long_name="Iron deposition from dust"               unit="mol/m2/s"                        /> 
     237    <field id="Ironsed"     long_name="Iron deposition from sediment"           unit="mol/m2/s"   grid_ref="grid_T_3D" /> 
     238    <field id="FESCAV"      long_name="Scavenging of Iron"                      unit="mmol-Fe/m3/s"   grid_ref="grid_T_3D" /> 
     239    <field id="FECOLL"      long_name="Colloidal Pumping of FeL"                unit="mmol-FeL/m3/s"  grid_ref="grid_T_3D" /> 
     240    <field id="LGWCOLL"     long_name="Coagulation loss of ligands"             unit="mmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     241    <field id="REMINF"      long_name="Oxic remineralization suppy of Fe"       unit="mmol-Fe/m3/s"  grid_ref="grid_T_3D" /> 
     242    <field id="BACT"        long_name="Bacterial Biomass"                       unit="mmol/m3"  grid_ref="grid_T_3D" /> 
     243    <field id="FEBACT"      long_name="Bacterial uptake of Fe"                  unit="molFe/m3/s"  grid_ref="grid_T_3D" /> 
     244    <field id="LPRODR"      long_name="OM remineralisation ligand production rate" unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     245    <field id="LPRODP"      long_name="phytoplankton ligand production rate"    unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     246    <field id="LIGREM"      long_name="Remineralisation loss of ligands"        unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     247    <field id="LIGPR"       long_name="Photochemical loss of ligands"           unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     248    <field id="LDETP"       long_name="Ligand destruction during phytoplankton uptake" unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     249    <field id="LPRODZ2"     long_name="mesozooplankton ligand production rate"  unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     250    <field id="LPRODZ"      long_name="microzooplankton ligand production rate" unit="nmol-L/m3/s"  grid_ref="grid_T_3D" /> 
     251    <field id="FEZOO"       long_name="microzooplankton iron recycling rate"    unit="nmol-FeL/m3/s"  grid_ref="grid_T_3D" /> 
     252    <field id="FEZOO2"      long_name="mesozooplankton iron recycling rate"     unit="nmol-FeL/m3/s"  grid_ref="grid_T_3D" /> 
     253 
     254    <!-- PISCES tracers trends --> 
     255    <field id="INTdtAlk"    long_name="Vertically int. of change of alkalinity"             unit="mol/m2/s"                       /> 
     256    <field id="INTdtDIC"    long_name="Vertically int. of change of dissic    "             unit="mol/m2/s"                       /> 
     257    <field id="INTdtFer"    long_name="Vertically int. of change of iron      "             unit="mol/m2/s"                       /> 
     258    <field id="INTdtDIN"    long_name="Vertically int. of change of nitrogen  "             unit="mol/m2/s"                       /> 
     259    <field id="INTdtDIP"    long_name="Vertically int. of change of phophate  "             unit="mol/m2/s"                       /> 
     260    <field id="INTdtSil"    long_name="Vertically int. of change of silicon   "             unit="mol/m2/s"                       /> 
     261 
     262 
     263    <!-- dbio_T on T grid : variables available with diaar5 --> 
     264    <field id="TPP"         long_name="Total Primary production of phyto"                   unit="mol/m3/s"  grid_ref="grid_T_3D" /> 
     265    <field id="TPNEW"       long_name="New Primary production of phyto"                     unit="mol/m3/s"  grid_ref="grid_T_3D" /> 
     266    <field id="TPBFE"       long_name="Total biogenic iron production"                      unit="mol/m3/s"  grid_ref="grid_T_3D" /> 
     267    <field id="INTDIC"      long_name="DIC content"                                         unit="kg/m2"                          /> 
     268    <field id="O2MIN"       long_name="Oxygen minimum concentration"                        unit="mol/m3"                          /> 
     269    <field id="ZO2MIN"      long_name="Depth of oxygen minimum concentration"               unit="m"                              /> 
     270    <field id="INTNFIX"     long_name="Nitrogen fixation rate : vert. integrated"           unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > Nfix * e3t </field > 
     271    <field id="INTPPPHYN"   long_name="Vertically integrated primary production by nanophy" unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PPPHYN * e3t </field > 
     272    <field id="INTPPPHYD"   long_name="Vertically integrated primary production by diatom"  unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PPPHYD * e3t </field > 
     273    <field id="INTPPPHYP"   long_name="Vertically integrated primary production by picophy" unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PPPHYP * e3t </field > 
     274    <field id="INTPP"       long_name="Vertically integrated primary production by phyto"   unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > TPP * e3t </field > 
     275    <field id="INTPNEW"     long_name="Vertically integrated new primary production"        unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > TPNEW * e3t </field > 
     276    <field id="INTPBFE"     long_name="Vertically integrated of biogenic iron production"   unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > TPBFE * e3t </field > 
     277    <field id="INTPBSI"     long_name="Vertically integrated of biogenic Si production"     unit="mol/m2/s"  grid_ref="grid_T_vsum"  detect_missing_value="true" > PBSi * e3t </field > 
     278 
     279    <!-- PISCES light : variables available with key_pisces_reduced --> 
     280    <field id="FNO3PHY"     long_name="FNO3PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
     281    <field id="FNH4PHY"     long_name="FNH4PHY"                                 unit=""          grid_ref="grid_T_3D" /> 
     282    <field id="FNH4NO3"     long_name="FNH4NO3"                                 unit=""          grid_ref="grid_T_3D" /> 
     283    <field id="TNO3PHY"     long_name="TNO3PHY"                                 unit=""  /> 
     284    <field id="TNH4PHY"     long_name="TNH4PHY"                                 unit=""  /> 
     285    <field id="TPHYDOM"     long_name="TPHYDOM"                                 unit=""  /> 
     286    <field id="TPHYNH4"     long_name="TPHYNH4"                                 unit=""  /> 
     287    <field id="TPHYZOO"     long_name="TPHYZOO"                                 unit=""  /> 
     288    <field id="TPHYDET"     long_name="TPHYDET"                                 unit=""  /> 
     289    <field id="TDETZOO"     long_name="TDETZOO"                                 unit=""  /> 
     290    <field id="TZOODET"     long_name="TZOODET"                                 unit=""  /> 
     291    <field id="TZOOBOD"     long_name="TZOOBOD"                                 unit=""  /> 
     292    <field id="TZOONH4"     long_name="TZOONH4"                                 unit=""  /> 
     293    <field id="TZOODOM"     long_name="TZOODOM"                                 unit=""  /> 
     294    <field id="TNH4NO3"     long_name="TNH4NO3"                                 unit=""  /> 
     295    <field id="TDOMNH4"     long_name="TDOMNH4"                                 unit=""  /> 
     296    <field id="TDETNH4"     long_name="TDETNH4"                                 unit=""  /> 
     297    <field id="TPHYTOT"     long_name="TPHYTOT"                                 unit=""  /> 
     298    <field id="TZOOTOT"     long_name="TZOOTOT"                                 unit=""  /> 
     299    <field id="SEDPOC"      long_name="SEDPOC"                                  unit=""  /> 
     300    <field id="TDETSED"     long_name="TDETSED"                                 unit=""  /> 
     301  </field_group> 
     302 
     303  <field_group id="tracer_scalar"  grid_ref="grid_scalar"  > 
     304    <!-- PISCES scalar  --> 
     305    <field id="pno3tot"         long_name="Global mean nitrate concentration"                  unit="mol/m3"   /> 
     306    <field id="ppo4tot"         long_name="global mean phosphorus concentration"               unit="mol/m3"   /> 
     307    <field id="psiltot"         long_name="Global mean silicate concentration"                 unit="mol/m3"   /> 
     308    <field id="palktot"         long_name="Global mean alkalinity concentration"               unit="mol/m3"   /> 
     309    <field id="pfertot"         long_name="Global mean iron concentration"                     unit="mol/m3"   /> 
     310    <field id="tcflx"           long_name="Total Flux of Carbon out of the ocean"              unit="mol/s"   /> 
     311    <field id="tcflxcum"        long_name="Cumulative total Flux of Carbon out of the ocean"   unit="mol/s"   /> 
     312    <field id="tcexp"           long_name="Total Carbon export at 100m"                        unit="mol/s"   /> 
     313    <field id="tintpp"          long_name="Global total integrated primary production"         unit="mol/s"   /> 
     314    <field id="tnfix"           long_name="Global total nitrogen fixation"                     unit="mol/s"   /> 
     315    <field id="tdenit"          long_name="Total denitrification"                              unit="mol/s"   /> 
     316  </field_group> 
     317 
     318</field_definition> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/grid_def_nemo.xml

    r12377 r14021  
    44= grid definition = = DO NOT CHANGE = 
    55============================================================================================================ 
    6     --> 
    7  
    8     <grid_definition>     
    9  
    10         <!--  --> 
    11        <grid id="grid_T_2D" > 
    12          <domain domain_ref="grid_T" /> 
    13        </grid> 
    14         <!--  --> 
    15        <grid id="grid_T_ncatice" > 
    16          <domain domain_ref="grid_T" /> 
    17          <axis axis_ref="ncatice" /> 
    18        </grid> 
    19         <!--  --> 
    20        <grid id="grid_T_3D" > 
    21          <domain domain_ref="grid_T" /> 
    22          <axis axis_ref="deptht" /> 
    23        </grid> 
    24         <!--  --> 
    25        <grid id="grid_T_3DS" > 
    26          <domain domain_ref="grid_T" /> 
    27          <axis axis_ref="profsed" /> 
    28        </grid> 
    29         <!--  --> 
    30        <grid id="grid_U_2D" > 
    31          <domain domain_ref="grid_U" /> 
    32        </grid> 
    33         <!--  --> 
    34        <grid id="grid_U_3D" > 
    35          <domain domain_ref="grid_U" /> 
    36          <axis axis_ref="depthu" /> 
    37        </grid> 
    38         <!--  --> 
    39        <grid id="grid_V_2D" > 
    40          <domain domain_ref="grid_V" /> 
    41        </grid> 
    42         <!--  --> 
    43        <grid id="grid_V_3D" > 
    44          <domain domain_ref="grid_V" /> 
    45          <axis axis_ref="depthv" /> 
    46        </grid> 
    47         <!--  --> 
    48        <grid id="grid_W_2D" > 
    49          <domain domain_ref="grid_W" /> 
    50        </grid> 
    51         <!--  --> 
    52        <grid id="grid_W_3D" > 
    53          <domain domain_ref="grid_W" /> 
    54          <axis axis_ref="depthw" /> 
    55        </grid> 
    56         <!--  --> 
    57        <grid id="grid_1point" > 
    58          <domain domain_ref="1point"/> 
    59        </grid> 
    60         <!--  --> 
    61        <grid id="grid_T_nfloat" > 
    62          <domain domain_ref="grid_T" /> 
    63          <axis axis_ref="nfloat" /> 
    64        </grid> 
    65         <!--  --> 
    66        <grid id="grid_EqT" > 
    67          <domain domain_ref="EqT" /> 
    68        </grid> 
    69         <!--  --> 
    70  
    71  
    72        <grid id="grid_znl_T_2D"> 
    73          <domain domain_ref="gznl" /> 
    74          <axis axis_ref="basin" /> 
    75        </grid> 
    76  
    77        <grid id="grid_znl_T_3D"> 
    78          <domain domain_ref="gznl" /> 
    79          <axis axis_ref="deptht"  /> 
    80          <axis axis_ref="basin" /> 
    81        </grid> 
    82  
    83        <grid id="grid_znl_W_3D"> 
    84          <domain domain_ref="gznl" /> 
    85          <axis axis_ref="depthw"  /> 
    86          <axis axis_ref="basin" /> 
    87        </grid> 
    88  
    89       <grid id="grid_ptr_T_2D"> 
    90          <domain domain_ref="ptr" /> 
    91          <axis axis_ref="basin" /> 
    92        </grid> 
    93  
    94        <grid id="grid_ptr_T_3D"> 
    95          <domain  domain_ref="ptr" /> 
    96          <axis axis_ref="deptht"  /> 
    97          <axis axis_ref="basin" /> 
    98        </grid> 
    99  
    100        <grid id="grid_ptr_W_3D"> 
    101          <domain  domain_ref="ptr" /> 
    102          <axis axis_ref="depthw"  /> 
    103          <axis axis_ref="basin" /> 
    104        </grid> 
    105  
    106        <grid id="grid_ptr_W_GLO"> 
    107          <domain  domain_ref="ptr" /> 
    108          <axis axis_ref="depthw"  /> 
    109          <scalar> 
    110            <extract_axis position="0" /> 
    111          </scalar> 
    112        </grid> 
    113  
    114        <grid id="grid_ptr_W_ATL"> 
    115          <domain  domain_ref="ptr" /> 
    116          <axis axis_ref="depthw"  /> 
    117          <scalar> 
    118            <extract_axis position="1" /> 
    119          </scalar> 
    120        </grid> 
    121  
    122        <grid id="grid_ptr_W_IND"> 
    123          <domain  domain_ref="ptr" /> 
    124          <axis axis_ref="depthw"  /> 
    125          <scalar> 
    126            <extract_axis position="2" /> 
    127          </scalar> 
    128        </grid> 
    129  
    130        <grid id="grid_T_SFC"> 
    131          <domain domain_ref="grid_T" /> 
    132          <scalar> 
    133            <extract_axis position="0" /> 
    134          </scalar> 
    135        </grid> 
    136  
    137        <grid id="grid_T_vsum"> 
    138          <domain domain_ref="grid_T"/> 
    139          <scalar> 
    140             <reduce_axis operation="sum" /> 
    141          </scalar> 
    142        </grid> 
    143  
    144        <grid id="grid_U_vsum"> 
    145          <domain domain_ref="grid_U"/> 
    146          <scalar> 
    147             <reduce_axis operation="sum" /> 
    148          </scalar> 
    149        </grid> 
    150  
    151        <grid id="grid_V_vsum"> 
    152          <domain domain_ref="grid_V"/> 
    153          <scalar> 
    154             <reduce_axis operation="sum" /> 
    155          </scalar> 
    156        </grid> 
    157  
    158        <!-- for ORCA2 grid  --> 
    159        <grid id="cumul_U"> 
    160          <axis axis_ref="cumul_U" n_glo="182" > 
    161            <reduce_domain local="true" operation="sum" direction="jDir" /> 
    162            <reduce_axis operation="sum" /> 
    163          </axis> 
    164          <axis axis_ref="depthu" /> 
    165        </grid> 
    166  
    167        <!-- for eORCA1 grid 
    168  
    169        <grid id="cumul_U"> 
    170          <axis axis_ref="cumul_U" n_glo="362" > 
    171            <reduce_domain local="true" operation="sum" direction="jDir" /> 
    172            <reduce_axis operation="sum" /> 
    173          </axis> 
    174          <axis axis_ref="depthu" /> 
    175        </grid> 
    176  
    177       --> 
    178  
    179  
    180        <grid id="grid_T_zoom_300"> 
    181          <domain domain_ref="grid_T" /> 
    182          <axis axis_ref="deptht300" /> 
    183        </grid> 
    184  
    185        <grid id="grid_U_scalar" > 
    186          <domain domain_ref="grid_U" /> 
    187          <scalar/> 
    188        </grid> 
    189  
    190        <grid id="grid_V_scalar" > 
    191          <domain domain_ref="grid_V" /> 
    192          <scalar/> 
    193        </grid> 
    194   
    195        <grid id="grid_U_4strait"> 
    196          <domain domain_ref="grid_U" /> 
    197          <axis axis_ref="section"> 
    198            <duplicate_scalar/> 
    199          </axis> 
    200        </grid> 
    201   
    202        <grid id="grid_V_4strait"> 
    203          <domain domain_ref="grid_V" /> 
    204          <axis axis_ref="section"> 
    205            <duplicate_scalar/> 
    206          </axis> 
    207        </grid> 
    208   
    209        <grid id="grid_U_4strait_hsum"> 
    210          <scalar > 
    211            <reduce_domain operation="sum" local="true"/> 
    212            <reduce_scalar operation="sum" /> 
    213          </scalar> 
    214          <axis axis_ref="section"/> 
    215        </grid> 
    216   
    217        <grid id="grid_V_4strait_hsum"> 
    218          <scalar > 
    219            <reduce_domain operation="sum" local="true"/> 
    220            <reduce_scalar operation="sum" /> 
    221          </scalar> 
    222          <axis axis_ref="section"/> 
    223        </grid> 
    224   
    225        <grid id="grid_4strait"> 
    226          <axis axis_ref="section"/> 
    227        </grid> 
    228  
    229       <grid id="grid_U_4strait_ice"> 
    230         <domain domain_ref="grid_U" /> 
    231         <axis axis_ref="section_ice"> 
    232           <duplicate_scalar/> 
    233         </axis> 
    234       </grid> 
    235  
    236       <grid id="grid_V_4strait_ice"> 
    237         <domain domain_ref="grid_V" /> 
    238         <axis axis_ref="section_ice"> 
    239          <duplicate_scalar/> 
    240         </axis> 
    241       </grid> 
    242  
    243       <grid id="grid_U_4strait_ice_hsum"> 
    244         <scalar > 
    245          <reduce_domain operation="sum" local="true"/> 
    246          <reduce_scalar operation="sum" /> 
    247         </scalar> 
    248         <axis axis_ref="section_ice"/> 
    249       </grid> 
    250  
    251       <grid id="grid_V_4strait_ice_hsum"> 
    252          <scalar > 
    253           <reduce_domain operation="sum" local="true"/> 
    254           <reduce_scalar operation="sum" /> 
    255          </scalar> 
    256          <axis axis_ref="section_ice"/> 
    257       </grid> 
    258  
    259       <grid id="grid_4strait_ice"> 
    260         <axis axis_ref="section_ice"/> 
    261       </grid> 
    262   
    263       <!-- scalars --> 
    264       <grid id="grid_scalar" > 
    265         <scalar/> 
    266       </grid> 
    267  
    268       <!-- ABL grid definition --> 
    269       <grid id="grid_TA_2D"> 
    270         <domain domain_ref="grid_T" /> 
    271       </grid> 
    272       <grid id="grid_TA_3D"> 
    273         <domain domain_ref="grid_T" /> 
    274         <axis  id="ght_abl" /> 
    275       </grid> 
    276       <grid id="grid_WA_3D"> 
    277         <domain domain_ref="grid_T" /> 
    278         <axis  id="ghw_abl" /> 
    279       </grid> 
    280       <!--  --> 
    281  
    282       <!-- grid definitions for multiple-linear-regression analysis (diamlr) --> 
    283       <grid id="diamlr_grid_scalar" > 
    284    <scalar /> 
    285    <scalar /> 
    286       </grid> 
    287       <grid id="diamlr_grid_T_2D" > 
    288    <domain domain_ref="grid_T" /> 
    289    <scalar /> 
    290       </grid> 
    291       <grid id="diamlr_grid_U_2D" > 
    292    <domain domain_ref="grid_U" /> 
    293    <scalar /> 
    294       </grid> 
    295       <grid id="diamlr_grid_V_2D" > 
    296    <domain domain_ref="grid_V" /> 
    297    <scalar /> 
    298       </grid> 
    299       <grid id="diamlr_grid_W_2D" > 
    300    <domain domain_ref="grid_W" /> 
    301    <scalar /> 
    302       </grid> 
    303       <grid id="diamlr_grid_2D_to_grid_T_3D" > 
    304    <domain domain_ref="grid_T" /> 
    305         <axis axis_ref="deptht"> 
    306           <duplicate_scalar /> 
    307         </axis> 
    308       </grid> 
    309       <grid id="diamlr_grid_2D_to_grid_U_3D" > 
    310    <domain domain_ref="grid_U" /> 
    311         <axis axis_ref="depthu"> 
    312           <duplicate_scalar /> 
    313         </axis> 
    314       </grid> 
    315       <grid id="diamlr_grid_2D_to_grid_V_3D" > 
    316    <domain domain_ref="grid_V" /> 
    317         <axis axis_ref="depthv"> 
    318           <duplicate_scalar /> 
    319         </axis> 
    320       </grid> 
    321       <grid id="diamlr_grid_2D_to_grid_W_3D" > 
    322    <domain domain_ref="grid_W" /> 
    323         <axis axis_ref="depthw"> 
    324           <duplicate_scalar /> 
    325         </axis> 
    326       </grid> 
    327       <grid id="diamlr_grid_2D_to_scalar" > 
    328         <scalar> 
    329           <reduce_domain operation="average" /> 
    330         </scalar> 
    331    <scalar /> 
    332       </grid> 
    333       <!-- grid definitions for the computation of daily detided model diagnostics (diadetide) --> 
    334       <grid id="diadetide_grid_T_2D" > 
    335    <domain domain_ref="grid_T" /> 
    336    <scalar /> 
    337       </grid> 
    338       <grid id="diadetide_grid_U_2D" > 
    339    <domain domain_ref="grid_U" /> 
    340    <scalar /> 
    341       </grid> 
    342       <grid id="diadetide_grid_V_2D" > 
    343    <domain domain_ref="grid_V" /> 
    344    <scalar /> 
    345       </grid> 
    346       <grid id="diadetide_grid_2D_to_grid_T_3D" > 
    347    <domain domain_ref="grid_T" /> 
    348         <axis axis_ref="deptht"> 
    349           <duplicate_scalar /> 
    350         </axis> 
    351       </grid> 
    352       <grid id="diadetide_grid_2D_to_grid_U_3D" > 
    353    <domain domain_ref="grid_U" /> 
    354         <axis axis_ref="depthu"> 
    355           <duplicate_scalar /> 
    356         </axis> 
    357       </grid> 
    358       <grid id="diadetide_grid_2D_to_grid_V_3D" > 
    359    <domain domain_ref="grid_V" /> 
    360         <axis axis_ref="depthv"> 
    361           <duplicate_scalar /> 
    362         </axis> 
    363       </grid> 
    364       <grid id="diadetide_grid_2D_to_grid_W_3D" > 
    365    <domain domain_ref="grid_W" /> 
    366         <axis axis_ref="depthw"> 
    367           <duplicate_scalar /> 
    368         </axis> 
    369       </grid> 
    370  
    371     </grid_definition> 
     6--> 
     7 
     8<grid_definition> 
     9 
     10  <!--  --> 
     11  <grid id="grid_T_2D" > 
     12    <domain domain_ref="grid_T" /> 
     13  </grid> 
     14  <!--  --> 
     15  <grid id="grid_T_ncatice" > 
     16    <domain domain_ref="grid_T" /> 
     17    <axis axis_ref="ncatice" /> 
     18  </grid> 
     19  <!--  --> 
     20  <grid id="grid_T_3D" > 
     21    <domain domain_ref="grid_T" /> 
     22    <axis axis_ref="deptht" /> 
     23  </grid> 
     24  <!--  --> 
     25  <grid id="grid_T_3DS" > 
     26    <domain domain_ref="grid_T" /> 
     27    <axis axis_ref="profsed" /> 
     28  </grid> 
     29  <!--  --> 
     30  <grid id="grid_U_2D" > 
     31    <domain domain_ref="grid_U" /> 
     32  </grid> 
     33  <!--  --> 
     34  <grid id="grid_U_3D" > 
     35    <domain domain_ref="grid_U" /> 
     36    <axis axis_ref="depthu" /> 
     37  </grid> 
     38  <!--  --> 
     39  <grid id="grid_V_2D" > 
     40    <domain domain_ref="grid_V" /> 
     41  </grid> 
     42  <!--  --> 
     43  <grid id="grid_V_3D" > 
     44    <domain domain_ref="grid_V" /> 
     45    <axis axis_ref="depthv" /> 
     46  </grid> 
     47  <!--  --> 
     48  <grid id="grid_W_2D" > 
     49    <domain domain_ref="grid_W" /> 
     50  </grid> 
     51  <!--  --> 
     52  <grid id="grid_W_3D" > 
     53    <domain domain_ref="grid_W" /> 
     54    <axis axis_ref="depthw" /> 
     55  </grid> 
     56  <!--  --> 
     57  <grid id="grid_1point" > 
     58    <domain domain_ref="1point"/> 
     59  </grid> 
     60  <!--  --> 
     61  <grid id="grid_T_nfloat" > 
     62    <domain domain_ref="grid_T" /> 
     63    <axis axis_ref="nfloat" /> 
     64  </grid> 
     65  <!--  --> 
     66  <grid id="grid_EqT" > 
     67    <domain domain_ref="EqT" /> 
     68  </grid> 
     69  <!--  --> 
     70 
     71 
     72  <grid id="grid_znl_T_2D"> 
     73    <domain domain_ref="gznl" /> 
     74    <axis axis_ref="basin" /> 
     75  </grid> 
     76 
     77  <grid id="grid_znl_T_3D"> 
     78    <domain domain_ref="gznl" /> 
     79    <axis axis_ref="deptht"  /> 
     80    <axis axis_ref="basin" /> 
     81  </grid> 
     82 
     83  <grid id="grid_znl_W_3D"> 
     84    <domain domain_ref="gznl" /> 
     85    <axis axis_ref="depthw"  /> 
     86    <axis axis_ref="basin" /> 
     87  </grid> 
     88 
     89  <grid id="grid_ptr_T_2D"> 
     90    <domain domain_ref="ptr" /> 
     91    <axis axis_ref="basin" /> 
     92  </grid> 
     93 
     94  <grid id="grid_ptr_T_3D"> 
     95    <domain  domain_ref="ptr" /> 
     96    <axis axis_ref="deptht"  /> 
     97    <axis axis_ref="basin" /> 
     98  </grid> 
     99 
     100  <grid id="grid_ptr_W_3D"> 
     101    <domain  domain_ref="ptr" /> 
     102    <axis axis_ref="depthw"  /> 
     103    <axis axis_ref="basin" /> 
     104  </grid> 
     105 
     106  <grid id="grid_ptr_W_GLO"> 
     107    <domain  domain_ref="ptr" /> 
     108    <axis axis_ref="depthw"  /> 
     109    <scalar> 
     110      <extract_axis position="0" /> 
     111    </scalar> 
     112  </grid> 
     113 
     114  <grid id="grid_ptr_W_ATL"> 
     115    <domain  domain_ref="ptr" /> 
     116    <axis axis_ref="depthw"  /> 
     117    <scalar> 
     118      <extract_axis position="1" /> 
     119    </scalar> 
     120  </grid> 
     121 
     122  <grid id="grid_ptr_W_IND"> 
     123    <domain  domain_ref="ptr" /> 
     124    <axis axis_ref="depthw"  /> 
     125    <scalar> 
     126      <extract_axis position="2" /> 
     127    </scalar> 
     128  </grid> 
     129 
     130  <grid id="grid_T_SFC"> 
     131    <domain domain_ref="grid_T" /> 
     132    <scalar> 
     133      <extract_axis position="0" /> 
     134    </scalar> 
     135  </grid> 
     136 
     137  <grid id="grid_T_vsum"> 
     138    <domain domain_ref="grid_T"/> 
     139    <scalar> 
     140      <reduce_axis operation="sum" /> 
     141    </scalar> 
     142  </grid> 
     143 
     144  <grid id="grid_U_vsum"> 
     145    <domain domain_ref="grid_U"/> 
     146    <scalar> 
     147      <reduce_axis operation="sum" /> 
     148    </scalar> 
     149  </grid> 
     150 
     151  <grid id="grid_V_vsum"> 
     152    <domain domain_ref="grid_V"/> 
     153    <scalar> 
     154      <reduce_axis operation="sum" /> 
     155    </scalar> 
     156  </grid> 
     157 
     158  <!-- for ORCA2 grid  --> 
     159  <grid id="cumul_U"> 
     160    <axis axis_ref="cumul_U" n_glo="182" > 
     161      <reduce_domain local="true" operation="sum" direction="jDir" /> 
     162      <reduce_axis operation="sum" /> 
     163    </axis> 
     164    <axis axis_ref="depthu" /> 
     165  </grid> 
     166 
     167  <!-- for eORCA1 grid 
     168 
     169<grid id="cumul_U"> 
     170<axis axis_ref="cumul_U" n_glo="362" > 
     171<reduce_domain local="true" operation="sum" direction="jDir" /> 
     172<reduce_axis operation="sum" /> 
     173</axis> 
     174<axis axis_ref="depthu" /> 
     175</grid> 
     176 
     177  --> 
     178 
     179 
     180  <grid id="grid_T_zoom_300"> 
     181    <domain domain_ref="grid_T" /> 
     182    <axis axis_ref="deptht300" /> 
     183  </grid> 
     184 
     185  <grid id="grid_U_scalar" > 
     186    <domain domain_ref="grid_U" /> 
     187    <scalar/> 
     188  </grid> 
     189 
     190  <grid id="grid_V_scalar" > 
     191    <domain domain_ref="grid_V" /> 
     192    <scalar/> 
     193  </grid> 
     194 
     195  <grid id="grid_U_4strait"> 
     196    <domain domain_ref="grid_U" /> 
     197    <axis axis_ref="section"> 
     198      <duplicate_scalar/> 
     199    </axis> 
     200  </grid> 
     201 
     202  <grid id="grid_V_4strait"> 
     203    <domain domain_ref="grid_V" /> 
     204    <axis axis_ref="section"> 
     205      <duplicate_scalar/> 
     206    </axis> 
     207  </grid> 
     208 
     209  <grid id="grid_U_4strait_hsum"> 
     210    <scalar > 
     211      <reduce_domain operation="sum" local="true"/> 
     212      <reduce_scalar operation="sum" /> 
     213    </scalar> 
     214    <axis axis_ref="section"/> 
     215  </grid> 
     216 
     217  <grid id="grid_V_4strait_hsum"> 
     218    <scalar > 
     219      <reduce_domain operation="sum" local="true"/> 
     220      <reduce_scalar operation="sum" /> 
     221    </scalar> 
     222    <axis axis_ref="section"/> 
     223  </grid> 
     224 
     225  <grid id="grid_4strait"> 
     226    <axis axis_ref="section"/> 
     227  </grid> 
     228 
     229  <grid id="grid_U_4strait_ice"> 
     230    <domain domain_ref="grid_U" /> 
     231    <axis axis_ref="section_ice"> 
     232      <duplicate_scalar/> 
     233    </axis> 
     234  </grid> 
     235 
     236  <grid id="grid_V_4strait_ice"> 
     237    <domain domain_ref="grid_V" /> 
     238    <axis axis_ref="section_ice"> 
     239      <duplicate_scalar/> 
     240    </axis> 
     241  </grid> 
     242 
     243  <grid id="grid_U_4strait_ice_hsum"> 
     244    <scalar > 
     245      <reduce_domain operation="sum" local="true"/> 
     246      <reduce_scalar operation="sum" /> 
     247    </scalar> 
     248    <axis axis_ref="section_ice"/> 
     249  </grid> 
     250 
     251  <grid id="grid_V_4strait_ice_hsum"> 
     252    <scalar > 
     253      <reduce_domain operation="sum" local="true"/> 
     254      <reduce_scalar operation="sum" /> 
     255    </scalar> 
     256    <axis axis_ref="section_ice"/> 
     257  </grid> 
     258 
     259  <grid id="grid_4strait_ice"> 
     260    <axis axis_ref="section_ice"/> 
     261  </grid> 
     262 
     263  <!-- scalars --> 
     264  <grid id="grid_scalar" > 
     265    <scalar/> 
     266  </grid> 
     267 
     268  <!-- ABL grid definition --> 
     269  <grid id="grid_TA_2D"> 
     270    <domain domain_ref="grid_T" /> 
     271  </grid> 
     272  <grid id="grid_TA_3D"> 
     273    <domain domain_ref="grid_T" /> 
     274    <axis  id="ght_abl" /> 
     275  </grid> 
     276  <grid id="grid_WA_3D"> 
     277    <domain domain_ref="grid_T" /> 
     278    <axis  id="ghw_abl" /> 
     279  </grid> 
     280  <!--  --> 
     281 
     282  <!-- grid definitions for multiple-linear-regression analysis (diamlr) --> 
     283  <grid id="diamlr_grid_scalar" > 
     284    <scalar /> 
     285    <scalar /> 
     286  </grid> 
     287  <grid id="diamlr_grid_T_2D" > 
     288    <domain domain_ref="grid_T" /> 
     289    <scalar /> 
     290  </grid> 
     291  <grid id="diamlr_grid_U_2D" > 
     292    <domain domain_ref="grid_U" /> 
     293    <scalar /> 
     294  </grid> 
     295  <grid id="diamlr_grid_V_2D" > 
     296    <domain domain_ref="grid_V" /> 
     297    <scalar /> 
     298  </grid> 
     299  <grid id="diamlr_grid_W_2D" > 
     300    <domain domain_ref="grid_W" /> 
     301    <scalar /> 
     302  </grid> 
     303  <grid id="diamlr_grid_2D_to_grid_T_3D" > 
     304    <domain domain_ref="grid_T" /> 
     305    <axis axis_ref="deptht"> 
     306      <duplicate_scalar /> 
     307    </axis> 
     308  </grid> 
     309  <grid id="diamlr_grid_2D_to_grid_U_3D" > 
     310    <domain domain_ref="grid_U" /> 
     311    <axis axis_ref="depthu"> 
     312      <duplicate_scalar /> 
     313    </axis> 
     314  </grid> 
     315  <grid id="diamlr_grid_2D_to_grid_V_3D" > 
     316    <domain domain_ref="grid_V" /> 
     317    <axis axis_ref="depthv"> 
     318      <duplicate_scalar /> 
     319    </axis> 
     320  </grid> 
     321  <grid id="diamlr_grid_2D_to_grid_W_3D" > 
     322    <domain domain_ref="grid_W" /> 
     323    <axis axis_ref="depthw"> 
     324      <duplicate_scalar /> 
     325    </axis> 
     326  </grid> 
     327  <grid id="diamlr_grid_2D_to_scalar" > 
     328    <scalar> 
     329      <reduce_domain operation="average" /> 
     330    </scalar> 
     331    <scalar /> 
     332  </grid> 
     333  <!-- grid definitions for the computation of daily detided model diagnostics (diadetide) --> 
     334  <grid id="diadetide_grid_T_2D" > 
     335    <domain domain_ref="grid_T" /> 
     336    <scalar /> 
     337  </grid> 
     338  <grid id="diadetide_grid_U_2D" > 
     339    <domain domain_ref="grid_U" /> 
     340    <scalar /> 
     341  </grid> 
     342  <grid id="diadetide_grid_V_2D" > 
     343    <domain domain_ref="grid_V" /> 
     344    <scalar /> 
     345  </grid> 
     346  <grid id="diadetide_grid_2D_to_grid_T_3D" > 
     347    <domain domain_ref="grid_T" /> 
     348    <axis axis_ref="deptht"> 
     349      <duplicate_scalar /> 
     350    </axis> 
     351  </grid> 
     352  <grid id="diadetide_grid_2D_to_grid_U_3D" > 
     353    <domain domain_ref="grid_U" /> 
     354    <axis axis_ref="depthu"> 
     355      <duplicate_scalar /> 
     356    </axis> 
     357  </grid> 
     358  <grid id="diadetide_grid_2D_to_grid_V_3D" > 
     359    <domain domain_ref="grid_V" /> 
     360    <axis axis_ref="depthv"> 
     361      <duplicate_scalar /> 
     362    </axis> 
     363  </grid> 
     364  <grid id="diadetide_grid_2D_to_grid_W_3D" > 
     365    <domain domain_ref="grid_W" /> 
     366    <axis axis_ref="depthw"> 
     367      <duplicate_scalar /> 
     368    </axis> 
     369  </grid> 
     370 
     371</grid_definition> 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/cfgs/SHARED/namelist_ref

    r14017 r14021  
    237237   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    238238   ln_wave     = .false.   !  Activate coupling with wave  (T => fill namsbc_wave) 
    239    ln_cdgw     = .false.   !  Neutral drag coefficient read from wave model (T => ln_wave=.true. & fill namsbc_wave) 
    240    ln_sdw      = .false.   !  Read 2D Surf Stokes Drift & Computation of 3D stokes drift (T => ln_wave=.true. & fill namsbc_wave) 
    241    nn_sdrift   =  0        !  Parameterization for the calculation of 3D-Stokes drift from the surface Stokes drift 
    242       !                    !   = 0 Breivik 2015 parameterization: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    243       !                    !   = 1 Phillips:                      v_z=v_o*[exp(2*k*z)-beta*sqrt(-2*k*pi*z)*erfc(sqrt(-2*k*z))] 
    244       !                    !   = 2 Phillips as (1) but using the wave frequency from a wave model 
    245    ln_tauwoc   = .false.   !  Activate ocean stress modified by external wave induced stress (T => ln_wave=.true. & fill namsbc_wave) 
    246    ln_tauw     = .false.   !  Activate ocean stress components from wave model 
    247    ln_stcor    = .false.   !  Activate Stokes Coriolis term (T => ln_wave=.true. & ln_sdw=.true. & fill namsbc_wave) 
    248239   nn_lsm      = 0         !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
    249240                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    … …  
    386377   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    387378   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    388    sn_rcv_hsig   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    389379   sn_rcv_iceflx =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    390380   sn_rcv_mslp   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    391    sn_rcv_phioc  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    392    sn_rcv_sdrfx  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    393    sn_rcv_sdrfy  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    394    sn_rcv_wper   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    395    sn_rcv_wnum   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    396    sn_rcv_wfreq  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    397    sn_rcv_wdrag  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    398381   sn_rcv_ts_ice =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    399382   sn_rcv_isf    =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    400383   sn_rcv_icb    =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    401    sn_rcv_tauwoc =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    402    sn_rcv_tauw   =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
    403    sn_rcv_wdrag  =   'none'                 ,    'no'    ,     ''      ,         ''          ,   '' 
     384   sn_rcv_hsig   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     385   sn_rcv_phioc  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'T' 
     386   sn_rcv_sdrfx  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'T' 
     387   sn_rcv_sdrfy  =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     388   sn_rcv_wper   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     389   sn_rcv_wnum   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     390   sn_rcv_wstrf  =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     391   sn_rcv_wdrag  =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     392   sn_rcv_charn  =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'T' 
     393   sn_rcv_taw    =   'none'                 ,    'no'    ,     ''      ,         ''           ,   'U,V' 
     394   sn_rcv_bhd    =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     395   sn_rcv_tusd   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
     396   sn_rcv_tvsd   =   'none'                 ,    'no'    ,     ''      '         ''           ,   'T' 
    404397/ 
    405398!----------------------------------------------------------------------- 
    … …  
    586579&namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
    587580!----------------------------------------------------------------------- 
     581   ln_sdw      = .false.       !  get the 2D Surf Stokes Drift & Compute the 3D stokes drift 
     582   ln_stcor    = .false.       !  add Stokes Coriolis and tracer advection terms 
     583   ln_cdgw     = .false.       !  Neutral drag coefficient read from wave model 
     584   ln_tauoc    = .false.       !  ocean stress is modified by wave induced stress 
     585   ln_wave_test= .false.       !  Test case with constant wave fields 
     586! 
     587   ln_charn    = .false.       !  Charnock coefficient read from wave model (IFS only) 
     588   ln_taw      = .false.       !  ocean stress is modified by wave induced stress (coupled mode) 
     589   ln_phioc    = .false.       !  TKE flux from wave model 
     590   ln_bern_srfc= .false.       !  wave induced pressure. Bernoulli head J term 
     591   ln_breivikFV_2016 = .false. !  breivik 2016 vertical stokes profile 
     592   ln_vortex_force = .false.   !  Vortex Force term  
     593   ln_stshear  = .false.       !  include stokes shear in EKE computation 
     594! 
    588595   cn_dir      = './'      !  root directory for the waves data location 
    589596   !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 
    … …  
    595602   sn_hsw      =  'sdw_ecwaves_orca2'    ,        6.         , 'hs'         ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    596603   sn_wmp      =  'sdw_ecwaves_orca2'    ,        6.         , 'wmp'        ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    597    sn_wfr      =  'sdw_ecwaves_orca2'    ,        6.         , 'wfr'        ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    598604   sn_wnum     =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_num'   ,  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    599    sn_tauwoc   =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    600    sn_tauwx    =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    601    sn_tauwy    =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
     605   sn_tauoc    =  'sdw_ecwaves_orca2'    ,        6.         , 'wave_stress',  .true.  , .true. , 'yearly'  ,  ''              , ''       , '' 
    602606/ 
    603607!----------------------------------------------------------------------- 
    … …  
    11261130      nn_npc      =    1         ! frequency of application of npc 
    11271131      nn_npcp     =  365         ! npc control print frequency 
     1132   ln_zdfmfc   = .false.      !  Mass Flux Convection 
    11281133   ! 
    11291134   ln_zdfddm   = .false.   ! double diffusive mixing 
    … …  
    11761181      rn_mxlice   = 10.       ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 
    11771182   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value 
     1183   ln_mxhsw    = .false.   !  surface mixing length scale = F(wave height) 
    11781184   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002) 
    11791185      rn_lc       =   0.15    !  coef. associated to Langmuir cells 
    … …  
    11911197   !                       !           = 2 weighted by 1-fr_i 
    11921198   !                       !           = 3 weighted by 1-MIN(1,4*fr_i)    
     1199   nn_bc_surf   =     1    !  surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling (ln_cplwave=1) 
     1200   nn_bc_bot    =     1    !  bottom condition (0/1=Dir/Neum) ! Only applicable for wave coupling (ln_cplwave=1) 
    11931201/ 
    11941202!----------------------------------------------------------------------- 
    … …  
    12351243      !                        !  = 1: Pierson Moskowitz wave spectrum 
    12361244      !                        !  = 0: Constant La# = 0.3 
     1245/ 
     1246!----------------------------------------------------------------------- 
     1247&namzdf_mfc     !   Mass Flux Convection 
     1248!----------------------------------------------------------------------- 
     1249   ln_edmfuv  = .false.        ! Activate on velocity fields (Not available yet) 
     1250   rn_cemf    =  1.            ! entrain/detrain coef. (<0 => cte; >0 % depending on dW/dz 
     1251   rn_cwmf    = -0.            ! entrain/detrain coef. (<0 => cte; >0 % depending on dW/dz 
     1252   rn_cent    = 2.e-5          ! entrain of convective area 
     1253   rn_cdet    = 3.e-5          ! detrain of convective area  
     1254   rn_cap     = 0.9            ! Coef. for CAP estimation 
     1255   App_max    = 0.1            ! Maximum convection area (% of the cell) 
    12371256/ 
    12381257!----------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/ice.F90

    r14017 r14021  
    150150   ! 
    151151   !                                     !!** ice-rheology namelist (namdyn_rhg) ** 
     152   ! -- evp 
    152153   LOGICAL , PUBLIC ::   ln_rhg_EVP       ! EVP rheology switch, used for rdgrft and rheology 
    153154   LOGICAL , PUBLIC ::   ln_rhg_EAP       ! EAP rheology switch, used for rdgrft and rheology 
    154155   LOGICAL , PUBLIC ::   ln_aEVP          !: using adaptive EVP (T or F) 
    155    REAL(wp), PUBLIC ::   rn_creepl        !: creep limit : has to be under 1.0e-9 
     156   REAL(wp), PUBLIC ::   rn_creepl        !: creep limit (has to be low enough, circa 10-9 m/s, depending on rheology) 
    156157   REAL(wp), PUBLIC ::   rn_ecc           !: eccentricity of the elliptical yield curve 
    157158   INTEGER , PUBLIC ::   nn_nevp          !: number of iterations for subcycling 
    158159   REAL(wp), PUBLIC ::   rn_relast        !: ratio => telast/rDt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 
    159160   INTEGER , PUBLIC ::   nn_rhg_chkcvg    !: check ice rheology convergence 
     161   ! -- vp 
     162   LOGICAL , PUBLIC ::   ln_rhg_VP        !: VP rheology 
     163   INTEGER , PUBLIC ::   nn_vp_nout       !: Number of outer iterations 
     164   INTEGER , PUBLIC ::   nn_vp_ninn       !: Number of inner iterations (linear system solver) 
     165   INTEGER , PUBLIC ::   nn_vp_chkcvg     !: Number of iterations every each convergence is checked 
    160166   ! 
    161167   !                                     !!** ice-advection namelist (namdyn_adv) ** 
    … …  
    210216   !                                     !!** ice-ponds namelist (namthd_pnd) 
    211217   LOGICAL , PUBLIC ::   ln_pnd           !: Melt ponds (T) or not (F) 
    212    LOGICAL , PUBLIC ::   ln_pnd_LEV       !: Melt ponds scheme from Holland et al (2012), Flocco et al (2007, 2010) 
    213    REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum ice fraction that contributes to melt ponds 
    214    REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum ice fraction that contributes to melt ponds 
     218   LOGICAL , PUBLIC ::   ln_pnd_TOPO      !: Topographic Melt ponds scheme (Flocco et al 2007, 2010) 
     219   LOGICAL , PUBLIC ::   ln_pnd_LEV       !: Simple melt pond scheme 
     220   REAL(wp), PUBLIC ::   rn_apnd_min      !: Minimum fraction of melt water contributing to ponds 
     221   REAL(wp), PUBLIC ::   rn_apnd_max      !: Maximum fraction of melt water contributing to ponds 
     222   REAL(wp), PUBLIC ::   rn_pnd_flush     !: Pond flushing efficiency (tuning parameter) 
    215223   LOGICAL , PUBLIC ::   ln_pnd_CST       !: Melt ponds scheme with constant fraction and depth 
    216224   REAL(wp), PUBLIC ::   rn_apnd          !: prescribed pond fraction (0<rn_apnd<1) 
    … …  
    345353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   om_i          !: mean ice age over all categories                        (s) 
    346354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   tau_icebfr    !: ice friction on ocean bottom (landfast param activated) 
     355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   icb_mask      !: mask of grounded icebergs if landfast [0-1] 
    347356 
    348357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s           !: Snow temperatures     [K] 
    … …  
    366375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   vt_il         !: total melt pond lid volume per gridcell area [m] 
    367376 
     377   ! meltwater arrays to save for melt ponds (mv - could be grouped in a single meltwater volume array) 
     378   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   dh_i_sum_2d   !: surface melt (2d arrays for ponds)       [m] 
     379   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   dh_s_mlt_2d   !: snow surf melt (2d arrays for ponds)     [m] 
     380 
    368381   !!---------------------------------------------------------------------- 
    369382   !! * Global variables at before time step 
    370383   !!---------------------------------------------------------------------- 
    371384   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 
     385   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_ip_b, v_il_b             !: ponds and lids volumes 
    372386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, sv_i_b              !: 
    373387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
    … …  
    396410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vsnw         !: snw volume variation   [m/s] 
    397411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_aice         !: ice conc.  variation   [s-1] 
     412   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_vpnd         !: pond volume variation  [m/s] 
    398413   ! 
    399414   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   diag_adv_mass     !: advection of mass (kg/m2/s) 
    … …  
    473488         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) ,  & 
    474489         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,  & 
    475          &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj)            , STAT=ierr(ii) ) 
     490         &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj), icb_mask(jpi,jpj), STAT=ierr(ii) ) 
    476491 
    477492      ii = ii + 1 
    … …  
    483498      ii = ii + 1 
    484499      ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , h_ip(jpi,jpj,jpl),  & 
    485          &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) , STAT = ierr(ii) ) 
     500         &      v_il(jpi,jpj,jpl) , h_il(jpi,jpj,jpl) , a_ip_eff (jpi,jpj,jpl) ,                     & 
     501         &      dh_i_sum_2d(jpi,jpj,jpl) , dh_s_mlt_2d(jpi,jpj,jpl) , STAT = ierr(ii) ) 
    486502 
    487503      ii = ii + 1 
    … …  
    491507      ii = ii + 1 
    492508      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),         & 
     509         &      v_ip_b(jpi,jpj,jpl) , v_il_b(jpi,jpj,jpl) ,                                                         & 
    493510         &      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) , & 
    494511         &      STAT=ierr(ii) ) 
    … …  
    505522      ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj),                      & 
    506523         &      diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat  (jpi,jpj),                      & 
    507          &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), diag_aice(jpi,jpj), & 
     524         &      diag_sice  (jpi,jpj) , diag_vice   (jpi,jpj) , diag_vsnw  (jpi,jpj), diag_aice(jpi,jpj), diag_vpnd(jpi,jpj), & 
    508525         &      diag_adv_mass(jpi,jpj), diag_adv_salt(jpi,jpj), diag_adv_heat(jpi,jpj), STAT=ierr(ii) ) 
    509526 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icectl.F90

    r13601 r14021  
    1212   !!   'key_si3'                                       SI3 sea-ice model 
    1313   !!---------------------------------------------------------------------- 
    14    !!    ice_cons_hsm     : conservation tests on heat, salt and mass during a  time step (global)  
     14   !!    ice_cons_hsm     : conservation tests on heat, salt and mass during a  time step (global) 
    1515   !!    ice_cons_final   : conservation tests on heat, salt and mass at end of time step (global) 
    1616   !!    ice_cons2D       : conservation tests on heat, salt and mass at each gridcell 
    … …  
    5555   CHARACTER(LEN=50)   ::   clname="icedrift_diagnostics.ascii"   ! ascii filename 
    5656   INTEGER             ::   numicedrift                           ! outfile unit 
    57    REAL(wp)            ::   rdiag_icemass, rdiag_icesalt, rdiag_iceheat  
    58    REAL(wp)            ::   rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat  
    59     
     57   REAL(wp)            ::   rdiag_icemass, rdiag_icesalt, rdiag_iceheat 
     58   REAL(wp)            ::   rdiag_adv_icemass, rdiag_adv_icesalt, rdiag_adv_iceheat 
     59 
    6060   !! * Substitutions 
    6161#  include "do_loop_substitute.h90" 
    … …  
    7777      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    7878      !!              The thresholds (zchk_m, zchk_s, zchk_t) determine violations 
    79       !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    80       !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
     79      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
     80      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
    8181      !!------------------------------------------------------------------- 
    8282      INTEGER         , INTENT(in)    ::   icount        ! called at: =0 the begining of the routine, =1  the end 
    … …  
    8585      !! 
    8686      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
    87          &          zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin 
     87         &          zdiag_vimin, zdiag_vsmin, zdiag_vpmin, zdiag_vlmin, zdiag_aimin, zdiag_aimax, & 
     88         &          zdiag_eimin, zdiag_esmin, zdiag_simin 
    8889      REAL(wp) ::   zvtrp, zetrp 
    8990      REAL(wp) ::   zarea 
    … …  
    9293      IF( icount == 0 ) THEN 
    9394 
    94          pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) 
     95         pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ) 
    9596         pdiag_s = glob_sum( 'icectl',   SUM( sv_i * rhoi            , dim=3 ) * e1e2t ) 
    9697         pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 
    … …  
    112113 
    113114         ! -- mass diag -- ! 
    114          zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_Dt_ice       & 
     115         zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t )      & 
     116            &            - pdiag_v ) * r1_Dt_ice                                                                          & 
    115117            &         + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn +       & 
    116118            &                                 wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 
    … …  
    132134 
    133135         ! -- min/max diag -- ! 
    134          zdiag_amax  = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
    135          zdiag_vmin  = glob_min( 'icectl', v_i ) 
    136          zdiag_amin  = glob_min( 'icectl', a_i ) 
    137          zdiag_smin  = glob_min( 'icectl', sv_i ) 
     136         zdiag_aimax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
     137         zdiag_vimin = glob_min( 'icectl', v_i  ) 
     138         zdiag_vsmin = glob_min( 'icectl', v_s  ) 
     139         zdiag_vpmin = glob_min( 'icectl', v_ip ) 
     140         zdiag_vlmin = glob_min( 'icectl', v_il ) 
     141         zdiag_aimin = glob_min( 'icectl', a_i  ) 
     142         zdiag_simin = glob_min( 'icectl', sv_i ) 
    138143         zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 
    139144         zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 
    … …  
    143148         zetrp = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
    144149 
    145          ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     150         ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
    146151         zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
    147152 
    … …  
    155160               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
    156161            ! check negative values 
    157             IF( zdiag_vmin  < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i < 0         = ',zdiag_vmin 
    158             IF( zdiag_amin  < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i < 0         = ',zdiag_amin 
    159             IF( zdiag_smin  < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i < 0         = ',zdiag_smin 
    160             IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i < 0         = ',zdiag_eimin 
    161             IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s < 0         = ',zdiag_esmin 
     162            IF( zdiag_vimin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i  < 0        = ',zdiag_vimin 
     163            IF( zdiag_vsmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_s  < 0        = ',zdiag_vsmin 
     164            IF( zdiag_vpmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_ip < 0        = ',zdiag_vpmin 
     165            IF( zdiag_vlmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_il < 0        = ',zdiag_vlmin 
     166            IF( zdiag_aimin < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i  < 0        = ',zdiag_aimin 
     167            IF( zdiag_simin < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i  < 0        = ',zdiag_simin 
     168            IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i  < 0        = ',zdiag_eimin 
     169            IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s  < 0        = ',zdiag_esmin 
    162170            ! check maximum ice concentration 
    163             IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
    164                &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_amax 
     171            IF( zdiag_aimax>MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
     172               &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_aimax 
    165173            ! check if advection scheme is conservative 
    166174            IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    167                &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rdt_ice 
     175               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 
    168176            IF( ABS(zetrp) > zchk_t * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    169                &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rdt_ice 
     177               &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rDt_ice 
    170178         ENDIF 
    171179         ! 
    … …  
    183191      !!              It prints in ocean.output if there is a violation of conservation at each time-step 
    184192      !!              The thresholds (zchk_m, zchk_s, zchk_t) determine the violations 
    185       !!              For salt and heat thresholds, ice is considered to have a salinity of 10  
    186       !!              and a heat content of 3e5 J/kg (=latent heat of fusion)  
     193      !!              For salt and heat thresholds, ice is considered to have a salinity of 10 
     194      !!              and a heat content of 3e5 J/kg (=latent heat of fusion) 
    187195      !!------------------------------------------------------------------- 
    188196      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
    … …  
    193201      ! water flux 
    194202      ! -- mass diag -- ! 
    195       zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
    196          &                              + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) 
     203      zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr   + wfx_sub + wfx_pnd & 
     204         &                              + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) 
    197205 
    198206      ! -- salt diag -- ! 
    … …  
    200208 
    201209      ! -- heat diag -- ! 
    202       zdiag_heat  = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     210      zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
    203211      ! equivalent to this: 
    204212      !!zdiag_heat = glob_sum( 'icectl', ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 
    … …  
    206214      !!   &                                          ) * e1e2t ) 
    207215 
    208       ! ice area (+epsi10 to set a threshold > 0 when there is no ice)  
     216      ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
    209217      zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
    210218 
    … …  
    235243      !! 
    236244      REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
    237          &                              zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax   
     245         &                              zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax 
    238246      INTEGER ::   jl, jk 
    239247      LOGICAL ::   ll_stop_m = .FALSE. 
    … …  
    245253      IF( icount == 0 ) THEN 
    246254 
    247          pdiag_v = SUM( v_i  * rhoi + v_s * rhos, dim=3 ) 
    248          pdiag_s = SUM( sv_i * rhoi             , dim=3 ) 
     255         pdiag_v = SUM( v_i  * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) 
     256         pdiag_s = SUM( sv_i * rhoi , dim=3 ) 
    249257         pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) 
    250258 
    … …  
    253261            &       wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr 
    254262         ! salt flux 
    255          pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam  
     263         pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam 
    256264         ! heat flux 
    257          pdiag_ft =   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  &  
     265         pdiag_ft =   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  & 
    258266            &       - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr 
    259267 
    … …  
    261269 
    262270         ! -- mass diag -- ! 
    263          zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_Dt_ice                             & 
     271         zdiag_mass =   ( SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) - pdiag_v ) * r1_Dt_ice    & 
    264272            &         + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
    265273            &             wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr )           & 
    … …  
    275283         ! -- heat diag -- ! 
    276284         zdiag_heat =   ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_Dt_ice & 
    277             &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                &  
     285            &         + (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                                & 
    278286            &            - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr )                                        & 
    279287            &         - pdiag_ft 
    … …  
    316324         IF( ll_stop_s )   CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' ) 
    317325         IF( ll_stop_t )   CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' ) 
    318           
     326 
    319327      ENDIF 
    320328 
    … …  
    324332      !!--------------------------------------------------------------------- 
    325333      !!                 ***  ROUTINE ice_cons_wri  *** 
    326       !!         
    327       !! ** Purpose :   create a NetCDF file named cdfile_name which contains  
     334      !! 
     335      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
    328336      !!                the instantaneous fields when conservation issue occurs 
    329337      !! 
    … …  
    332340      CHARACTER(len=*), INTENT( in ) ::   cdfile_name      ! name of the file created 
    333341      REAL(wp), DIMENSION(:,:), INTENT( in ) ::   pdiag_mass, pdiag_salt, pdiag_heat, & 
    334          &                                        pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax   
     342         &                                        pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax 
    335343      !! 
    336344      INTEGER ::   inum 
    337345      !!---------------------------------------------------------------------- 
    338       !  
     346      ! 
    339347      IF(lwp) WRITE(numout,*) 
    340348      IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state' 
    341349      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  named :', cdfile_name, '...nc' 
    342       IF(lwp) WRITE(numout,*)                 
     350      IF(lwp) WRITE(numout,*) 
    343351 
    344352      CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 
    345        
     353 
    346354      CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 )    ! ice mass spurious lost/gain 
    347355      CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 )    ! ice salt spurious lost/gain 
    348356      CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 )    ! ice heat spurious lost/gain 
    349357      ! other diags 
    350       CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 )    !  
    351       CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 )    !  
    352       CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    !  
    353       CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    !  
    354        
     358      CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 )    ! 
     359      CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 )    ! 
     360      CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 )    ! 
     361      CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 )    ! 
     362      ! mean state 
     363      CALL iom_rstput( 0, 0, inum, 'icecon'    , SUM(a_i ,dim=3) , ktype = jp_r8 )    ! 
     364      CALL iom_rstput( 0, 0, inum, 'icevol'    , SUM(v_i ,dim=3) , ktype = jp_r8 )    ! 
     365      CALL iom_rstput( 0, 0, inum, 'snwvol'    , SUM(v_s ,dim=3) , ktype = jp_r8 )    ! 
     366      CALL iom_rstput( 0, 0, inum, 'pndvol'    , SUM(v_ip,dim=3) , ktype = jp_r8 )    ! 
     367      CALL iom_rstput( 0, 0, inum, 'lidvol'    , SUM(v_il,dim=3) , ktype = jp_r8 )    ! 
     368 
    355369      CALL iom_close( inum ) 
    356370 
    357371   END SUBROUTINE ice_cons_wri 
    358     
     372 
    359373   SUBROUTINE ice_ctl( kt ) 
    360374      !!------------------------------------------------------------------- 
    361       !!                   ***  ROUTINE ice_ctl ***  
    362       !!                  
     375      !!                   ***  ROUTINE ice_ctl *** 
     376      !! 
    363377      !! ** Purpose :   control checks 
    364378      !!------------------------------------------------------------------- 
    … …  
    372386      inb_alp(:) = 0 
    373387      ialert_id = 0 
    374        
     388 
    375389      ! Alert if very high salinity 
    376390      ialert_id = ialert_id + 1 ! reference number of this alert 
    … …  
    416430         END_3D 
    417431      END DO 
    418    
     432 
    419433      ! Alert if very warm ice 
    420434      ialert_id = ialert_id + 1 ! reference number of this alert 
    … …  
    430444         END_3D 
    431445      END DO 
    432        
     446 
    433447      ! Alerte if very thick ice 
    434448      ialert_id = ialert_id + 1 ! reference number of this alert 
    435449      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
    436       jl = jpl  
     450      jl = jpl 
    437451      DO_2D( 1, 1, 1, 1 ) 
    438452         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
    … …  
    446460      ialert_id = ialert_id + 1 ! reference number of this alert 
    447461      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
    448       jl = 1  
     462      jl = 1 
    449463      DO_2D( 1, 1, 1, 1 ) 
    450464         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
    … …  
    470484      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
    471485      DO_2D( 1, 1, 1, 1 ) 
    472          IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN  
     486         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 
    473487            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
    474488            WRITE(numout,*) ' at i,j = ',ji,jj 
    … …  
    482496      DO_2D( 1, 1, 1, 1 ) 
    483497         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
    484             & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN  
     498            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 
    485499            WRITE(numout,*) ' ALERTE :   Incompatible ice conc and vol ',at_i(ji,jj),vt_i(ji,jj) 
    486500            WRITE(numout,*) ' at i,j = ',ji,jj 
    … …  
    506520     ! 
    507521   END SUBROUTINE ice_ctl 
    508   
     522 
    509523   SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 ) 
    510524      !!------------------------------------------------------------------- 
    511       !!                   ***  ROUTINE ice_prt ***  
    512       !!                  
    513       !! ** Purpose :   Writes global ice state on the (i,j) point  
    514       !!                in ocean.ouput  
    515       !!                3 possibilities exist  
     525      !!                   ***  ROUTINE ice_prt *** 
     526      !! 
     527      !! ** Purpose :   Writes global ice state on the (i,j) point 
     528      !!                in ocean.ouput 
     529      !!                3 possibilities exist 
    516530      !!                n = 1/-1 -> simple ice state 
    517531      !!                n = 2    -> exhaustive state 
    518532      !!                n = 3    -> ice/ocean salt fluxes 
    519533      !! 
    520       !! ** input   :   point coordinates (i,j)  
     534      !! ** input   :   point coordinates (i,j) 
    521535      !!                n : number of the option 
    522536      !!------------------------------------------------------------------- 
    … …  
    536550            !  Simple state 
    537551            !---------------- 
    538              
     552 
    539553            IF ( kn == 1 .OR. kn == -1 ) THEN 
    540554               WRITE(numout,*) ' ice_prt - Point : ',ji,jj 
    … …  
    552566               WRITE(numout,*) ' - Cell values ' 
    553567               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    554                WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    555                WRITE(numout,*) ' ato_i         : ', ato_i(ji,jj)        
    556                WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    557                WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)        
     568               WRITE(numout,*) ' at_i          : ', at_i(ji,jj) 
     569               WRITE(numout,*) ' ato_i         : ', ato_i(ji,jj) 
     570               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj) 
     571               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj) 
    558572               DO jl = 1, jpl 
    559573                  WRITE(numout,*) ' - Category (', jl,')' 
    … …  
    578592            !  Exhaustive state 
    579593            !-------------------- 
    580              
     594 
    581595            IF ( kn .EQ. 2 ) THEN 
    582596               WRITE(numout,*) ' ice_prt - Point : ',ji,jj 
    … …  
    584598               WRITE(numout,*) ' Exhaustive state ' 
    585599               WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj) 
    586                WRITE(numout,*)  
     600               WRITE(numout,*) 
    587601               WRITE(numout,*) ' - Cell values ' 
    588602               WRITE(numout,*) '   ~~~~~~~~~~~ ' 
    589                WRITE(numout,*) ' at_i          : ', at_i(ji,jj)        
    590                WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj)        
    591                WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj)        
     603               WRITE(numout,*) ' at_i          : ', at_i(ji,jj) 
     604               WRITE(numout,*) ' vt_i          : ', vt_i(ji,jj) 
     605               WRITE(numout,*) ' vt_s          : ', vt_s(ji,jj) 
    592606               WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ji-1,jj) 
    593607               WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ji,jj) 
    … …  
    596610               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    597611               WRITE(numout,*) 
    598                 
     612 
    599613               DO jl = 1, jpl 
    600614                  WRITE(numout,*) ' - Category (',jl,')' 
    601                   WRITE(numout,*) '   ~~~~~~~~         '  
     615                  WRITE(numout,*) '   ~~~~~~~~         ' 
    602616                  WRITE(numout,*) ' h_i        : ', h_i(ji,jj,jl)              , ' h_s        : ', h_s(ji,jj,jl) 
    603617                  WRITE(numout,*) ' t_i        : ', t_i(ji,jj,1:nlay_i,jl) 
    604618                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1:nlay_s,jl) 
    605619                  WRITE(numout,*) ' s_i        : ', s_i(ji,jj,jl)              , ' o_i        : ', o_i(ji,jj,jl) 
    606                   WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)    
    607                   WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)    
    608                   WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)   
    609                   WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl)  
    610                   WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl)   
    611                   WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    612                   WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl)    
     620                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl) 
     621                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl) 
     622                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl) 
     623                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)            , ' ei1        : ', e_i_b(ji,jj,1,jl) 
     624                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)            , ' ei2_b      : ', e_i_b(ji,jj,2,jl) 
     625                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl) 
     626                  WRITE(numout,*) ' sv_i       : ', sv_i(ji,jj,jl)             , ' sv_i_b     : ', sv_i_b(ji,jj,jl) 
    613627               END DO !jl 
    614                 
     628 
    615629               WRITE(numout,*) 
    616630               WRITE(numout,*) ' - Heat / FW fluxes ' 
    … …  
    620634               WRITE(numout,*) ' qns_ini       : ', (1._wp-at_i_b(ji,jj)) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) 
    621635               WRITE(numout,*) 
    622                WRITE(numout,*)  
    623                WRITE(numout,*) ' sst        : ', sst_m(ji,jj)   
    624                WRITE(numout,*) ' sss        : ', sss_m(ji,jj)   
    625                WRITE(numout,*)  
     636               WRITE(numout,*) 
     637               WRITE(numout,*) ' sst        : ', sst_m(ji,jj) 
     638               WRITE(numout,*) ' sss        : ', sss_m(ji,jj) 
     639               WRITE(numout,*) 
    626640               WRITE(numout,*) ' - Stresses ' 
    627641               WRITE(numout,*) '   ~~~~~~~~ ' 
    628                WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj)  
     642               WRITE(numout,*) ' utau_ice   : ', utau_ice(ji,jj) 
    629643               WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ji,jj) 
    630                WRITE(numout,*) ' utau       : ', utau    (ji,jj)  
     644               WRITE(numout,*) ' utau       : ', utau    (ji,jj) 
    631645               WRITE(numout,*) ' vtau       : ', vtau    (ji,jj) 
    632646            ENDIF 
    633              
     647 
    634648            !--------------------- 
    635649            ! Salt / heat fluxes 
    636650            !--------------------- 
    637              
     651 
    638652            IF ( kn .EQ. 3 ) THEN 
    639653               WRITE(numout,*) ' ice_prt - Point : ',ji,jj 
    … …  
    650664               WRITE(numout,*) ' qt_atm_oi    : ', qt_atm_oi(ji,jj) 
    651665               WRITE(numout,*) ' qt_oce_ai    : ', qt_oce_ai(ji,jj) 
    652                WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj)               
     666               WRITE(numout,*) ' dhc          : ', diag_heat(ji,jj) 
    653667               WRITE(numout,*) 
    654668               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 
    655669               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
    656670               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
    657                WRITE(numout,*) ' qsb_ice_bot  : ', qsb_ice_bot(ji,jj)  
     671               WRITE(numout,*) ' qsb_ice_bot  : ', qsb_ice_bot(ji,jj) 
    658672               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_Dt_ice 
    659673               WRITE(numout,*) 
    … …  
    666680               WRITE(numout,*) 
    667681               WRITE(numout,*) ' - Momentum fluxes ' 
    668                WRITE(numout,*) ' utau      : ', utau(ji,jj)  
     682               WRITE(numout,*) ' utau      : ', utau(ji,jj) 
    669683               WRITE(numout,*) ' vtau      : ', vtau(ji,jj) 
    670             ENDIF  
     684            ENDIF 
    671685            WRITE(numout,*) ' ' 
    672686            ! 
    … …  
    680694      !!                  ***  ROUTINE ice_prt3D *** 
    681695      !! 
    682       !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated  
     696      !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated 
    683697      !! 
    684698      !!------------------------------------------------------------------- 
    685699      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
    686700      INTEGER                      ::   jk, jl        ! dummy loop indices 
    687        
     701 
    688702      CALL prt_ctl_info(' ========== ') 
    689703      CALL prt_ctl_info( cd_routine ) 
    … …  
    704718      CALL prt_ctl(tab2d_1=delta_i    , clinfo1=' delta_i     :') 
    705719      CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    706         
     720 
    707721      DO jl = 1, jpl 
    708722         CALL prt_ctl_info(' ') 
    … …  
    721735         CALL prt_ctl(tab2d_1=sv_i       (:,:,jl)        , clinfo1= ' sv_i        : ') 
    722736         CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' oa_i        : ') 
    723           
     737 
    724738         DO jk = 1, nlay_i 
    725739            CALL prt_ctl_info(' - Layer : ', ivar=jk) 
    … …  
    728742         END DO 
    729743      END DO 
    730        
     744 
    731745      CALL prt_ctl_info(' ') 
    732746      CALL prt_ctl_info(' - Stresses : ') 
    … …  
    734748      CALL prt_ctl(tab2d_1=utau       , clinfo1= ' utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ') 
    735749      CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ') 
    736        
     750 
    737751   END SUBROUTINE ice_prt3D 
    738752 
    … …  
    776790      ! -- mass diag -- ! 
    777791      zdiag_mass     = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
    778          &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rdt_ice 
     792         &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rDt_ice 
    779793      zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rDt_ice 
    780794 
    781795      ! -- salt diag -- ! 
    782       zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rdt_ice * 1.e-3 
     796      zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rDt_ice * 1.e-3 
    783797      zdiag_adv_salt = glob_sum( 'icectl', diag_adv_salt * e1e2t ) * rDt_ice * 1.e-3 
    784798 
    … …  
    839853      !!---------------------------------------------------------------------- 
    840854      !!                  ***  ROUTINE ice_drift_init  *** 
    841       !!                    
     855      !! 
    842856      !! ** Purpose :   create output file, initialise arrays 
    843857      !!---------------------------------------------------------------------- 
    … …  
    865879      ! 
    866880   END SUBROUTINE ice_drift_init 
    867        
     881 
    868882#else 
    869883   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn.F90

    r13472 r14021  
    22   !!====================================================================== 
    33   !!                     ***  MODULE  icedyn  *** 
    4    !!   Sea-Ice dynamics : master routine for sea ice dynamics  
     4   !!   Sea-Ice dynamics : master routine for sea ice dynamics 
    55   !!====================================================================== 
    66   !! history :  4.0  ! 2018  (C. Rousset)  original code SI3 [aka Sea Ice cube] 
    … …  
    2929   USE lbclnk         ! lateral boundary conditions (or mpp links) 
    3030   USE timing         ! Timing 
     31   USE fldread        ! read input fields 
    3132 
    3233   IMPLICIT NONE 
    … …  
    3536   PUBLIC   ice_dyn        ! called by icestp.F90 
    3637   PUBLIC   ice_dyn_init   ! called by icestp.F90 
    37     
     38 
    3839   INTEGER ::              nice_dyn   ! choice of the type of dynamics 
    3940   !                                        ! associated indices: 
    4041   INTEGER, PARAMETER ::   np_dynALL     = 1   ! full ice dynamics               (rheology + advection + ridging/rafting + correction) 
    41    INTEGER, PARAMETER ::   np_dynRHGADV  = 2   ! pure dynamics                   (rheology + advection)  
     42   INTEGER, PARAMETER ::   np_dynRHGADV  = 2   ! pure dynamics                   (rheology + advection) 
    4243   INTEGER, PARAMETER ::   np_dynADV1D   = 3   ! only advection 1D - test case from Schar & Smolarkiewicz 1996 
    4344   INTEGER, PARAMETER ::   np_dynADV2D   = 4   ! only advection 2D w prescribed vel.(rn_uvice + advection) 
    … …  
    5051   REAL(wp) ::   rn_uice          !    prescribed u-vel (case np_dynADV1D & np_dynADV2D) 
    5152   REAL(wp) ::   rn_vice          !    prescribed v-vel (case np_dynADV1D & np_dynADV2D) 
    52     
     53 
     54   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_icbmsk   ! structure of input grounded icebergs mask (file informations, fields read) 
     55 
    5356   !! * Substitutions 
    5457#  include "do_loop_substitute.h90" 
    … …  
    6366      !!------------------------------------------------------------------- 
    6467      !!               ***  ROUTINE ice_dyn  *** 
    65       !!                
     68      !! 
    6669      !! ** Purpose :   this routine manages sea ice dynamics 
    6770      !! 
    … …  
    8184      ! 
    8285      ! controls 
    83       IF( ln_timing )   CALL timing_start('icedyn') 
     86      IF( ln_timing )   CALL timing_start('ice_dyn') 
    8487      ! 
    8588      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    8891         WRITE(numout,*)'~~~~~~~' 
    8992      ENDIF 
    90       !                       
     93      ! 
    9194      ! retrieve thickness from volume for landfast param. and UMx advection scheme 
    9295      WHERE( a_i(:,:,:) >= epsi20 ) 
    … …  
    106109      END WHERE 
    107110      ! 
     111      IF( ln_landfast_L16 ) THEN 
     112         CALL fld_read( kt, 1, sf_icbmsk ) 
     113         icb_mask(:,:) = sf_icbmsk(1)%fnow(:,:,1) 
     114      ENDIF 
    108115      ! 
    109116      SELECT CASE( nice_dyn )          !-- Set which dynamics is running 
    … …  
    111118      CASE ( np_dynALL )           !==  all dynamical processes  ==! 
    112119         ! 
    113          CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology   
     120         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology 
    114121         CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice 
    115          CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting  
     122         CALL ice_dyn_rdgrft( kt )                                          ! -- ridging/rafting 
    116123         CALL ice_cor       ( kt , 1 )                                      ! -- Corrections 
    117124         ! 
    118125      CASE ( np_dynRHGADV  )       !==  no ridge/raft & no corrections ==! 
    119126         ! 
    120          CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology   
     127         CALL ice_dyn_rhg   ( kt, Kmm )                                     ! -- rheology 
    121128         CALL ice_dyn_adv   ( kt )                                          ! -- advection of ice 
    122129         CALL Hpiling                                                       ! -- simple pile-up (replaces ridging/rafting) 
    … …  
    127134         ! --- monotonicity test from Schar & Smolarkiewicz 1996 --- ! 
    128135         ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 
    129          ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s  
     136         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 
    130137         DO_2D( 1, 1, 1, 1 ) 
    131138            zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp ) 
    … …  
    149156      ! 
    150157      ! 
    151       ! diagnostics: divergence at T points  
     158      ! diagnostics: divergence at T points 
    152159      IF( iom_use('icediv') ) THEN 
    153160         ! 
    … …  
    172179      ! 
    173180      ! controls 
    174       IF( ln_timing )   CALL timing_stop ('icedyn') 
     181      IF( ln_timing )   CALL timing_stop ('ice_dyn') 
    175182      ! 
    176183   END SUBROUTINE ice_dyn 
    … …  
    216223      !! ** input   :   Namelist namdyn 
    217224      !!------------------------------------------------------------------- 
    218       INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
     225      INTEGER ::   ios, ioptio, ierror   ! Local integer output status for namelist read 
     226      ! 
     227      CHARACTER(len=256) ::   cn_dir     ! Root directory for location of ice files 
     228      TYPE(FLD_N)        ::   sn_icbmsk  ! informations about the grounded icebergs field to be read 
    219229      !! 
    220230      NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  & 
    221231         &             rn_ishlat ,                                                           & 
    222          &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile 
     232         &             ln_landfast_L16, rn_lf_depfra, rn_lf_bfr, rn_lf_relax, rn_lf_tensile, & 
     233         &             sn_icbmsk, cn_dir 
    223234      !!------------------------------------------------------------------- 
    224235      ! 
    … …  
    248259      ENDIF 
    249260      !                             !== set the choice of ice dynamics ==! 
    250       ioptio = 0  
     261      ioptio = 0 
    251262      !      !--- full dynamics                               (rheology + advection + ridging/rafting + correction) 
    252263      IF( ln_dynALL    ) THEN   ;   ioptio = ioptio + 1   ;   nice_dyn = np_dynALL       ;   ENDIF 
    … …  
    269280      IF( .NOT.ln_landfast_L16 )   tau_icebfr(:,:) = 0._wp 
    270281      ! 
     282      !                                      !--- allocate and fill structure for grounded icebergs mask 
     283      IF( ln_landfast_L16 ) THEN 
     284         ALLOCATE( sf_icbmsk(1), STAT=ierror ) 
     285         IF( ierror > 0 ) THEN 
     286            CALL ctl_stop( 'ice_dyn_init: unable to allocate sf_icbmsk structure' ) ; RETURN 
     287         ENDIF 
     288         ! 
     289         CALL fld_fill( sf_icbmsk, (/ sn_icbmsk /), cn_dir, 'ice_dyn_init',   & 
     290            &                                               'landfast ice is a function of read grounded icebergs', 'icedyn' ) 
     291         ! 
     292         ALLOCATE( sf_icbmsk(1)%fnow(jpi,jpj,1) ) 
     293         IF( sf_icbmsk(1)%ln_tint )   ALLOCATE( sf_icbmsk(1)%fdta(jpi,jpj,1,2) ) 
     294         IF( TRIM(sf_icbmsk(1)%clrootname) == 'NOT USED' ) sf_icbmsk(1)%fnow(:,:,1) = 0._wp   ! not used field  (set to 0) 
     295      ELSE 
     296         icb_mask(:,:) = 0._wp 
     297      ENDIF 
     298      !                                      !--- other init 
    271299      CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters 
    272300      CALL ice_dyn_rhg_init             ! set ice rheology parameters 
    … …  
    279307   !!   Default option         Empty module           NO SI3 sea-ice model 
    280308   !!---------------------------------------------------------------------- 
    281 #endif  
     309#endif 
    282310 
    283311   !!====================================================================== 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_adv_pra.F90

    r14017 r14021  
    156156 
    157157         ! diagnostics 
    158          zdiag_adv_mass(:,:) =   SUM(  pv_i(:,:,:) , dim=3 ) * rhoi + SUM(  pv_s(:,:,:) , dim=3 ) * rhos 
     158         zdiag_adv_mass(:,:) =   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     159            &                  + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow 
    159160         zdiag_adv_salt(:,:) =   SUM( psv_i(:,:,:) , dim=3 ) * rhoi 
    160161         zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
    … …  
    178179               z0ei(:,:,jk,jl) = pe_i(:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    179180            END DO 
    180             IF ( ln_pnd_LEV ) THEN 
     181            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    181182               z0ap(:,:,jl) = pa_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond fraction 
    182183               z0vp(:,:,jl) = pv_ip(:,:,jl) * e1e2t(:,:)      ! Melt pond volume 
    … …  
    214215            END DO 
    215216            ! 
    216             IF ( ln_pnd_LEV ) THEN 
     217            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    217218               CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    218219               CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
    … …  
    249250                  &                                 sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 
    250251            END DO 
    251             IF ( ln_pnd_LEV ) THEN 
     252            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    252253               CALL adv_y( zdt , zvdx , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap )    !--- melt pond fraction 
    253254               CALL adv_x( zdt , zudy , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 
    … …  
    278279         CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei  , 'T', 1._wp, sxe   , 'T', -1._wp, sye   , 'T', -1._wp  & ! ice enthalpy 
    279280            &                                , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
    280          IF ( ln_pnd_LEV ) THEN 
     281         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    281282            CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
    282283               &                                , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
    … …  
    302303               pe_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    303304            END DO 
    304             IF ( ln_pnd_LEV ) THEN 
     305            IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    305306               pa_ip(:,:,jl) = z0ap(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    306307               pv_ip(:,:,jl) = z0vp(:,:,jl) * r1_e1e2t(:,:) * tmask(:,:,1) 
    … …  
    320321         ! 
    321322         ! --- diagnostics --- ! 
    322          diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 
     323         diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     324            &                                        + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow & 
    323325            &                                        - zdiag_adv_mass(:,:) ) * z1_dt 
    324326         diag_adv_salt(:,:) = diag_adv_salt(:,:) + (   SUM( psv_i(:,:,:) , dim=3 ) * rhoi & 
    … …  
    769771               !                               ! -- check h_ip -- ! 
    770772               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    771                IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     773               IF( ln_pnd_LEV .OR. ln_pnd_TOPO .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    772774                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    773775                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    10151017            END DO 
    10161018            ! 
    1017             IF( ln_pnd_LEV ) THEN                                    ! melt pond fraction 
     1019            IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN                                    ! melt pond fraction 
    10181020               IF( iom_varid( numrir, 'sxap', ldstop = .FALSE. ) > 0 ) THEN 
    10191021                  CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap , psgn = -1._wp ) 
    … …  
    10571059            sxc0  = 0._wp   ;   syc0  = 0._wp   ;   sxxc0  = 0._wp   ;   syyc0  = 0._wp   ;   sxyc0  = 0._wp      ! snow layers heat content 
    10581060            sxe   = 0._wp   ;   sye   = 0._wp   ;   sxxe   = 0._wp   ;   syye   = 0._wp   ;   sxye   = 0._wp      ! ice layers heat content 
    1059             IF( ln_pnd_LEV ) THEN 
     1061            IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    10601062               sxap = 0._wp ;   syap = 0._wp    ;   sxxap = 0._wp    ;   syyap = 0._wp    ;   sxyap = 0._wp       ! melt pond fraction 
    10611063               sxvp = 0._wp ;   syvp = 0._wp    ;   sxxvp = 0._wp    ;   syyvp = 0._wp    ;   sxyvp = 0._wp       ! melt pond volume 
    … …  
    11351137         END DO 
    11361138         ! 
    1137          IF( ln_pnd_LEV ) THEN                                       ! melt pond fraction 
     1139         IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN                                       ! melt pond fraction 
    11381140            CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap  ) 
    11391141            CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap  ) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_adv_umx.F90

    r13633 r14021  
    1414   !!   ultimate_x(_y)    : compute a tracer value at velocity points using ULTIMATE scheme at various orders 
    1515   !!   macho             : compute the fluxes 
    16    !!   nonosc_ice        : limit the fluxes using a non-oscillatory algorithm  
     16   !!   nonosc_ice        : limit the fluxes using a non-oscillatory algorithm 
    1717   !!---------------------------------------------------------------------- 
    1818   USE phycst         ! physical constant 
    … …  
    6363      !!---------------------------------------------------------------------- 
    6464      !!                  ***  ROUTINE ice_dyn_adv_umx  *** 
    65       !!  
    66       !! **  Purpose :   Compute the now trend due to total advection of  
     65      !! 
     66      !! **  Purpose :   Compute the now trend due to total advection of 
    6767      !!                 tracers and add it to the general trend of tracer equations 
    6868      !!                 using an "Ultimate-Macho" scheme 
    6969      !! 
    70       !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.  
     70      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    7171      !!---------------------------------------------------------------------- 
    7272      INTEGER                     , INTENT(in   ) ::   kn_umx     ! order of the scheme (1-5=UM or 20=CEN2) 
    … …  
    103103      REAL(wp), DIMENSION(jpi,jpj,nlay_s,jpl) ::   ze_s, zes_max 
    104104      ! 
    105       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs  
     105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 
    106106      !! diagnostics 
    107       REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat       
     107      REAL(wp), DIMENSION(jpi,jpj)            ::   zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 
    108108      !!---------------------------------------------------------------------- 
    109109      ! 
    … …  
    131131         ELSEWHERE                      ; ze_s(:,:,jk,:) = 0._wp 
    132132         END WHERE 
    133       END DO    
     133      END DO 
    134134      CALL icemax4D( ze_i , zei_max ) 
    135135      CALL icemax4D( ze_s , zes_max ) 
    … …  
    143143      zcflnow(1) =                  MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) ) 
    144144      zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) ) 
    145        
     145 
    146146      ! non-blocking global communication send zcflnow and receive zcflprv 
    147147      CALL mpp_delay_max( 'icedyn_adv_umx', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) 
    … …  
    157157      zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 
    158158      ! 
    159       ! setup transport for each ice cat  
     159      ! setup transport for each ice cat 
    160160      DO jl = 1, jpl 
    161161         zu_cat(:,:,jl) = zudy(:,:) 
    … …  
    182182 
    183183         ! diagnostics 
    184          zdiag_adv_mass(:,:) =   SUM(  pv_i(:,:,:) , dim=3 ) * rhoi + SUM(  pv_s(:,:,:) , dim=3 ) * rhos 
     184         zdiag_adv_mass(:,:) =   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     185            &                  + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow 
    185186         zdiag_adv_salt(:,:) =   SUM( psv_i(:,:,:) , dim=3 ) * rhoi 
    186187         zdiag_adv_heat(:,:) = - SUM(SUM( pe_i(:,:,1:nlay_i,:) , dim=4 ), dim=3 ) & 
    … …  
    189190         ! record at_i before advection (for open water) 
    190191         zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    191           
     192 
    192193         ! inverse of A and Ap 
    193194         WHERE( pa_i(:,:,:) >= epsi20 )   ;   z1_ai(:,:,:) = 1._wp / pa_i(:,:,:) 
    … …  
    200201         ! setup a mask where advection will be upstream 
    201202         IF( ll_neg ) THEN 
    202             IF( .NOT. ALLOCATED(imsk_small) )   ALLOCATE( imsk_small(jpi,jpj,jpl) )  
    203             IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) )  
     203            IF( .NOT. ALLOCATED(imsk_small) )   ALLOCATE( imsk_small(jpi,jpj,jpl) ) 
     204            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
    204205            DO jl = 1, jpl 
    205206               DO_2D( 1, 0, 1, 0 ) 
    … …  
    231232            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 
    232233               &                                      zhvar, pv_i, zua_ups, zva_ups ) 
    233             !== Snw volume ==!          
     234            !== Snw volume ==! 
    234235            zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 
    235236            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 
    … …  
    259260            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 
    260261               &                                      zhvar, pv_i, zua_ups, zva_ups ) 
    261             !== Snw volume ==!          
     262            !== Snw volume ==! 
    262263            zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 
    263264            CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 
    … …  
    315316                  &                                      zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups ) 
    316317            END DO 
    317             !== Snow volume ==!          
     318            !== Snow volume ==! 
    318319            zuv_ups = zua_ups 
    319320            zvv_ups = zva_ups 
    … …  
    338339         ! 
    339340         !== melt ponds ==! 
    340          IF ( ln_pnd_LEV ) THEN 
     341         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    341342            ! concentration 
    342343            zamsk = 1._wp 
    … …  
    358359 
    359360         ! --- Lateral boundary conditions --- ! 
    360          IF    ( ln_pnd_LEV .AND. ln_pnd_lids ) THEN 
     361         IF    ( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. ln_pnd_lids ) THEN 
    361362            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
    362363               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 
    363          ELSEIF( ln_pnd_LEV .AND. .NOT.ln_pnd_lids ) THEN 
     364         ELSEIF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. .NOT.ln_pnd_lids ) THEN 
    364365            CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 
    365366               &                                , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 
    … …  
    373374         zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 
    374375         DO_2D( 0, 0, 0, 0 ) 
    375             pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) &  
     376            pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 
    376377               &                          - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 
    377378         END_2D 
    … …  
    379380         ! 
    380381         ! --- diagnostics --- ! 
    381          diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i(:,:,:) , dim=3 ) * rhoi + SUM( pv_s(:,:,:) , dim=3 ) * rhos & 
     382         diag_adv_mass(:,:) = diag_adv_mass(:,:) + (   SUM( pv_i (:,:,:) , dim=3 ) * rhoi + SUM( pv_s (:,:,:) , dim=3 ) * rhos & 
     383            &                                        + SUM( pv_ip(:,:,:) , dim=3 ) * rhow + SUM( pv_il(:,:,:) , dim=3 ) * rhow & 
    382384            &                                        - zdiag_adv_mass(:,:) ) * z1_dt 
    383385         diag_adv_salt(:,:) = diag_adv_salt(:,:) + (   SUM( psv_i(:,:,:) , dim=3 ) * rhoi & 
    … …  
    404406   END SUBROUTINE ice_dyn_adv_umx 
    405407 
    406     
     408 
    407409   SUBROUTINE adv_umx( pamsk, kn_umx, jt, kt, pdt, pu, pv, puc, pvc, pubox, pvbox,  & 
    408410      &                                            pt, ptc, pua_ups, pva_ups, pua_ho, pva_ho ) 
    409411      !!---------------------------------------------------------------------- 
    410412      !!                  ***  ROUTINE adv_umx  *** 
    411       !!  
    412       !! **  Purpose :   Compute the now trend due to total advection of  
     413      !! 
     414      !! **  Purpose :   Compute the now trend due to total advection of 
    413415      !!                 tracers and add it to the general trend of tracer equations 
    414416      !! 
    … …  
    432434      !! 
    433435      !!             in eq. c), one can solve the equation for  S (ln_advS=T), then dVS/dt = -div(uV * uS  / u) 
    434       !!                                                or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u)  
     436      !!                                                or for HS (ln_advS=F), then dVS/dt = -div(uA * uHS / u) 
    435437      !! 
    436438      !! ** Note : - this method can lead to tiny negative V (-1.e-20) => set it to 0 while conserving mass etc. 
    … …  
    460462      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out), OPTIONAL ::   pua_ho, pva_ho   ! high order u*a fluxes 
    461463      ! 
    462       INTEGER  ::   ji, jj, jl       ! dummy loop indices   
     464      INTEGER  ::   ji, jj, jl       ! dummy loop indices 
    463465      REAL(wp) ::   ztra             ! local scalar 
    464466      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zfu_ho , zfv_ho , zpt 
    … …  
    466468      !!---------------------------------------------------------------------- 
    467469      ! 
    468       ! Upstream (_ups) fluxes  
     470      ! Upstream (_ups) fluxes 
    469471      ! ----------------------- 
    470472      CALL upstream( pamsk, jt, kt, pdt, pt, pu, pv, zt_ups, zfu_ups, zfv_ups ) 
    471        
    472       ! High order (_ho) fluxes  
     473 
     474      ! High order (_ho) fluxes 
    473475      ! ----------------------- 
    474476      SELECT CASE( kn_umx ) 
    … …  
    504506                  zfv_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) * pva_ups(ji,jj,jl) / pv(ji,jj) 
    505507               ELSE 
    506                   zfv_ho (ji,jj,jl) = 0._wp   
    507                   zfv_ups(ji,jj,jl) = 0._wp   
     508                  zfv_ho (ji,jj,jl) = 0._wp 
     509                  zfv_ups(ji,jj,jl) = 0._wp 
    508510               ENDIF 
    509511            END_2D 
    … …  
    549551      DO jl = 1, jpl 
    550552         DO_2D( 0, 0, 0, 0 ) 
    551             ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) )   
    552             ! 
    553             ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1)                
     553            ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 
     554            ! 
     555            ptc(ji,jj,jl) = ( ptc(ji,jj,jl) + ztra * r1_e1e2t(ji,jj) * pdt ) * tmask(ji,jj,1) 
    554556         END_2D 
    555557      END DO 
    … …  
    561563      !!--------------------------------------------------------------------- 
    562564      !!                    ***  ROUTINE upstream  *** 
    563       !!      
     565      !! 
    564566      !! **  Purpose :   compute the upstream fluxes and upstream guess of tracer 
    565567      !!---------------------------------------------------------------------- 
    … …  
    570572      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt               ! tracer fields 
    571573      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
    572       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_ups           ! upstream guess of tracer  
    573       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ups, pfv_ups ! upstream fluxes  
     574      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_ups           ! upstream guess of tracer 
     575      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ups, pfv_ups ! upstream fluxes 
    574576      ! 
    575577      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    … …  
    636638            ! 
    637639         ENDIF 
    638           
     640 
    639641      ENDIF 
    640642      ! 
    … …  
    653655   END SUBROUTINE upstream 
    654656 
    655     
     657 
    656658   SUBROUTINE cen2( pamsk, jt, kt, pdt, pt, pu, pv, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
    657659      !!--------------------------------------------------------------------- 
    658660      !!                    ***  ROUTINE cen2  *** 
    659       !!      
     661      !! 
    660662      !! **  Purpose :   compute the high order fluxes using a centered 
    661       !!                 second order scheme  
     663      !!                 second order scheme 
    662664      !!---------------------------------------------------------------------- 
    663665      REAL(wp)                        , INTENT(in   ) ::   pamsk            ! advection of concentration (1) or other tracers (0) 
    … …  
    667669      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt               ! tracer fields 
    668670      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
    669       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer  
    670       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes  
    671       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes  
     671      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer 
     672      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes 
     673      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes 
    672674      ! 
    673675      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    … …  
    748750         ENDIF 
    749751         IF( np_limiter == 1 )   CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
    750           
     752 
    751753      ENDIF 
    752     
     754 
    753755   END SUBROUTINE cen2 
    754756 
    755     
     757 
    756758   SUBROUTINE macho( pamsk, kn_umx, jt, kt, pdt, pt, pu, pv, pubox, pvbox, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
    757759      !!--------------------------------------------------------------------- 
    758760      !!                    ***  ROUTINE macho  *** 
    759       !!      
    760       !! **  Purpose :   compute the high order fluxes using Ultimate-Macho scheme   
     761      !! 
     762      !! **  Purpose :   compute the high order fluxes using Ultimate-Macho scheme 
    761763      !! 
    762764      !! **  Method  :   ... 
    763765      !! 
    764       !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.  
     766      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    765767      !!---------------------------------------------------------------------- 
    766768      REAL(wp)                        , INTENT(in   ) ::   pamsk            ! advection of concentration (1) or other tracers (0) 
    … …  
    772774      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
    773775      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pubox, pvbox     ! upstream velocity 
    774       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer  
    775       REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes  
    776       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes  
     776      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt_ups           ! upstream guess of tracer 
     777      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pfu_ups, pfv_ups ! upstream fluxes 
     778      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho, pfv_ho   ! high order fluxes 
    777779      ! 
    778780      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    … …  
    805807         !                                                        !--  limiter in y --! 
    806808         IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 
    807          !          
     809         ! 
    808810         ! 
    809811      ELSE                                                               !==  even ice time step:  adv_y then adv_x  ==! 
    … …  
    819821                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
    820822                  &                                                                                        * pamsk           & 
    821                   &                             ) * pdt ) * tmask(ji,jj,1)  
     823                  &                             ) * pdt ) * tmask(ji,jj,1) 
    822824            END_2D 
    823825         END DO 
    … …  
    843845      !!--------------------------------------------------------------------- 
    844846      !!                    ***  ROUTINE ultimate_x  *** 
    845       !!      
    846       !! **  Purpose :   compute tracer at u-points  
     847      !! 
     848      !! **  Purpose :   compute tracer at u-points 
    847849      !! 
    848850      !! **  Method  :   ... 
    849851      !! 
    850       !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.  
     852      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    851853      !!---------------------------------------------------------------------- 
    852854      REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0) 
    … …  
    855857      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pu        ! ice i-velocity component 
    856858      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt        ! tracer fields 
    857       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_u      ! tracer at u-point  
    858       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho    ! high order flux  
     859      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_u      ! tracer at u-point 
     860      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfu_ho    ! high order flux 
    859861      ! 
    860862      INTEGER  ::   ji, jj, jl             ! dummy loop indices 
    … …  
    895897      ! 
    896898      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21) 
    897          !         
     899         ! 
    898900         DO jl = 1, jpl 
    899901            DO_2D( 0, 0, 1, 0 ) 
    … …  
    909911               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    910912               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    911                   &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) )  
    912             END_2D 
    913          END DO 
    914          !   
     913                  &                                                            - zcu   * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
     914            END_2D 
     915         END DO 
     916         ! 
    915917      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24) 
    916918         ! 
    … …  
    981983      ! 
    982984   END SUBROUTINE ultimate_x 
    983     
    984   
     985 
     986 
    985987   SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 
    986988      !!--------------------------------------------------------------------- 
    987989      !!                    ***  ROUTINE ultimate_y  *** 
    988       !!      
    989       !! **  Purpose :   compute tracer at v-points  
     990      !! 
     991      !! **  Purpose :   compute tracer at v-points 
    990992      !! 
    991993      !! **  Method  :   ... 
    992994      !! 
    993       !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74.  
     995      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    994996      !!---------------------------------------------------------------------- 
    995997      REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0) 
    … …  
    9981000      REAL(wp), DIMENSION(:,:  )      , INTENT(in   ) ::   pv        ! ice j-velocity component 
    9991001      REAL(wp), DIMENSION(:,:,:)      , INTENT(in   ) ::   pt        ! tracer fields 
    1000       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_v      ! tracer at v-point  
    1001       REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfv_ho    ! high order flux  
     1002      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pt_v      ! tracer at v-point 
     1003      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(  out) ::   pfv_ho    ! high order flux 
    10021004      ! 
    10031005      INTEGER  ::   ji, jj, jl         ! dummy loop indices 
    … …  
    11131115      ! 
    11141116   END SUBROUTINE ultimate_y 
    1115       
     1117 
    11161118 
    11171119   SUBROUTINE nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 
    11181120      !!--------------------------------------------------------------------- 
    11191121      !!                    ***  ROUTINE nonosc_ice  *** 
    1120       !!      
    1121       !! **  Purpose :   compute monotonic tracer fluxes from the upstream  
    1122       !!       scheme and the before field by a non-oscillatory algorithm  
     1122      !! 
     1123      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
     1124      !!       scheme and the before field by a non-oscillatory algorithm 
    11231125      !! 
    11241126      !! **  Method  :   ... 
    … …  
    11391141      !!---------------------------------------------------------------------- 
    11401142      zbig = 1.e+40_wp 
    1141        
     1143 
    11421144      ! antidiffusive flux : high order minus low order 
    11431145      ! -------------------------------------------------- 
    … …  
    11551157      !                                    pfu_ho 
    11561158      !                           *         ---> 
    1157       !                        |      |  *   |        |  
    1158       !                        |      |      |    *   |     
     1159      !                        |      |  *   |        | 
     1160      !                        |      |      |    *   | 
    11591161      !                        |      |      |        |    * 
    1160       !            t_ups :       i-1     i       i+1       i+2    
     1162      !            t_ups :       i-1     i       i+1       i+2 
    11611163      IF( ll_prelim ) THEN 
    1162           
     1164 
    11631165         DO jl = 1, jpl 
    11641166            DO_2D( 0, 0, 0, 0 ) 
    … …  
    11981200      z1_dt = 1._wp / pdt 
    11991201      DO jl = 1, jpl 
    1200           
     1202 
    12011203         DO_2D( 1, 1, 1, 1 ) 
    12021204            IF    ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 
    … …  
    12421244            ! if all the points are outside ice cover 
    12431245            IF( zup == -zbig )   zbetup(ji,jj,jl) = 0._wp ! zbig 
    1244             IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig             
     1246            IF( zdo ==  zbig )   zbetdo(ji,jj,jl) = 0._wp ! zbig 
    12451247            ! 
    12461248         END_2D 
    … …  
    12481250      CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    12491251 
    1250        
     1252 
    12511253      ! monotonic flux in the y direction 
    12521254      ! --------------------------------- 
    … …  
    12781280   END SUBROUTINE nonosc_ice 
    12791281 
    1280     
     1282 
    12811283   SUBROUTINE limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 
    12821284      !!--------------------------------------------------------------------- 
    12831285      !!                    ***  ROUTINE limiter_x  *** 
    1284       !!      
    1285       !! **  Purpose :   compute flux limiter  
     1286      !! 
     1287      !! **  Purpose :   compute flux limiter 
    12861288      !!---------------------------------------------------------------------- 
    12871289      REAL(wp)                  , INTENT(in   ) ::   pdt          ! tracer time-step 
    … …  
    12931295      REAL(wp) ::   Cr, Rjm, Rj, Rjp, uCFL, zpsi, zh3, zlimiter, Rr 
    12941296      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    1295       REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpx       ! tracer slopes  
     1297      REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpx       ! tracer slopes 
    12961298      !!---------------------------------------------------------------------- 
    12971299      ! 
    … …  
    13021304      END DO 
    13031305      CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
    1304        
     1306 
    13051307      DO jl = 1, jpl 
    13061308         DO_2D( 0, 0, 0, 0 ) 
    13071309            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
    1308              
     1310 
    13091311            Rjm = zslpx(ji-1,jj,jl) 
    13101312            Rj  = zslpx(ji  ,jj,jl) 
    … …  
    13171319               ENDIF 
    13181320 
    1319                zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)      
     1321               zh3 = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 
    13201322               IF( Rj > 0. ) THEN 
    13211323                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pu(ji,jj)),  & 
    … …  
    13691371   END SUBROUTINE limiter_x 
    13701372 
    1371     
     1373 
    13721374   SUBROUTINE limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 
    13731375      !!--------------------------------------------------------------------- 
    13741376      !!                    ***  ROUTINE limiter_y  *** 
    1375       !!      
    1376       !! **  Purpose :   compute flux limiter  
     1377      !! 
     1378      !! **  Purpose :   compute flux limiter 
    13771379      !!---------------------------------------------------------------------- 
    13781380      REAL(wp)                   , INTENT(in   ) ::   pdt          ! tracer time-step 
    … …  
    13841386      REAL(wp) ::   Cr, Rjm, Rj, Rjp, vCFL, zpsi, zh3, zlimiter, Rr 
    13851387      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    1386       REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpy       ! tracer slopes  
     1388      REAL(wp), DIMENSION (jpi,jpj,jpl) ::   zslpy       ! tracer slopes 
    13871389      !!---------------------------------------------------------------------- 
    13881390      ! 
    … …  
    14081410               ENDIF 
    14091411 
    1410                zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl)      
     1412               zh3 = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 
    14111413               IF( Rj > 0. ) THEN 
    14121414                  zlimiter =  MAX( 0., MIN( zh3, MAX(-Rr * 0.5 * ABS(pv(ji,jj)),  & 
    … …  
    14971499               !                               ! -- check h_ip -- ! 
    14981500               ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 
    1499                IF( ln_pnd_LEV .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
     1501               IF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 
    15001502                  zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 
    15011503                  IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 
    … …  
    15221524                  pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 
    15231525                  pv_s(ji,jj,jl)          = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 
    1524                ENDIF            
    1525                !                   
     1526               ENDIF 
     1527               ! 
    15261528               !                               ! -- check s_i -- ! 
    15271529               ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean 
    … …  
    15351537            ENDIF 
    15361538         END_2D 
    1537       END DO  
     1539      END DO 
    15381540      ! 
    15391541      !                                           ! -- check e_i/v_i -- ! 
    … …  
    16221624   SUBROUTINE icemax3D( pice , pmax ) 
    16231625      !!--------------------------------------------------------------------- 
    1624       !!                   ***  ROUTINE icemax3D ***                      
     1626      !!                   ***  ROUTINE icemax3D *** 
    16251627      !! ** Purpose :  compute the max of the 9 points around 
    16261628      !!---------------------------------------------------------------------- 
    … …  
    16311633      !!---------------------------------------------------------------------- 
    16321634      DO jl = 1, jpl 
    1633          DO jj = Njs0-1, Nje0+1     
     1635         DO jj = Njs0-1, Nje0+1 
    16341636            DO ji = Nis0, Nie0 
    16351637               zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 
    16361638            END DO 
    16371639         END DO 
    1638          DO jj = Njs0, Nje0     
     1640         DO jj = Njs0, Nje0 
    16391641            DO ji = Nis0, Nie0 
    16401642               pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    … …  
    16461648   SUBROUTINE icemax4D( pice , pmax ) 
    16471649      !!--------------------------------------------------------------------- 
    1648       !!                   ***  ROUTINE icemax4D ***                      
     1650      !!                   ***  ROUTINE icemax4D *** 
    16491651      !! ** Purpose :  compute the max of the 9 points around 
    16501652      !!---------------------------------------------------------------------- 
    … …  
    16571659      DO jl = 1, jpl 
    16581660         DO jk = 1, jlay 
    1659             DO jj = Njs0-1, Nje0+1     
     1661            DO jj = Njs0-1, Nje0+1 
    16601662               DO ji = Nis0, Nie0 
    16611663                  zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 
    16621664               END DO 
    16631665            END DO 
    1664             DO jj = Njs0, Nje0     
     1666            DO jj = Njs0, Nje0 
    16651667               DO ji = Nis0, Nie0 
    16661668                  pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rdgrft.F90

    r14017 r14021  
    186186            ! closing_net = rate at which open water area is removed + ice area removed by ridging 
    187187            !                                                        - ice area added in new ridges 
    188             IF( ln_rhg_EVP )  closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 
    189             IF( ln_rhg_EAP )  closing_net(ji) = zconv(ji) 
     188            IF( ln_rhg_EVP .OR. ln_rhg_VP ) & 
     189               &               closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 
     190            IF( ln_rhg_EAP )   closing_net(ji) = zconv(ji) 
    190191            ! 
    191192            IF( zdivu(ji) < 0._wp )   closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) )   ! make sure the closing rate is large enough 
    … …  
    578579               oirft2(ji) = oa_i_2d(ji,jl1)   * afrft * hi_hrft 
    579580 
    580                IF ( ln_pnd_LEV ) THEN 
     581               IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    581582                  aprdg1     = a_ip_2d(ji,jl1) * afrdg 
    582583                  aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) 
    … …  
    615616               sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1    - sirft(ji) 
    616617               oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1    - oirft1 
    617                IF ( ln_pnd_LEV ) THEN 
     618               IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    618619                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1    - aprft1 
    619620                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 
    … …  
    712713                  v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji)  +  & 
    713714                     &                                  vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 
    714                   IF ( ln_pnd_LEV ) THEN 
     715                  IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    715716                     v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + (   vprdg (ji) * rn_fpndrdg * fvol   (ji)   & 
    716717                        &                                   + vprft (ji) * rn_fpndrft * zswitch(ji)   ) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rhg.F90

    r14017 r14021  
    1818   USE icedyn_rhg_evp ! sea-ice: EVP rheology 
    1919   USE icedyn_rhg_eap ! sea-ice: EAP rheology 
     20   USE icedyn_rhg_vp  ! sea-ice: VP  rheology 
    2021   USE icectl         ! sea-ice: control prints 
    2122   ! 
    … …  
    3536   INTEGER, PARAMETER ::   np_rhgEVP = 1   ! EVP rheology 
    3637   INTEGER, PARAMETER ::   np_rhgEAP = 2   ! EAP rheology 
     38   INTEGER, PARAMETER ::   np_rhgVP  = 3   ! VP rheology 
    3739 
    38    ! ** namelist (namrhg) ** 
    3940   ! 
    4041   !!---------------------------------------------------------------------- 
    … …  
    7879         CALL ice_dyn_rhg_evp( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i ) 
    7980         ! 
     81         !                             !------------------------! 
     82      CASE( np_rhgVP  )                ! Viscous-Plastic        ! 
     83         !                             !------------------------! 
     84         CALL ice_dyn_rhg_vp ( kt, shear_i, divu_i, delta_i ) 
     85         ! 
    8086         !                             !----------------------------! 
    8187      CASE( np_rhgEAP )                ! Elasto-Anisotropic-Plastic ! 
    … …  
    8490      END SELECT 
    8591      ! 
    86       IF( lrst_ice ) THEN                       !* write EVP fields in the restart file 
    87          IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'WRITE', kt ) 
     92      IF( lrst_ice ) THEN 
     93         IF( ln_rhg_EVP )   CALL rhg_evp_rst( 'WRITE', kt ) !* write EVP fields in the restart file 
    8894         IF( ln_rhg_EAP )   CALL rhg_eap_rst( 'WRITE', kt ) !* write EAP fields in the restart file 
     95         ! MV note: no restart needed for VP as there is no time equation for stress tensor 
    8996      ENDIF 
    9097      ! 
    … …  
    113120      INTEGER ::   ios, ioptio   ! Local integer output status for namelist read 
    114121      !! 
    115       NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, ln_rhg_EAP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg 
     122      NAMELIST/namdyn_rhg/  ln_rhg_EVP, ln_aEVP, ln_rhg_EAP, rn_creepl, rn_ecc , nn_nevp, rn_relast, nn_rhg_chkcvg, &  !-- evp 
     123         &                  ln_rhg_VP, nn_vp_nout, nn_vp_ninn, nn_vp_chkcvg                                            !-- vp 
    116124      !!------------------------------------------------------------------- 
    117125      ! 
    … …  
    129137         WRITE(numout,*) '      rheology EVP (icedyn_rhg_evp)                        ln_rhg_EVP    = ', ln_rhg_EVP 
    130138         WRITE(numout,*) '         use adaptive EVP (aEVP)                           ln_aEVP       = ', ln_aEVP 
    131          WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl 
    132          WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc 
     139         WRITE(numout,*) '         creep limit                                       rn_creepl     = ', rn_creepl ! also used by vp 
     140         WRITE(numout,*) '         eccentricity of the elliptical yield curve        rn_ecc        = ', rn_ecc    ! also used by vp 
    133141         WRITE(numout,*) '         number of iterations for subcycling               nn_nevp       = ', nn_nevp 
    134142         WRITE(numout,*) '         ratio of elastic timescale over ice time step     rn_relast     = ', rn_relast 
    135          WRITE(numout,*) '      check convergence of rheology                        nn_rhg_chkcvg = ', nn_rhg_chkcvg 
    136          IF    ( nn_rhg_chkcvg == 0 ) THEN   ;   WRITE(numout,*) '         no check' 
    137          ELSEIF( nn_rhg_chkcvg == 1 ) THEN   ;   WRITE(numout,*) '         check cvg at the main time step' 
    138          ELSEIF( nn_rhg_chkcvg == 2 ) THEN   ;   WRITE(numout,*) '         check cvg at both main and rheology time steps' 
     143         WRITE(numout,*) '         check convergence of rheology                     nn_rhg_chkcvg = ', nn_rhg_chkcvg 
     144         WRITE(numout,*) '      rheology VP   (icedyn_rhg_VP)                        ln_rhg_VP     = ', ln_rhg_VP 
     145         WRITE(numout,*) '         number of outer iterations                        nn_vp_nout    = ', nn_vp_nout 
     146         WRITE(numout,*) '         number of inner iterations                        nn_vp_ninn    = ', nn_vp_ninn 
     147         WRITE(numout,*) '         iteration step for convergence check              nn_vp_chkcvg  = ', nn_vp_chkcvg 
     148         IF( ln_rhg_EVP ) THEN 
     149            IF    ( nn_rhg_chkcvg == 0 ) THEN   ;   WRITE(numout,*) '         no check cvg' 
     150            ELSEIF( nn_rhg_chkcvg == 1 ) THEN   ;   WRITE(numout,*) '         check cvg at the main time step' 
     151            ELSEIF( nn_rhg_chkcvg == 2 ) THEN   ;   WRITE(numout,*) '         check cvg at both main and rheology time steps' 
     152            ENDIF 
    139153         ENDIF 
    140154         WRITE(numout,*) '      rheology EAP (icedyn_rhg_eap)                        ln_rhg_EAP = ', ln_rhg_EAP 
    … …  
    145159      IF( ln_rhg_EVP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEVP    ;   ENDIF 
    146160      IF( ln_rhg_EAP ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgEAP    ;   ENDIF 
     161      IF( ln_rhg_VP  ) THEN   ;   ioptio = ioptio + 1   ;   nice_rhg = np_rhgVP     ;   ENDIF 
    147162      IF( ioptio /= 1 )   CALL ctl_stop( 'ice_dyn_rhg_init: choose one and only one ice rheology' ) 
    148163      ! 
    149164      IF( ln_rhg_EVP  )   CALL rhg_evp_rst( 'READ' )  !* read or initialize all required files 
    150165      IF( ln_rhg_EAP  )   CALL rhg_eap_rst( 'READ' )  !* read or initialize all required files 
     166      ! no restart for VP as there is no explicit time dependency in the equation 
    151167      ! 
    152168   END SUBROUTINE ice_dyn_rhg_init 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icedyn_rhg_evp.F90

    r14017 r14021  
    326326            zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    327327            ! ice-bottom stress at U points 
    328             zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) 
     328            zvCr = zaU(ji,jj) * rn_lf_depfra * hu(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 
    329329            ztaux_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    330330            ! ice-bottom stress at V points 
    331             zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) 
     331            zvCr = zaV(ji,jj) * rn_lf_depfra * hv(ji,jj,Kmm) * ( 1._wp - icb_mask(ji,jj) ) ! if grounded icebergs are read: ocean depth = 0 
    332332            ztauy_base(ji,jj) = - rn_lf_bfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    333333            ! ice_bottom stress at T points 
    334             zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) 
     334            zvCr = at_i(ji,jj) * rn_lf_depfra * ht(ji,jj) * ( 1._wp - icb_mask(ji,jj) )    ! if grounded icebergs are read: ocean depth = 0 
    335335            tau_icebfr(ji,jj) = - rn_lf_bfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    336336         END_2D 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/iceistate.F90

    r13472 r14021  
    1818   USE oce            ! dynamics and tracers variables 
    1919   USE dom_oce        ! ocean domain 
    20    USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd  
     20   USE sbc_oce , ONLY : sst_m, sss_m, ln_ice_embd 
    2121   USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b 
    2222   USE eosbn2         ! equation of state 
    … …  
    3636   USE agrif_oce 
    3737   USE agrif_ice 
    38    USE agrif_ice_interp  
    39 # endif    
     38   USE agrif_ice_interp 
     39# endif 
    4040 
    4141   IMPLICIT NONE 
    … …  
    8787      !! 
    8888      !! ** Method  :   This routine will put some ice where ocean 
    89       !!                is at the freezing point, then fill in ice  
    90       !!                state variables using prescribed initial  
    91       !!                values in the namelist             
     89      !!                is at the freezing point, then fill in ice 
     90      !!                state variables using prescribed initial 
     91      !!                values in the namelist 
    9292      !! 
    9393      !! ** Steps   :   1) Set initial surface and basal temperatures 
    … …  
    9999      !!              where there is no ice 
    100100      !!-------------------------------------------------------------------- 
    101       INTEGER, INTENT(in) :: kt            ! time step  
     101      INTEGER, INTENT(in) :: kt            ! time step 
    102102      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 
    103103      ! 
    … …  
    125125      ! basal temperature (considered at freezing point)   [Kelvin] 
    126126      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
    127       t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
     127      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) 
    128128      ! 
    129129      ! surface temperature and conductivity 
    … …  
    150150      e_i (:,:,:,:) = 0._wp 
    151151      e_s (:,:,:,:) = 0._wp 
    152        
     152 
    153153      ! general fields 
    154154      a_i (:,:,:) = 0._wp 
    … …  
    225225               IF( TRIM(si(jp_apd)%clrootname) == 'NOT USED' ) & 
    226226                  &     si(jp_apd)%fnow(:,:,1) = ( rn_apd_ini_n * zswitch + rn_apd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) & ! rn_apd = pond fraction => rn_apnd * a_i = pond conc. 
    227                   &                              * si(jp_ati)%fnow(:,:,1)  
     227                  &                              * si(jp_ati)%fnow(:,:,1) 
    228228               ! 
    229229               ! pond depth 
    … …  
    244244               ! 
    245245               ! change the switch for the following 
    246                WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1)  
     246               WHERE( zat_i_ini(:,:) > 0._wp )   ;   zswitch(:,:) = tmask(:,:,1) 
    247247               ELSEWHERE                         ;   zswitch(:,:) = 0._wp 
    248248               END WHERE 
    … …  
    252252               !                          !---------------! 
    253253               ! no ice if (sst - Tfreez) >= thresold 
    254                WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp  
     254               WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst )   ;   zswitch(:,:) = 0._wp 
    255255               ELSEWHERE                                                                    ;   zswitch(:,:) = tmask(:,:,1) 
    256256               END WHERE 
    … …  
    265265                  zt_su_ini(:,:) = rn_tsu_ini_n * zswitch(:,:) 
    266266                  ztm_s_ini(:,:) = rn_tms_ini_n * zswitch(:,:) 
    267                   zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc.  
     267                  zapnd_ini(:,:) = rn_apd_ini_n * zswitch(:,:) * zat_i_ini(:,:) ! rn_apd = pond fraction => rn_apd * a_i = pond conc. 
    268268                  zhpnd_ini(:,:) = rn_hpd_ini_n * zswitch(:,:) 
    269269                  zhlid_ini(:,:) = rn_hld_ini_n * zswitch(:,:) 
    … …  
    291291               zhlid_ini(:,:) = 0._wp 
    292292            ENDIF 
    293              
     293 
    294294            IF ( .NOT.ln_pnd_lids ) THEN 
    295295               zhlid_ini(:,:) = 0._wp 
    296296            ENDIF 
    297              
     297 
    298298            !----------------! 
    299299            ! 3) fill fields ! 
    … …  
    319319            CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d(1:npti)  , zhpnd_ini ) 
    320320            CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d(1:npti)  , zhlid_ini ) 
    321              
     321 
    322322            ! allocate temporary arrays 
    323323            ALLOCATE( zhi_2d (npti,jpl), zhs_2d (npti,jpl), zai_2d (npti,jpl), & 
    … …  
    373373            DO jl = 1, jpl 
    374374               DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    375                   t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
     375                  t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl) 
    376376                  ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
    377377                  e_i(ji,jj,jk,jl) = zswitch(ji,jj) * v_i(ji,jj,jl) * r1_nlay_i * & 
    … …  
    381381               END_3D 
    382382            END DO 
    383              
     383 
    384384#if  defined key_agrif 
    385385         ELSE 
    386   
     386 
    387387            Agrif_SpecialValue    = -9999. 
    388388            Agrif_UseSpecialValue = .TRUE. 
    … …  
    395395            use_sign_north = .FALSE. 
    396396            Agrif_UseSpecialValue = .FALSE. 
    397         ! lbc ????  
     397        ! lbc ???? 
    398398   ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, v_il, t_su, e_s, e_i 
    399399            CALL ice_var_glo2eqv 
    … …  
    409409         v_ip(:,:,:) = h_ip(:,:,:) * a_ip(:,:,:) 
    410410         v_il(:,:,:) = h_il(:,:,:) * a_ip(:,:,:) 
    411           
     411 
    412412         ! specific temperatures for coupled runs 
    413413         tn_ice(:,:,:) = t_su(:,:,:) 
    … …  
    426426      ! 4) Snow-ice mass (case ice is fully embedded) 
    427427      !---------------------------------------------- 
    428       snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s(:,:,:) + rhoi * v_i(:,:,:), dim=3  )   ! snow+ice mass 
     428      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s + rhoi * v_i + rhow * ( v_ip + v_il ), dim=3  )   ! snow+ice mass 
    429429      snwice_mass_b(:,:) = snwice_mass(:,:) 
    430430      ! 
    … …  
    487487      !!------------------------------------------------------------------- 
    488488      !!                   ***  ROUTINE ice_istate_init  *** 
    489       !!         
    490       !! ** Purpose :   Definition of initial state of the ice  
    491       !! 
    492       !! ** Method  :   Read the namini namelist and check the parameter  
     489      !! 
     490      !! ** Purpose :   Definition of initial state of the ice 
     491      !! 
     492      !! ** Method  :   Read the namini namelist and check the parameter 
    493493      !!              values called at the first timestep (nit000) 
    494494      !! 
    … …  
    531531         WRITE(numout,*) '      max ocean temp. above Tfreeze with initial ice   rn_thres_sst   = ', rn_thres_sst 
    532532         IF( ln_iceini .AND. nn_iceini_file == 0 ) THEN 
    533             WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s  
     533            WRITE(numout,*) '      initial snw thickness in the north-south         rn_hts_ini     = ', rn_hts_ini_n,rn_hts_ini_s 
    534534            WRITE(numout,*) '      initial ice thickness in the north-south         rn_hti_ini     = ', rn_hti_ini_n,rn_hti_ini_s 
    535535            WRITE(numout,*) '      initial ice concentr  in the north-south         rn_ati_ini     = ', rn_ati_ini_n,rn_ati_ini_s 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/iceitd.F90

    r13618 r14021  
    1818   !!---------------------------------------------------------------------- 
    1919   USE dom_oce        ! ocean domain 
    20    USE phycst         ! physical constants  
     20   USE phycst         ! physical constants 
    2121   USE ice1D          ! sea-ice: thermodynamic variables 
    2222   USE ice            ! sea-ice: variables 
    … …  
    2929   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    3030   USE prtctl         ! Print control 
     31   USE timing         ! Timing 
    3132 
    3233   IMPLICIT NONE 
    … …  
    6566      !!                after thermodynamic growth of ice thickness 
    6667      !! 
    67       !! ** Method  :   Linear remapping  
     68      !! ** Method  :   Linear remapping 
    6869      !! 
    6970      !! References :   W.H. Lipscomb, JGR 2001 
    7071      !!------------------------------------------------------------------ 
    71       INTEGER , INTENT (in) ::   kt      ! Ocean time step  
     72      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
    7273      ! 
    7374      INTEGER  ::   ji, jj, jl, jcat     ! dummy loop index 
    … …  
    7576      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars 
    7677      REAL(wp) ::   zx2, zwk2, zda0, zetamax           !   -      - 
    77       REAL(wp) ::   zx3         
     78      REAL(wp) ::   zx3 
    7879      REAL(wp) ::   zslope          ! used to compute local thermodynamic "speeds" 
    7980      ! 
    … …  
    8788      REAL(wp), DIMENSION(jpij,0:jpl) ::   zhbnew          ! new boundaries of ice categories 
    8889      !!------------------------------------------------------------------ 
    89  
    90       IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution'  
     90      IF( ln_timing )   CALL timing_start('iceitd_rem') 
     91 
     92      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution' 
    9193 
    9294      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    … …  
    105107         ENDIF 
    106108      END_2D 
    107        
     109 
    108110      !----------------------------------------------------------------------------------------------- 
    109111      !  2) Compute new category boundaries 
    … …  
    141143               ELSEIF( a_ib_2d(ji,jl) <= epsi10 .AND. a_ib_2d(ji,jl+1) >  epsi10 ) THEN   ! a(jl)=0 => Hn* = Hn + fn+1*dt 
    142144                  zhbnew(ji,jl) = hi_max(jl) + zdhice(ji,jl+1) 
    143                ELSE                                                                       ! a(jl+1) & a(jl) = 0  
     145               ELSE                                                                       ! a(jl+1) & a(jl) = 0 
    144146                  zhbnew(ji,jl) = hi_max(jl) 
    145147               ENDIF 
    146148               ! 
    147149               ! --- 2 conditions for remapping --- ! 
    148                ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi                
    149                !    Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible  
     150               ! 1) hn(t+1)+espi < Hn* < hn+1(t+1)-epsi 
     151               !    Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 
    150152               !          in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
    151153# if defined key_single 
    … …  
    157159# endif 
    158160               ! 
    159                ! 2) Hn-1 < Hn* < Hn+1   
     161               ! 2) Hn-1 < Hn* < Hn+1 
    160162               IF( zhbnew(ji,jl) < hi_max(jl-1) )   nptidx(ji) = 0 
    161163               IF( zhbnew(ji,jl) > hi_max(jl+1) )   nptidx(ji) = 0 
    … …  
    169171               zhbnew(ji,jpl) = MAX( hi_max(jpl-1), 3._wp * h_i_2d(ji,jpl) - 2._wp * zhbnew(ji,jpl-1) ) 
    170172            ELSE 
    171                zhbnew(ji,jpl) = hi_max(jpl)   
     173               zhbnew(ji,jpl) = hi_max(jpl) 
    172174            ENDIF 
    173175            ! 
    174176            ! --- 1 additional condition for remapping (1st category) --- ! 
    175             ! H0+epsi < h1(t) < H1-epsi  
    176             !    h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible  
     177            ! H0+epsi < h1(t) < H1-epsi 
     178            !    h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 
    177179            !    in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 
    178180# if defined key_single 
    … …  
    200202         ! 
    201203      ENDIF 
    202     
     204 
    203205      !----------------------------------------------------------------------------------------------- 
    204       !  4) Compute g(h)  
     206      !  4) Compute g(h) 
    205207      !----------------------------------------------------------------------------------------------- 
    206208      IF( npti > 0 ) THEN 
    207209         ! 
    208210         zhb0(:) = hi_max(0)   ;   zhb1(:) = hi_max(1) 
    209          g0(:,:) = 0._wp       ;   g1(:,:) = 0._wp  
    210          hL(:,:) = 0._wp       ;   hR(:,:) = 0._wp  
     211         g0(:,:) = 0._wp       ;   g1(:,:) = 0._wp 
     212         hL(:,:) = 0._wp       ;   hR(:,:) = 0._wp 
    211213         ! 
    212214         DO jl = 1, jpl 
    … …  
    218220            ! 
    219221            IF( jl == 1 ) THEN 
    220                !   
     222               ! 
    221223               ! --- g(h) for category 1 --- ! 
    222224               CALL itd_glinear( zhb0(1:npti)  , zhb1(1:npti)  , h_ib_1d(1:npti)  , a_i_1d(1:npti)  ,  &   ! in 
    … …  
    228230                  IF( a_i_1d(ji) > epsi10 ) THEN 
    229231                     ! 
    230                      zdh0 =  h_i_1d(ji) - h_ib_1d(ji)                 
     232                     zdh0 =  h_i_1d(ji) - h_ib_1d(ji) 
    231233                     IF( zdh0 < 0.0 ) THEN      ! remove area from category 1 
    232234                        zdh0 = MIN( -zdh0, hi_max(1) ) 
    … …  
    236238                        IF( zetamax > 0.0 ) THEN 
    237239                           zx1    = zetamax 
    238                            zx2    = 0.5 * zetamax * zetamax  
     240                           zx2    = 0.5 * zetamax * zetamax 
    239241                           zda0   = g1(ji,1) * zx2 + g0(ji,1) * zx1                ! ice area removed 
    240                            zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i                 
     242                           zdamax = a_i_1d(ji) * (1.0 - h_i_1d(ji) / h_ib_1d(ji) ) ! Constrain new thickness <= h_i 
    241243                           zda0   = MIN( zda0, zdamax )                            ! ice area lost due to melting of thin ice (zdamax > 0) 
    242244                           ! Remove area, conserving volume 
    … …  
    248250                     ELSE ! if ice accretion zdh0 > 0 
    249251                        ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1) 
    250                         zhbnew(ji,0) = MIN( zdh0, hi_max(1) )  
     252                        zhbnew(ji,0) = MIN( zdh0, hi_max(1) ) 
    251253                     ENDIF 
    252254                     ! 
    … …  
    261263            ENDIF ! jl=1 
    262264            ! 
    263             ! --- g(h) for each thickness category --- !   
     265            ! --- g(h) for each thickness category --- ! 
    264266            CALL itd_glinear( zhbnew(1:npti,jl-1), zhbnew(1:npti,jl), h_i_1d(1:npti)   , a_i_1d(1:npti)   ,  &   ! in 
    265267               &              g0    (1:npti,jl  ), g1    (1:npti,jl), hL    (1:npti,jl), hR    (1:npti,jl)   )   ! out 
    266268            ! 
    267269         END DO 
    268           
     270 
    269271         !----------------------------------------------------------------------------------------------- 
    270272         !  5) Compute area and volume to be shifted across each boundary (Eq. 18) 
    … …  
    276278               ! left and right integration limits in eta space 
    277279               IF (zhbnew(ji,jl) > hi_max(jl)) THEN ! Hn* > Hn => transfer from jl to jl+1 
    278                   zetamin = MAX( hi_max(jl)   , hL(ji,jl) ) - hL(ji,jl)   ! hi_max(jl) - hL  
     280                  zetamin = MAX( hi_max(jl)   , hL(ji,jl) ) - hL(ji,jl)   ! hi_max(jl) - hL 
    279281                  zetamax = MIN( zhbnew(ji,jl), hR(ji,jl) ) - hL(ji,jl)   ! hR - hL 
    280282                  jdonor(ji,jl) = jl 
    … …  
    299301            END DO 
    300302         END DO 
    301           
     303 
    302304         !---------------------------------------------------------------------------------------------- 
    303305         ! 6) Shift ice between categories 
    304306         !---------------------------------------------------------------------------------------------- 
    305307         CALL itd_shiftice ( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) 
    306           
     308 
    307309         !---------------------------------------------------------------------------------------------- 
    308310         ! 7) Make sure h_i >= minimum ice thickness hi_min 
    … …  
    314316         DO ji = 1, npti 
    315317            IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 
    316                a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin  
    317                IF( ln_pnd_LEV )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
     318               a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 
     319               IF( ln_pnd_LEV .OR. ln_pnd_TOPO )   a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 
    318320               h_i_1d(ji) = rn_himin 
    319321            ENDIF 
    … …  
    328330      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    329331      IF( ln_icediachk )   CALL ice_cons2D  (1, 'iceitd_rem',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
     332      IF( ln_timing    )   CALL timing_stop ('iceitd_rem') 
    330333      ! 
    331334   END SUBROUTINE ice_itd_rem 
    … …  
    381384            pg1(ji) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5_wp )   ! Eq. 14 
    382385            ! 
    383          ELSE  ! remap_flag = .false. or a_i < epsi10  
     386         ELSE  ! remap_flag = .false. or a_i < epsi10 
    384387            phL(ji) = 0._wp 
    385388            phR(ji) = 0._wp 
    … …  
    412415      REAL(wp), DIMENSION(jpij,nlay_s,jpl) ::   ze_s_2d 
    413416      !!------------------------------------------------------------------ 
    414           
     417 
    415418      CALL tab_3d_2d( npti, nptidx(1:npti), h_i_2d (1:npti,1:jpl), h_i  ) 
    416419      CALL tab_3d_2d( npti, nptidx(1:npti), a_i_2d (1:npti,1:jpl), a_i  ) 
    … …  
    442445         END DO 
    443446      END DO 
    444        
     447 
    445448      !------------------------------------------------------------------------------- 
    446449      ! 2) Transfer volume and energy between categories 
    … …  
    454457               ! 
    455458               IF ( jl1 == jl  ) THEN   ;   jl2 = jl1+1 
    456                ELSE                     ;   jl2 = jl  
     459               ELSE                     ;   jl2 = jl 
    457460               ENDIF 
    458461               ! 
    … …  
    472475               ztrans         = v_s_2d(ji,jl1) * zworkv(ji)          ! Snow volumes 
    473476               v_s_2d(ji,jl1) = v_s_2d(ji,jl1) - ztrans 
    474                v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans  
     477               v_s_2d(ji,jl2) = v_s_2d(ji,jl2) + ztrans 
    475478               ! 
    476479               ztrans          = oa_i_2d(ji,jl1) * zworka(ji)        ! Ice age 
    … …  
    485488               zaTsfn(ji,jl1)  = zaTsfn(ji,jl1) - ztrans 
    486489               zaTsfn(ji,jl2)  = zaTsfn(ji,jl2) + ztrans 
    487                !   
    488                IF ( ln_pnd_LEV ) THEN 
     490               ! 
     491               IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    489492                  ztrans          = a_ip_2d(ji,jl1) * zworka(ji)     ! Pond fraction 
    490493                  a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 
    491494                  a_ip_2d(ji,jl2) = a_ip_2d(ji,jl2) + ztrans 
    492                   !                                               
    493                   ztrans          = v_ip_2d(ji,jl1) * zworka(ji)     ! Pond volume (also proportional to da/a) 
     495                  ! 
     496                  ztrans          = v_ip_2d(ji,jl1) * zworkv(ji)     ! Pond volume 
    494497                  v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 
    495498                  v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 
    496499                  ! 
    497500                  IF ( ln_pnd_lids ) THEN                            ! Pond lid volume 
    498                      ztrans          = v_il_2d(ji,jl1) * zworka(ji) 
     501                     ztrans          = v_il_2d(ji,jl1) * zworkv(ji) 
    499502                     v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 
    500503                     v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 
    … …  
    552555            &   a_i_2d(1:npti,jl) = a_i_2d(1:npti,jl) * rn_amax_1d(1:npti) / zworka(1:npti) 
    553556      END DO 
    554        
     557 
    555558      !------------------------------------------------------------------------------- 
    556559      ! 4) Update ice thickness and temperature 
    … …  
    561564      WHERE( a_i_2d(1:npti,:) >= epsi20 ) 
    562565# endif 
    563          h_i_2d (1:npti,:)  =  v_i_2d(1:npti,:) / a_i_2d(1:npti,:)  
    564          t_su_2d(1:npti,:)  =  zaTsfn(1:npti,:) / a_i_2d(1:npti,:)  
     566         h_i_2d (1:npti,:)  =  v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 
     567         t_su_2d(1:npti,:)  =  zaTsfn(1:npti,:) / a_i_2d(1:npti,:) 
    565568      ELSEWHERE 
    566569         h_i_2d (1:npti,:)  = 0._wp 
    … …  
    588591      ! 
    589592   END SUBROUTINE itd_shiftice 
    590     
     593 
    591594 
    592595   SUBROUTINE ice_itd_reb( kt ) 
    … …  
    600603      !!              to the neighboring category 
    601604      !!------------------------------------------------------------------ 
    602       INTEGER , INTENT (in) ::   kt      ! Ocean time step  
     605      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
    603606      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    604607      ! 
    … …  
    606609      REAL(wp), DIMENSION(jpij,jpl-1) ::   zdaice, zdvice   ! ice area and volume transferred 
    607610      !!------------------------------------------------------------------ 
    608       ! 
    609       IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution'  
     611      IF( ln_timing )   CALL timing_start('iceitd_reb') 
     612      ! 
     613      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' 
    610614      ! 
    611615      IF( ln_icediachk )   CALL ice_cons_hsm(0, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    … …  
    623627            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 
    624628               npti = npti + 1 
    625                nptidx( npti ) = (jj - 1) * jpi + ji                   
     629               nptidx( npti ) = (jj - 1) * jpi + ji 
    626630            ENDIF 
    627631         END_2D 
    628632         ! 
    629          IF( npti > 0 ) THEN             
     633         IF( npti > 0 ) THEN 
    630634            !!clem   CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 
    631635            CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) ) 
    … …  
    633637            ! 
    634638            DO ji = 1, npti 
    635                jdonor(ji,jl)  = jl  
     639               jdonor(ji,jl)  = jl 
    636640               ! how much of a_i you send in cat sup is somewhat arbitrary 
    637                !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
    638                !!          zdaice(ji,jl)  = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji)   
    639                !!          zdvice(ji,jl)  = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 ) 
    640                !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 
    641                !!          zdaice(ji,jl)  = a_i_1d(ji) 
    642                !!          zdvice(ji,jl)  = v_i_1d(ji) 
    643                !!clem: these are from UCL and work ok 
    644                zdaice(ji,jl)  = a_i_1d(ji) * 0.5_wp 
    645                zdvice(ji,jl)  = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 
     641               ! these are from CICE => transfer everything 
     642               !!zdaice(ji,jl)  = a_i_1d(ji) 
     643               !!zdvice(ji,jl)  = v_i_1d(ji) 
     644               ! these are from LLN => transfer only half of the category 
     645               zdaice(ji,jl)  =                       0.5_wp  * a_i_1d(ji) 
     646               zdvice(ji,jl)  = v_i_1d(ji) - (1._wp - 0.5_wp) * a_i_1d(ji) * hi_mean(jl) 
    646647            END DO 
    647648            ! 
    … …  
    662663            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 
    663664               npti = npti + 1 
    664                nptidx( npti ) = (jj - 1) * jpi + ji                   
     665               nptidx( npti ) = (jj - 1) * jpi + ji 
    665666            ENDIF 
    666667         END_2D 
    … …  
    671672            DO ji = 1, npti 
    672673               jdonor(ji,jl) = jl + 1 
    673                zdaice(ji,jl) = a_i_1d(ji)  
     674               zdaice(ji,jl) = a_i_1d(ji) 
    674675               zdvice(ji,jl) = v_i_1d(ji) 
    675676            END DO 
    … …  
    686687      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    687688      IF( ln_icediachk )   CALL ice_cons2D  (1, 'iceitd_reb',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
     689      IF( ln_timing    )   CALL timing_stop ('iceitd_reb') 
    688690      ! 
    689691   END SUBROUTINE ice_itd_reb 
    … …  
    719721         WRITE(numout,*) '         mean ice thickness in the domain                               rn_himean  = ', rn_himean 
    720722         WRITE(numout,*) '      Ice categories are defined by rn_catbnd                           ln_cat_usr = ', ln_cat_usr 
    721          WRITE(numout,*) '      minimum ice thickness allowed                                     rn_himin   = ', rn_himin  
    722          WRITE(numout,*) '      maximum ice thickness allowed                                     rn_himax   = ', rn_himax  
     723         WRITE(numout,*) '      minimum ice thickness allowed                                     rn_himin   = ', rn_himin 
     724         WRITE(numout,*) '      maximum ice thickness allowed                                     rn_himax   = ', rn_himax 
    723725      ENDIF 
    724726      ! 
    … …  
    727729      !-----------------------------------! 
    728730      !                             !== set the choice of ice categories ==! 
    729       ioptio = 0  
     731      ioptio = 0 
    730732      IF( ln_cat_hfn ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_cathfn    ;   ENDIF 
    731733      IF( ln_cat_usr ) THEN   ;   ioptio = ioptio + 1   ;   nice_catbnd = np_catusr    ;   ENDIF 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icesbc.F90

    r13719 r14021  
    6262      !!------------------------------------------------------------------- 
    6363      ! 
    64       IF( ln_timing )   CALL timing_start('ice_sbc') 
     64      IF( ln_timing )   CALL timing_start('icesbc') 
    6565      ! 
    6666      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    9090      ENDIF 
    9191      ! 
    92       IF( ln_timing )   CALL timing_stop('ice_sbc') 
     92      IF( ln_timing )   CALL timing_stop('icesbc') 
    9393      ! 
    9494   END SUBROUTINE ice_sbc_tau 
    … …  
    123123      !!-------------------------------------------------------------------- 
    124124      ! 
    125       IF( ln_timing )   CALL timing_start('ice_sbc_flx') 
     125      IF( ln_timing )   CALL timing_start('icesbc') 
    126126 
    127127      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    179179      ENDIF 
    180180      ! 
    181       IF( ln_timing )   CALL timing_stop('ice_sbc_flx') 
     181      IF( ln_timing )   CALL timing_stop('icesbc') 
    182182      ! 
    183183   END SUBROUTINE ice_sbc_flx 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icestp.F90

    r14017 r14021  
    121121      !!---------------------------------------------------------------------- 
    122122      ! 
    123       IF( ln_timing )   CALL timing_start('ice_stp') 
     123      IF( ln_timing )   CALL timing_start('icestp') 
    124124      ! 
    125125      !                                      !-----------------------! 
    … …  
    215215!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    216216      ! 
    217       IF( ln_timing )   CALL timing_stop('ice_stp') 
     217      IF( ln_timing )   CALL timing_stop('icestp') 
    218218      ! 
    219219   END SUBROUTINE ice_stp 
    … …  
    373373      v_i_b (:,:,:)   = v_i (:,:,:)     ! ice volume 
    374374      v_s_b (:,:,:)   = v_s (:,:,:)     ! snow volume 
     375      v_ip_b(:,:,:)   = v_ip(:,:,:)     ! pond volume 
     376      v_il_b(:,:,:)   = v_il(:,:,:)     ! pond lid volume 
    375377      sv_i_b(:,:,:)   = sv_i(:,:,:)     ! salt content 
    376378      e_s_b (:,:,:,:) = e_s (:,:,:,:)   ! snow thermal energy 
    … …  
    432434         diag_heat(ji,jj) = 0._wp ;   diag_sice(ji,jj) = 0._wp 
    433435         diag_vice(ji,jj) = 0._wp ;   diag_vsnw(ji,jj) = 0._wp 
     436         diag_aice(ji,jj) = 0._wp ;   diag_vpnd(ji,jj) = 0._wp 
    434437 
    435438         tau_icebfr (ji,jj) = 0._wp   ! landfast ice param only (clem: important to keep the init here) 
    … …  
    457460            qcn_ice    (ji,jj,jl) = 0._wp   ! conductive flux (ln_cndflx=T & ln_cndemule=T) 
    458461            qtr_ice_bot(ji,jj,jl) = 0._wp   ! part of solar radiation transmitted through the ice needed at least for outputs 
     462            ! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux) 
     463            dh_i_sum_2d(ji,jj,jl) = 0._wp 
     464            dh_s_mlt_2d(ji,jj,jl) = 0._wp 
    459465         END_2D 
    460466      ENDDO 
    … …  
    485491         diag_vsnw(:,:) = diag_vsnw(:,:) & 
    486492            &             + SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_Dt_ice * rhos 
     493         diag_vpnd(:,:) = diag_vpnd(:,:) & 
     494            &             + SUM(     v_ip + v_il          - v_ip_b - v_il_b                , dim=3 ) * r1_Dt_ice * rhow 
    487495         ! 
    488496         IF( kn == 2 )    CALL iom_put ( 'hfxdhc' , diag_heat )   ! output of heat trend 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd.F90

    r13643 r14021  
    6969   SUBROUTINE ice_thd( kt ) 
    7070      !!------------------------------------------------------------------- 
    71       !!                ***  ROUTINE ice_thd  ***        
    72       !!   
     71      !!                ***  ROUTINE ice_thd  *** 
     72      !! 
    7373      !! ** Purpose : This routine manages ice thermodynamics 
    74       !!          
     74      !! 
    7575      !! ** Action : - computation of oceanic sensible heat flux at the ice base 
    7676      !!                              energy budget in the leads 
    … …  
    114114         ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 
    115115      ENDIF 
    116        
     116 
    117117      !---------------------------------------------! 
    118118      ! computation of friction velocity at T points 
    … …  
    157157         ! --- Sensible ocean-to-ice heat flux (W/m2) --- ! 
    158158         !     (mostly>0 but <0 if supercooling) 
    159          zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
     159         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
    160160         qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 
    161           
    162          ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     161 
     162         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
    163163         !                              the freezing point, so that we do not have SST < T_freeze 
    164164         !                              This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg 
    … …  
    166166         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
    167167 
     168         ! If conditions are always supercooled (such as at the mouth of ice-shelves), then ice grows continuously 
     169         ! ==> stop ice formation by artificially setting up the turbulent fluxes to 0 when volume > 20m (arbitrary) 
     170         IF( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) > 0._wp .AND. vt_i(ji,jj) >= 20._wp ) THEN 
     171            zqfr               = 0._wp 
     172            zqfr_pos           = 0._wp 
     173            qsb_ice_bot(ji,jj) = 0._wp 
     174         ENDIF 
     175         ! 
    168176         ! --- Energy Budget of the leads (qlead, J.m-2) --- ! 
    169177         !     qlead is the energy received from the atm. in the leads. 
    … …  
    202210         ! 
    203211      END_2D 
    204        
     212 
    205213      ! In case we bypass open-water ice formation 
    206214      IF( .NOT. ln_icedO )  qlead(:,:) = 0._wp 
    … …  
    219227         npti = 0 ; nptidx(:) = 0 
    220228         DO_2D( 1, 1, 1, 1 ) 
    221             IF ( a_i(ji,jj,jl) > epsi10 ) THEN      
     229            IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
    222230               npti         = npti  + 1 
    223231               nptidx(npti) = (jj - 1) * jpi + ji 
    … …  
    226234 
    227235         IF( npti > 0 ) THEN  ! If there is no ice, do nothing. 
    228             !                                                                 
     236            ! 
    229237                              CALL ice_thd_1d2d( jl, 1 )            ! --- Move to 1D arrays --- ! 
    230238            !                                                       ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 
    231239            ! 
    232             s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here)  
    233             dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp  
     240            s_i_new   (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp   ! --- some init --- !  (important to have them here) 
     241            dh_i_sum  (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm  (1:npti) = 0._wp 
    234242            dh_i_sub  (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 
    235243            dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp 
    236             !                                       
     244            ! 
    237245                              CALL ice_thd_zdf                      ! --- Ice-Snow temperature --- ! 
    238246            ! 
    239247            IF( ln_icedH ) THEN                                     ! --- Growing/Melting --- ! 
    240                               CALL ice_thd_dh                           ! Ice-Snow thickness    
    241                               CALL ice_thd_pnd                          ! Melt ponds formation 
     248                              CALL ice_thd_dh                           ! Ice-Snow thickness 
    242249                              CALL ice_thd_ent( e_i_1d(1:npti,:) )      ! Ice enthalpy remapping 
    243250            ENDIF 
    244                               CALL ice_thd_sal( ln_icedS )          ! --- Ice salinity --- !     
     251                              CALL ice_thd_sal( ln_icedS )          ! --- Ice salinity --- ! 
    245252            ! 
    246253                              CALL ice_thd_temp                     ! --- Temperature update --- ! 
    … …  
    259266      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 
    260267      IF( ln_icediachk )   CALL ice_cons2D  (1, 'icethd',  diag_v,  diag_s,  diag_t,  diag_fv,  diag_fs,  diag_ft) 
    261       !                    
     268      ! 
     269      IF ( ln_pnd .AND. ln_icedH ) & 
     270         &                    CALL ice_thd_pnd                      ! --- Melt ponds 
     271      ! 
    262272      IF( jpl > 1  )          CALL ice_itd_rem( kt )                ! --- Transport ice between thickness categories --- ! 
    263273      ! 
    … …  
    266276                              CALL ice_cor( kt , 2 )                ! --- Corrections --- ! 
    267277      ! 
    268       oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice              ! ice natural aging incrementation      
     278      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice              ! ice natural aging incrementation 
    269279      ! 
    270280      ! convergence tests 
    … …  
    280290      IF( ln_timing )   CALL timing_stop('icethd')                                        ! timing 
    281291      ! 
    282    END SUBROUTINE ice_thd  
    283  
    284   
     292   END SUBROUTINE ice_thd 
     293 
     294 
    285295   SUBROUTINE ice_thd_temp 
    286296      !!----------------------------------------------------------------------- 
    287       !!                   ***  ROUTINE ice_thd_temp ***  
    288       !!                  
     297      !!                   ***  ROUTINE ice_thd_temp *** 
     298      !! 
    289299      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy 
    290300      !! 
    … …  
    292302      !!------------------------------------------------------------------- 
    293303      INTEGER  ::   ji, jk   ! dummy loop indices 
    294       REAL(wp) ::   ztmelts, zbbb, zccc  ! local scalar  
     304      REAL(wp) ::   ztmelts, zbbb, zccc  ! local scalar 
    295305      !!------------------------------------------------------------------- 
    296306      ! Recover ice temperature 
    … …  
    302312            zccc          = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts, 0._wp ) ) 
    303313            t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_rcpi 
    304              
     314 
    305315            ! mask temperature 
    306             rswitch       = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) )  
     316            rswitch       = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 
    307317            t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 
    308          END DO  
    309       END DO  
     318         END DO 
     319      END DO 
    310320      ! 
    311321   END SUBROUTINE ice_thd_temp 
    … …  
    314324   SUBROUTINE ice_thd_mono 
    315325      !!----------------------------------------------------------------------- 
    316       !!                   ***  ROUTINE ice_thd_mono ***  
    317       !!                  
     326      !!                   ***  ROUTINE ice_thd_mono *** 
     327      !! 
    318328      !! ** Purpose :   Lateral melting in case virtual_itd 
    319329      !!                          ( dA = A/2h dh ) 
    … …  
    322332      REAL(wp) ::   zhi_bef            ! ice thickness before thermo 
    323333      REAL(wp) ::   zdh_mel, zda_mel   ! net melting 
    324       REAL(wp) ::   zvi, zvs           ! ice/snow volumes  
     334      REAL(wp) ::   zvi, zvs           ! ice/snow volumes 
    325335      !!----------------------------------------------------------------------- 
    326336      ! 
    … …  
    334344            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 
    335345            zda_mel     = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 
    336             a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel )  
     346            a_i_1d(ji)  = MAX( epsi20, a_i_1d(ji) + zda_mel ) 
    337347            ! adjust thickness 
    338             h_i_1d(ji) = zvi / a_i_1d(ji)             
    339             h_s_1d(ji) = zvs / a_i_1d(ji)             
     348            h_i_1d(ji) = zvi / a_i_1d(ji) 
     349            h_s_1d(ji) = zvs / a_i_1d(ji) 
    340350            ! retrieve total concentration 
    341351            at_i_1d(ji) = a_i_1d(ji) 
    … …  
    348358   SUBROUTINE ice_thd_1d2d( kl, kn ) 
    349359      !!----------------------------------------------------------------------- 
    350       !!                   ***  ROUTINE ice_thd_1d2d ***  
    351       !!                  
     360      !!                   ***  ROUTINE ice_thd_1d2d *** 
     361      !! 
    352362      !! ** Purpose :   move arrays from 1d to 2d and the reverse 
    353363      !!----------------------------------------------------------------------- 
    354       INTEGER, INTENT(in) ::   kl   ! index of the ice category  
     364      INTEGER, INTENT(in) ::   kl   ! index of the ice category 
    355365      INTEGER, INTENT(in) ::   kn   ! 1= from 2D to 1D   ;   2= from 1D to 2D 
    356366      ! 
    … …  
    377387            CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl)  ) 
    378388         END DO 
    379          CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    380          CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    381          CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    382389         ! 
    383390         CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d  (1:npti), qprec_ice            ) 
    … …  
    387394         CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d   (1:npti), dqns_ice(:,:,kl)     ) 
    388395         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d       (1:npti), t_bo                 ) 
    389          CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d    (1:npti), sprecip              )  
     396         CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d    (1:npti), sprecip              ) 
    390397         CALL tab_2d_1d( npti, nptidx(1:npti), qsb_ice_bot_1d(1:npti), qsb_ice_bot          ) 
    391398         CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d       (1:npti), fhld                 ) 
    392           
     399 
    393400         CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d    (1:npti), qml_ice    (:,:,kl) ) 
    394401         CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d    (1:npti), qcn_ice    (:,:,kl) ) 
    … …  
    409416         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr          ) 
    410417         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam          ) 
    411          CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd          ) 
    412418         ! 
    413419         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog          ) 
    … …  
    464470         v_s_1d (1:npti) = h_s_1d (1:npti) * a_i_1d (1:npti) 
    465471         sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 
    466          v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 
    467          v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 
    468472         oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 
    469           
     473 
    470474         CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i             ) 
    471475         CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl)     ) 
    … …  
    483487            CALL tab_1d_2d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,kl)  ) 
    484488         END DO 
    485          CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d     (1:npti), a_ip     (:,:,kl) ) 
    486          CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d     (1:npti), h_ip     (:,:,kl) ) 
    487          CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d     (1:npti), h_il     (:,:,kl) ) 
    488489         ! 
    489490         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) 
    … …  
    501502         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_spr_1d (1:npti), wfx_spr        ) 
    502503         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_lam_1d (1:npti), wfx_lam        ) 
    503          CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d (1:npti), wfx_pnd        ) 
    504504         ! 
    505505         CALL tab_1d_2d( npti, nptidx(1:npti), sfx_bog_1d (1:npti), sfx_bog        ) 
    … …  
    529529         CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) ) 
    530530         CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) ) 
    531          ! SIMIP diagnostics          
     531         ! Melt ponds 
     532         CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum  (1:npti) , dh_i_sum_2d(:,:,kl) ) 
     533         CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt  (1:npti) , dh_s_mlt_2d(:,:,kl) ) 
     534         ! SIMIP diagnostics 
    532535         CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d       (1:npti), t_si       (:,:,kl) ) 
    533536         CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) 
    … …  
    537540         CALL tab_1d_2d( npti, nptidx(1:npti), v_s_1d (1:npti), v_s (:,:,kl) ) 
    538541         CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 
    539          CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 
    540          CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 
    541542         CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 
    542543         ! check convergence of heat diffusion scheme 
    … …  
    553554   SUBROUTINE ice_thd_init 
    554555      !!------------------------------------------------------------------- 
    555       !!                   ***  ROUTINE ice_thd_init ***  
    556       !!                  
     556      !!                   ***  ROUTINE ice_thd_init *** 
     557      !! 
    557558      !! ** Purpose :   Physical constants and parameters associated with 
    558559      !!                ice thermodynamics 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd_dh.F90

    r13643 r14021  
    22   !!====================================================================== 
    33   !!                       ***  MODULE icethd_dh *** 
    4    !!   seaice : thermodynamic growth and melt  
     4   !!   seaice : thermodynamic growth and melt 
    55   !!====================================================================== 
    66   !! History :       !  2003-05  (M. Vancoppenolle) Original code in 1D 
    7    !!                 !  2005-06  (M. Vancoppenolle) 3D version  
     7   !!                 !  2005-06  (M. Vancoppenolle) 3D version 
    88   !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube] 
    99   !!---------------------------------------------------------------------- 
    … …  
    2424   USE lib_mpp        ! MPP library 
    2525   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    26     
     26 
    2727   IMPLICIT NONE 
    2828   PRIVATE 
    … …  
    5555      !!                - Snow ice formation 
    5656      !! 
     57      !! ** Note     :  h=max(0,h+dh) are often used to ensure positivity of h. 
     58      !!                very small negative values can occur otherwise (e.g. -1.e-20) 
     59      !! 
    5760      !! References : Bitz and Lipscomb, 1999, J. Geophys. Res. 
    58       !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646    
    59       !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let.  
     61      !!              Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646 
     62      !!              Vancoppenolle, Fichefet and Bitz, 2005, Geophys. Res. Let. 
    6063      !!              Vancoppenolle et al.,2009, Ocean Modelling 
    6164      !!------------------------------------------------------------------ 
    … …  
    6467 
    6568      REAL(wp) ::   ztmelts      ! local scalar 
    66       REAL(wp) ::   zdum        
     69      REAL(wp) ::   zdum 
    6770      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    6871      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    … …  
    7982      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
    8083 
    81       REAL(wp), DIMENSION(jpij) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
    8284      REAL(wp), DIMENSION(jpij) ::   zq_top      ! heat for surface ablation                   (J.m-2) 
    8385      REAL(wp), DIMENSION(jpij) ::   zq_bot      ! heat for bottom ablation                    (J.m-2) 
    … …  
    8587      REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
    8688      REAL(wp), DIMENSION(jpij) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2) 
    87  
    88       REAL(wp), DIMENSION(jpij) ::   zdh_s_mel   ! snow melt  
    89       REAL(wp), DIMENSION(jpij) ::   zdh_s_pre   ! snow precipitation  
    90       REAL(wp), DIMENSION(jpij) ::   zdh_s_sub   ! snow sublimation 
    91  
    92       REAL(wp), DIMENSION(jpij,nlay_s) ::   zh_s      ! snw layer thickness 
    93       REAL(wp), DIMENSION(jpij,nlay_i) ::   zh_i      ! ice layer thickness 
    94       REAL(wp), DIMENSION(jpij,nlay_i) ::   zdeltah 
    95       INTEGER , DIMENSION(jpij,nlay_i) ::   icount    ! number of layers vanished by melting  
    96  
     89      REAL(wp), DIMENSION(jpij) ::   zdeltah 
    9790      REAL(wp), DIMENSION(jpij) ::   zsnw        ! distribution of snow after wind blowing 
    9891 
     92      INTEGER , DIMENSION(jpij,nlay_i)     ::   icount    ! number of layers vanishing by melting 
     93      REAL(wp), DIMENSION(jpij,0:nlay_i+1) ::   zh_i      ! ice layer thickness (m) 
     94      REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   zh_s      ! snw layer thickness (m) 
     95      REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   ze_s      ! snw layer enthalpy (J.m-3) 
     96 
    9997      REAL(wp) ::   zswitch_sal 
    10098 
    101       INTEGER  ::   num_iter_max      ! Heat conservation  
     99      INTEGER  ::   num_iter_max      ! Heat conservation 
    102100      !!------------------------------------------------------------------ 
    103101 
    … …  
    108106      END SELECT 
    109107 
    110       ! initialize layer thicknesses and enthalpies 
     108      ! initialize ice layer thicknesses and enthalpies 
     109      eh_i_old(1:npti,0:nlay_i+1) = 0._wp 
    111110      h_i_old (1:npti,0:nlay_i+1) = 0._wp 
    112       eh_i_old(1:npti,0:nlay_i+1) = 0._wp 
     111      zh_i    (1:npti,0:nlay_i+1) = 0._wp 
    113112      DO jk = 1, nlay_i 
    114113         DO ji = 1, npti 
     114            eh_i_old(ji,jk) = h_i_1d(ji) * r1_nlay_i * e_i_1d(ji,jk) 
    115115            h_i_old (ji,jk) = h_i_1d(ji) * r1_nlay_i 
    116             eh_i_old(ji,jk) = e_i_1d(ji,jk) * h_i_old(ji,jk) 
     116            zh_i    (ji,jk) = h_i_1d(ji) * r1_nlay_i 
     117         END DO 
     118      END DO 
     119      ! 
     120      ! initialize snw layer thicknesses and enthalpies 
     121      zh_s(1:npti,0) = 0._wp 
     122      ze_s(1:npti,0) = 0._wp 
     123      DO jk = 1, nlay_s 
     124         DO ji = 1, npti 
     125            zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 
     126            ze_s(ji,jk) = e_s_1d(ji,jk) 
    117127         END DO 
    118128      END DO 
    … …  
    139149      ! 
    140150      DO ji = 1, npti 
    141          zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji)  
     151         zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji) 
    142152         zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rDt_ice ) 
    143       END DO 
    144  
    145       ! Ice and snow layer thicknesses 
    146       !------------------------------- 
    147       DO jk = 1, nlay_i 
    148          DO ji = 1, npti 
    149             zh_i(ji,jk) = h_i_1d(ji) * r1_nlay_i 
    150          END DO 
    151       END DO 
    152  
    153       DO jk = 1, nlay_s 
    154          DO ji = 1, npti 
    155             zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 
    156          END DO 
    157153      END DO 
    158154 
    … …  
    167163         DO ji = 1, npti 
    168164            IF( t_s_1d(ji,jk) > rt0 ) THEN 
    169                hfx_res_1d    (ji) = hfx_res_1d    (ji) + e_s_1d(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0 
    170                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos          * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux 
     165               hfx_res_1d    (ji) = hfx_res_1d    (ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0 
     166               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos        * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux 
    171167               ! updates 
    172                dh_s_mlt(ji)    = dh_s_mlt(ji) - zh_s(ji,jk) 
    173                h_s_1d  (ji)    = h_s_1d(ji) - zh_s(ji,jk) 
     168               dh_s_mlt(ji)    =             dh_s_mlt(ji) - zh_s(ji,jk) 
     169               h_s_1d  (ji)    = MAX( 0._wp, h_s_1d  (ji) - zh_s(ji,jk) ) 
    174170               zh_s    (ji,jk) = 0._wp 
    175                e_s_1d  (ji,jk) = 0._wp 
    176                t_s_1d  (ji,jk) = rt0 
     171               ze_s    (ji,jk) = 0._wp 
    177172            END IF 
    178173         END DO 
    179       END DO          
     174      END DO 
    180175 
    181176      ! Snow precipitation 
    182177      !------------------- 
    183       CALL ice_var_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
    184  
    185       zdeltah(1:npti,:) = 0._wp 
     178      CALL ice_var_snwblow( 1._wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing 
     179 
    186180      DO ji = 1, npti 
    187181         IF( sprecip_1d(ji) > 0._wp ) THEN 
     182            zh_s(ji,0) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji)   ! thickness of precip 
     183            ze_s(ji,0) = MAX( 0._wp, - qprec_ice_1d(ji) )                              ! enthalpy of the precip (>0, J.m-3) 
    188184            ! 
    189             ! --- precipitation --- 
    190             zdh_s_pre (ji) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji)   ! thickness change 
    191             zqprec    (ji) = - qprec_ice_1d(ji)                                             ! enthalpy of the precip (>0, J.m-3) 
     185            hfx_spr_1d(ji) = hfx_spr_1d(ji) + ze_s(ji,0) * zh_s(ji,0) * a_i_1d(ji) * r1_Dt_ice   ! heat flux from snow precip (>0, W.m-2) 
     186            wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos       * zh_s(ji,0) * a_i_1d(ji) * r1_Dt_ice   ! mass flux, <0 
    192187            ! 
    193             hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat flux from snow precip (>0, W.m-2) 
    194             wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhos          * a_i_1d(ji) * zdh_s_pre(ji) * r1_Dt_ice   ! mass flux, <0 
    195              
    196             ! --- melt of falling snow --- 
    197             rswitch              = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 
    198             zdeltah       (ji,1) = - rswitch * zq_top(ji) / MAX( zqprec(ji) , epsi20 )   ! thickness change 
    199             zdeltah       (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) )                 ! bound melting  
    200             hfx_snw_1d    (ji)   = hfx_snw_1d    (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji)    * r1_Dt_ice   ! heat used to melt snow (W.m-2, >0) 
    201             wfx_snw_sum_1d(ji)   = wfx_snw_sum_1d(ji) - rhos          * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip), >0 
    202              
    203             ! updates available heat + precipitations after melting 
    204             dh_s_mlt (ji) = dh_s_mlt(ji) + zdeltah(ji,1) 
    205             zq_top   (ji) = MAX( 0._wp , zq_top (ji) + zdeltah(ji,1) * zqprec(ji) )       
    206             zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
    207              
    208188            ! update thickness 
    209             h_s_1d(ji) = MAX( 0._wp , h_s_1d(ji) + zdh_s_pre(ji) ) 
    210             ! 
    211          ELSE 
    212             ! 
    213             zdh_s_pre(ji) = 0._wp 
    214             zqprec   (ji) = 0._wp 
    215             ! 
     189            h_s_1d(ji) = h_s_1d(ji) + zh_s(ji,0) 
    216190         ENDIF 
    217       END DO 
    218  
    219       ! recalculate snow layers 
    220       DO jk = 1, nlay_s 
    221          DO ji = 1, npti 
    222             zh_s(ji,jk) = h_s_1d(ji) * r1_nlay_s 
    223          END DO 
    224191      END DO 
    225192 
    226193      ! Snow melting 
    227194      ! ------------ 
    228       ! If heat still available (zq_top > 0), then melt more snow 
    229       zdeltah(1:npti,:) = 0._wp 
    230       zdh_s_mel(1:npti) = 0._wp 
    231       DO jk = 1, nlay_s 
     195      ! If heat still available (zq_top > 0) 
     196      ! then all snw precip has been melted and we need to melt more snow 
     197      DO jk = 0, nlay_s 
    232198         DO ji = 1, npti 
    233199            IF( zh_s(ji,jk) > 0._wp .AND. zq_top(ji) > 0._wp ) THEN 
    234200               ! 
    235                rswitch          = MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,jk) - epsi20 ) ) 
    236                zdeltah  (ji,jk) = - rswitch * zq_top(ji) / MAX( e_s_1d(ji,jk), epsi20 )   ! thickness change 
    237                zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) )                   ! bound melting 
    238                zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk) 
    239                 
    240                hfx_snw_1d(ji)     = hfx_snw_1d(ji)     - zdeltah(ji,jk) * a_i_1d(ji) * e_s_1d (ji,jk) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0) 
    241                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos           * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice   ! snow melting only = water into the ocean (then without snow precip) 
    242                 
     201               rswitch = MAX( 0._wp , SIGN( 1._wp , ze_s(ji,jk) - epsi20 ) ) 
     202               zdum    = - rswitch * zq_top(ji) / MAX( ze_s(ji,jk), epsi20 )   ! thickness change 
     203               zdum    = MAX( zdum , - zh_s(ji,jk) )                           ! bound melting 
     204 
     205               hfx_snw_1d    (ji) = hfx_snw_1d    (ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice   ! heat used to melt snow(W.m-2, >0) 
     206               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos        * zdum * a_i_1d(ji) * r1_Dt_ice   ! snow melting only = water into the ocean 
     207 
    243208               ! updates available heat + thickness 
    244                dh_s_mlt(ji)    = dh_s_mlt(ji) + zdeltah(ji,jk) 
    245                zq_top  (ji)    = MAX( 0._wp , zq_top(ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) ) 
    246                h_s_1d  (ji)    = MAX( 0._wp , h_s_1d(ji) + zdeltah(ji,jk) ) 
    247                zh_s    (ji,jk) = MAX( 0._wp , zh_s(ji,jk) + zdeltah(ji,jk) ) 
     209               dh_s_mlt(ji)    =              dh_s_mlt(ji)    + zdum 
     210               zq_top  (ji)    = MAX( 0._wp , zq_top  (ji)    + zdum * ze_s(ji,jk) ) 
     211               h_s_1d  (ji)    = MAX( 0._wp , h_s_1d  (ji)    + zdum ) 
     212               zh_s    (ji,jk) = MAX( 0._wp , zh_s    (ji,jk) + zdum ) 
     213!!$               IF( zh_s(ji,jk) == 0._wp )   ze_s(ji,jk) = 0._wp 
    248214               ! 
    249215            ENDIF 
    … …  
    251217      END DO 
    252218 
    253       ! Snow sublimation  
     219      ! Snow sublimation 
    254220      !----------------- 
    255221      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    256222      !    comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean) 
    257       zdeltah(1:npti,:) = 0._wp 
     223      zdeltah   (1:npti) = 0._wp ! total snow thickness that sublimates, < 0 
     224      zevap_rema(1:npti) = 0._wp 
    258225      DO ji = 1, npti 
    259226         IF( evap_ice_1d(ji) > 0._wp ) THEN 
     227            zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0 
     228            zevap_rema(ji) = MAX( 0._wp, evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos ) ! remaining evap in kg.m-2 (used for ice sublimation later on) 
     229         ENDIF 
     230      END DO 
     231 
     232      DO jk = 0, nlay_s 
     233         DO ji = 1, npti 
     234            zdum = MAX( -zh_s(ji,jk), zdeltah(ji) ) ! snow layer thickness that sublimates, < 0 
    260235            ! 
    261             zdh_s_sub (ji)   = MAX( - h_s_1d(ji) , - evap_ice_1d(ji) * r1_rhos * rDt_ice ) 
    262             zevap_rema(ji)   = evap_ice_1d(ji) * rDt_ice + zdh_s_sub(ji) * rhos   ! remaining evap in kg.m-2 (used for ice melting later on) 
    263             zdeltah   (ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 
    264              
    265             hfx_sub_1d    (ji) = hfx_sub_1d(ji) + &   ! Heat flux by sublimation [W.m-2], < 0 (sublimate snow that had fallen, then pre-existing snow) 
    266                &                 ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * e_s_1d(ji,1) )  & 
    267                &                 * a_i_1d(ji) * r1_Dt_ice 
    268             wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos * a_i_1d(ji) * zdh_s_sub(ji) * r1_Dt_ice   ! Mass flux by sublimation 
    269              
    270             ! new snow thickness 
    271             h_s_1d(ji)    =  MAX( 0._wp , h_s_1d(ji) + zdh_s_sub(ji) ) 
    272             ! update precipitations after sublimation and correct sublimation 
    273             zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 
    274             zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 
    275             ! 
    276          ELSE 
    277             ! 
    278             zdh_s_sub (ji) = 0._wp 
    279             zevap_rema(ji) = 0._wp 
    280             ! 
    281          ENDIF 
    282       END DO 
    283        
    284       ! --- Update snow diags --- ! 
    285       DO ji = 1, npti 
    286          dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
    287       END DO 
    288  
    289       ! Update temperature, energy 
    290       !--------------------------- 
    291       ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
    292       DO jk = 1, nlay_s 
    293          DO ji = 1,npti 
    294             rswitch       = MAX( 0._wp , SIGN( 1._wp, h_s_1d(ji) - epsi20 ) ) 
    295             e_s_1d(ji,jk) = rswitch / MAX( h_s_1d(ji), epsi20 ) *            & 
    296               &             ( ( zdh_s_pre(ji)              ) * zqprec(ji) +  & 
    297               &               ( h_s_1d(ji) - zdh_s_pre(ji) ) * rhos * ( rcpi * ( rt0 - t_s_1d(ji,jk) ) + rLfus ) ) 
    298          END DO 
    299       END DO 
    300        
     236            hfx_sub_1d    (ji) = hfx_sub_1d    (ji) + ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice  ! Heat flux of snw that sublimates [W.m-2], < 0 
     237            wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos        * zdum * a_i_1d(ji) * r1_Dt_ice  ! Mass flux by sublimation 
     238 
     239            ! update thickness 
     240            h_s_1d(ji)    = MAX( 0._wp , h_s_1d(ji)    + zdum ) 
     241            zh_s  (ji,jk) = MAX( 0._wp , zh_s  (ji,jk) + zdum ) 
     242!!$            IF( zh_s(ji,jk) == 0._wp )   ze_s(ji,jk) = 0._wp 
     243 
     244            ! update sublimation left 
     245            zdeltah(ji) = MIN( zdeltah(ji) - zdum, 0._wp ) 
     246         END DO 
     247      END DO 
     248 
     249      ! 
    301250      !                       ! ============ ! 
    302251      !                       !     Ice      ! 
    303252      !                       ! ============ ! 
    304253 
    305       ! Surface ice melting  
     254      ! Surface ice melting 
    306255      !-------------------- 
    307       zdeltah(1:npti,:) = 0._wp ! important 
    308256      DO jk = 1, nlay_i 
    309257         DO ji = 1, npti 
    310258            ztmelts = - rTmlt * sz_i_1d(ji,jk)   ! Melting point of layer k [C] 
    311              
     259 
    312260            IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting 
    313261 
    314                zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0]        
    315                zdE            = 0._wp                                 ! Specific enthalpy difference (J/kg, <0) 
    316                                                                       ! set up at 0 since no energy is needed to melt water...(it is already melted) 
    317                zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing      
    318                                                                       ! this should normally not happen, but sometimes, heat diffusion leads to this 
    319                zfmdt          = - zdeltah(ji,jk) * rhoi               ! Mass flux x time step > 0 
    320                           
    321                dh_i_itm(ji)   = dh_i_itm(ji) + zdeltah(ji,jk)         ! Cumulate internal melting 
    322                 
    323                zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0] 
    324  
    325                hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0 
    326                !                                                                                                  ice enthalpy zEi is "sent" to the ocean 
    327                sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux 
    328                !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok 
    329                wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    330  
     262               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0] 
     263               zdE            =   0._wp                               ! Specific enthalpy difference (J/kg, <0) 
     264               !                                                          set up at 0 since no energy is needed to melt water...(it is already melted) 
     265               zdum           = MIN( 0._wp , - zh_i(ji,jk) )          ! internal melting occurs when the internal temperature is above freezing 
     266               !                                                          this should normally not happen, but sometimes, heat diffusion leads to this 
     267               zfmdt          = - zdum * rhoi                         ! Recompute mass flux [kg/m2, >0] 
     268               ! 
     269               dh_i_itm(ji)   = dh_i_itm(ji) + zdum                   ! Cumulate internal melting 
     270               ! 
     271               hfx_res_1d(ji) = hfx_res_1d(ji) + zEi  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux to the ocean [W.m-2], <0 
     272               !                                                                                          ice enthalpy zEi is "sent" to the ocean 
     273               wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice    ! Mass flux 
     274               sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice    ! Salt flux 
     275               !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok 
    331276            ELSE                                        !-- Surface melting 
    332                 
     277 
    333278               zEi            = - e_i_1d(ji,jk) * r1_rhoi             ! Specific enthalpy of layer k [J/kg, <0] 
    334279               zEw            =    rcp * ztmelts                      ! Specific enthalpy of resulting meltwater [J/kg, <0] 
    335280               zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
    336                 
     281 
    337282               zfmdt          = - zq_top(ji) / zdE                    ! Mass flux to the ocean [kg/m2, >0] 
    338                 
    339                zdeltah(ji,jk) = - zfmdt * r1_rhoi                     ! Melt of layer jk [m, <0] 
    340                 
    341                zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
    342                 
    343                zq_top(ji)      = MAX( 0._wp , zq_top(ji) - zdeltah(ji,jk) * rhoi * zdE ) ! update available heat 
    344                 
    345                dh_i_sum(ji)   = dh_i_sum(ji) + zdeltah(ji,jk)         ! Cumulate surface melt 
    346                 
    347                zfmdt          = - rhoi * zdeltah(ji,jk)               ! Recompute mass flux [kg/m2, >0] 
    348                 
     283 
     284               zdum          = - zfmdt * r1_rhoi                     ! Melt of layer jk [m, <0] 
     285 
     286               zdum           = MIN( 0._wp , MAX( zdum , - zh_i(ji,jk) ) )    ! Melt of layer jk cannot exceed the layer thickness [m, <0] 
     287 
     288               zq_top(ji)     = MAX( 0._wp , zq_top(ji) - zdum * rhoi * zdE ) ! update available heat 
     289 
     290               dh_i_sum(ji)   = dh_i_sum(ji) + zdum                   ! Cumulate surface melt 
     291 
     292               zfmdt          = - rhoi * zdum                         ! Recompute mass flux [kg/m2, >0] 
     293 
    349294               zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
    350                 
    351                sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux >0 
    352                !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok) 
    353                hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux [W.m-2], < 0 
    354                hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], > 0   
    355                !  
    356                wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    357                 
     295 
     296               hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux [W.m-2], < 0 
     297               hfx_sum_1d(ji) = hfx_sum_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice    ! Heat flux used in this process [W.m-2], > 0 
     298               wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice    ! Mass flux 
     299               sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice    ! Salt flux >0 
     300               !                                                                                          using s_i_1d and not sz_i_1d(jk) is ok) 
    358301            END IF 
    359              
     302            ! update thickness 
     303            zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 
     304            h_i_1d(ji)  = MAX( 0._wp, h_i_1d(ji)  + zdum ) 
     305            ! 
     306            ! update heat content (J.m-2) and layer thickness 
     307            eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 
     308            h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 
     309            ! 
     310            ! 
    360311            ! Ice sublimation 
    361312            ! --------------- 
    362             zdum            = MAX( - ( zh_i(ji,jk) + zdeltah(ji,jk) ) , - zevap_rema(ji) * r1_rhoi ) 
    363             zdeltah (ji,jk) = zdeltah (ji,jk) + zdum 
    364             dh_i_sub(ji)    = dh_i_sub(ji)    + zdum 
    365              
    366             sfx_sub_1d(ji)     = sfx_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * s_i_1d(ji) * r1_Dt_ice  ! Salt flux >0 
    367             !                                                                                          clem: flux is sent to the ocean for simplicity 
    368             !                                                                                                but salt should remain in the ice except 
    369             !                                                                                                if all ice is melted. => must be corrected 
    370             hfx_sub_1d(ji)     = hfx_sub_1d(ji) + zdum * e_i_1d(ji,jk) * a_i_1d(ji) * r1_Dt_ice      ! Heat flux [W.m-2], < 0 
    371  
    372             wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi * a_i_1d(ji) * zdum * r1_Dt_ice           ! Mass flux > 0 
    373  
    374             ! update remaining mass flux 
    375             zevap_rema(ji)  = zevap_rema(ji) + zdum * rhoi 
    376              
    377             ! record which layers have disappeared (for bottom melting)  
     313            zdum               = MAX( - zh_i(ji,jk) , - zevap_rema(ji) * r1_rhoi ) 
     314            ! 
     315            hfx_sub_1d(ji)     = hfx_sub_1d(ji)     + e_i_1d(ji,jk) * zdum              * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0 
     316            wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi          * zdum              * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0 
     317            sfx_sub_1d(ji)     = sfx_sub_1d(ji)     - rhoi          * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice ! Salt flux >0 
     318            !                                                                                                      clem: flux is sent to the ocean for simplicity 
     319            !                                                                                                            but salt should remain in the ice except 
     320            !                                                                                                            if all ice is melted. => must be corrected 
     321            ! update remaining mass flux and thickness 
     322            zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi 
     323            zh_i(ji,jk)    = MAX( 0._wp, zh_i(ji,jk) + zdum ) 
     324            h_i_1d(ji)     = MAX( 0._wp, h_i_1d(ji)  + zdum ) 
     325            dh_i_sub(ji)   = dh_i_sub(ji) + zdum 
     326 
     327            ! update heat content (J.m-2) and layer thickness 
     328            eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 
     329            h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 
     330 
     331            ! record which layers have disappeared (for bottom melting) 
    378332            !    => icount=0 : no layer has vanished 
    379333            !    => icount=5 : 5 layers have vanished 
    380             rswitch       = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )  
     334            rswitch       = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) ) 
    381335            icount(ji,jk) = NINT( rswitch ) 
    382             zh_i(ji,jk)   = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
    383                          
    384             ! update heat content (J.m-2) and layer thickness 
    385             eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 
    386             h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    387          END DO 
    388       END DO 
    389        
    390       ! update ice thickness 
    391       DO ji = 1, npti 
    392          h_i_1d(ji) =  MAX( 0._wp , h_i_1d(ji) + dh_i_sum(ji) + dh_i_itm(ji) + dh_i_sub(ji) ) 
     336 
     337         END DO 
    393338      END DO 
    394339 
    … …  
    399344 
    400345 
    401       ! Ice Basal growth  
     346      ! Ice Basal growth 
    402347      !------------------ 
    403348      ! Basal growth is driven by heat imbalance at the ice-ocean interface, 
    404       ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux  
    405       ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot).  
    406       ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice  
     349      ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux 
     350      ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot). 
     351      ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice 
    407352 
    408353      ! If salinity varies in time, an iterative procedure is required, because 
    … …  
    414359      num_iter_max = 1 
    415360      IF( nn_icesal == 2 )   num_iter_max = 5  ! salinity varying in time 
    416        
     361 
    417362      DO ji = 1, npti 
    418363         IF(  zf_tt(ji) < 0._wp  ) THEN 
    … …  
    421366               ! New bottom ice salinity (Cox & Weeks, JGR88 ) 
    422367               !--- zswi1  if dh/dt < 2.0e-8 
    423                !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7  
     368               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7 
    424369               !--- zswi2  if dh/dt > 3.6e-7 
    425370               zgrr     = MIN( 1.0e-3, MAX ( dh_i_bog(ji) * r1_Dt_ice , epsi10 ) ) 
    … …  
    430375                  &          + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 ) 
    431376 
    432                s_i_new(ji)   = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji)  ! New ice salinity 
    433  
    434                ztmelts       = - rTmlt * s_i_new(ji)                                                  ! New ice melting point (C) 
    435  
    436                zt_i_new      = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
    437                 
    438                zEi           = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
    439                   &            - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 
    440  
    441                zEw           = rcp  * ( t_bo_1d(ji) - rt0 )                                           ! Specific enthalpy of seawater (J/kg, < 0) 
    442  
    443                zdE           = zEi - zEw                                                              ! Specific enthalpy difference (J/kg, <0) 
    444  
    445                dh_i_bog(ji)  = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 
    446                 
     377               s_i_new(ji)    = zswitch_sal * zfracs * sss_1d(ji) + ( 1. - zswitch_sal ) * s_i_1d(ji)  ! New ice salinity 
     378 
     379               ztmelts        = - rTmlt * s_i_new(ji)                                                  ! New ice melting point (C) 
     380 
     381               zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
     382 
     383               zEi            = rcpi * ( zt_i_new - (ztmelts+rt0) ) &                                  ! Specific enthalpy of forming ice (J/kg, <0) 
     384                  &             - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 
     385 
     386               zEw            = rcp  * ( t_bo_1d(ji) - rt0 )                                           ! Specific enthalpy of seawater (J/kg, < 0) 
     387 
     388               zdE            = zEi - zEw                                                              ! Specific enthalpy difference (J/kg, <0) 
     389 
     390               dh_i_bog(ji)   = rDt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoi ) ) 
     391 
    447392            END DO 
    448             ! Contribution to Energy and Salt Fluxes                                     
    449             zfmdt          = - rhoi * dh_i_bog(ji)                                                   ! Mass flux x time step (kg/m2, < 0) 
    450              
    451             hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], >0 
    452             hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat flux used in this process [W.m-2], <0 
    453              
    454             sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * s_i_new(ji) * r1_Dt_ice     ! Salt flux, <0 
    455  
    456             wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * a_i_1d(ji) * dh_i_bog(ji) * r1_Dt_ice                   ! Mass flux, <0 
     393            ! Contribution to Energy and Salt Fluxes 
     394            zfmdt = - rhoi * dh_i_bog(ji)                                                              ! Mass flux x time step (kg/m2, < 0) 
     395 
     396            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], >0 
     397            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zdE  * zfmdt                      * a_i_1d(ji) * r1_Dt_ice   ! Heat flux used in this process [W.m-2], <0 
     398            wfx_bog_1d(ji) = wfx_bog_1d(ji) - rhoi * dh_i_bog(ji)               * a_i_1d(ji) * r1_Dt_ice   ! Mass flux, <0 
     399            sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoi * dh_i_bog(ji) * s_i_new(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux, <0 
     400 
     401            ! update thickness 
     402            zh_i(ji,nlay_i+1) = zh_i(ji,nlay_i+1) + dh_i_bog(ji) 
     403            h_i_1d(ji)        = h_i_1d(ji)        + dh_i_bog(ji) 
    457404 
    458405            ! update heat content (J.m-2) and layer thickness 
    … …  
    466413      ! Ice Basal melt 
    467414      !--------------- 
    468       zdeltah(1:npti,:) = 0._wp ! important 
    469415      DO jk = nlay_i, 1, -1 
    470416         DO ji = 1, npti 
    471             IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting  
     417            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting 
    472418 
    473419               ztmelts = - rTmlt * sz_i_1d(ji,jk)  ! Melting point of layer jk (C) 
    … …  
    475421               IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting 
    476422 
    477                   zEi               = - e_i_1d(ji,jk) * r1_rhoi     ! Specific enthalpy of melting ice (J/kg, <0) 
    478                   zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
    479                                                                     !    set up at 0 since no energy is needed to melt water...(it is already melted) 
    480                   zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing      
    481                                                                     ! this should normally not happen, but sometimes, heat diffusion leads to this 
    482  
    483                   dh_i_itm (ji)     = dh_i_itm(ji) + zdeltah(ji,jk) 
    484  
    485                   zfmdt             = - zdeltah(ji,jk) * rhoi      ! Mass flux x time step > 0 
    486  
    487                   hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0 
    488                   !                                                                                                  ice enthalpy zEi is "sent" to the ocean 
    489                   sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice    ! Salt flux 
    490                   !                                                                                                  using s_i_1d and not sz_i_1d(jk) is ok 
    491                   wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    492  
    493                   ! update heat content (J.m-2) and layer thickness 
    494                   eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 
    495                   h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    496  
     423                  zEi            = - e_i_1d(ji,jk) * r1_rhoi     ! Specific enthalpy of melting ice (J/kg, <0) 
     424                  zdE            = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
     425                  !                                                  set up at 0 since no energy is needed to melt water...(it is already melted) 
     426                  zdum           = MIN( 0._wp , - zh_i(ji,jk) )  ! internal melting occurs when the internal temperature is above freezing 
     427                  !                                                  this should normally not happen, but sometimes, heat diffusion leads to this 
     428                  dh_i_itm (ji)  = dh_i_itm(ji) + zdum 
     429                  ! 
     430                  zfmdt          = - zdum * rhoi                 ! Mass flux x time step > 0 
     431                  ! 
     432                  hfx_res_1d(ji) = hfx_res_1d(ji) + zEi  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], <0 
     433                  !                                                                                         ice enthalpy zEi is "sent" to the ocean 
     434                  wfx_res_1d(ji) = wfx_res_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice   ! Mass flux 
     435                  sfx_res_1d(ji) = sfx_res_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux 
     436                  !                                                                                         using s_i_1d and not sz_i_1d(jk) is ok 
    497437               ELSE                                        !-- Basal melting 
    498438 
    499                   zEi             = - e_i_1d(ji,jk) * r1_rhoi                                 ! Specific enthalpy of melting ice (J/kg, <0) 
    500                   zEw             = rcp * ztmelts                                             ! Specific enthalpy of meltwater (J/kg, <0) 
    501                   zdE             = zEi - zEw                                                 ! Specific enthalpy difference   (J/kg, <0) 
    502  
    503                   zfmdt           = - zq_bot(ji) / zdE                                        ! Mass flux x time step (kg/m2, >0) 
    504  
    505                   zdeltah(ji,jk)  = - zfmdt * r1_rhoi                                         ! Gross thickness change 
    506  
    507                   zdeltah(ji,jk)  = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) )       ! bound thickness change 
    508                    
    509                   zq_bot(ji)      = MAX( 0._wp , zq_bot(ji) - zdeltah(ji,jk) * rhoi * zdE )   ! update available heat. MAX is necessary for roundup errors 
    510  
    511                   dh_i_bom(ji)    = dh_i_bom(ji) + zdeltah(ji,jk)                             ! Update basal melt 
    512  
    513                   zfmdt           = - zdeltah(ji,jk) * rhoi                                   ! Mass flux x time step > 0 
    514  
    515                   zQm             = zfmdt * zEw                                               ! Heat exchanged with ocean 
    516  
    517                   hfx_thd_1d(ji)  = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice                           ! Heat flux to the ocean [W.m-2], <0   
    518                   hfx_bom_1d(ji)  = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_Dt_ice                           ! Heat used in this process [W.m-2], >0   
    519  
    520                   sfx_bom_1d(ji)  = sfx_bom_1d(ji) - rhoi *  a_i_1d(ji) * zdeltah(ji,jk) * s_i_1d(ji) * r1_Dt_ice   ! Salt flux 
    521                   !                                                                                                   using s_i_1d and not sz_i_1d(jk) is ok 
    522                    
    523                   wfx_bom_1d(ji)  = wfx_bom_1d(ji) - rhoi * a_i_1d(ji) * zdeltah(ji,jk) * r1_Dt_ice                 ! Mass flux 
    524  
    525                   ! update heat content (J.m-2) and layer thickness 
    526                   eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdeltah(ji,jk) * e_i_1d(ji,jk) 
    527                   h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
     439                  zEi            = - e_i_1d(ji,jk) * r1_rhoi                       ! Specific enthalpy of melting ice (J/kg, <0) 
     440                  zEw            = rcp * ztmelts                                   ! Specific enthalpy of meltwater (J/kg, <0) 
     441                  zdE            = zEi - zEw                                       ! Specific enthalpy difference   (J/kg, <0) 
     442 
     443                  zfmdt          = - zq_bot(ji) / zdE                              ! Mass flux x time step (kg/m2, >0) 
     444 
     445                  zdum           = - zfmdt * r1_rhoi                               ! Gross thickness change 
     446 
     447                  zdum           = MIN( 0._wp , MAX( zdum, - zh_i(ji,jk) ) )       ! bound thickness change 
     448 
     449                  zq_bot(ji)     = MAX( 0._wp , zq_bot(ji) - zdum * rhoi * zdE )   ! update available heat. MAX is necessary for roundup errors 
     450 
     451                  dh_i_bom(ji)   = dh_i_bom(ji) + zdum                             ! Update basal melt 
     452 
     453                  zfmdt          = - zdum * rhoi                                   ! Mass flux x time step > 0 
     454 
     455                  zQm            = zfmdt * zEw                                     ! Heat exchanged with ocean 
     456 
     457                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat flux to the ocean [W.m-2], <0 
     458                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zdE  * zfmdt             * a_i_1d(ji) * r1_Dt_ice   ! Heat used in this process [W.m-2], >0 
     459                  wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoi * zdum              * a_i_1d(ji) * r1_Dt_ice   ! Mass flux 
     460                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoi * zdum * s_i_1d(ji) * a_i_1d(ji) * r1_Dt_ice   ! Salt flux 
     461                  !                                                                                         using s_i_1d and not sz_i_1d(jk) is ok 
    528462               ENDIF 
    529             
     463               ! update thickness 
     464               zh_i(ji,jk) = MAX( 0._wp, zh_i(ji,jk) + zdum ) 
     465               h_i_1d(ji)  = MAX( 0._wp, h_i_1d(ji)  + zdum ) 
     466               ! 
     467               ! update heat content (J.m-2) and layer thickness 
     468               eh_i_old(ji,jk) = eh_i_old(ji,jk) + zdum * e_i_1d(ji,jk) 
     469               h_i_old (ji,jk) = h_i_old (ji,jk) + zdum 
    530470            ENDIF 
    531471         END DO 
    532472      END DO 
    533473 
    534       ! Update temperature, energy 
    535       ! -------------------------- 
    536       DO ji = 1, npti 
    537          h_i_1d(ji) = MAX( 0._wp , h_i_1d(ji) + dh_i_bog(ji) + dh_i_bom(ji) ) 
    538       END DO   
    539  
    540       ! If heat still available then melt more snow 
    541       !------------------------------------------- 
    542       zdeltah(1:npti,:) = 0._wp ! important 
    543       DO ji = 1, npti 
    544          zq_rema (ji)   = zq_top(ji) + zq_bot(ji)  
    545          rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) )   ! =1 if snow 
    546          rswitch        = rswitch * MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,1) - epsi20 ) ) 
    547          zdeltah (ji,1) = - rswitch * zq_rema(ji) / MAX( e_s_1d(ji,1), epsi20 ) 
    548          zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - h_s_1d(ji) ) ) ! bound melting 
    549          dh_s_tot(ji)   = dh_s_tot(ji) + zdeltah(ji,1) 
    550          h_s_1d  (ji)   = h_s_1d  (ji) + zdeltah(ji,1) 
    551          
    552          zq_rema(ji)        = zq_rema(ji) + zdeltah(ji,1) * e_s_1d(ji,1)                               ! update available heat (J.m-2) 
    553          hfx_snw_1d(ji)     = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * e_s_1d(ji,1) * r1_Dt_ice   ! Heat used to melt snow, W.m-2 (>0) 
    554          wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhos * a_i_1d(ji) * zdeltah(ji,1) * r1_Dt_ice       ! Mass flux 
    555          dh_s_mlt(ji)       = dh_s_mlt(ji) + zdeltah(ji,1) 
    556          !     
    557          ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
    558          !!hfx_res_1d(ji) = hfx_res_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_Dt_ice 
    559  
    560          IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
    561       END DO 
    562  
    563       ! 
     474      ! Remove snow if ice has melted entirely 
     475      ! -------------------------------------- 
     476      DO jk = 0, nlay_s 
     477         DO ji = 1,npti 
     478            IF( h_i_1d(ji) == 0._wp ) THEN 
     479               ! mass & energy loss to the ocean 
     480               hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice  ! heat flux to the ocean [W.m-2], < 0 
     481               wfx_res_1d(ji) = wfx_res_1d(ji) + rhos        * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice  ! mass flux 
     482 
     483               ! update thickness and energy 
     484               h_s_1d(ji)    = 0._wp 
     485               ze_s  (ji,jk) = 0._wp 
     486               zh_s  (ji,jk) = 0._wp 
     487            ENDIF 
     488         END DO 
     489      END DO 
     490 
     491      ! Snow load on ice 
     492      ! ----------------- 
     493      ! When snow load exceeds Archimede's limit and sst is positive, 
     494      ! snow-ice formation (next bloc) can lead to negative ice enthalpy. 
     495      ! Therefore we consider here that this excess of snow falls into the ocean 
     496      zdeltah(1:npti) = h_s_1d(1:npti) + h_i_1d(1:npti) * (rhoi-rho0) * r1_rhos 
     497      DO jk = 0, nlay_s 
     498         DO ji = 1, npti 
     499            IF( zdeltah(ji) > 0._wp .AND. sst_1d(ji) > 0._wp ) THEN 
     500               ! snow layer thickness that falls into the ocean 
     501               zdum = MIN( zdeltah(ji) , zh_s(ji,jk) ) 
     502               ! mass & energy loss to the ocean 
     503               hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice  ! heat flux to the ocean [W.m-2], < 0 
     504               wfx_res_1d(ji) = wfx_res_1d(ji) + rhos        * zdum * a_i_1d(ji) * r1_Dt_ice  ! mass flux 
     505               ! update thickness and energy 
     506               h_s_1d(ji)    = MAX( 0._wp, h_s_1d(ji)  - zdum ) 
     507               zh_s  (ji,jk) = MAX( 0._wp, zh_s(ji,jk) - zdum ) 
     508               ! update snow thickness that still has to fall 
     509               zdeltah(ji)   = MAX( 0._wp, zdeltah(ji) - zdum ) 
     510            ENDIF 
     511         END DO 
     512      END DO 
     513 
    564514      ! Snow-Ice formation 
    565515      ! ------------------ 
    566       ! When snow load excesses Archimede's limit, snow-ice interface goes down under sea-level,  
    567       ! flooding of seawater transforms snow into ice dh_snowice is positive for the ice 
     516      ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level, 
     517      ! flooding of seawater transforms snow into ice. Thickness that is transformed is dh_snowice (positive for the ice) 
    568518      z1_rho = 1._wp / ( rhos+rho0-rhoi ) 
     519      zdeltah(1:npti) = 0._wp 
    569520      DO ji = 1, npti 
    570521         ! 
    571          dh_snowice(ji) = MAX(  0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho ) 
     522         dh_snowice(ji) = MAX( 0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho ) 
    572523 
    573524         h_i_1d(ji)    = h_i_1d(ji) + dh_snowice(ji) 
    … …  
    577528         zfmdt          = ( rhos - rhoi ) * dh_snowice(ji)    ! <0 
    578529         zEw            = rcp * sst_1d(ji) 
    579          zQm            = zfmdt * zEw  
    580           
    581          hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_Dt_ice ! Heat flux 
    582  
    583          sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * a_i_1d(ji) * zfmdt * r1_Dt_ice ! Salt flux 
     530         zQm            = zfmdt * zEw 
     531 
     532         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zEw        * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Heat flux 
     533         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_1d(ji) * zfmdt * a_i_1d(ji) * r1_Dt_ice ! Salt flux 
    584534 
    585535         ! Case constant salinity in time: virtual salt flux to keep salinity constant 
    586536         IF( nn_icesal /= 2 )  THEN 
    587             sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d (ji) * a_i_1d(ji) * zfmdt                  * r1_Dt_ice  & ! put back sss_m     into the ocean 
    588                &                            - s_i_1d(ji)  * a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice     ! and get  rn_icesal from the ocean  
     537            sfx_bri_1d(ji) = sfx_bri_1d(ji) - sss_1d(ji) * zfmdt                 * a_i_1d(ji) * r1_Dt_ice  & ! put back sss_m     into the ocean 
     538               &                            - s_i_1d(ji) * dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice     ! and get  rn_icesal from the ocean 
    589539         ENDIF 
    590540 
    591541         ! Mass flux: All snow is thrown in the ocean, and seawater is taken to replace the volume 
    592          wfx_sni_1d(ji)     = wfx_sni_1d(ji)     - a_i_1d(ji) * dh_snowice(ji) * rhoi * r1_Dt_ice 
    593          wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhos * r1_Dt_ice 
     542         wfx_sni_1d    (ji) = wfx_sni_1d    (ji) - dh_snowice(ji) * rhoi * a_i_1d(ji) * r1_Dt_ice 
     543         wfx_snw_sni_1d(ji) = wfx_snw_sni_1d(ji) + dh_snowice(ji) * rhos * a_i_1d(ji) * r1_Dt_ice 
     544 
     545         ! update thickness 
     546         zh_i(ji,0)  = zh_i(ji,0) + dh_snowice(ji) 
     547         zdeltah(ji) =              dh_snowice(ji) 
    594548 
    595549         ! update heat content (J.m-2) and layer thickness 
    596          eh_i_old(ji,0) = eh_i_old(ji,0) + dh_snowice(ji) * e_s_1d(ji,1) + zfmdt * zEw 
    597550         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 
    598           
    599       END DO 
    600  
    601       ! 
    602       ! Update temperature, energy 
    603       ! -------------------------- 
    604       DO ji = 1, npti 
    605          rswitch     = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) )  
    606          t_su_1d(ji) = rswitch * t_su_1d(ji) + ( 1._wp - rswitch ) * rt0 
    607       END DO 
    608  
     551         eh_i_old(ji,0) = eh_i_old(ji,0) + zfmdt * zEw           ! 1st part (sea water enthalpy) 
     552 
     553      END DO 
     554      ! 
     555      DO jk = nlay_s, 0, -1   ! flooding of snow starts from the base 
     556         DO ji = 1, npti 
     557            zdum           = MIN( zdeltah(ji), zh_s(ji,jk) )     ! amount of snw that floods, > 0 
     558            zh_s(ji,jk)    = MAX( 0._wp, zh_s(ji,jk) - zdum )    ! remove some snow thickness 
     559            eh_i_old(ji,0) = eh_i_old(ji,0) + zdum * ze_s(ji,jk) ! 2nd part (snow enthalpy) 
     560            ! update dh_snowice 
     561            zdeltah(ji)    = MAX( 0._wp, zdeltah(ji) - zdum ) 
     562         END DO 
     563      END DO 
     564      ! 
     565      ! 
     566!!$      ! --- Update snow diags --- ! 
     567!!$      !!clem: this is wrong. dh_s_tot is not used anyway 
     568!!$      DO ji = 1, npti 
     569!!$         dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah(ji) + zdh_s_sub(ji) - dh_snowice(ji) 
     570!!$      END DO 
     571      ! 
     572      ! 
     573      ! Remapping of snw enthalpy on a regular grid 
     574      !-------------------------------------------- 
     575      CALL snw_ent( zh_s, ze_s, e_s_1d ) 
     576 
     577      ! recalculate t_s_1d from e_s_1d 
    609578      DO jk = 1, nlay_s 
    610579         DO ji = 1,npti 
    611             ! where there is no ice or no snow 
    612             rswitch = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) ) * ( 1._wp - MAX( 0._wp, SIGN(1._wp, - h_i_1d(ji) ) ) ) 
    613             ! mass & energy loss to the ocean 
    614             hfx_res_1d(ji) = hfx_res_1d(ji) + ( 1._wp - rswitch ) * & 
    615                &                              ( e_s_1d(ji,jk) * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice )  ! heat flux to the ocean [W.m-2], < 0 
    616             wfx_res_1d(ji) = wfx_res_1d(ji) + ( 1._wp - rswitch ) * & 
    617                &                              ( rhos          * h_s_1d(ji) * r1_nlay_s * a_i_1d(ji) * r1_Dt_ice )  ! mass flux 
    618             ! update energy (mass is updated in the next loop) 
    619             e_s_1d(ji,jk) = rswitch * e_s_1d(ji,jk) 
    620             ! recalculate t_s_1d from e_s_1d 
    621             t_s_1d(ji,jk) = rt0 + rswitch * ( - e_s_1d(ji,jk) * r1_rhos * r1_rcpi + rLfus * r1_rcpi ) 
    622          END DO 
    623       END DO 
     580            IF( h_s_1d(ji) > 0._wp ) THEN 
     581               t_s_1d(ji,jk) = rt0 + ( - e_s_1d(ji,jk) * r1_rhos * r1_rcpi + rLfus * r1_rcpi ) 
     582            ELSE 
     583               t_s_1d(ji,jk) = rt0 
     584            ENDIF 
     585         END DO 
     586      END DO 
     587 
     588      ! Note: remapping of ice enthalpy is done in icethd.F90 
    624589 
    625590      ! --- ensure that a_i = 0 & h_s = 0 where h_i = 0 --- 
    626       WHERE( h_i_1d(1:npti) == 0._wp )    
    627          a_i_1d(1:npti) = 0._wp 
    628          h_s_1d(1:npti) = 0._wp 
     591      WHERE( h_i_1d(1:npti) == 0._wp ) 
     592         a_i_1d (1:npti) = 0._wp 
     593         h_s_1d (1:npti) = 0._wp 
     594         t_su_1d(1:npti) = rt0 
    629595      END WHERE 
    630       ! 
     596 
    631597   END SUBROUTINE ice_thd_dh 
     598 
     599   SUBROUTINE snw_ent( ph_old, pe_old, pe_new ) 
     600      !!------------------------------------------------------------------- 
     601      !!               ***   ROUTINE snw_ent  *** 
     602      !! 
     603      !! ** Purpose : 
     604      !!           This routine computes new vertical grids in the snow, 
     605      !!           and consistently redistributes temperatures. 
     606      !!           Redistribution is made so as to ensure to energy conservation 
     607      !! 
     608      !! 
     609      !! ** Method  : linear conservative remapping 
     610      !! 
     611      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 
     612      !!            2) linear remapping on the new layers 
     613      !! 
     614      !! ------------ cum0(0)                        ------------- cum1(0) 
     615      !!                                    NEW      ------------- 
     616      !! ------------ cum0(1)               ==>      ------------- 
     617      !!     ...                                     ------------- 
     618      !! ------------                                ------------- 
     619      !! ------------ cum0(nlay_s+1)                 ------------- cum1(nlay_s) 
     620      !! 
     621      !! 
     622      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 
     623      !!------------------------------------------------------------------- 
     624      REAL(wp), DIMENSION(jpij,0:nlay_s), INTENT(in   ) ::   ph_old             ! old thicknesses (m) 
     625      REAL(wp), DIMENSION(jpij,0:nlay_s), INTENT(in   ) ::   pe_old             ! old enthlapies (J.m-3) 
     626      REAL(wp), DIMENSION(jpij,1:nlay_s), INTENT(inout) ::   pe_new             ! new enthlapies (J.m-3, remapped) 
     627      ! 
     628      INTEGER  :: ji         !  dummy loop indices 
     629      INTEGER  :: jk0, jk1   !  old/new layer indices 
     630      ! 
     631      REAL(wp), DIMENSION(jpij,0:nlay_s+1) ::   zeh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces 
     632      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces 
     633      REAL(wp), DIMENSION(jpij)            ::   zhnew               ! new layers thicknesses 
     634      !!------------------------------------------------------------------- 
     635 
     636      !-------------------------------------------------------------------------- 
     637      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces 
     638      !-------------------------------------------------------------------------- 
     639      zeh_cum0(1:npti,0) = 0._wp 
     640      zh_cum0 (1:npti,0) = 0._wp 
     641      DO jk0 = 1, nlay_s+1 
     642         DO ji = 1, npti 
     643            zeh_cum0(ji,jk0) = zeh_cum0(ji,jk0-1) + pe_old(ji,jk0-1) * ph_old(ji,jk0-1) 
     644            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + ph_old(ji,jk0-1) 
     645         END DO 
     646      END DO 
     647 
     648      !------------------------------------ 
     649      !  2) Interpolation on the new layers 
     650      !------------------------------------ 
     651      ! new layer thickesses 
     652      DO ji = 1, npti 
     653         zhnew(ji) = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s 
     654      END DO 
     655 
     656      ! new layers interfaces 
     657      zh_cum1(1:npti,0) = 0._wp 
     658      DO jk1 = 1, nlay_s 
     659         DO ji = 1, npti 
     660            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 
     661         END DO 
     662      END DO 
     663 
     664      zeh_cum1(1:npti,0:nlay_s) = 0._wp 
     665      ! new cumulative q*h => linear interpolation 
     666      DO jk0 = 1, nlay_s+1 
     667         DO jk1 = 1, nlay_s-1 
     668            DO ji = 1, npti 
     669               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 
     670                  zeh_cum1(ji,jk1) = ( zeh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  & 
     671                     &                 zeh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  & 
     672                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 
     673               ENDIF 
     674            END DO 
     675         END DO 
     676      END DO 
     677      ! to ensure that total heat content is strictly conserved, set: 
     678      zeh_cum1(1:npti,nlay_s) = zeh_cum0(1:npti,nlay_s+1) 
     679 
     680      ! new enthalpies 
     681      DO jk1 = 1, nlay_s 
     682         DO ji = 1, npti 
     683            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) ) 
     684            pe_new(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 
     685         END DO 
     686      END DO 
     687 
     688   END SUBROUTINE snw_ent 
     689 
    632690 
    633691#else 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd_pnd.F90

    r13472 r14021  
    1 MODULE icethd_pnd  
     1MODULE icethd_pnd 
    22   !!====================================================================== 
    33   !!                     ***  MODULE  icethd_pnd   *** 
    … …  
    2020   USE ice1D          ! sea-ice: thermodynamics variables 
    2121   USE icetab         ! sea-ice: 1D <==> 2D transformation 
     22   USE sbc_ice        ! surface energy budget 
    2223   ! 
    2324   USE in_out_manager ! I/O manager 
     25   USE iom            ! I/O manager library 
    2426   USE lib_mpp        ! MPP library 
    2527   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero) 
    … …  
    3436   INTEGER ::              nice_pnd    ! choice of the type of pond scheme 
    3537   !                                   ! associated indices: 
    36    INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme 
    37    INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant ice pond scheme 
    38    INTEGER, PARAMETER ::   np_pndLEV = 2   ! Level ice pond scheme 
    39  
     38   INTEGER, PARAMETER ::   np_pndNO   = 0   ! No pond scheme 
     39   INTEGER, PARAMETER ::   np_pndCST  = 1   ! Constant ice pond scheme 
     40   INTEGER, PARAMETER ::   np_pndLEV  = 2   ! Level ice pond scheme 
     41   INTEGER, PARAMETER ::   np_pndTOPO = 3   ! Level ice pond scheme 
     42 
     43   !-------------------------------------------------------------------------- 
     44   ! Diagnostics for pond volume per area 
     45   ! 
     46   ! dV/dt = mlt + drn + lid + rnf 
     47   ! mlt   = input from surface melting 
     48   ! drn   = drainage through brine network 
     49   ! lid   = lid growth & melt 
     50   ! rnf   = runoff (water directly removed out of surface melting + overflow) 
     51   ! 
     52   ! In topo mode, the pond water lost because it is in the snow is not included in the budget 
     53   ! In level mode, all terms are incorporated 
     54   ! 
     55   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_mlt       ! meltwater pond volume input      [kg/m2/s] 
     56   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_drn       ! pond volume lost by drainage     [-] 
     57   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_lid       ! exchange with lid / refreezing   [-] 
     58   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   diag_dvpn_rnf       ! meltwater pond lost to runoff    [-] 
     59   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_mlt_1d    ! meltwater pond volume input      [-] 
     60   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_drn_1d    ! pond volume lost by drainage     [-] 
     61   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_lid_1d    ! exchange with lid / refreezing   [-] 
     62   REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   diag_dvpn_rnf_1d    ! meltwater pond lost to runoff    [-] 
     63 
     64   !! * Substitutions 
     65#  include "do_loop_substitute.h90" 
    4066   !!---------------------------------------------------------------------- 
    4167   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    4672 
    4773   SUBROUTINE ice_thd_pnd 
     74 
    4875      !!------------------------------------------------------------------- 
    4976      !!               ***  ROUTINE ice_thd_pnd   *** 
    50       !!                
     77      !! 
    5178      !! ** Purpose :   change melt pond fraction and thickness 
    52       !!                 
     79      !! 
     80      !! ** Note    : Melt ponds affect only radiative transfer for now 
     81      !!              No heat, no salt. 
     82      !!              The current diagnostics lacks a contribution from drainage 
    5383      !!------------------------------------------------------------------- 
     84      INTEGER ::   ji, jj, jl        ! loop indices 
     85      !!------------------------------------------------------------------- 
     86 
     87      ALLOCATE( diag_dvpn_mlt(jpi,jpj), diag_dvpn_lid(jpi,jpj), diag_dvpn_drn(jpi,jpj), diag_dvpn_rnf(jpi,jpj) ) 
     88      ALLOCATE( diag_dvpn_mlt_1d(jpij), diag_dvpn_lid_1d(jpij), diag_dvpn_drn_1d(jpij), diag_dvpn_rnf_1d(jpij) ) 
    5489      ! 
    55       SELECT CASE ( nice_pnd ) 
     90      diag_dvpn_mlt (:,:) = 0._wp   ;   diag_dvpn_drn (:,:) = 0._wp 
     91      diag_dvpn_lid (:,:) = 0._wp   ;   diag_dvpn_rnf (:,:) = 0._wp 
     92      diag_dvpn_mlt_1d(:) = 0._wp   ;   diag_dvpn_drn_1d(:) = 0._wp 
     93      diag_dvpn_lid_1d(:) = 0._wp   ;   diag_dvpn_rnf_1d(:) = 0._wp 
     94 
     95      !------------------------------------- 
     96      !  Remove ponds where ice has vanished 
     97      !------------------------------------- 
     98      at_i(:,:) = SUM( a_i, dim=3 ) 
    5699      ! 
    57       CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==! 
    58          ! 
    59       CASE (np_pndLEV)   ;   CALL pnd_LEV    !==  Level ice melt ponds  ==! 
    60          ! 
    61       END SELECT 
     100      DO jl = 1, jpl 
     101         DO_2D( 1, 1, 1, 1 ) 
     102            IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN 
     103               wfx_pnd  (ji,jj)    = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 
     104               a_ip     (ji,jj,jl) = 0._wp 
     105               v_ip     (ji,jj,jl) = 0._wp 
     106               v_il     (ji,jj,jl) = 0._wp 
     107               h_ip     (ji,jj,jl) = 0._wp 
     108               h_il     (ji,jj,jl) = 0._wp 
     109               a_ip_frac(ji,jj,jl) = 0._wp 
     110            ENDIF 
     111         END_2D 
     112      END DO 
     113 
     114      !------------------------------ 
     115      !  Identify grid cells with ice 
     116      !------------------------------ 
     117      npti = 0   ;   nptidx(:) = 0 
     118      DO_2D( 1, 1, 1, 1 ) 
     119         IF( at_i(ji,jj) >= epsi10 ) THEN 
     120            npti = npti + 1 
     121            nptidx( npti ) = (jj - 1) * jpi + ji 
     122         ENDIF 
     123      END_2D 
     124 
     125      !------------------------------------ 
     126      !  Select melt pond scheme to be used 
     127      !------------------------------------ 
     128      IF( npti > 0 ) THEN 
     129         SELECT CASE ( nice_pnd ) 
     130            ! 
     131         CASE (np_pndCST)   ;   CALL pnd_CST                              !==  Constant melt ponds  ==! 
     132            ! 
     133         CASE (np_pndLEV)   ;   CALL pnd_LEV                              !==  Level ice melt ponds  ==! 
     134            ! 
     135         CASE (np_pndTOPO)  ;   CALL pnd_TOPO                             !==  Topographic melt ponds  ==! 
     136            ! 
     137         END SELECT 
     138      ENDIF 
     139 
     140      !------------------------------------ 
     141      !  Diagnostics 
     142      !------------------------------------ 
     143      CALL iom_put( 'dvpn_mlt', diag_dvpn_mlt ) ! input from melting 
     144      CALL iom_put( 'dvpn_lid', diag_dvpn_lid ) ! exchanges with lid 
     145      CALL iom_put( 'dvpn_drn', diag_dvpn_drn ) ! vertical drainage 
     146      CALL iom_put( 'dvpn_rnf', diag_dvpn_rnf ) ! runoff + overflow 
    62147      ! 
    63    END SUBROUTINE ice_thd_pnd  
    64  
    65  
    66    SUBROUTINE pnd_CST  
     148      DEALLOCATE( diag_dvpn_mlt   , diag_dvpn_lid   , diag_dvpn_drn   , diag_dvpn_rnf    ) 
     149      DEALLOCATE( diag_dvpn_mlt_1d, diag_dvpn_lid_1d, diag_dvpn_drn_1d, diag_dvpn_rnf_1d ) 
     150 
     151   END SUBROUTINE ice_thd_pnd 
     152 
     153 
     154   SUBROUTINE pnd_CST 
    67155      !!------------------------------------------------------------------- 
    68156      !!                ***  ROUTINE pnd_CST  *** 
    … …  
    70158      !! ** Purpose :   Compute melt pond evolution 
    71159      !! 
    72       !! ** Method  :   Melt pond fraction and thickness are prescribed  
     160      !! ** Method  :   Melt pond fraction and thickness are prescribed 
    73161      !!                to non-zero values when t_su = 0C 
    74162      !! 
    75163      !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd) 
    76       !!                 
     164      !! 
    77165      !! ** Note   : Coupling with such melt ponds is only radiative 
    78166      !!             Advection, ridging, rafting... are bypassed 
    … …  
    80168      !! ** References : Bush, G.W., and Trump, D.J. (2017) 
    81169      !!------------------------------------------------------------------- 
    82       INTEGER  ::   ji        ! loop indices 
     170      INTEGER  ::   ji, jl    ! loop indices 
     171      REAL(wp) ::   zdv_pnd   ! Amount of water going into the ponds & lids 
    83172      !!------------------------------------------------------------------- 
    84       DO ji = 1, npti 
    85          ! 
    86          IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN 
    87             h_ip_1d(ji)      = rn_hpnd     
    88             a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
    89             h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
    90          ELSE 
    91             h_ip_1d(ji)      = 0._wp     
    92             a_ip_1d(ji)      = 0._wp 
    93             h_il_1d(ji)      = 0._wp 
    94          ENDIF 
    95          ! 
     173      DO jl = 1, jpl 
     174 
     175         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d    (1:npti), a_i    (:,:,jl) ) 
     176         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d   (1:npti), t_su   (:,:,jl) ) 
     177         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d   (1:npti), a_ip   (:,:,jl) ) 
     178         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d   (1:npti), h_ip   (:,:,jl) ) 
     179         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d   (1:npti), h_il   (:,:,jl) ) 
     180         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:)    ) 
     181 
     182         DO ji = 1, npti 
     183            ! 
     184            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) 
     185            ! 
     186            IF( a_i_1d(ji) >= 0.01_wp .AND. t_su_1d(ji) >= rt0 ) THEN 
     187               h_ip_1d(ji)      = rn_hpnd 
     188               a_ip_1d(ji)      = rn_apnd * a_i_1d(ji) 
     189               h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever 
     190            ELSE 
     191               h_ip_1d(ji)      = 0._wp 
     192               a_ip_1d(ji)      = 0._wp 
     193               h_il_1d(ji)      = 0._wp 
     194            ENDIF 
     195            ! 
     196            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) 
     197            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     198            ! 
     199            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) - zdv_pnd 
     200            wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zdv_pnd * rhow * r1_Dt_ice 
     201            ! 
     202         END DO 
     203 
     204         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d   (1:npti), a_ip   (:,:,jl) ) 
     205         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d   (1:npti), h_ip   (:,:,jl) ) 
     206         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d   (1:npti), h_il   (:,:,jl) ) 
     207         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d   (1:npti), v_ip   (:,:,jl) ) 
     208         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d   (1:npti), v_il   (:,:,jl) ) 
     209         CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd(:,:)    ) 
     210 
    96211      END DO 
    97212      ! 
    … …  
    107222      !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing 
    108223      !!              We  work with volumes and then redistribute changes into thickness and concentration 
    109       !!              assuming linear relationship between the two.  
     224      !!              assuming linear relationship between the two. 
    110225      !! 
    111226      !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 --- 
    … …  
    122237      !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 --- 
    123238      !! 
    124       !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H  
     239      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H 
    125240      !!                                                                      H = lid thickness 
    126241      !!                                                                      Lf = latent heat of fusion 
    … …  
    132247      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 --- 
    133248      !! 
    134       !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 --- 
    135       !!                                     perm = permability of sea-ice 
     249      !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi * flush         --- from Flocco et al 2007 --- 
     250      !!                                     perm = permability of sea-ice                              + correction from Hunke et al 2012 (flush) 
    136251      !!                                     visc = water viscosity 
    137252      !!                                     Hp   = height of top of the pond above sea-level 
    138253      !!                                     Hi   = ice thickness thru which there is flushing 
     254      !!                                     flush= correction otherwise flushing is excessive 
    139255      !! 
    140256      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness 
    … …  
    143259      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect 
    144260      !! 
    145       !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min 
    146       !!  
    147       !! ** Note       :   mostly stolen from CICE 
     261      !! ** Tunable parameters : rn_apnd_max, rn_apnd_min, rn_pnd_flush 
     262      !! 
     263      !! ** Note       :   Mostly stolen from CICE but not only. These are between level-ice ponds and CESM ponds. 
    148264      !! 
    149265      !! ** References :   Flocco and Feltham (JGR, 2007) 
    150266      !!                   Flocco et al       (JGR, 2010) 
    151267      !!                   Holland et al      (J. Clim, 2012) 
     268      !!                   Hunke et al        (OM 2012) 
    152269      !!------------------------------------------------------------------- 
    153270      REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array 
    … …  
    157274      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity 
    158275      !! 
    159       REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding 
     276      REAL(wp) ::   zfr_mlt, zdv_mlt, zdv_avail       ! fraction and volume of available meltwater retained for melt ponding 
    160277      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes 
     278      REAL(wp) ::   zdv_pnd                           ! Amount of water going into the ponds & lids 
    161279      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh 
    162280      REAL(wp) ::   zv_ip_max                         ! max pond volume allowed 
    163281      REAL(wp) ::   zdT                               ! zTp-t_su 
    164       REAL(wp) ::   zsbr                              ! Brine salinity 
     282      REAL(wp) ::   zsbr, ztmelts                     ! Brine salinity 
    165283      REAL(wp) ::   zperm                             ! permeability of sea ice 
    166284      REAL(wp) ::   zfac, zdum                        ! temporary arrays 
    167285      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse 
    168286      !! 
    169       INTEGER  ::   ji, jk                            ! loop indices 
     287      INTEGER  ::   ji, jk, jl                        ! loop indices 
    170288      !!------------------------------------------------------------------- 
    171       z1_rhow   = 1._wp / rhow  
     289      z1_rhow   = 1._wp / rhow 
    172290      z1_aspect = 1._wp / zaspect 
    173       z1_Tp     = 1._wp / zTp  
    174  
    175       DO ji = 1, npti 
    176          !                                                            !----------------------------------------------------! 
    177          IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction ! 
    178             !                                                         !----------------------------------------------------! 
    179             !--- Remove ponds on thin ice or tiny ice fractions 
    180             a_ip_1d(ji)      = 0._wp 
    181             h_ip_1d(ji)      = 0._wp 
    182             h_il_1d(ji)      = 0._wp 
    183             !                                                         !--------------------------------! 
    184          ELSE                                                         ! Case ice thickness >= rn_himin ! 
    185             !                                                         !--------------------------------! 
    186             v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     291      z1_Tp     = 1._wp / zTp 
     292 
     293      CALL tab_2d_1d( npti, nptidx(1:npti), at_i_1d          (1:npti), at_i          ) 
     294      CALL tab_2d_1d( npti, nptidx(1:npti), wfx_pnd_1d       (1:npti), wfx_pnd       ) 
     295 
     296      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt ) 
     297      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn ) 
     298      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_lid_1d (1:npti), diag_dvpn_lid ) 
     299      CALL tab_2d_1d( npti, nptidx(1:npti), diag_dvpn_rnf_1d (1:npti), diag_dvpn_rnf ) 
     300 
     301      DO jl = 1, jpl 
     302 
     303         CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d  (1:npti), a_i (:,:,jl) ) 
     304         CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d  (1:npti), h_i (:,:,jl) ) 
     305         CALL tab_2d_1d( npti, nptidx(1:npti), t_su_1d (1:npti), t_su(:,:,jl) ) 
     306         CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip(:,:,jl) ) 
     307         CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip(:,:,jl) ) 
     308         CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il(:,:,jl) ) 
     309 
     310         CALL tab_2d_1d( npti, nptidx(1:npti), dh_i_sum(1:npti), dh_i_sum_2d(:,:,jl) ) 
     311         CALL tab_2d_1d( npti, nptidx(1:npti), dh_s_mlt(1:npti), dh_s_mlt_2d(:,:,jl) ) 
     312 
     313         DO jk = 1, nlay_i 
     314            CALL tab_2d_1d( npti, nptidx(1:npti), sz_i_1d(1:npti,jk), sz_i(:,:,jk,jl) ) 
     315            CALL tab_2d_1d( npti, nptidx(1:npti), t_i_1d (1:npti,jk), t_i (:,:,jk,jl) ) 
     316         END DO 
     317 
     318         !----------------------- 
     319         ! Melt pond calculations 
     320         !----------------------- 
     321         DO ji = 1, npti 
     322            ! 
     323            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) 
     324            !                                                            !----------------------------------------------------! 
     325            IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < 0.01_wp ) THEN   ! Case ice thickness < rn_himin or tiny ice fraction ! 
     326               !                                                         !----------------------------------------------------! 
     327               !--- Remove ponds on thin ice or tiny ice fractions 
     328               a_ip_1d(ji) = 0._wp 
     329               h_ip_1d(ji) = 0._wp 
     330               h_il_1d(ji) = 0._wp 
     331               !                                                         !--------------------------------! 
     332            ELSE                                                         ! Case ice thickness >= rn_himin ! 
     333               !                                                         !--------------------------------! 
     334               v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness 
     335               v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
     336               ! 
     337               !------------------! 
     338               ! case ice melting ! 
     339               !------------------! 
     340               ! 
     341               !--- available meltwater for melt ponding (zdv_avail) ---! 
     342               zdv_avail = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) ! > 0 
     343               zfr_mlt   = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed 
     344               zdv_mlt   = MAX( 0._wp, zfr_mlt * zdv_avail ) ! max for roundoff errors? 
     345               ! 
     346               !--- overflow ---! 
     347               ! 
     348               ! area driven overflow 
     349               !    If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
     350               !       a_ip_max = zfr_mlt * a_i 
     351               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 
     352               zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
     353               zdv_mlt   = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     354 
     355               ! depth driven overflow 
     356               !    If pond depth exceeds half the ice thickness then reduce the pond volume 
     357               !       h_ip_max = 0.5 * h_i 
     358               !       => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as: 
     359               zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
     360               zdv_mlt   = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
     361 
     362               !--- Pond growing ---! 
     363               v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
     364               ! 
     365               !--- Lid melting ---! 
     366               IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
     367               ! 
     368               !-------------------! 
     369               ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
     370               !-------------------! 
     371               ! 
     372               zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
     373               ! 
     374               !--- Pond contraction (due to refreezing) ---! 
     375               IF( ln_pnd_lids ) THEN 
     376                  ! 
     377                  !--- Lid growing and subsequent pond shrinking ---! 
     378                  zdv_frz = - 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
     379                     &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rDt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
     380 
     381                  ! Lid growing 
     382                  v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_frz ) 
     383 
     384                  ! Pond shrinking 
     385                  v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz ) 
     386 
     387               ELSE 
     388                  zdv_frz = v_ip_1d(ji) * ( EXP( 0.01_wp * zdT * z1_Tp ) - 1._wp )  ! Holland 2012 (eq. 6) 
     389                  ! Pond shrinking 
     390                  v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zdv_frz ) 
     391               ENDIF 
     392               ! 
     393               !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     394               ! v_ip     = h_ip * a_ip 
     395               ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 
     396               a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     397               h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     398               ! 
     399 
     400               !------------------------------------------------! 
     401               ! Pond drainage through brine network (flushing) ! 
     402               !------------------------------------------------! 
     403               ! height of top of the pond above sea-level 
     404               zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 
     405 
     406               ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 
     407               DO jk = 1, nlay_i 
     408                  ! MV Assur is inconsistent with SI3 
     409                  !!zsbr = - 1.2_wp                                  & 
     410                  !!   &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
     411                  !!   &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
     412                  !!   &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 
     413                  !!ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
     414                  ! MV linear expression more consistent & simpler: zsbr = - ( t_i_1d(ji,jk) - rt0 ) / rTmlt 
     415                  ztmelts  = -rTmlt * sz_i_1d(ji,jk) 
     416                  ztmp(jk) = ztmelts / MIN( ztmelts, t_i_1d(ji,jk) - rt0 ) 
     417               END DO 
     418               zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
     419 
     420               ! Do the drainage using Darcy's law 
     421               zdv_flush   = -zperm * rho0 * grav * zhp * rDt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) * rn_pnd_flush ! zflush comes from Hunke et al. (2012) 
     422               zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) ! < 0 
     423               v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
     424 
     425               !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
     426               a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
     427               h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
     428 
     429               !--- Corrections and lid thickness ---! 
     430               IF( ln_pnd_lids ) THEN 
     431                  !--- retrieve lid thickness from volume ---! 
     432                  IF( a_ip_1d(ji) > 0.01_wp ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
     433                  ELSE                               ;   h_il_1d(ji) = 0._wp 
     434                  ENDIF 
     435                  !--- remove ponds if lids are much larger than ponds ---! 
     436                  IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
     437                     a_ip_1d(ji) = 0._wp 
     438                     h_ip_1d(ji) = 0._wp 
     439                     h_il_1d(ji) = 0._wp 
     440                  ENDIF 
     441               ENDIF 
     442 
     443               ! diagnostics: dvpnd = mlt+rnf+lid+drn 
     444               diag_dvpn_mlt_1d(ji) = diag_dvpn_mlt_1d(ji) + rhow *   zdv_avail             * r1_Dt_ice   ! > 0, surface melt input 
     445               diag_dvpn_rnf_1d(ji) = diag_dvpn_rnf_1d(ji) + rhow * ( zdv_mlt - zdv_avail ) * r1_Dt_ice   ! < 0, runoff 
     446               diag_dvpn_lid_1d(ji) = diag_dvpn_lid_1d(ji) + rhow *   zdv_frz               * r1_Dt_ice   ! < 0, shrinking 
     447               diag_dvpn_drn_1d(ji) = diag_dvpn_drn_1d(ji) + rhow *   zdv_flush             * r1_Dt_ice   ! < 0, drainage 
     448               ! 
     449            ENDIF 
     450            ! 
     451            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji) 
    187452            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji) 
    188453            ! 
    189             !------------------! 
    190             ! case ice melting ! 
    191             !------------------! 
     454            zdv_pnd = ( h_ip_1d(ji) + h_il_1d(ji) ) * a_ip_1d(ji) - zdv_pnd 
     455            wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zdv_pnd * rhow * r1_Dt_ice 
    192456            ! 
    193             !--- available meltwater for melt ponding ---! 
    194             zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 
    195             zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed 
    196             zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors?  
    197             ! 
    198             !--- overflow ---! 
    199             ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume 
    200             !    a_ip_max = zfr_mlt * a_i 
    201             !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
    202             zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect 
    203             zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
    204  
    205             ! If pond depth exceeds half the ice thickness then reduce the pond volume 
    206             !    h_ip_max = 0.5 * h_i 
    207             !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:  
    208             zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) 
    209             zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) ) 
    210              
    211             !--- Pond growing ---! 
    212             v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt 
    213             ! 
    214             !--- Lid melting ---! 
    215             IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0 
    216             ! 
    217             !--- mass flux ---! 
    218             IF( zdv_mlt > 0._wp ) THEN 
    219                zfac = zdv_mlt * rhow * r1_Dt_ice                        ! melt pond mass flux < 0 [kg.m-2.s-1] 
    220                wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac 
    221                ! 
    222                zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux 
    223                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum) 
    224                wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum) 
    225             ENDIF 
    226  
    227             !-------------------! 
    228             ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0) 
    229             !-------------------! 
    230             ! 
    231             zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) 
    232             ! 
    233             !--- Pond contraction (due to refreezing) ---! 
    234             IF( ln_pnd_lids ) THEN 
    235                ! 
    236                !--- Lid growing and subsequent pond shrinking ---!  
    237                zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0 
    238                   &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors 
    239                 
    240                ! Lid growing 
    241                v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz ) 
    242                 
    243                ! Pond shrinking 
    244                v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz ) 
    245  
    246             ELSE 
    247                ! Pond shrinking 
    248                v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6) 
    249             ENDIF 
    250             ! 
    251             !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
    252             ! v_ip     = h_ip * a_ip 
    253             ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip) 
    254             a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
    255             h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
    256  
    257             !---------------!             
    258             ! Pond flushing ! 
    259             !---------------! 
    260             ! height of top of the pond above sea-level 
    261             zhp = ( h_i_1d(ji) * ( rho0 - rhoi ) + h_ip_1d(ji) * ( rho0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rho0 
    262              
    263             ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 
    264             DO jk = 1, nlay_i 
    265                zsbr = - 1.2_wp                                  & 
    266                   &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    & 
    267                   &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 & 
    268                   &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3 
    269                ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
    270             END DO 
    271             zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
    272              
    273             ! Do the drainage using Darcy's law 
    274             zdv_flush   = -zperm * rho0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 
    275             zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) ) 
    276             v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 
    277              
    278             !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 
    279             a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 
    280             h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji) 
    281  
    282             !--- Corrections and lid thickness ---! 
    283             IF( ln_pnd_lids ) THEN 
    284                !--- retrieve lid thickness from volume ---! 
    285                IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji) 
    286                ELSE                              ;   h_il_1d(ji) = 0._wp 
    287                ENDIF 
    288                !--- remove ponds if lids are much larger than ponds ---! 
    289                IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN 
    290                   a_ip_1d(ji)      = 0._wp 
    291                   h_ip_1d(ji)      = 0._wp 
    292                   h_il_1d(ji)      = 0._wp 
    293                ENDIF 
    294             ENDIF 
    295             ! 
    296          ENDIF 
    297           
     457         END DO 
     458 
     459         !-------------------------------------------------------------------- 
     460         ! Retrieve 2D arrays 
     461         !-------------------------------------------------------------------- 
     462         CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d(1:npti), a_ip(:,:,jl) ) 
     463         CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d(1:npti), h_ip(:,:,jl) ) 
     464         CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d(1:npti), h_il(:,:,jl) ) 
     465         CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,jl) ) 
     466         CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,jl) ) 
     467         ! 
    298468      END DO 
    299469      ! 
     470      CALL tab_1d_2d( npti, nptidx(1:npti), wfx_pnd_1d(1:npti), wfx_pnd ) 
     471      ! 
     472      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_mlt_1d (1:npti), diag_dvpn_mlt        ) 
     473      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_drn_1d (1:npti), diag_dvpn_drn        ) 
     474      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_lid_1d (1:npti), diag_dvpn_lid        ) 
     475      CALL tab_1d_2d( npti, nptidx(1:npti), diag_dvpn_rnf_1d (1:npti), diag_dvpn_rnf        ) 
     476      ! 
    300477   END SUBROUTINE pnd_LEV 
    301478 
    302479 
    303    SUBROUTINE ice_thd_pnd_init  
     480 
     481   SUBROUTINE pnd_TOPO 
     482 
     483      !!------------------------------------------------------------------- 
     484      !!                ***  ROUTINE pnd_TOPO  *** 
     485      !! 
     486      !! ** Purpose :   Compute melt pond evolution based on the ice 
     487      !!                topography inferred from the ice thickness distribution 
     488      !! 
     489      !! ** Method  :   This code is initially based on Flocco and Feltham 
     490      !!                (2007) and Flocco et al. (2010). 
     491      !! 
     492      !!                - Calculate available pond water base on surface meltwater 
     493      !!                - Redistribute water as a function of topography, drain water 
     494      !!                - Exchange water with the lid 
     495      !! 
     496      !! ** Tunable parameters : 
     497      !! 
     498      !! ** Note : 
     499      !! 
     500      !! ** References 
     501      !! 
     502      !!    Flocco, D. and D. L. Feltham, 2007.  A continuum model of melt pond 
     503      !!    evolution on Arctic sea ice.  J. Geophys. Res. 112, C08016, doi: 
     504      !!    10.1029/2006JC003836. 
     505      !! 
     506      !!    Flocco, D., D. L. Feltham and A. K. Turner, 2010.  Incorporation of 
     507      !!    a physically based melt pond scheme into the sea ice component of a 
     508      !!    climate model.  J. Geophys. Res. 115, C08012, 
     509      !!    doi: 10.1029/2009JC005568. 
     510      !! 
     511      !!------------------------------------------------------------------- 
     512      REAL(wp), PARAMETER :: &   ! shared parameters for topographic melt ponds 
     513         zTd     = 0.15_wp       , & ! temperature difference for freeze-up (C) 
     514         zvp_min = 1.e-4_wp          ! minimum pond volume (m) 
     515 
     516 
     517      ! local variables 
     518      REAL(wp) :: & 
     519         zdHui,   &      ! change in thickness of ice lid (m) 
     520         zomega,  &      ! conduction 
     521         zdTice,  &      ! temperature difference across ice lid (C) 
     522         zdvice,  &      ! change in ice volume (m) 
     523         zTavg,   &      ! mean surface temperature across categories (C) 
     524         zfsurf,  &      ! net heat flux, excluding conduction and transmitted radiation (W/m2) 
     525         zTp,     &      ! pond freezing temperature (C) 
     526         zrhoi_L, &      ! volumetric latent heat of sea ice (J/m^3) 
     527         zfr_mlt, &      ! fraction and volume of available meltwater retained for melt ponding 
     528         z1_rhow, &      ! inverse water density 
     529         zv_pnd  , &     ! volume of meltwater contributing to ponds 
     530         zv_mlt          ! total amount of meltwater produced 
     531 
     532      REAL(wp), DIMENSION(jpi,jpj) ::   zvolp, &     !! total melt pond water available before redistribution and drainage 
     533                                        zvolp_res    !! remaining melt pond water available after drainage 
     534 
     535      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_a_i 
     536 
     537      INTEGER  ::   ji, jj, jk, jl                    ! loop indices 
     538 
     539      INTEGER  ::   i_test 
     540 
     541      ! Note 
     542      ! equivalent for CICE translation 
     543      ! a_ip      -> apond 
     544      ! a_ip_frac -> apnd 
     545 
     546      CALL ctl_stop( 'STOP', 'icethd_pnd : topographic melt ponds are still an ongoing work' ) 
     547 
     548      !--------------------------------------------------------------- 
     549      ! Initialise 
     550      !--------------------------------------------------------------- 
     551 
     552      ! Parameters & constants (move to parameters) 
     553      zrhoi_L   = rhoi * rLfus      ! volumetric latent heat (J/m^3) 
     554      zTp       = rt0 - 0.15_wp          ! pond freezing point, slightly below 0C (ponds are bid saline) 
     555      z1_rhow   = 1._wp / rhow 
     556 
     557      ! Set required ice variables (hard-coded here for now) 
     558!      zfpond(:,:) = 0._wp          ! contributing freshwater flux (?) 
     559 
     560      at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) ! ice fraction 
     561      vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) ! volume per grid area 
     562      vt_ip(:,:) = SUM( v_ip(:,:,:), dim=3 ) ! pond volume per grid area 
     563      vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) ! lid volume per grid area 
     564 
     565      ! thickness 
     566      WHERE( a_i(:,:,:) > epsi20 )   ;   z1_a_i(:,:,:) = 1._wp / a_i(:,:,:) 
     567      ELSEWHERE                      ;   z1_a_i(:,:,:) = 0._wp 
     568      END WHERE 
     569      h_i(:,:,:) = v_i (:,:,:) * z1_a_i(:,:,:) 
     570 
     571      !--------------------------------------------------------------- 
     572      ! Change 2D to 1D 
     573      !--------------------------------------------------------------- 
     574      ! MV 
     575      ! a less computing-intensive version would have 2D-1D passage here 
     576      ! use what we have in iceitd.F90 (incremental remapping) 
     577 
     578      !-------------------------------------------------------------- 
     579      ! Collect total available pond water volume 
     580      !-------------------------------------------------------------- 
     581      ! Assuming that meltwater (+rain in principle) runsoff the surface 
     582      ! Holland et al (2012) suggest that the fraction of runoff decreases with total ice fraction 
     583      ! I cite her words, they are very talkative 
     584      ! "grid cells with very little ice cover (and hence more open water area) 
     585      ! have a higher runoff fraction to rep- resent the greater proximity of ice to open water." 
     586      ! "This results in the same runoff fraction r for each ice category within a grid cell" 
     587 
     588      zvolp(:,:) = 0._wp 
     589 
     590      DO jl = 1, jpl 
     591         DO_2D( 1, 1, 1, 1 ) 
     592 
     593               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
     594 
     595                  !--- Available and contributing meltwater for melt ponding ---! 
     596                  zv_mlt  = - ( dh_i_sum_2d(ji,jj,jl) * rhoi + dh_s_mlt_2d(ji,jj,jl) * rhos ) &        ! available volume of surface melt water per grid area 
     597                     &    * z1_rhow * a_i(ji,jj,jl) 
     598                      ! MV -> could move this directly in ice_thd_dh and get an array (ji,jj,jl) for surface melt water volume per grid area 
     599                  zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i(ji,jj)                  ! fraction of surface meltwater going to ponds 
     600                  zv_pnd  = zfr_mlt * zv_mlt                                                           ! contributing meltwater volume for category jl 
     601 
     602                  diag_dvpn_mlt(ji,jj) = diag_dvpn_mlt(ji,jj) + zv_mlt * r1_Dt_ice                     ! diags 
     603                  diag_dvpn_rnf(ji,jj) = diag_dvpn_rnf(ji,jj) + ( 1. - zfr_mlt ) * zv_mlt * r1_Dt_ice 
     604 
     605                  !--- Create possible new ponds 
     606                  ! if pond does not exist, create new pond over full ice area 
     607                  !IF ( a_ip_frac(ji,jj,jl) < epsi10 ) THEN 
     608                  IF ( a_ip(ji,jj,jl) < epsi10 ) THEN 
     609                     a_ip(ji,jj,jl)       = a_i(ji,jj,jl) 
     610                     a_ip_frac(ji,jj,jl)  = 1.0_wp    ! pond fraction of sea ice (apnd for CICE) 
     611                  ENDIF 
     612 
     613                  !--- Deepen existing ponds with no change in pond fraction, before redistribution and drainage 
     614                  v_ip(ji,jj,jl) = v_ip(ji,jj,jl) +  zv_pnd                                            ! use pond water to increase thickness 
     615                  h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
     616 
     617                  !--- Total available pond water volume (pre-existing + newly produced)j 
     618                  zvolp(ji,jj)   = zvolp(ji,jj)   + v_ip(ji,jj,jl) 
     619!                 zfpond(ji,jj) = zfpond(ji,jj) + zpond * a_ip_frac(ji,jj,jl) ! useless for now 
     620 
     621               ENDIF ! a_i 
     622 
     623         END_2D 
     624      END DO ! ji 
     625 
     626      !-------------------------------------------------------------- 
     627      ! Redistribute and drain water from ponds 
     628      !-------------------------------------------------------------- 
     629      CALL ice_thd_pnd_area( zvolp, zvolp_res ) 
     630 
     631      !-------------------------------------------------------------- 
     632      ! Melt pond lid growth and melt 
     633      !-------------------------------------------------------------- 
     634 
     635      IF( ln_pnd_lids ) THEN 
     636 
     637         DO_2D( 1, 1, 1, 1 ) 
     638 
     639            IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. vt_ip(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 
     640 
     641               !-------------------------- 
     642               ! Pond lid growth and melt 
     643               !-------------------------- 
     644               ! Mean surface temperature 
     645               zTavg = 0._wp 
     646               DO jl = 1, jpl 
     647                  zTavg = zTavg + t_su(ji,jj,jl)*a_i(ji,jj,jl) 
     648               END DO 
     649               zTavg = zTavg / a_i(ji,jj,jl) !!! could get a division by zero here 
     650 
     651               DO jl = 1, jpl-1 
     652 
     653                  IF ( v_il(ji,jj,jl) > epsi10 ) THEN 
     654 
     655                     !---------------------------------------------------------------- 
     656                     ! Lid melting: floating upper ice layer melts in whole or part 
     657                     !---------------------------------------------------------------- 
     658                     ! Use Tsfc for each category 
     659                     IF ( t_su(ji,jj,jl) > zTp ) THEN 
     660 
     661                        zdvice = MIN( dh_i_sum_2d(ji,jj,jl)*a_ip(ji,jj,jl), v_il(ji,jj,jl) ) 
     662 
     663                        IF ( zdvice > epsi10 ) THEN 
     664 
     665                           v_il (ji,jj,jl) = v_il (ji,jj,jl)   - zdvice 
     666                           v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)    + zdvice ! MV: not sure i understand dh_i_sum seems counted twice - 
     667                                                                        ! as it is already counted in surface melt 
     668!                          zvolp(ji,jj)     = zvolp(ji,jj)     + zdvice ! pointless to calculate total volume (done in icevar) 
     669!                          zfpond(ji,jj)    = fpond(ji,jj)     + zdvice ! pointless to follow fw budget (ponds have no fw) 
     670 
     671                           IF ( v_il(ji,jj,jl) < epsi10 .AND. v_ip(ji,jj,jl) > epsi10) THEN 
     672                           ! ice lid melted and category is pond covered 
     673                              v_ip(ji,jj,jl)  = v_ip(ji,jj,jl)  + v_il(ji,jj,jl) 
     674!                             zfpond(ji,jj)    = zfpond (ji,jj)    + v_il(ji,jj,jl) 
     675                              v_il(ji,jj,jl)   = 0._wp 
     676                           ENDIF 
     677                           h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) !!! could get a division by zero here 
     678 
     679                           diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) + zdvice   ! diag 
     680 
     681                        ENDIF 
     682 
     683                     !---------------------------------------------------------------- 
     684                     ! Freeze pre-existing lid 
     685                     !---------------------------------------------------------------- 
     686 
     687                     ELSE IF ( v_ip(ji,jj,jl) > epsi10 ) THEN ! Tsfcn(i,j,n) <= Tp 
     688 
     689                        ! differential growth of base of surface floating ice layer 
     690                        zdTice = MAX( - t_su(ji,jj,jl) - zTd , 0._wp ) ! > 0 
     691                        zomega = rcnd_i * zdTice / zrhoi_L 
     692                        zdHui  = SQRT( 2._wp * zomega * rDt_ice + ( v_il(ji,jj,jl) / a_i(ji,jj,jl) )**2 ) & 
     693                               - v_il(ji,jj,jl) / a_i(ji,jj,jl) 
     694                        zdvice = min( zdHui*a_ip(ji,jj,jl) , v_ip(ji,jj,jl) ) 
     695 
     696                        IF ( zdvice > epsi10 ) THEN 
     697                           v_il (ji,jj,jl)  = v_il(ji,jj,jl)   + zdvice 
     698                           v_ip(ji,jj,jl)   = v_ip(ji,jj,jl)   - zdvice 
     699!                          zvolp(ji,jj)    = zvolp(ji,jj)     - zdvice 
     700!                          zfpond(ji,jj)   = zfpond(ji,jj)    - zdvice 
     701                           h_ip(ji,jj,jl)   = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
     702 
     703                           diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice    ! diag 
     704 
     705                        ENDIF 
     706 
     707                     ENDIF ! Tsfcn(i,j,n) 
     708 
     709                  !---------------------------------------------------------------- 
     710                  ! Freeze new lids 
     711                  !---------------------------------------------------------------- 
     712                  !  upper ice layer begins to form 
     713                  ! note: albedo does not change 
     714 
     715                  ELSE ! v_il < epsi10 
     716 
     717                     ! thickness of newly formed ice 
     718                     ! the surface temperature of a meltpond is the same as that 
     719                     ! of the ice underneath (0C), and the thermodynamic surface 
     720                     ! flux is the same 
     721 
     722                     !!! we need net surface energy flux, excluding conduction 
     723                     !!! fsurf is summed over categories in CICE 
     724                     !!! we have the category-dependent flux, let us use it ? 
     725                     zfsurf = qns_ice(ji,jj,jl) + qsr_ice(ji,jj,jl) 
     726                     zdHui  = MAX ( -zfsurf * rDt_ice/zrhoi_L , 0._wp ) 
     727                     zdvice = MIN ( zdHui * a_ip(ji,jj,jl) , v_ip(ji,jj,jl) ) 
     728                     IF ( zdvice > epsi10 ) THEN 
     729                        v_il (ji,jj,jl)  = v_il(ji,jj,jl)   + zdvice 
     730                        v_ip(ji,jj,jl)   = v_ip(ji,jj,jl)   - zdvice 
     731 
     732                        diag_dvpn_lid(ji,jj) = diag_dvpn_lid(ji,jj) - zdvice      ! diag 
     733!                       zvolp(ji,jj)     = zvolp(ji,jj)     - zdvice 
     734!                       zfpond(ji,jj)    = zfpond(ji,jj)    - zdvice 
     735                        h_ip(ji,jj,jl)   = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) ! MV - in principle, this is useless as h_ip is computed in icevar 
     736                     ENDIF 
     737 
     738                  ENDIF  ! v_il 
     739 
     740               END DO ! jl 
     741 
     742            ELSE  ! remove ponds on thin ice 
     743 
     744               v_ip(ji,jj,:) = 0._wp 
     745               v_il(ji,jj,:) = 0._wp 
     746!              zfpond(ji,jj) = zfpond(ji,jj)- zvolp(ji,jj) 
     747!                 zvolp(ji,jj)    = 0._wp 
     748 
     749            ENDIF 
     750 
     751         END_2D 
     752 
     753      ENDIF ! ln_pnd_lids 
     754 
     755      !--------------------------------------------------------------- 
     756      ! Clean-up variables (probably duplicates what icevar would do) 
     757      !--------------------------------------------------------------- 
     758      ! MV comment 
     759      ! In the ideal world, the lines above should update only v_ip, a_ip, v_il 
     760      ! icevar should recompute all other variables (if needed at all) 
     761 
     762      DO jl = 1, jpl 
     763 
     764         DO_2D( 1, 1, 1, 1 ) 
     765 
     766!              ! zap lids on small ponds 
     767!              IF ( a_i(ji,jj,jl) > epsi10 .AND. v_ip(ji,jj,jl) < epsi10 & 
     768!                                          .AND. v_il(ji,jj,jl) > epsi10) THEN 
     769!                 v_il(ji,jj,jl) = 0._wp ! probably uselesss now since we get zap_small 
     770!              ENDIF 
     771 
     772               ! recalculate equivalent pond variables 
     773               IF ( a_ip(ji,jj,jl) > epsi10) THEN 
     774                  h_ip(ji,jj,jl)      = v_ip(ji,jj,jl) / a_i(ji,jj,jl) 
     775                  a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i(ji,jj,jl) ! MV in principle, useless as computed in icevar 
     776                  h_il(ji,jj,jl) = v_il(ji,jj,jl) / a_ip(ji,jj,jl) ! MV in principle, useless as computed in icevar 
     777               ENDIF 
     778!                 h_ip(ji,jj,jl)      = 0._wp ! MV in principle, useless as computed in icevar 
     779!                 h_il(ji,jj,jl)      = 0._wp ! MV in principle, useless as omputed in icevar 
     780!              ENDIF 
     781 
     782         END_2D 
     783 
     784      END DO   ! jl 
     785 
     786 
     787   END SUBROUTINE pnd_TOPO 
     788 
     789 
     790   SUBROUTINE ice_thd_pnd_area( zvolp , zdvolp ) 
     791 
     792       !!------------------------------------------------------------------- 
     793       !!                ***  ROUTINE ice_thd_pnd_area *** 
     794       !! 
     795       !! ** Purpose : Given the total volume of available pond water, 
     796       !!              redistribute and drain water 
     797       !! 
     798       !! ** Method 
     799       !! 
     800       !-----------| 
     801       !           | 
     802       !           |-----------| 
     803       !___________|___________|______________________________________sea-level 
     804       !           |           | 
     805       !           |           |---^--------| 
     806       !           |           |   |        | 
     807       !           |           |   |        |-----------|              |------- 
     808       !           |           |   | alfan  |           |              | 
     809       !           |           |   |        |           |--------------| 
     810       !           |           |   |        |           |              | 
     811       !---------------------------v------------------------------------------- 
     812       !           |           |   ^        |           |              | 
     813       !           |           |   |        |           |--------------| 
     814       !           |           |   | betan  |           |              | 
     815       !           |           |   |        |-----------|              |------- 
     816       !           |           |   |        | 
     817       !           |           |---v------- | 
     818       !           |           | 
     819       !           |-----------| 
     820       !           | 
     821       !-----------| 
     822       ! 
     823       !! 
     824       !!------------------------------------------------------------------ 
     825 
     826       REAL (wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & 
     827          zvolp,                                       &  ! total available pond water 
     828          zdvolp                                          ! remaining meltwater after redistribution 
     829 
     830       INTEGER ::  & 
     831          ns,      & 
     832          m_index, & 
     833          permflag 
     834 
     835       REAL (wp), DIMENSION(jpl) :: & 
     836          hicen, & 
     837          hsnon, & 
     838          asnon, & 
     839          alfan, & 
     840          betan, & 
     841          cum_max_vol, & 
     842          reduced_aicen 
     843 
     844       REAL (wp), DIMENSION(0:jpl) :: & 
     845          cum_max_vol_tmp 
     846 
     847       REAL (wp) :: & 
     848          hpond, & 
     849          drain, & 
     850          floe_weight, & 
     851          pressure_head, & 
     852          hsl_rel, & 
     853          deltah, & 
     854          perm, & 
     855          msno 
     856 
     857       REAL (wp), parameter :: & 
     858          viscosity = 1.79e-3_wp     ! kinematic water viscosity in kg/m/s 
     859 
     860      REAL(wp), PARAMETER :: &   ! shared parameters for topographic melt ponds 
     861         zvp_min = 1.e-4_wp          ! minimum pond volume (m) 
     862 
     863      INTEGER  ::   ji, jj, jk, jl                    ! loop indices 
     864 
     865       a_ip(:,:,:) = 0._wp 
     866       h_ip(:,:,:) = 0._wp 
     867 
     868       DO_2D( 1, 1, 1, 1 ) 
     869 
     870             IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 
     871 
     872        !------------------------------------------------------------------- 
     873        ! initialize 
     874        !------------------------------------------------------------------- 
     875 
     876        DO jl = 1, jpl 
     877 
     878           !---------------------------------------- 
     879           ! compute the effective snow fraction 
     880           !---------------------------------------- 
     881 
     882           IF (a_i(ji,jj,jl) < epsi10)  THEN 
     883              hicen(jl) =  0._wp 
     884              hsnon(jl) =  0._wp 
     885              reduced_aicen(jl) = 0._wp 
     886              asnon(jl) = 0._wp         !js: in CICE 5.1.2: make sense as the compiler may not initiate the variables 
     887           ELSE 
     888              hicen(jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     889              hsnon(jl) = v_s(ji,jj,jl) / a_i(ji,jj,jl) 
     890              reduced_aicen(jl) = 1._wp ! n=jpl 
     891 
     892              !js: initial code in NEMO_DEV 
     893              !IF (n < jpl) reduced_aicen(jl) = aicen(jl) & 
     894              !                     * (-0.024_wp*hicen(jl) + 0.832_wp) 
     895 
     896              !js: from CICE 5.1.2: this limit reduced_aicen to 0.2 when hicen is too large 
     897              IF (jl < jpl) reduced_aicen(jl) = a_i(ji,jj,jl) & 
     898                                   * max(0.2_wp,(-0.024_wp*hicen(jl) + 0.832_wp)) 
     899 
     900              asnon(jl) = reduced_aicen(jl)  ! effective snow fraction (empirical) 
     901              ! MV should check whether this makes sense to have the same effective snow fraction in here 
     902              ! OLI: it probably doesn't 
     903           END IF 
     904 
     905  ! This choice for alfa and beta ignores hydrostatic equilibium of categories. 
     906  ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming 
     907  ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all 
     908  ! categories.  alfa and beta partition the ITD - they are areas not thicknesses! 
     909  ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area. 
     910  ! Here, alfa = 60% of the ice area (and since hice is constant in a category, 
     911  ! alfan = 60% of the ice volume) in each category lies above the reference line, 
     912  ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required. 
     913 
     914  ! MV: 
     915  ! Note that this choice is not in the original FF07 paper and has been adopted in CICE 
     916  ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe 
     917 
     918  ! Where does that choice come from ? => OLI : Coz' Chuck Norris said so... 
     919 
     920           alfan(jl) = 0.6 * hicen(jl) 
     921           betan(jl) = 0.4 * hicen(jl) 
     922 
     923           cum_max_vol(jl)     = 0._wp 
     924           cum_max_vol_tmp(jl) = 0._wp 
     925 
     926        END DO ! jpl 
     927 
     928        cum_max_vol_tmp(0) = 0._wp 
     929        drain = 0._wp 
     930        zdvolp(ji,jj) = 0._wp 
     931 
     932        !---------------------------------------------------------- 
     933        ! Drain overflow water, update pond fraction and volume 
     934        !---------------------------------------------------------- 
     935 
     936        !-------------------------------------------------------------------------- 
     937        ! the maximum amount of water that can be contained up to each ice category 
     938        !-------------------------------------------------------------------------- 
     939        ! If melt ponds are too deep to be sustainable given the ITD (OVERFLOW) 
     940        ! Then the excess volume cum_max_vol(jl) drains out of the system 
     941        ! It should be added to wfx_pnd_out 
     942 
     943        DO jl = 1, jpl-1 ! last category can not hold any volume 
     944 
     945           IF (alfan(jl+1) >= alfan(jl) .AND. alfan(jl+1) > 0._wp ) THEN 
     946 
     947              ! total volume in level including snow 
     948              cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) + & 
     949                 (alfan(jl+1) - alfan(jl)) * sum(reduced_aicen(1:jl)) 
     950 
     951              ! subtract snow solid volumes from lower categories in current level 
     952              DO ns = 1, jl 
     953                 cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl) & 
     954                    - rhos/rhow * &     ! free air fraction that can be filled by water 
     955                      asnon(ns)  * &    ! effective areal fraction of snow in that category 
     956                      max(min(hsnon(ns)+alfan(ns)-alfan(jl), alfan(jl+1)-alfan(jl)), 0._wp) 
     957              END DO 
     958 
     959           ELSE ! assume higher categories unoccupied 
     960              cum_max_vol_tmp(jl) = cum_max_vol_tmp(jl-1) 
     961           END IF 
     962           !IF (cum_max_vol_tmp(jl) < z0) THEN 
     963           !   CALL abort_ice('negative melt pond volume') 
     964           !END IF 
     965        END DO 
     966        cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1)  ! last category holds no volume 
     967        cum_max_vol  (1:jpl) = cum_max_vol_tmp(1:jpl) 
     968 
     969        !---------------------------------------------------------------- 
     970        ! is there more meltwater than can be held in the floe? 
     971        !---------------------------------------------------------------- 
     972        IF (zvolp(ji,jj) >= cum_max_vol(jpl)) THEN 
     973           drain = zvolp(ji,jj) - cum_max_vol(jpl) + epsi10 
     974           zvolp(ji,jj) = zvolp(ji,jj) - drain ! update meltwater volume available 
     975 
     976           diag_dvpn_rnf(ji,jj) = - drain      ! diag - overflow counted in the runoff part (arbitrary choice) 
     977 
     978           zdvolp(ji,jj) = drain         ! this is the drained water 
     979           IF (zvolp(ji,jj) < epsi10) THEN 
     980              zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj) 
     981              zvolp(ji,jj) = 0._wp 
     982           END IF 
     983        END IF 
     984 
     985        ! height and area corresponding to the remaining volume 
     986        ! routine leaves zvolp unchanged 
     987        CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index) 
     988 
     989        DO jl = 1, m_index 
     990           !h_ip(jl) = hpond - alfan(jl) + alfan(1) ! here oui choulde update 
     991           !                                         !  volume instead, no ? 
     992           h_ip(ji,jj,jl) = max((hpond - alfan(jl) + alfan(1)), 0._wp)      !js: from CICE 5.1.2 
     993           a_ip(ji,jj,jl) = reduced_aicen(jl) 
     994           ! in practise, pond fraction depends on the empirical snow fraction 
     995           ! so in turn on ice thickness 
     996        END DO 
     997        !zapond = sum(a_ip(1:m_index))     !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d 
     998 
     999        !------------------------------------------------------------------------ 
     1000        ! Drainage through brine network (permeability) 
     1001        !------------------------------------------------------------------------ 
     1002        !!! drainage due to ice permeability - Darcy's law 
     1003 
     1004        ! sea water level 
     1005        msno = 0._wp 
     1006        DO jl = 1 , jpl 
     1007          msno = msno + v_s(ji,jj,jl) * rhos 
     1008        END DO 
     1009        floe_weight = ( msno + rhoi*vt_i(ji,jj) + rho0*zvolp(ji,jj) ) / at_i(ji,jj) 
     1010        hsl_rel = floe_weight / rho0 & 
     1011                - ( ( sum(betan(:)*a_i(ji,jj,:)) / at_i(ji,jj) ) + alfan(1) ) 
     1012 
     1013        deltah = hpond - hsl_rel 
     1014        pressure_head = grav * rho0 * max(deltah, 0._wp) 
     1015 
     1016        ! drain if ice is permeable 
     1017        permflag = 0 
     1018 
     1019        IF (pressure_head > 0._wp) THEN 
     1020           DO jl = 1, jpl-1 
     1021              IF ( hicen(jl) /= 0._wp ) THEN 
     1022 
     1023              !IF (hicen(jl) > 0._wp) THEN           !js: from CICE 5.1.2 
     1024 
     1025                 perm = 0._wp ! MV ugly dummy patch 
     1026                 CALL ice_thd_pnd_perm(t_i(ji,jj,:,jl),  sz_i(ji,jj,:,jl), perm) ! bof 
     1027                 IF (perm > 0._wp) permflag = 1 
     1028 
     1029                 drain = perm*a_ip(ji,jj,jl)*pressure_head*rDt_ice / & 
     1030                                          (viscosity*hicen(jl)) 
     1031                 zdvolp(ji,jj) = zdvolp(ji,jj) + min(drain, zvolp(ji,jj)) 
     1032                 zvolp(ji,jj) = max(zvolp(ji,jj) - drain, 0._wp) 
     1033 
     1034                 diag_dvpn_drn(ji,jj) = - drain ! diag (could be better coded) 
     1035 
     1036                 IF (zvolp(ji,jj) < epsi10) THEN 
     1037                    zdvolp(ji,jj) = zdvolp(ji,jj) + zvolp(ji,jj) 
     1038                    zvolp(ji,jj) = 0._wp 
     1039                 END IF 
     1040             END IF 
     1041          END DO 
     1042 
     1043           ! adjust melt pond dimensions 
     1044           IF (permflag > 0) THEN 
     1045              ! recompute pond depth 
     1046             CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, alfan, zvolp(ji,jj), cum_max_vol, hpond, m_index) 
     1047              DO jl = 1, m_index 
     1048                 h_ip(ji,jj,jl) = hpond - alfan(jl) + alfan(1) 
     1049                 a_ip(ji,jj,jl) = reduced_aicen(jl) 
     1050              END DO 
     1051              !zapond = sum(a_ip(1:m_index))       !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d 
     1052           END IF 
     1053        END IF ! pressure_head 
     1054 
     1055        !------------------------------- 
     1056        ! remove water from the snow 
     1057        !------------------------------- 
     1058        !------------------------------------------------------------------------ 
     1059        ! total melt pond volume in category does not include snow volume 
     1060        ! snow in melt ponds is not melted 
     1061        !------------------------------------------------------------------------ 
     1062 
     1063        ! MV here, it seems that we remove some meltwater from the ponds, but I can't really tell 
     1064        ! how much, so I did not diagnose it 
     1065        ! so if there is a problem here, nobody is going to see it... 
     1066 
     1067 
     1068        ! Calculate pond volume for lower categories 
     1069        DO jl = 1,m_index-1 
     1070           v_ip(ji,jj,jl) = a_ip(ji,jj,jl) * h_ip(ji,jj,jl) & ! what is not in the snow 
     1071                          - (rhos/rhow) * asnon(jl) * min(hsnon(jl), h_ip(ji,jj,jl)) 
     1072        END DO 
     1073 
     1074        ! Calculate pond volume for highest category = remaining pond volume 
     1075 
     1076        ! The following is completely unclear to Martin at least 
     1077        ! Could we redefine properly and recode in a more readable way ? 
     1078 
     1079        ! m_index = last category with melt pond 
     1080 
     1081        IF (m_index == 1) v_ip(ji,jj,m_index) = zvolp(ji,jj) ! volume of mw in 1st category is the total volume of melt water 
     1082 
     1083        IF (m_index > 1) THEN 
     1084          IF (zvolp(ji,jj) > sum( v_ip(ji,jj,1:m_index-1))) THEN 
     1085             v_ip(ji,jj,m_index) = zvolp(ji,jj) - sum(v_ip(ji,jj,1:m_index-1)) 
     1086          ELSE 
     1087             v_ip(ji,jj,m_index) = 0._wp 
     1088             h_ip(ji,jj,m_index) = 0._wp 
     1089             a_ip(ji,jj,m_index) = 0._wp 
     1090             ! If remaining pond volume is negative reduce pond volume of 
     1091             ! lower category 
     1092             IF ( zvolp(ji,jj) + epsi10 < SUM(v_ip(ji,jj,1:m_index-1))) & 
     1093              v_ip(ji,jj,m_index-1) = v_ip(ji,jj,m_index-1) - sum(v_ip(ji,jj,1:m_index-1)) + zvolp(ji,jj) 
     1094          END IF 
     1095        END IF 
     1096 
     1097        DO jl = 1,m_index 
     1098           IF (a_ip(ji,jj,jl) > epsi10) THEN 
     1099               h_ip(ji,jj,jl) = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
     1100           ELSE 
     1101              zdvolp(ji,jj) = zdvolp(ji,jj) + v_ip(ji,jj,jl) 
     1102              h_ip(ji,jj,jl) = 0._wp 
     1103              v_ip(ji,jj,jl)  = 0._wp 
     1104              a_ip(ji,jj,jl) = 0._wp 
     1105           END IF 
     1106        END DO 
     1107        DO jl = m_index+1, jpl 
     1108           h_ip(ji,jj,jl) = 0._wp 
     1109           a_ip(ji,jj,jl) = 0._wp 
     1110           v_ip(ji,jj,jl) = 0._wp 
     1111        END DO 
     1112 
     1113           ENDIF 
     1114 
     1115     END_2D 
     1116 
     1117    END SUBROUTINE ice_thd_pnd_area 
     1118 
     1119 
     1120    SUBROUTINE ice_thd_pnd_depth(aicen, asnon, hsnon, alfan, zvolp, cum_max_vol, hpond, m_index) 
     1121       !!------------------------------------------------------------------- 
     1122       !!                ***  ROUTINE ice_thd_pnd_depth  *** 
     1123       !! 
     1124       !! ** Purpose :   Compute melt pond depth 
     1125       !!------------------------------------------------------------------- 
     1126 
     1127       REAL (wp), DIMENSION(jpl), INTENT(IN) :: & 
     1128          aicen, & 
     1129          asnon, & 
     1130          hsnon, & 
     1131          alfan, & 
     1132          cum_max_vol 
     1133 
     1134       REAL (wp), INTENT(IN) :: & 
     1135          zvolp 
     1136 
     1137       REAL (wp), INTENT(OUT) :: & 
     1138          hpond 
     1139 
     1140       INTEGER, INTENT(OUT) :: & 
     1141          m_index 
     1142 
     1143       INTEGER :: n, ns 
     1144 
     1145       REAL (wp), DIMENSION(0:jpl+1) :: & 
     1146          hitl, & 
     1147          aicetl 
     1148 
     1149       REAL (wp) :: & 
     1150          rem_vol, & 
     1151          area, & 
     1152          vol, & 
     1153          tmp, & 
     1154          z0   = 0.0_wp 
     1155 
     1156       !---------------------------------------------------------------- 
     1157       ! hpond is zero if zvolp is zero - have we fully drained? 
     1158       !---------------------------------------------------------------- 
     1159 
     1160       IF (zvolp < epsi10) THEN 
     1161        hpond = z0 
     1162        m_index = 0 
     1163       ELSE 
     1164 
     1165        !---------------------------------------------------------------- 
     1166        ! Calculate the category where water fills up to 
     1167        !---------------------------------------------------------------- 
     1168 
     1169        !----------| 
     1170        !          | 
     1171        !          | 
     1172        !          |----------|                                     -- -- 
     1173        !__________|__________|_________________________________________ ^ 
     1174        !          |          |             rem_vol     ^                | Semi-filled 
     1175        !          |          |----------|-- -- -- - ---|-- ---- -- -- --v layer 
     1176        !          |          |          |              | 
     1177        !          |          |          |              |hpond 
     1178        !          |          |          |----------|   |     |------- 
     1179        !          |          |          |          |   |     | 
     1180        !          |          |          |          |---v-----| 
     1181        !          |          | m_index  |          |         | 
     1182        !------------------------------------------------------------- 
     1183 
     1184        m_index = 0  ! 1:m_index categories have water in them 
     1185        DO n = 1, jpl 
     1186           IF (zvolp <= cum_max_vol(n)) THEN 
     1187              m_index = n 
     1188              IF (n == 1) THEN 
     1189                 rem_vol = zvolp 
     1190              ELSE 
     1191                 rem_vol = zvolp - cum_max_vol(n-1) 
     1192              END IF 
     1193              exit ! to break out of the loop 
     1194           END IF 
     1195        END DO 
     1196        m_index = min(jpl-1, m_index) 
     1197 
     1198        !---------------------------------------------------------------- 
     1199        ! semi-filled layer may have m_index different snow in it 
     1200        !---------------------------------------------------------------- 
     1201 
     1202        !-----------------------------------------------------------  ^ 
     1203        !                                                             |  alfan(m_index+1) 
     1204        !                                                             | 
     1205        !hitl(3)-->                             |----------|          | 
     1206        !hitl(2)-->                |------------| * * * * *|          | 
     1207        !hitl(1)-->     |----------|* * * * * * |* * * * * |          | 
     1208        !hitl(0)-->-------------------------------------------------  |  ^ 
     1209        !                various snow from lower categories          |  |alfa(m_index) 
     1210 
     1211        ! hitl - heights of the snow layers from thinner and current categories 
     1212        ! aicetl - area of each snow depth in this layer 
     1213 
     1214        hitl(:) = z0 
     1215        aicetl(:) = z0 
     1216        DO n = 1, m_index 
     1217           hitl(n)   = max(min(hsnon(n) + alfan(n) - alfan(m_index), & 
     1218                                  alfan(m_index+1) - alfan(m_index)), z0) 
     1219           aicetl(n) = asnon(n) 
     1220 
     1221           aicetl(0) = aicetl(0) + (aicen(n) - asnon(n)) 
     1222        END DO 
     1223 
     1224        hitl(m_index+1) = alfan(m_index+1) - alfan(m_index) 
     1225        aicetl(m_index+1) = z0 
     1226 
     1227        !---------------------------------------------------------------- 
     1228        ! reorder array according to hitl 
     1229        ! snow heights not necessarily in height order 
     1230        !---------------------------------------------------------------- 
     1231 
     1232        DO ns = 1, m_index+1 
     1233           DO n = 0, m_index - ns + 1 
     1234              IF (hitl(n) > hitl(n+1)) THEN ! swap order 
     1235                 tmp = hitl(n) 
     1236                 hitl(n) = hitl(n+1) 
     1237                 hitl(n+1) = tmp 
     1238                 tmp = aicetl(n) 
     1239                 aicetl(n) = aicetl(n+1) 
     1240                 aicetl(n+1) = tmp 
     1241              END IF 
     1242           END DO 
     1243        END DO 
     1244 
     1245        !---------------------------------------------------------------- 
     1246        ! divide semi-filled layer into set of sublayers each vertically homogenous 
     1247        !---------------------------------------------------------------- 
     1248 
     1249        !hitl(3)---------------------------------------------------------------- 
     1250        !                                                       | * * * * * * * * 
     1251        !                                                       |* * * * * * * * * 
     1252        !hitl(2)---------------------------------------------------------------- 
     1253        !                                    | * * * * * * * *  | * * * * * * * * 
     1254        !                                    |* * * * * * * * * |* * * * * * * * * 
     1255        !hitl(1)---------------------------------------------------------------- 
     1256        !                 | * * * * * * * *  | * * * * * * * *  | * * * * * * * * 
     1257        !                 |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * 
     1258        !hitl(0)---------------------------------------------------------------- 
     1259        !    aicetl(0)         aicetl(1)           aicetl(2)          aicetl(3) 
     1260 
     1261        ! move up over layers incrementing volume 
     1262        DO n = 1, m_index+1 
     1263 
     1264           area = sum(aicetl(:)) - &                 ! total area of sub-layer 
     1265                (rhos/rho0) * sum(aicetl(n:jpl+1)) ! area of sub-layer occupied by snow 
     1266 
     1267           vol = (hitl(n) - hitl(n-1)) * area      ! thickness of sub-layer times area 
     1268 
     1269           IF (vol >= rem_vol) THEN  ! have reached the sub-layer with the depth within 
     1270              hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1) 
     1271 
     1272              exit 
     1273           ELSE  ! still in sub-layer below the sub-layer with the depth 
     1274              rem_vol = rem_vol - vol 
     1275           END IF 
     1276 
     1277        END DO 
     1278 
     1279       END IF 
     1280 
     1281    END SUBROUTINE ice_thd_pnd_depth 
     1282 
     1283 
     1284    SUBROUTINE ice_thd_pnd_perm(ticen, salin, perm) 
     1285       !!------------------------------------------------------------------- 
     1286       !!                ***  ROUTINE ice_thd_pnd_perm *** 
     1287       !! 
     1288       !! ** Purpose :   Determine the liquid fraction of brine in the ice 
     1289       !!                and its permeability 
     1290       !!------------------------------------------------------------------- 
     1291 
     1292       REAL (wp), DIMENSION(nlay_i), INTENT(IN) :: & 
     1293          ticen,  &     ! internal ice temperature (K) 
     1294          salin         ! salinity (ppt)     !js: ppt according to cice 
     1295 
     1296       REAL (wp), INTENT(OUT) :: & 
     1297          perm      ! permeability 
     1298 
     1299       REAL (wp) ::   & 
     1300          Sbr       ! brine salinity 
     1301 
     1302       REAL (wp), DIMENSION(nlay_i) ::   & 
     1303          Tin, &    ! ice temperature 
     1304          phi       ! liquid fraction 
     1305 
     1306       INTEGER :: k 
     1307 
     1308       !----------------------------------------------------------------- 
     1309       ! Compute ice temperatures from enthalpies using quadratic formula 
     1310       !----------------------------------------------------------------- 
     1311 
     1312       DO k = 1,nlay_i 
     1313          Tin(k) = ticen(k) - rt0   !js: from K to degC 
     1314       END DO 
     1315 
     1316       !----------------------------------------------------------------- 
     1317       ! brine salinity and liquid fraction 
     1318       !----------------------------------------------------------------- 
     1319 
     1320       DO k = 1, nlay_i 
     1321 
     1322          Sbr    = - Tin(k) / rTmlt ! Consistent expression with SI3 (linear liquidus) 
     1323          ! Best expression to date is that one (Vancoppenolle et al JGR 2019) 
     1324          ! Sbr  = - 18.7 * Tin(k) - 0.519 * Tin(k)**2 - 0.00535 * Tin(k) **3 
     1325          phi(k) = salin(k) / Sbr 
     1326 
     1327       END DO 
     1328 
     1329       !----------------------------------------------------------------- 
     1330       ! permeability 
     1331       !----------------------------------------------------------------- 
     1332 
     1333       perm = 3.0e-08_wp * (minval(phi))**3 ! Golden et al. (2007) 
     1334 
     1335   END SUBROUTINE ice_thd_pnd_perm 
     1336 
     1337   SUBROUTINE ice_thd_pnd_init 
    3041338      !!------------------------------------------------------------------- 
    3051339      !!                  ***  ROUTINE ice_thd_pnd_init   *** 
    … …  
    3081342      !!              over sea ice 
    3091343      !! 
    310       !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond   
     1344      !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond 
    3111345      !!               parameter values called at the first timestep (nit000) 
    3121346      !! 
    313       !! ** input   :   Namelist namthd_pnd   
     1347      !! ** input   :   Namelist namthd_pnd 
    3141348      !!------------------------------------------------------------------- 
    3151349      INTEGER  ::   ios, ioptio   ! Local integer 
    3161350      !! 
    317       NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, & 
     1351      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, rn_pnd_flush, & 
    3181352         &                          ln_pnd_CST , rn_apnd, rn_hpnd,         & 
     1353         &                          ln_pnd_TOPO,                           & 
    3191354         &                          ln_pnd_lids, ln_pnd_alb 
    3201355      !!------------------------------------------------------------------- 
    … …  
    3321367         WRITE(numout,*) '   Namelist namicethd_pnd:' 
    3331368         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd 
     1369         WRITE(numout,*) '         Topographic melt pond scheme                             ln_pnd_TOPO  = ', ln_pnd_TOPO 
    3341370         WRITE(numout,*) '         Level ice melt pond scheme                               ln_pnd_LEV   = ', ln_pnd_LEV 
    3351371         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min 
    3361372         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max 
     1373         WRITE(numout,*) '            Pond flushing efficiency                              rn_pnd_flush = ', rn_pnd_flush 
    3371374         WRITE(numout,*) '         Constant ice melt pond scheme                            ln_pnd_CST   = ', ln_pnd_CST 
    3381375         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd 
    … …  
    3471384      IF( ln_pnd_CST  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF 
    3481385      IF( ln_pnd_LEV  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndLEV    ;   ENDIF 
     1386      IF( ln_pnd_TOPO ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndTOPO   ;   ENDIF 
    3491387      IF( ioptio /= 1 )   & 
    350          & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' ) 
     1388         & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV, ln_pnd_CST or ln_pnd_TOPO)' ) 
    3511389      ! 
    3521390      SELECT CASE( nice_pnd ) 
    353       CASE( np_pndNO )          
     1391      CASE( np_pndNO ) 
    3541392         IF( ln_pnd_alb  ) THEN ; ln_pnd_alb  = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' )  ; ENDIF 
    3551393         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF 
    356       CASE( np_pndCST )          
     1394      CASE( np_pndCST ) 
    3571395         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF 
    3581396      END SELECT 
    3591397      ! 
    3601398   END SUBROUTINE ice_thd_pnd_init 
    361     
     1399 
    3621400#else 
    3631401   !!---------------------------------------------------------------------- 
    3641402   !!   Default option          Empty module          NO SI3 sea-ice model 
    3651403   !!---------------------------------------------------------------------- 
    366 #endif  
     1404#endif 
    3671405 
    3681406   !!====================================================================== 
    369 END MODULE icethd_pnd  
     1407END MODULE icethd_pnd 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icethd_zdf_bl99.F90

    r13472 r14021  
    22   !!====================================================================== 
    33   !!                       ***  MODULE icethd_zdf_BL99 *** 
    4    !!   sea-ice: vertical heat diffusion in sea ice (computation of temperatures)  
     4   !!   sea-ice: vertical heat diffusion in sea ice (computation of temperatures) 
    55   !!====================================================================== 
    66   !! History :       !  2003-02  (M. Vancoppenolle) original 1D code 
    … …  
    1515   !!---------------------------------------------------------------------- 
    1616   USE dom_oce        ! ocean space and time domain 
    17    USE phycst         ! physical constants (ocean directory)  
     17   USE phycst         ! physical constants (ocean directory) 
    1818   USE ice            ! sea-ice: variables 
    1919   USE ice1D          ! sea-ice: thermodynamics variables 
    … …  
    4444      !! 
    4545      !! ** Method  : solves the heat equation diffusion with a Neumann boundary 
    46       !!              condition at the surface and a Dirichlet one at the bottom.  
     46      !!              condition at the surface and a Dirichlet one at the bottom. 
    4747      !!              Solar radiation is partially absorbed into the ice. 
    48       !!              The specific heat and thermal conductivities depend on ice  
    49       !!              salinity and temperature to take into account brine pocket    
     48      !!              The specific heat and thermal conductivities depend on ice 
     49      !!              salinity and temperature to take into account brine pocket 
    5050      !!              melting. The numerical scheme is an iterative Crank-Nicolson 
    5151      !!              on a non-uniform multilayer grid in the ice and snow system. 
    … …  
    9191      REAL(wp) ::   zbeta     =  0.117_wp     ! for thermal conductivity (could be 0.13) 
    9292      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
    93       REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered at 0C  
    94       REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature  
    95       REAL(wp) ::   zhs_ssl   =  0.03_wp      ! surface scattering layer in the snow  
     93      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered at 0C 
     94      REAL(wp) ::   zdti_bnd  =  1.e-4_wp     ! maximal authorized error on temperature 
     95      REAL(wp) ::   zhs_ssl   =  0.03_wp      ! surface scattering layer in the snow 
    9696      REAL(wp) ::   zhi_ssl   =  0.10_wp      ! surface scattering layer in the ice 
    9797      REAL(wp) ::   zh_min    =  1.e-3_wp     ! minimum ice/snow thickness for conduction 
    9898      REAL(wp) ::   ztmelts                   ! ice melting temperature 
    99       REAL(wp) ::   zdti_max                  ! current maximal error on temperature  
     99      REAL(wp) ::   zdti_max                  ! current maximal error on temperature 
    100100      REAL(wp) ::   zcpi                      ! Ice specific heat 
    101101      REAL(wp) ::   zhfx_err, zdq             ! diag errors on heat 
    … …  
    109109      REAL(wp), DIMENSION(jpij) ::   zdqns_ice_b  ! derivative of the surface flux function 
    110110      ! 
    111       REAL(wp), DIMENSION(jpij       )     ::   ztsuold     ! Old surface temperature in the ice 
    112       REAL(wp), DIMENSION(jpij,nlay_i)     ::   ztiold      ! Old temperature in the ice 
    113       REAL(wp), DIMENSION(jpij,nlay_s)     ::   ztsold      ! Old temperature in the snow 
    114       REAL(wp), DIMENSION(jpij,nlay_i)     ::   ztib        ! Temporary temperature in the ice to check the convergence 
    115       REAL(wp), DIMENSION(jpij,nlay_s)     ::   ztsb        ! Temporary temperature in the snow to check the convergence 
    116       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   ztcond_i    ! Ice thermal conductivity 
    117       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   ztcond_i_cp ! copy 
    118       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zradtr_i    ! Radiation transmitted through the ice 
    119       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zradab_i    ! Radiation absorbed in the ice 
    120       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zkappa_i    ! Kappa factor in the ice 
    121       REAL(wp), DIMENSION(jpij,0:nlay_i)   ::   zeta_i      ! Eta factor in the ice 
    122       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zradtr_s    ! Radiation transmited through the snow 
    123       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zradab_s    ! Radiation absorbed in the snow 
    124       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zkappa_s    ! Kappa factor in the snow 
    125       REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeta_s      ! Eta factor in the snow 
    126       REAL(wp), DIMENSION(jpij)            ::   zkappa_comb ! Combined snow and ice surface conductivity 
    127       REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindterm    ! 'Ind'ependent term 
    128       REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zindtbis    ! Temporary 'ind'ependent term 
    129       REAL(wp), DIMENSION(jpij,nlay_i+3)   ::   zdiagbis    ! Temporary 'dia'gonal term 
    130       REAL(wp), DIMENSION(jpij,nlay_i+3,3) ::   ztrid       ! Tridiagonal system terms 
    131       REAL(wp), DIMENSION(jpij)            ::   zq_ini      ! diag errors on heat 
    132       REAL(wp), DIMENSION(jpij)            ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat 
    133       REAL(wp), DIMENSION(jpij)            ::   za_s_fra    ! ice fraction covered by snow  
    134       REAL(wp), DIMENSION(jpij)            ::   isnow       ! snow presence (1) or not (0)  
    135       REAL(wp), DIMENSION(jpij)            ::   isnow_comb  ! snow presence for met-office  
     111      REAL(wp), DIMENSION(jpij       )   ::   ztsuold     ! Old surface temperature in the ice 
     112      REAL(wp), DIMENSION(jpij,nlay_i)   ::   ztiold      ! Old temperature in the ice 
     113      REAL(wp), DIMENSION(jpij,nlay_s)   ::   ztsold      ! Old temperature in the snow 
     114      REAL(wp), DIMENSION(jpij,nlay_i)   ::   ztib        ! Temporary temperature in the ice to check the convergence 
     115      REAL(wp), DIMENSION(jpij,nlay_s)   ::   ztsb        ! Temporary temperature in the snow to check the convergence 
     116      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity 
     117      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   ztcond_i_cp ! copy 
     118      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice 
     119      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice 
     120      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice 
     121      REAL(wp), DIMENSION(jpij,0:nlay_i) ::   zeta_i      ! Eta factor in the ice 
     122      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow 
     123      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow 
     124      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow 
     125      REAL(wp), DIMENSION(jpij,0:nlay_s) ::   zeta_s      ! Eta factor in the snow 
     126      REAL(wp), DIMENSION(jpij)          ::   zkappa_comb ! Combined snow and ice surface conductivity 
     127      REAL(wp), DIMENSION(jpij)          ::   zq_ini      ! diag errors on heat 
     128      REAL(wp), DIMENSION(jpij)          ::   zghe        ! G(he), th. conduct enhancement factor, mono-cat 
     129      REAL(wp), DIMENSION(jpij)          ::   za_s_fra    ! ice fraction covered by snow 
     130      REAL(wp), DIMENSION(jpij)          ::   isnow       ! snow presence (1) or not (0) 
     131      REAL(wp), DIMENSION(jpij)          ::   isnow_comb  ! snow presence for met-office 
     132      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zindterm    ! 'Ind'ependent term 
     133      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zindtbis    ! Temporary 'ind'ependent term 
     134      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1)   ::   zdiagbis    ! Temporary 'dia'gonal term 
     135      REAL(wp), DIMENSION(jpij,nlay_i+nlay_s+1,3) ::   ztrid       ! Tridiagonal system terms 
    136136      ! 
    137137      ! Mono-category 
    … …  
    139139      REAL(wp) ::   zhe        ! dummy factor 
    140140      REAL(wp) ::   zcnd_i     ! mean sea ice thermal conductivity 
    141       !!------------------------------------------------------------------      
     141      !!------------------------------------------------------------------ 
    142142 
    143143      ! --- diag error on heat diffusion - PART 1 --- ! 
    144144      DO ji = 1, npti 
    145145         zq_ini(ji) = ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i +  & 
    146             &           SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s )  
     146            &           SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 
    147147      END DO 
    148148 
    149149      ! calculate ice fraction covered by snow for radiation 
    150150      CALL ice_var_snwfra( h_s_1d(1:npti), za_s_fra(1:npti) ) 
    151        
     151 
    152152      !------------------ 
    153153      ! 1) Initialization 
    … …  
    155155      ! 
    156156      ! extinction radiation in the snow 
    157       IF    ( nn_qtrice == 0 ) THEN   ! constant  
     157      IF    ( nn_qtrice == 0 ) THEN   ! constant 
    158158         zraext_s(1:npti) = rn_kappa_s 
    159159      ELSEIF( nn_qtrice == 1 ) THEN   ! depends on melting/freezing conditions 
    … …  
    166166      DO ji = 1, npti 
    167167         ! ice thickness 
    168          IF( h_i_1d(ji) > 0._wp ) THEN  
     168         IF( h_i_1d(ji) > 0._wp ) THEN 
    169169            zh_i  (ji) = MAX( zh_min , h_i_1d(ji) ) * r1_nlay_i ! set a minimum thickness for conduction 
    170170            z1_h_i(ji) = 1._wp / zh_i(ji)                       !       it must be very small 
    … …  
    198198         ztsuold    (1:npti) = t_su_1d(1:npti)                          ! surface temperature initial value 
    199199         t_su_1d    (1:npti) = MIN( t_su_1d(1:npti), rt0 - ztsu_err )   ! required to leave the choice between melting or not 
    200          zdqns_ice_b(1:npti) = dqns_ice_1d(1:npti)                      ! derivative of incoming nonsolar flux  
     200         zdqns_ice_b(1:npti) = dqns_ice_1d(1:npti)                      ! derivative of incoming nonsolar flux 
    201201         zqns_ice_b (1:npti) = qns_ice_1d(1:npti)                       ! store previous qns_ice_1d value 
    202202         ! 
    … …  
    221221      ! 
    222222      zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * za_s_fra(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - za_s_fra(1:npti) ) 
    223       DO jk = 1, nlay_i  
     223      DO jk = 1, nlay_i 
    224224         DO ji = 1, npti 
    225225            !                             ! radiation transmitted below the layer-th ice layer 
    … …  
    227227               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zh_min  ) ) & 
    228228               &            + ( 1._wp - za_s_fra(ji) ) * qtr_ice_top_1d(ji)                        &   ! part snow free 
    229                &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) )             
     229               &                                       * EXP( - rn_kappa_i * MAX( 0._wp, zh_i(ji) * REAL(jk) - zhi_ssl ) ) 
    230230            !                             ! radiation absorbed by the layer-th ice layer 
    231231            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    … …  
    288288         DO ji = 1, npti 
    289289            IF ( .NOT. l_T_converged(ji) ) & 
    290                ztcond_i(ji,:) = MAX( zkimin, ztcond_i_cp(ji,:) )         
     290               ztcond_i(ji,:) = MAX( zkimin, ztcond_i_cp(ji,:) ) 
    291291         END DO 
    292292         ! 
    … …  
    401401            zdiagbis(1:npti,:)   = 0._wp 
    402402 
    403             DO jm = nlay_s + 2, nlay_s + nlay_i  
     403            DO jm = nlay_s + 2, nlay_s + nlay_i 
    404404               DO ji = 1, npti 
    405405                  jk = jm - nlay_s - 1 
    … …  
    414414            DO ji = 1, npti 
    415415               ! ice bottom term 
    416                ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1)    
     416               ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1) 
    417417               ztrid   (ji,jm,2) = 1._wp + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i-1) + zkappa_i(ji,nlay_i) * zg1 ) 
    418418               ztrid   (ji,jm,3) = 0._wp 
    419419               zindterm(ji,jm)   = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) *  & 
    420                   &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) )  
     420                  &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 
    421421            END DO 
    422422 
    … …  
    433433                     zindterm(ji,jm)   = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 
    434434                  END DO 
    435                    
     435 
    436436                  ! case of only one layer in the ice (ice equation is altered) 
    437437                  IF( nlay_i == 1 ) THEN 
    438438                     ztrid   (ji,nlay_s+2,3) = 0._wp 
    439                      zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji)  
    440                   ENDIF 
    441                    
     439                     zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 
     440                  ENDIF 
     441 
    442442                  IF( t_su_1d(ji) < rt0 ) THEN   !--  case 1 : no surface melting 
    443                       
     443 
    444444                     jm_min(ji) = 1 
    445445                     jm_max(ji) = nlay_i + nlay_s + 1 
    446                       
     446 
    447447                     ! surface equation 
    448448                     ztrid   (ji,1,1) = 0._wp 
    … …  
    450450                     ztrid   (ji,1,3) =                   zg1s * zkappa_s(ji,0) 
    451451                     zindterm(ji,1)   = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji) 
    452                       
     452 
    453453                     ! first layer of snow equation 
    454454                     ztrid   (ji,2,1) =       - zeta_s(ji,1) *                    zkappa_s(ji,0) * zg1s 
    … …  
    456456                     ztrid   (ji,2,3) =       - zeta_s(ji,1) *   zkappa_s(ji,1) 
    457457                     zindterm(ji,2)   = ztsold(ji,1) + zeta_s(ji,1) * zradab_s(ji,1) 
    458                       
     458 
    459459                  ELSE                            !--  case 2 : surface is melting 
    460460                     ! 
    461461                     jm_min(ji) = 2 
    462462                     jm_max(ji) = nlay_i + nlay_s + 1 
    463                       
     463 
    464464                     ! first layer of snow equation 
    465465                     ztrid   (ji,2,1) = 0._wp 
    466466                     ztrid   (ji,2,2) = 1._wp + zeta_s(ji,1) * ( zkappa_s(ji,1) + zkappa_s(ji,0) * zg1s ) 
    467                      ztrid   (ji,2,3) =       - zeta_s(ji,1) *   zkappa_s(ji,1)  
    468                      zindterm(ji,2)   = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) )  
     467                     ztrid   (ji,2,3) =       - zeta_s(ji,1) *   zkappa_s(ji,1) 
     468                     zindterm(ji,2)   = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + zkappa_s(ji,0) * zg1s * t_su_1d(ji) ) 
    469469                  ENDIF 
    470470                  !                            !---------------------! 
    … …  
    476476                     jm_min(ji) = nlay_s + 1 
    477477                     jm_max(ji) = nlay_i + nlay_s + 1 
    478                       
    479                      ! surface equation    
     478 
     479                     ! surface equation 
    480480                     ztrid   (ji,jm_min(ji),1) = 0._wp 
    481                      ztrid   (ji,jm_min(ji),2) = zdqns_ice_b(ji) - zkappa_i(ji,0) * zg1     
     481                     ztrid   (ji,jm_min(ji),2) = zdqns_ice_b(ji) - zkappa_i(ji,0) * zg1 
    482482                     ztrid   (ji,jm_min(ji),3) =                   zkappa_i(ji,0) * zg1 
    483483                     zindterm(ji,jm_min(ji))   = zdqns_ice_b(ji) * t_su_1d(ji) - zfnet(ji) 
    484                       
     484 
    485485                     ! first layer of ice equation 
    486486                     ztrid   (ji,jm_min(ji)+1,1) =       - zeta_i(ji,1) *                    zkappa_i(ji,0) * zg1 
    487487                     ztrid   (ji,jm_min(ji)+1,2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 
    488                      ztrid   (ji,jm_min(ji)+1,3) =       - zeta_i(ji,1) *   zkappa_i(ji,1)   
    489                      zindterm(ji,jm_min(ji)+1)   = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1)   
    490                       
     488                     ztrid   (ji,jm_min(ji)+1,3) =       - zeta_i(ji,1) *   zkappa_i(ji,1) 
     489                     zindterm(ji,jm_min(ji)+1)   = ztiold(ji,1) + zeta_i(ji,1) * zradab_i(ji,1) 
     490 
    491491                     ! case of only one layer in the ice (surface & ice equations are altered) 
    492492                     IF( nlay_i == 1 ) THEN 
    … …  
    499499                        zindterm(ji,jm_min(ji)+1)   = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji)) 
    500500                     ENDIF 
    501                       
     501 
    502502                  ELSE                            !--  case 2 : surface is melting 
    503                       
     503 
    504504                     jm_min(ji) = nlay_s + 2 
    505505                     jm_max(ji) = nlay_i + nlay_s + 1 
    506                       
     506 
    507507                     ! first layer of ice equation 
    508508                     ztrid   (ji,jm_min(ji),1) = 0._wp 
    509                      ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 )   
     509                     ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * ( zkappa_i(ji,1) + zkappa_i(ji,0) * zg1 ) 
    510510                     ztrid   (ji,jm_min(ji),3) =       - zeta_i(ji,1) *   zkappa_i(ji,1) 
    511                      zindterm(ji,jm_min(ji))   = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji))  
    512                       
     511                     zindterm(ji,jm_min(ji))   = ztiold(ji,1) + zeta_i(ji,1) * (zradab_i(ji,1) + zkappa_i(ji,0) * zg1 * t_su_1d(ji)) 
     512 
    513513                     ! case of only one layer in the ice (surface & ice equations are altered) 
    514514                     IF( nlay_i == 1 ) THEN 
    … …  
    519519                           &                      + t_su_1d(ji) * zeta_i(ji,1) * zkappa_i(ji,0) * 2._wp 
    520520                     ENDIF 
    521                       
     521 
    522522                  ENDIF 
    523523               ENDIF 
    … …  
    533533            ! Solve the tridiagonal system with Gauss elimination method. 
    534534            ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984 
    535             jm_maxt = 0 
    536             jm_mint = nlay_i+5 
    537             DO ji = 1, npti 
    538                jm_mint = MIN(jm_min(ji),jm_mint) 
    539                jm_maxt = MAX(jm_max(ji),jm_maxt) 
    540             END DO 
    541  
    542             DO jk = jm_mint+1, jm_maxt 
    543                DO ji = 1, npti 
    544                   jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     535!!$            jm_maxt = 0 
     536!!$            jm_mint = nlay_i+5 
     537!!$            DO ji = 1, npti 
     538!!$               jm_mint = MIN(jm_min(ji),jm_mint) 
     539!!$               jm_maxt = MAX(jm_max(ji),jm_maxt) 
     540!!$            END DO 
     541!!$            !!clem SNWLAY => check why LIM1D does not get this loop. Is nlay_i+5 correct? 
     542!!$ 
     543!!$            DO jk = jm_mint+1, jm_maxt 
     544!!$               DO ji = 1, npti 
     545!!$                  jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     546!!$                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
     547!!$                  zindtbis(ji,jm) = zindterm(ji,jm  ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1  ) / zdiagbis(ji,jm-1) 
     548!!$               END DO 
     549!!$            END DO 
     550            ! clem: maybe one should find a way to reverse this loop for mpi performance 
     551            DO ji = 1, npti 
     552               jm_mint = jm_min(ji) 
     553               jm_maxt = jm_max(ji) 
     554               DO jm = jm_mint+1, jm_maxt 
    545555                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
    546556                  zindtbis(ji,jm) = zindterm(ji,jm  ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1  ) / zdiagbis(ji,jm-1) 
    … …  
    564574            END DO 
    565575 
     576            ! snow temperatures 
    566577            DO ji = 1, npti 
    567578               ! Variables used after iterations 
    568579               ! Value must be frozen after convergence for MPP independance reason 
    569                IF ( .NOT. l_T_converged(ji) ) THEN 
    570                   ! snow temperatures       
    571                   IF( h_s_1d(ji) > 0._wp ) THEN 
    572                      t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
    573                   ENDIF 
    574                   ! surface temperature 
     580               IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     581                  &   t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
     582            END DO 
     583            !!clem SNWLAY 
     584            DO jm = nlay_s, 2, -1 
     585               DO ji = 1, npti 
     586                  jk = jm - 1 
     587                  IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     588                     &   t_s_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_s_1d(ji,jk+1) ) / zdiagbis(ji,jm) 
     589               END DO 
     590            END DO 
     591 
     592            ! surface temperature 
     593            DO ji = 1, npti 
     594               IF( .NOT. l_T_converged(ji) ) THEN 
    575595                  ztsub(ji) = t_su_1d(ji) 
    576596                  IF( t_su_1d(ji) < rt0 ) THEN 
    577                      t_su_1d(ji) = (  zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
    578                         &           ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
     597                     t_su_1d(ji) = ( zindtbis(ji,jm_min(ji)) - ztrid(ji,jm_min(ji),3) *  & 
     598                        &          ( isnow(ji) * t_s_1d(ji,1) + ( 1._wp - isnow(ji) ) * t_i_1d(ji,1) ) ) / zdiagbis(ji,jm_min(ji)) 
    579599                  ENDIF 
    580600               ENDIF 
    581601            END DO 
    582             !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 
    583602            ! 
    584603            !-------------------------------------------------------------- 
    … …  
    609628                     zdti_max      =  MAX( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
    610629                  END DO 
    611                    
     630 
    612631                  ! convergence test 
    613632                  IF( ln_zdf_chkcvg ) THEN 
    … …  
    646665            zdiagbis(1:npti,:)   = 0._wp 
    647666 
    648             DO jm = nlay_s + 2, nlay_s + nlay_i  
     667            DO jm = nlay_s + 2, nlay_s + nlay_i 
    649668               DO ji = 1, npti 
    650669                  jk = jm - nlay_s - 1 
    … …  
    659678            DO ji = 1, npti 
    660679               ! ice bottom term 
    661                ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1)    
     680               ztrid   (ji,jm,1) =       - zeta_i(ji,nlay_i) *   zkappa_i(ji,nlay_i-1) 
    662681               ztrid   (ji,jm,2) = 1._wp + zeta_i(ji,nlay_i) * ( zkappa_i(ji,nlay_i-1) + zkappa_i(ji,nlay_i) * zg1 ) 
    663682               ztrid   (ji,jm,3) = 0._wp 
    664683               zindterm(ji,jm)   = ztiold(ji,nlay_i) + zeta_i(ji,nlay_i) *  & 
    665                   &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) )  
     684                  &              ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i) * zg1 * t_bo_1d(ji) ) 
    666685            ENDDO 
    667686 
    … …  
    678697                     zindterm(ji,jm)   = ztsold(ji,jk) + zeta_s(ji,jk) * zradab_s(ji,jk) 
    679698                  END DO 
    680                    
     699 
    681700                  ! case of only one layer in the ice (ice equation is altered) 
    682701                  IF ( nlay_i == 1 ) THEN 
    683702                     ztrid   (ji,nlay_s+2,3) = 0._wp 
    684                      zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji)  
    685                   ENDIF 
    686                    
     703                     zindterm(ji,nlay_s+2)   = zindterm(ji,nlay_s+2) + zeta_i(ji,1) * zkappa_i(ji,1) * t_bo_1d(ji) 
     704                  ENDIF 
     705 
    687706                  jm_min(ji) = 2 
    688707                  jm_max(ji) = nlay_i + nlay_s + 1 
    689                    
     708 
    690709                  ! first layer of snow equation 
    691710                  ztrid   (ji,2,1) = 0._wp 
    692711                  ztrid   (ji,2,2) = 1._wp + zeta_s(ji,1) * zkappa_s(ji,1) 
    693                   ztrid   (ji,2,3) =       - zeta_s(ji,1) * zkappa_s(ji,1)  
    694                   zindterm(ji,2)   = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + qcn_ice_1d(ji) )  
    695                    
     712                  ztrid   (ji,2,3) =       - zeta_s(ji,1) * zkappa_s(ji,1) 
     713                  zindterm(ji,2)   = ztsold(ji,1) + zeta_s(ji,1) * ( zradab_s(ji,1) + qcn_ice_1d(ji) ) 
     714 
    696715                  !                            !---------------------! 
    697716               ELSE                            ! cells without snow  ! 
    … …  
    699718                  jm_min(ji) = nlay_s + 2 
    700719                  jm_max(ji) = nlay_i + nlay_s + 1 
    701                    
     720 
    702721                  ! first layer of ice equation 
    703722                  ztrid   (ji,jm_min(ji),1) = 0._wp 
    704                   ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * zkappa_i(ji,1)   
     723                  ztrid   (ji,jm_min(ji),2) = 1._wp + zeta_i(ji,1) * zkappa_i(ji,1) 
    705724                  ztrid   (ji,jm_min(ji),3) =       - zeta_i(ji,1) * zkappa_i(ji,1) 
    706725                  zindterm(ji,jm_min(ji))   = ztiold(ji,1) + zeta_i(ji,1) * ( zradab_i(ji,1) + qcn_ice_1d(ji) ) 
    707                    
     726 
    708727                  ! case of only one layer in the ice (surface & ice equations are altered) 
    709728                  IF( nlay_i == 1 ) THEN 
    … …  
    714733                        &                                     ( zradab_i(ji,1) + zkappa_i(ji,1) * t_bo_1d(ji) + qcn_ice_1d(ji) ) 
    715734                  ENDIF 
    716                    
     735 
    717736               ENDIF 
    718737               ! 
    … …  
    727746            ! Solve the tridiagonal system with Gauss elimination method. 
    728747            ! Thomas algorithm, from Computational fluid Dynamics, J.D. ANDERSON, McGraw-Hill 1984 
    729             jm_maxt = 0 
    730             jm_mint = nlay_i+5 
    731             DO ji = 1, npti 
    732                jm_mint = MIN(jm_min(ji),jm_mint) 
    733                jm_maxt = MAX(jm_max(ji),jm_maxt) 
    734             END DO 
    735              
    736             DO jk = jm_mint+1, jm_maxt 
    737                DO ji = 1, npti 
    738                   jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     748!!$            jm_maxt = 0 
     749!!$            jm_mint = nlay_i+5 
     750!!$            DO ji = 1, npti 
     751!!$               jm_mint = MIN(jm_min(ji),jm_mint) 
     752!!$               jm_maxt = MAX(jm_max(ji),jm_maxt) 
     753!!$            END DO 
     754!!$ 
     755!!$            DO jk = jm_mint+1, jm_maxt 
     756!!$               DO ji = 1, npti 
     757!!$                  jm = MIN(MAX(jm_min(ji)+1,jk),jm_max(ji)) 
     758!!$                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
     759!!$                  zindtbis(ji,jm) = zindterm(ji,jm)   - ztrid(ji,jm,1) * zindtbis(ji,jm-1)   / zdiagbis(ji,jm-1) 
     760!!$               END DO 
     761!!$            END DO 
     762            ! clem: maybe one should find a way to reverse this loop for mpi performance 
     763            DO ji = 1, npti 
     764               jm_mint = jm_min(ji) 
     765               jm_maxt = jm_max(ji) 
     766               DO jm = jm_mint+1, jm_maxt 
    739767                  zdiagbis(ji,jm) = ztrid   (ji,jm,2) - ztrid(ji,jm,1) * ztrid   (ji,jm-1,3) / zdiagbis(ji,jm-1) 
    740                   zindtbis(ji,jm) = zindterm(ji,jm)   - ztrid(ji,jm,1) * zindtbis(ji,jm-1)  / zdiagbis(ji,jm-1) 
     768                  zindtbis(ji,jm) = zindterm(ji,jm  ) - ztrid(ji,jm,1) * zindtbis(ji,jm-1  ) / zdiagbis(ji,jm-1) 
    741769               END DO 
    742770            END DO 
    743              
     771 
    744772            ! ice temperatures 
    745773            DO ji = 1, npti 
    … …  
    758786               END DO 
    759787            END DO 
    760              
    761             ! snow temperatures       
    762             DO ji = 1, npti 
    763                ! Variable used after iterations 
     788 
     789            ! snow temperatures 
     790            DO ji = 1, npti 
     791               ! Variables used after iterations 
    764792               ! Value must be frozen after convergence for MPP independance reason 
    765                IF ( .NOT. l_T_converged(ji) ) THEN 
    766                   IF( h_s_1d(ji) > 0._wp ) THEN 
    767                      t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
    768                   ENDIF 
    769                ENDIF 
    770             END DO 
    771             !clem: in order to have several layers of snow, there is a missing loop here for t_s_1d(1:nlay_s-1) 
     793               IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     794                  &   t_s_1d(ji,nlay_s) = ( zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) * t_i_1d(ji,1) ) / zdiagbis(ji,nlay_s+1) 
     795            END DO 
     796            !!clem SNWLAY 
     797            DO jm = nlay_s, 2, -1 
     798               DO ji = 1, npti 
     799                  jk = jm - 1 
     800                  IF ( .NOT. l_T_converged(ji) .AND. h_s_1d(ji) > 0._wp ) & 
     801                     &   t_s_1d(ji,jk) = ( zindtbis(ji,jm) - ztrid(ji,jm,3) * t_s_1d(ji,jk+1) ) / zdiagbis(ji,jm) 
     802               END DO 
     803            END DO 
    772804            ! 
    773805            !-------------------------------------------------------------- 
    … …  
    791823 
    792824                  DO jk = 1, nlay_i 
    793                      ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0  
     825                     ztmelts       = -rTmlt * sz_i_1d(ji,jk) + rt0 
    794826                     t_i_1d(ji,jk) =  MAX( MIN( t_i_1d(ji,jk), ztmelts ), rt0 - 100._wp ) 
    795827                     zdti_max      =  MAX ( zdti_max, ABS( t_i_1d(ji,jk) - ztib(ji,jk) ) ) 
    … …  
    853885         ! 
    854886         DO ji = 1, npti 
    855             hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji)  
     887            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qns_ice_1d(ji) - zqns_ice_b(ji) ) * a_i_1d(ji) 
    856888         END DO 
    857889         ! 
    … …  
    861893      ! 
    862894      IF( k_cnd == np_cnd_OFF .OR. k_cnd == np_cnd_ON ) THEN 
    863           
    864          CALL ice_var_enthalpy        
    865           
     895 
     896         CALL ice_var_enthalpy 
     897 
    866898         ! zhfx_err = correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation 
    867899         DO ji = 1, npti 
    868900            zdq = - zq_ini(ji) + ( SUM( e_i_1d(ji,1:nlay_i) ) * h_i_1d(ji) * r1_nlay_i +  & 
    869901               &                   SUM( e_s_1d(ji,1:nlay_s) ) * h_s_1d(ji) * r1_nlay_s ) 
    870              
     902 
    871903            IF( k_cnd == np_cnd_OFF ) THEN 
    872                 
     904 
    873905               IF( t_su_1d(ji) < rt0 ) THEN  ! case T_su < 0degC 
    874906                  zhfx_err = ( qns_ice_1d(ji)     + qsr_ice_1d(ji)     - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  & 
    … …  
    878910                     &       + zdq * r1_Dt_ice ) * a_i_1d(ji) 
    879911               ENDIF 
    880                 
     912 
    881913            ELSEIF( k_cnd == np_cnd_ON ) THEN 
    882              
     914 
    883915               zhfx_err    = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji)  & 
    884916                  &          + zdq * r1_Dt_ice ) * a_i_1d(ji) 
    885              
     917 
    886918            ENDIF 
    887919            ! 
    … …  
    889921            hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err 
    890922            ! 
    891             ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2    
     923            ! hfx_dif = Heat flux diagnostic of sensible heat used to warm/cool ice in W.m-2 
    892924            hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_Dt_ice * a_i_1d(ji) 
    893925            ! 
    … …  
    920952      ! --- SIMIP diagnostics 
    921953      ! 
    922       DO ji = 1, npti          
     954      DO ji = 1, npti 
    923955         !--- Snow-ice interfacial temperature (diagnostic SIMIP) 
    924956         IF( h_s_1d(ji) >= zhs_ssl ) THEN 
    925             t_si_1d(ji) = (   rn_cnd_s       * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,1)   & 
    926                &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1) ) & 
     957            t_si_1d(ji) = (   rn_cnd_s       * h_i_1d(ji) * r1_nlay_i * t_s_1d(ji,nlay_s)   & 
     958               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s * t_i_1d(ji,1)      ) & 
    927959               &          / ( rn_cnd_s       * h_i_1d(ji) * r1_nlay_i & 
    928960               &            + ztcond_i(ji,1) * h_s_1d(ji) * r1_nlay_s ) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/iceupdate.F90

    r13643 r14021  
    6767      !!------------------------------------------------------------------- 
    6868      !!                ***  ROUTINE ice_update_flx *** 
    69       !!   
    70       !! ** Purpose :   Update the surface ocean boundary condition for heat  
     69      !! 
     70      !! ** Purpose :   Update the surface ocean boundary condition for heat 
    7171      !!                salt and mass over areas where sea-ice is non-zero 
    72       !!          
     72      !! 
    7373      !! ** Action  : - computes the heat and freshwater/salt fluxes 
    7474      !!                at the ice-ocean interface. 
    7575      !!              - Update the ocean sbc 
    76       !!      
    77       !! ** Outputs : - qsr     : sea heat flux:     solar  
     76      !! 
     77      !! ** Outputs : - qsr     : sea heat flux:     solar 
    7878      !!              - qns     : sea heat flux: non solar 
    79       !!              - emp     : freshwater budget: volume flux  
    80       !!              - sfx     : salt flux  
     79      !!              - emp     : freshwater budget: volume flux 
     80      !!              - sfx     : salt flux 
    8181      !!              - fr_i    : ice fraction 
    8282      !!              - tn_ice  : sea-ice surface temperature 
    … …  
    9494      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
    9595      !!--------------------------------------------------------------------- 
    96       IF( ln_timing )   CALL timing_start('ice_update') 
     96      IF( ln_timing )   CALL timing_start('iceupdate') 
    9797 
    9898      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    104104      ! Net heat flux on top of the ice-ocean (W.m-2) 
    105105      !---------------------------------------------- 
    106       qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:)  
     106      qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 
    107107 
    108108      ! --- case we bypass ice thermodynamics --- ! 
    … …  
    114114         qevap_ice  (:,:,:) = 0._wp 
    115115      ENDIF 
    116        
     116 
    117117      DO_2D( 1, 1, 1, 1 ) 
    118118 
    119          ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2)  
     119         ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) 
    120120         !--------------------------------------------------- 
    121121         zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
    122122 
    123          ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2)  
     123         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
    124124         !--------------------------------------------------- 
    125125         qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 
    126126            &                                - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 
    127127            &                                + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 
    128             &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj)                  
    129           
     128            &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 
     129 
    130130         ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    131131         !---------------------------------------------------------------------------- 
    … …  
    144144         ! 
    145145         ! the non-solar is simply derived from the solar flux 
    146          qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr               
    147           
    148          ! Mass flux at the atm. surface        
     146         qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr 
     147 
     148         ! Mass flux at the atm. surface 
    149149         !----------------------------------- 
    150150         wfx_sub(ji,jj) = wfx_snw_sub(ji,jj) + wfx_ice_sub(ji,jj) 
    151151 
    152          ! Mass flux at the ocean surface       
     152         ! Mass flux at the ocean surface 
    153153         !------------------------------------ 
    154154         ! ice-ocean  mass flux 
    155155         wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
    156             &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) + wfx_pnd(ji,jj) 
    157           
     156            &           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) + wfx_lam(ji,jj) 
     157 
    158158         ! snw-ocean mass flux 
    159159         wfx_snw(ji,jj) = wfx_snw_sni(ji,jj) + wfx_snw_dyn(ji,jj) + wfx_snw_sum(ji,jj) 
    160           
     160 
    161161         ! total mass flux at the ocean/ice interface 
    162          fmmflx(ji,jj) =                - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! ice-ocean mass flux saved at least for biogeochemical model 
    163          emp   (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_err_sub(ji,jj)   ! atm-ocean + ice-ocean mass flux 
    164  
    165          ! Salt flux at the ocean surface       
     162         fmmflx(ji,jj) =                - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj)   ! ice-ocean mass flux saved at least for biogeochemical model 
     163         emp   (ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_pnd(ji,jj) - wfx_err_sub(ji,jj)   ! atm-ocean + ice-ocean mass flux 
     164 
     165         ! Salt flux at the ocean surface 
    166166         !------------------------------------------ 
    167167         sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   & 
    168168            &       + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 
    169           
    170          ! Mass of snow and ice per unit area    
     169 
     170         ! Mass of snow and ice per unit area 
    171171         !---------------------------------------- 
    172172         snwice_mass_b(ji,jj) = snwice_mass(ji,jj)       ! save mass from the previous ice time step 
    173173         !                                               ! new mass per unit area 
    174          snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)  )  
     174         snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) + rhow * (vt_ip(ji,jj) + vt_il(ji,jj)) ) 
    175175         !                                               ! time evolution of snow+ice mass 
    176176         snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_Dt_ice 
    177           
     177 
    178178      END_2D 
    179179 
    180180      ! Storing the transmitted variables 
    181181      !---------------------------------- 
    182       fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction             
    183       tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
     182      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction 
     183      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature 
    184184 
    185185      ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 
    … …  
    216216      CALL iom_put( 'vfxice'    , wfx_ice     )   ! mass flux from total ice growth/melt 
    217217      CALL iom_put( 'vfxbog'    , wfx_bog     )   ! mass flux from bottom growth 
    218       CALL iom_put( 'vfxbom'    , wfx_bom     )   ! mass flux from bottom melt  
    219       CALL iom_put( 'vfxsum'    , wfx_sum     )   ! mass flux from surface melt  
    220       CALL iom_put( 'vfxlam'    , wfx_lam     )   ! mass flux from lateral melt  
     218      CALL iom_put( 'vfxbom'    , wfx_bom     )   ! mass flux from bottom melt 
     219      CALL iom_put( 'vfxsum'    , wfx_sum     )   ! mass flux from surface melt 
     220      CALL iom_put( 'vfxlam'    , wfx_lam     )   ! mass flux from lateral melt 
    221221      CALL iom_put( 'vfxsni'    , wfx_sni     )   ! mass flux from snow-ice formation 
    222222      CALL iom_put( 'vfxopw'    , wfx_opw     )   ! mass flux from growth in open water 
    223223      CALL iom_put( 'vfxdyn'    , wfx_dyn     )   ! mass flux from dynamics (ridging) 
    224       CALL iom_put( 'vfxres'    , wfx_res     )   ! mass flux from undiagnosed processes  
     224      CALL iom_put( 'vfxres'    , wfx_res     )   ! mass flux from undiagnosed processes 
    225225      CALL iom_put( 'vfxpnd'    , wfx_pnd     )   ! mass flux from melt ponds 
    226226      CALL iom_put( 'vfxsub'    , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.) 
    227       CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean       
    228  
    229       IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations   
     227      CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean 
     228 
     229      IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 
    230230         WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 
    231231         ELSEWHERE                                     ; z2d = 0._wp 
    … …  
    237237      CALL iom_put( 'vfxsnw'     , wfx_snw     )   ! mass flux from total snow growth/melt 
    238238      CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum )   ! mass flux from snow melt at the surface 
    239       CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation  
    240       CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging)  
    241       CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)  
     239      CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation 
     240      CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging) 
     241      CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.) 
    242242      CALL iom_put( 'vfxsnw_pre' , wfx_spr     )   ! snow precip 
    243243 
    … …  
    252252      IF( iom_use('qt_oce'     ) )   CALL iom_put( 'qt_oce'     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
    253253      IF( iom_use('qt_ice'     ) )   CALL iom_put( 'qt_ice'     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
    254       IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
    255       IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
     254      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm) 
     255      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 
    256256      IF( iom_use('qemp_oce'   ) )   CALL iom_put( 'qemp_oce'   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean 
    257257      IF( iom_use('qemp_ice'   ) )   CALL iom_put( 'qemp_ice'   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice 
    … …  
    259259      ! heat fluxes from ice transformations 
    260260      !                            ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 
    261       CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth  
     261      CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth 
    262262      CALL iom_put ('hfxbom'     , hfx_bom     )   ! heat flux used for ice bottom melt 
    263263      CALL iom_put ('hfxsum'     , hfx_sum     )   ! heat flux used for ice surface melt 
    264264      CALL iom_put ('hfxopw'     , hfx_opw     )   ! heat flux used for ice formation in open water 
    265265      CALL iom_put ('hfxdif'     , hfx_dif     )   ! heat flux used for ice temperature change 
    266       CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt  
     266      CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt 
    267267      CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion 
    268268 
    269269      ! heat fluxes associated with mass exchange (freeze/melt/precip...) 
    270       CALL iom_put ('hfxthd'     , hfx_thd     )   !   
    271       CALL iom_put ('hfxdyn'     , hfx_dyn     )   !   
    272       CALL iom_put ('hfxres'     , hfx_res     )   !   
    273       CALL iom_put ('hfxsub'     , hfx_sub     )   !   
    274       CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content  
     270      CALL iom_put ('hfxthd'     , hfx_thd     )   ! 
     271      CALL iom_put ('hfxdyn'     , hfx_dyn     )   ! 
     272      CALL iom_put ('hfxres'     , hfx_res     )   ! 
     273      CALL iom_put ('hfxsub'     , hfx_sub     )   ! 
     274      CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content 
    275275 
    276276      ! other heat fluxes 
    … …  
    286286      IF( ln_icectl         )   CALL ice_prt       (kt, iiceprt, jiceprt, 3, 'Final state ice_update') ! prints 
    287287      IF( sn_cfctl%l_prtctl )   CALL ice_prt3D     ('iceupdate')                                       ! prints 
    288       IF( ln_timing         )   CALL timing_stop   ('ice_update')                                      ! timing 
     288      IF( ln_timing         )   CALL timing_stop   ('iceupdate')                                       ! timing 
    289289      ! 
    290290   END SUBROUTINE ice_update_flx 
    … …  
    294294      !!------------------------------------------------------------------- 
    295295      !!                ***  ROUTINE ice_update_tau *** 
    296       !!   
     296      !! 
    297297      !! ** Purpose : Update the ocean surface stresses due to the ice 
    298       !!          
     298      !! 
    299299      !! ** Action  : * at each ice time step (every nn_fsbc time step): 
    300       !!                - compute the modulus of ice-ocean relative velocity  
     300      !!                - compute the modulus of ice-ocean relative velocity 
    301301      !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid) 
    302302      !!                      tmod_io = rhoco * | U_ice-U_oce | 
    303303      !!                - update the modulus of stress at ocean surface 
    304304      !!                      taum = (1-a) * taum + a * tmod_io * | U_ice-U_oce | 
    305       !!              * at each ocean time step (every kt):  
     305      !!              * at each ocean time step (every kt): 
    306306      !!                  compute linearized ice-ocean stresses as 
    307307      !!                      Utau = tmod_io * | U_ice - pU_oce | 
    … …  
    310310      !!    NB: - ice-ocean rotation angle no more allowed 
    311311      !!        - here we make an approximation: taum is only computed every ice time step 
    312       !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids  
     312      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
    313313      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton... 
    314314      !! 
    … …  
    324324      REAL(wp) ::   zflagi                          !   -      - 
    325325      !!--------------------------------------------------------------------- 
    326       IF( ln_timing )   CALL timing_start('ice_update_tau') 
     326      IF( ln_timing )   CALL timing_start('ice_update') 
    327327 
    328328      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    337337         DO_2D( 0, 0, 0, 0 )                          !* update the modulus of stress at ocean surface (T-point) 
    338338            !                                               ! 2*(U_ice-U_oce) at T-point 
    339             zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)    
    340             zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)  
     339            zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) 
     340            zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
    341341            !                                              ! |U_ice-U_oce|^2 
    342342            zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  ) 
    … …  
    354354      !                                      !==  every ocean time-step  ==! 
    355355      IF ( ln_drgice_imp ) THEN 
    356          ! Save drag with right sign to update top drag in the ocean implicit friction  
    357          rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1)  
     356         ! Save drag with right sign to update top drag in the ocean implicit friction 
     357         rCdU_ice(:,:) = -r1_rho0 * tmod_io(:,:) * at_i(:,:) * tmask(:,:,1) 
    358358         zflagi = 0._wp 
    359359      ELSE 
    … …  
    362362      ! 
    363363      DO_2D( 0, 0, 0, 0 )                             !* update the stress WITHOUT an ice-ocean rotation angle 
    364          ! ice area at u and v-points  
     364         ! ice area at u and v-points 
    365365         zat_u  = ( at_i(ji,jj) * tmask(ji,jj,1) + at_i (ji+1,jj    ) * tmask(ji+1,jj  ,1) )  & 
    366366            &     / MAX( 1.0_wp , tmask(ji,jj,1) + tmask(ji+1,jj  ,1) ) 
    … …  
    376376      CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp )   ! lateral boundary condition 
    377377      ! 
    378       IF( ln_timing )   CALL timing_stop('ice_update_tau') 
    379       !   
     378      IF( ln_timing )   CALL timing_stop('ice_update') 
     379      ! 
    380380   END SUBROUTINE ice_update_tau 
    381381 
    … …  
    384384      !!------------------------------------------------------------------- 
    385385      !!                  ***  ROUTINE ice_update_init  *** 
    386       !!              
     386      !! 
    387387      !! ** Purpose :   allocate ice-ocean stress fields and read restarts 
    388388      !!                containing the snow & ice mass 
    … …  
    408408      !!--------------------------------------------------------------------- 
    409409      !!                   ***  ROUTINE rhg_evp_rst  *** 
    410       !!                      
     410      !! 
    411411      !! ** Purpose :   Read or write RHG file in restart file 
    412412      !! 
    … …  
    456456   !!   Default option         Dummy module           NO SI3 sea-ice model 
    457457   !!---------------------------------------------------------------------- 
    458 #endif  
     458#endif 
    459459 
    460460   !!====================================================================== 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icevar.F90

    r13472 r14021  
    3434   !!                        - st_i(jpi,jpj) 
    3535   !!                        - et_s(jpi,jpj)  total snow heat content 
    36    !!                        - et_i(jpi,jpj)  total ice thermal content  
     36   !!                        - et_i(jpi,jpj)  total ice thermal content 
    3737   !!                        - sm_i(jpi,jpj)  mean ice salinity 
    3838   !!                        - tm_i(jpi,jpj)  mean ice temperature 
    … …  
    5555   !!---------------------------------------------------------------------- 
    5656   USE dom_oce        ! ocean space and time domain 
    57    USE phycst         ! physical constants (ocean directory)  
     57   USE phycst         ! physical constants (ocean directory) 
    5858   USE sbc_oce , ONLY : sss_m, ln_ice_embd, nn_fsbc 
    5959   USE ice            ! sea-ice: variables 
    … …  
    6767   PRIVATE 
    6868 
    69    PUBLIC   ice_var_agg           
    70    PUBLIC   ice_var_glo2eqv       
    71    PUBLIC   ice_var_eqv2glo       
    72    PUBLIC   ice_var_salprof       
    73    PUBLIC   ice_var_salprof1d     
     69   PUBLIC   ice_var_agg 
     70   PUBLIC   ice_var_glo2eqv 
     71   PUBLIC   ice_var_eqv2glo 
     72   PUBLIC   ice_var_salprof 
     73   PUBLIC   ice_var_salprof1d 
    7474   PUBLIC   ice_var_zapsmall 
    7575   PUBLIC   ice_var_zapneg 
    7676   PUBLIC   ice_var_roundoff 
    77    PUBLIC   ice_var_bv            
    78    PUBLIC   ice_var_enthalpy            
     77   PUBLIC   ice_var_bv 
     78   PUBLIC   ice_var_enthalpy 
    7979   PUBLIC   ice_var_sshdyn 
    8080   PUBLIC   ice_var_itd 
    … …  
    108108      !!                ***  ROUTINE ice_var_agg  *** 
    109109      !! 
    110       !! ** Purpose :   aggregates ice-thickness-category variables to  
     110      !! ** Purpose :   aggregates ice-thickness-category variables to 
    111111      !!              all-ice variables, i.e. it turns VGLO into VAGG 
    112112      !!------------------------------------------------------------------- 
    … …  
    130130      vt_il(:,:) = SUM( v_il(:,:,:), dim=3 ) 
    131131      ! 
    132       ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction   
     132      ato_i(:,:) = 1._wp - at_i(:,:)         ! open water fraction 
    133133      ! 
    134134      !!GS: tm_su always needed by ABL over sea-ice 
    … …  
    155155         hm_i(:,:) = vt_i(:,:) * z1_at_i(:,:) 
    156156         hm_s(:,:) = vt_s(:,:) * z1_at_i(:,:) 
    157          !          
     157         ! 
    158158         !                          ! mean temperature (K), salinity and age 
    159159         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    … …  
    182182         WHERE( at_ip(:,:) > epsi20 )   ;   hm_ip(:,:) = vt_ip(:,:) / at_ip(:,:)   ;   hm_il(:,:) = vt_il(:,:) / at_ip(:,:) 
    183183         ELSEWHERE                      ;   hm_ip(:,:) = 0._wp                     ;   hm_il(:,:) = 0._wp 
    184          END WHERE          
     184         END WHERE 
    185185         ! 
    186186         DEALLOCATE( z1_vt_i , z1_vt_s ) 
    … …  
    197197      !!                ***  ROUTINE ice_var_glo2eqv *** 
    198198      !! 
    199       !! ** Purpose :   computes equivalent variables as function of   
     199      !! ** Purpose :   computes equivalent variables as function of 
    200200      !!              global variables, i.e. it turns VGLO into VEQV 
    201201      !!------------------------------------------------------------------- 
    … …  
    210210      !!------------------------------------------------------------------- 
    211211 
    212 !!gm Question 2:  It is possible to define existence of sea-ice in a common way between  
     212!!gm Question 2:  It is possible to define existence of sea-ice in a common way between 
    213213!!                ice area and ice volume ? 
    214214!!                the idea is to be able to define one for all at the begining of this routine 
    … …  
    234234 
    235235      zhmax    =          hi_max(jpl) 
    236       z1_zhmax =  1._wp / hi_max(jpl)                
     236      z1_zhmax =  1._wp / hi_max(jpl) 
    237237      WHERE( h_i(:,:,jpl) > zhmax )   ! bound h_i by hi_max (i.e. 99 m) with associated update of ice area 
    238          h_i  (:,:,jpl) = zhmax 
    239          a_i   (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax  
     238         h_i   (:,:,jpl) = zhmax 
     239         a_i   (:,:,jpl) = v_i(:,:,jpl) * z1_zhmax 
    240240         z1_a_i(:,:,jpl) = zhmax * z1_v_i(:,:,jpl) 
    241241      END WHERE 
    242242      !                                           !--- snow thickness 
    243243      h_s(:,:,:) = v_s (:,:,:) * z1_a_i(:,:,:) 
    244       !                                           !--- ice age       
     244      !                                           !--- ice age 
    245245      o_i(:,:,:) = oa_i(:,:,:) * z1_a_i(:,:,:) 
    246       !                                           !--- pond and lid thickness       
     246      !                                           !--- pond and lid thickness 
    247247      h_ip(:,:,:) = v_ip(:,:,:) * z1_a_ip(:,:,:) 
    248248      h_il(:,:,:) = v_il(:,:,:) * z1_a_ip(:,:,:) 
    … …  
    252252      ELSEWHERE( h_il(:,:,:) >= zhl_max )  ;   a_ip_eff(:,:,:) = 0._wp                  ! lid is very thick. Cover all the pond up with ice and snow 
    253253      ELSEWHERE                            ;   a_ip_eff(:,:,:) = a_ip_frac(:,:,:) * &   ! lid is in between. Expose part of the pond 
    254          &                                                       ( h_il(:,:,:) - zhl_min ) / ( zhl_max - zhl_min ) 
     254         &                                                       ( zhl_max - h_il(:,:,:) ) / ( zhl_max - zhl_min ) 
    255255      END WHERE 
    256256      ! 
    … …  
    258258      a_ip_eff = MIN( a_ip_eff, 1._wp - za_s_fra )   ! make sure (a_ip_eff + a_s_fra) <= 1 
    259259      ! 
    260       !                                           !---  salinity (with a minimum value imposed everywhere)      
     260      !                                           !---  salinity (with a minimum value imposed everywhere) 
    261261      IF( nn_icesal == 2 ) THEN 
    262262         WHERE( v_i(:,:,:) > epsi20 )   ;   s_i(:,:,:) = MAX( rn_simin , MIN( rn_simax, sv_i(:,:,:) * z1_v_i(:,:,:) ) ) 
    … …  
    272272      DO jl = 1, jpl 
    273273         DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
    274             IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
     274            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
    275275               ! 
    276276               ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3] 
    … …  
    300300      END DO 
    301301      ! 
    302       ! integrated values  
     302      ! integrated values 
    303303      vt_i (:,:) = SUM( v_i , dim=3 ) 
    304304      vt_s (:,:) = SUM( v_s , dim=3 ) 
    … …  
    312312      !!                ***  ROUTINE ice_var_eqv2glo *** 
    313313      !! 
    314       !! ** Purpose :   computes global variables as function of  
     314      !! ** Purpose :   computes global variables as function of 
    315315      !!              equivalent variables,  i.e. it turns VEQV into VGLO 
    316316      !!------------------------------------------------------------------- 
    … …  
    329329      !!                ***  ROUTINE ice_var_salprof *** 
    330330      !! 
    331       !! ** Purpose :   computes salinity profile in function of bulk salinity      
    332       !! 
    333       !! ** Method  : If bulk salinity greater than zsi1,  
     331      !! ** Purpose :   computes salinity profile in function of bulk salinity 
     332      !! 
     333      !! ** Method  : If bulk salinity greater than zsi1, 
    334334      !!              the profile is assumed to be constant (S_inf) 
    335335      !!              If bulk salinity lower than zsi0, 
    … …  
    348348      !!------------------------------------------------------------------- 
    349349 
    350 !!gm Question: Remove the option 3 ?  How many years since it last use ?  
     350!!gm Question: Remove the option 3 ?  How many years since it last use ? 
    351351 
    352352      SELECT CASE ( nn_icesal ) 
    … …  
    369369            END DO 
    370370         END DO 
    371          !                                      ! Slope of the linear profile  
     371         !                                      ! Slope of the linear profile 
    372372         WHERE( h_i(:,:,:) > epsi20 )   ;   z_slope_s(:,:,:) = 2._wp * s_i(:,:,:) / h_i(:,:,:) 
    373373         ELSEWHERE                      ;   z_slope_s(:,:,:) = 0._wp 
    … …  
    379379               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    380380               !                             ! force a constant profile when SSS too low (Baltic Sea) 
    381                IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
     381               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp 
    382382            END_2D 
    383383         END DO 
    … …  
    448448         ALLOCATE( z_slope_s(jpij), zalpha(jpij) ) 
    449449         ! 
    450          !                                      ! Slope of the linear profile  
     450         !                                      ! Slope of the linear profile 
    451451         WHERE( h_i_1d(1:npti) > epsi20 )   ;   z_slope_s(1:npti) = 2._wp * s_i_1d(1:npti) / h_i_1d(1:npti) 
    452452         ELSEWHERE                          ;   z_slope_s(1:npti) = 0._wp 
    453453         END WHERE 
    454           
     454 
    455455         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    456456         DO ji = 1, npti 
    … …  
    534534         DO_2D( 1, 1, 1, 1 ) 
    535535            ! update exchanges with ocean 
    536             sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
    537             wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_Dt_ice 
    538             wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_Dt_ice 
     536            sfx_res(ji,jj)  = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
     537            wfx_res(ji,jj)  = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_Dt_ice 
     538            wfx_res(ji,jj)  = wfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_Dt_ice 
     539            wfx_pnd(ji,jj)  = wfx_pnd(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * ( v_ip(ji,jj,jl)+v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 
    539540            ! 
    540541            a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 
    … …  
    551552            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
    552553            v_il (ji,jj,jl) = v_il (ji,jj,jl) * zswitch(ji,jj) 
     554            h_ip (ji,jj,jl) = h_ip (ji,jj,jl) * zswitch(ji,jj) 
     555            h_il (ji,jj,jl) = h_il (ji,jj,jl) * zswitch(ji,jj) 
    553556            ! 
    554557         END_2D 
    555558         ! 
    556       END DO  
     559      END DO 
    557560 
    558561      ! to be sure that at_i is the sum of a_i(jl) 
    … …  
    635638               psv_i  (ji,jj,jl) = 0._wp 
    636639            ENDIF 
     640            IF( pv_ip(ji,jj,jl) < 0._wp .OR. pv_il(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN 
     641               wfx_pnd(ji,jj)    = wfx_pnd(ji,jj) + pv_il(ji,jj,jl) * rhow * z1_dt 
     642               pv_il  (ji,jj,jl) = 0._wp 
     643            ENDIF 
     644            IF( pv_ip(ji,jj,jl) < 0._wp .OR. pa_ip(ji,jj,jl) <= 0._wp ) THEN 
     645               wfx_pnd(ji,jj)    = wfx_pnd(ji,jj) + pv_ip(ji,jj,jl) * rhow * z1_dt 
     646               pv_ip  (ji,jj,jl) = 0._wp 
     647            ENDIF 
    637648         END_2D 
    638649         ! 
    639       END DO  
     650      END DO 
    640651      ! 
    641652      WHERE( pato_i(:,:)   < 0._wp )   pato_i(:,:)   = 0._wp 
    … …  
    643654      WHERE( pa_i  (:,:,:) < 0._wp )   pa_i  (:,:,:) = 0._wp 
    644655      WHERE( pa_ip (:,:,:) < 0._wp )   pa_ip (:,:,:) = 0._wp 
    645       WHERE( pv_ip (:,:,:) < 0._wp )   pv_ip (:,:,:) = 0._wp ! in theory one should change wfx_pnd(-) and wfx_sum(+) 
    646       WHERE( pv_il (:,:,:) < 0._wp )   pv_il (:,:,:) = 0._wp !    but it does not change conservation, so keep it this way is ok 
    647656      ! 
    648657   END SUBROUTINE ice_var_zapneg 
    … …  
    675684      WHERE( pe_i (1:npti,:,:) < 0._wp )   pe_i (1:npti,:,:) = 0._wp   !  e_i must be >= 0 
    676685      WHERE( pe_s (1:npti,:,:) < 0._wp )   pe_s (1:npti,:,:) = 0._wp   !  e_s must be >= 0 
    677       IF( ln_pnd_LEV ) THEN 
     686      IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    678687         WHERE( pa_ip(1:npti,:) < 0._wp )    pa_ip(1:npti,:)   = 0._wp   ! a_ip must be >= 0 
    679688         WHERE( pv_ip(1:npti,:) < 0._wp )    pv_ip(1:npti,:)   = 0._wp   ! v_ip must be >= 0 
    … …  
    684693      ! 
    685694   END SUBROUTINE ice_var_roundoff 
    686     
     695 
    687696 
    688697   SUBROUTINE ice_var_bv 
    … …  
    704713      DO jl = 1, jpl 
    705714         DO jk = 1, nlay_i 
    706             WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 )    
     715            WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 ) 
    707716               bv_i(:,:,jl) = bv_i(:,:,jl) - rTmlt * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 ) 
    708717            END WHERE 
    … …  
    718727   SUBROUTINE ice_var_enthalpy 
    719728      !!------------------------------------------------------------------- 
    720       !!                   ***  ROUTINE ice_var_enthalpy ***  
    721       !!                  
     729      !!                   ***  ROUTINE ice_var_enthalpy *** 
     730      !! 
    722731      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
    723732      !! 
    … …  
    725734      !!------------------------------------------------------------------- 
    726735      INTEGER  ::   ji, jk   ! dummy loop indices 
    727       REAL(wp) ::   ztmelts  ! local scalar  
     736      REAL(wp) ::   ztmelts  ! local scalar 
    728737      !!------------------------------------------------------------------- 
    729738      ! 
    … …  
    732741            ztmelts      = - rTmlt  * sz_i_1d(ji,jk) 
    733742            t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts + rt0 ) ! Force t_i_1d to be lower than melting point => likely conservation issue 
    734                                                                 !   (sometimes zdf scheme produces abnormally high temperatures)    
     743                                                                !   (sometimes zdf scheme produces abnormally high temperatures) 
    735744            e_i_1d(ji,jk) = rhoi * ( rcpi  * ( ztmelts - ( t_i_1d(ji,jk) - rt0 ) )           & 
    736745               &                   + rLfus * ( 1._wp - ztmelts / ( t_i_1d(ji,jk) - rt0 ) )   & 
    … …  
    746755   END SUBROUTINE ice_var_enthalpy 
    747756 
    748     
     757 
    749758   FUNCTION ice_var_sshdyn(pssh, psnwice_mass, psnwice_mass_b) 
    750759      !!--------------------------------------------------------------------- 
    751760      !!                   ***  ROUTINE ice_var_sshdyn  *** 
    752       !!                      
     761      !! 
    753762      !! ** Purpose :  compute the equivalent ssh in lead when sea ice is embedded 
    754763      !! 
    … …  
    756765      !! 
    757766      !! ** Reference : Jean-Michel Campin, John Marshall, David Ferreira, 
    758       !!                Sea ice-ocean coupling using a rescaled vertical coordinate z*,  
     767      !!                Sea ice-ocean coupling using a rescaled vertical coordinate z*, 
    759768      !!                Ocean Modelling, Volume 24, Issues 1-2, 2008 
    760769      !!---------------------------------------------------------------------- 
    … …  
    774783      ! compute ice load used to define the equivalent ssh in lead 
    775784      IF( ln_ice_embd ) THEN 
    776          !                                             
     785         ! 
    777786         ! average interpolation coeff as used in dynspg = (1/nn_fsbc)   * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} 
    778787         !                                               = (1/nn_fsbc)^2 * {SUM[n]        , n=0,nn_fsbc-1} 
    … …  
    793802   END FUNCTION ice_var_sshdyn 
    794803 
    795     
     804 
    796805   !!------------------------------------------------------------------- 
    797806   !!                ***  INTERFACE ice_var_itd   *** 
    … …  
    822831      ph_ip(:) = phtip(:) 
    823832      ph_il(:) = phtil(:) 
    824        
     833 
    825834   END SUBROUTINE ice_var_itd_1c1c 
    826835 
    … …  
    837846      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   z1_ai, z1_vi, z1_vs 
    838847      ! 
    839       INTEGER ::   idim   
     848      INTEGER ::   idim 
    840849      !!------------------------------------------------------------------- 
    841850      ! 
    … …  
    879888      ! 
    880889   END SUBROUTINE ice_var_itd_Nc1c 
    881     
     890 
    882891   SUBROUTINE ice_var_itd_1cMc( phti, phts, pati ,                             ph_i, ph_s, pa_i, & 
    883892      &                         ptmi, ptms, ptmsu, psmi, patip, phtip, phtil,  pt_i, pt_s, pt_su, ps_i, pa_ip, ph_ip, ph_il ) 
    … …  
    889898      !! ** Method:   ice thickness distribution follows a gamma function from Abraham et al. (2015) 
    890899      !!              it has the property of conserving total concentration and volume 
    891       !!               
     900      !! 
    892901      !! 
    893902      !! ** Arguments : phti: 1-cat ice thickness 
    … …  
    895904      !!                pati: 1-cat ice concentration 
    896905      !! 
    897       !! ** Output    : jpl-cat  
     906      !! ** Output    : jpl-cat 
    898907      !! 
    899908      !!  Abraham, C., Steiner, N., Monahan, A. and Michel, C., 2015. 
    900909      !!               Effects of subgrid‐scale snow thickness variability on radiative transfer in sea ice. 
    901       !!               Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614  
     910      !!               Journal of Geophysical Research: Oceans, 120(8), pp.5597-5614 
    902911      !!------------------------------------------------------------------- 
    903912      REAL(wp), DIMENSION(:),   INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    … …  
    978987               ! In case snow load is in excess that would lead to transformation from snow to ice 
    979988               ! Then, transfer the snow excess into the ice (different from icethd_dh) 
    980                zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 )  
     989               zdh = MAX( 0._wp, ( rhos * ph_s(ji,jl) + ( rhoi - rho0 ) * ph_i(ji,jl) ) * r1_rho0 ) 
    981990               ! recompute h_i, h_s avoiding out of bounds values 
    982991               ph_i(ji,jl) = MIN( hi_max(jl), ph_i(ji,jl) + zdh ) 
    … …  
    10381047      !! 
    10391048      !! ** Method:   Iterative procedure 
    1040       !!                 
     1049      !! 
    10411050      !!               1) Fill ice cat that correspond to input thicknesses 
    10421051      !!                  Find the lowest(jlmin) and highest(jlmax) cat that are filled 
    10431052      !! 
    10441053      !!               2) Expand the filling to the cat jlmin-1 and jlmax+1 
    1045       !!                   by removing 25% ice area from jlmin and jlmax (resp.)  
    1046       !!               
    1047       !!               3) Expand the filling to the empty cat between jlmin and jlmax  
     1054      !!                   by removing 25% ice area from jlmin and jlmax (resp.) 
     1055      !! 
     1056      !!               3) Expand the filling to the empty cat between jlmin and jlmax 
    10481057      !!                   by a) removing 25% ice area from the lower cat (ascendant loop jlmin=>jlmax) 
    10491058      !!                      b) removing 25% ice area from the higher cat (descendant loop jlmax=>jlmin) 
    … …  
    10531062      !!                pati: N-cat ice concentration 
    10541063      !! 
    1055       !! ** Output    : jpl-cat  
    1056       !! 
    1057       !!  (Example of application: BDY forcings when inputs have N-cat /= jpl)   
     1064      !! ** Output    : jpl-cat 
     1065      !! 
     1066      !!  (Example of application: BDY forcings when inputs have N-cat /= jpl) 
    10581067      !!------------------------------------------------------------------- 
    10591068      REAL(wp), DIMENSION(:,:), INTENT(in)    ::   phti, phts, pati    ! input  ice/snow variables 
    … …  
    10681077      REAL(wp), PARAMETER ::   ztrans = 0.25_wp 
    10691078      INTEGER  ::   ji, jl, jl1, jl2 
    1070       INTEGER  ::   idim, icat   
     1079      INTEGER  ::   idim, icat 
    10711080      !!------------------------------------------------------------------- 
    10721081      ! 
    … …  
    11071116      ELSE                              ! input cat /= output cat ! 
    11081117         !                              ! ----------------------- ! 
    1109           
     1118 
    11101119         ALLOCATE( jlfil(idim,jpl), jlfil2(idim,jpl) )       ! allocate arrays 
    11111120         ALLOCATE( jlmin(idim), jlmax(idim) ) 
    … …  
    11171126         ! 
    11181127         ! --- fill the categories --- ! 
    1119          !     find where cat-input = cat-output and fill cat-output fields   
     1128         !     find where cat-input = cat-output and fill cat-output fields 
    11201129         jlmax(:) = 0 
    11211130         jlmin(:) = 999 
    … …  
    11381147         END DO 
    11391148         ! 
    1140          ! --- fill the gaps between categories --- !   
     1149         ! --- fill the gaps between categories --- ! 
    11411150         !     transfer from categories filled at the previous step to the empty ones in between 
    11421151         DO ji = 1, idim 
    … …  
    11591168         END DO 
    11601169         ! 
    1161          jlfil2(:,:) = jlfil(:,:)  
     1170         jlfil2(:,:) = jlfil(:,:) 
    11621171         ! fill categories from low to high 
    11631172         DO jl = 2, jpl-1 
    … …  
    11801189                  ! fill low 
    11811190                  pa_i(ji,jl) = pa_i(ji,jl) + ztrans * pa_i(ji,jl+1) 
    1182                   ph_i(ji,jl) = hi_mean(jl)  
     1191                  ph_i(ji,jl) = hi_mean(jl) 
    11831192                  jlfil2(ji,jl) = jl 
    11841193                  ! remove high 
    … …  
    12701279   !!               we argue that snow does not cover the whole ice because 
    12711280   !!               of wind blowing... 
    1272    !!                 
     1281   !! 
    12731282   !! ** Arguments : ph_s: snow thickness 
    1274    !!                 
     1283   !! 
    12751284   !! ** Output    : pa_s_fra: fraction of ice covered by snow 
    12761285   !! 
    … …  
    13171326      ENDIF 
    13181327   END SUBROUTINE ice_var_snwfra_1d 
    1319     
     1328 
    13201329   !!-------------------------------------------------------------------------- 
    13211330   !! INTERFACE ice_var_snwblow 
    … …  
    13271336   !!                If snow fall was uniform, a fraction (1-at_i) would fall into leads 
    13281337   !!                but because of the winds, more snow falls on leads than on sea ice 
    1329    !!                and a greater fraction (1-at_i)^beta of the total mass of snow  
     1338   !!                and a greater fraction (1-at_i)^beta of the total mass of snow 
    13301339   !!                (beta < 1) falls in leads. 
    1331    !!                In reality, beta depends on wind speed,  
    1332    !!                and should decrease with increasing wind speed but here, it is  
     1340   !!                In reality, beta depends on wind speed, 
     1341   !!                and should decrease with increasing wind speed but here, it is 
    13331342   !!                considered as a constant. an average value is 0.66 
    13341343   !!-------------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/ICE/icewri.F90

    r13472 r14021  
    1010   !!   'key_si3'                                       SI3 sea-ice model 
    1111   !!---------------------------------------------------------------------- 
    12    !!   ice_wri       : write of the diagnostics variables in ouput file  
     12   !!   ice_wri       : write of the diagnostics variables in ouput file 
    1313   !!   ice_wri_state : write for initial state or/and abandon 
    1414   !!---------------------------------------------------------------------- 
    … …  
    3333 
    3434   PUBLIC ice_wri        ! called by ice_stp 
    35    PUBLIC ice_wri_state  ! called by dia_wri_state  
     35   PUBLIC ice_wri_state  ! called by dia_wri_state 
    3636 
    3737   !! * Substitutions 
    … …  
    5252      INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices 
    5353      REAL(wp) ::   z2da, z2db, zrho1, zrho2 
    54       REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
     54      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
    5555      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast                     ! 2D workspace 
    5656      REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask 
    … …  
    5959      ! Global ice diagnostics (SIMIP) 
    6060      REAL(wp) ::   zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh   ! area, extent, volume 
    61       REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh  
     61      REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
    6262      !!------------------------------------------------------------------- 
    6363      ! 
    … …  
    9292      CALL iom_put( 'icemask05', zmsk05 )   ! ice mask 5% 
    9393      CALL iom_put( 'icemask15', zmsk15 )   ! ice mask 15% 
    94       CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0)  
     94      CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0) 
    9595      ! 
    9696      ! general fields 
    97       IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area  
     97      IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area 
    9898      IF( iom_use('snwmass' ) )   CALL iom_put( 'snwmass', vt_s * rhos * zmsksn )                                           ! Snow mass per cell area 
    9999      IF( iom_use('iceconc' ) )   CALL iom_put( 'iceconc', at_i        * zmsk00 )                                           ! ice concentration 
    … …  
    106106      IF( iom_use('snwvolu' ) )   CALL iom_put( 'snwvolu', vt_s        * zmsksn )                                           ! snow volume 
    107107      IF( iom_use('icefrb'  ) ) THEN                                                                                        ! Ice freeboard 
    108          z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                          
     108         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) ) 
    109109         WHERE( z2d < 0._wp )   z2d = 0._wp 
    110110                                  CALL iom_put( 'icefrb' , z2d * zmsk00         ) 
    … …  
    160160      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    161161      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories 
     162      IF( iom_use('icevpnd_cat' ) )   CALL iom_put( 'icevpnd_cat' ,   v_ip         * zmsk00l                                   ) ! melt pond volume for categories 
    162163      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond thickness for categories 
    163164      IF( iom_use('icehlid_cat' ) )   CALL iom_put( 'icehlid_cat' ,   h_il         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond lid thickness for categories 
    164       IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
     165      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac per ice area for categories 
    165166      IF( iom_use('iceaepnd_cat') )   CALL iom_put( 'iceaepnd_cat',   a_ip_eff     * zmsk00l                                   ) ! melt pond effective frac for categories 
    166167      IF( iom_use('icealb_cat'  ) )   CALL iom_put( 'icealb_cat'  ,   alb_ice      * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice albedo for categories 
    … …  
    185186      IF( iom_use('dmsmel') )   CALL iom_put( 'dmsmel', - wfx_snw_sum                                                         ) ! Snow mass change through melt 
    186187      IF( iom_use('dmsdyn') )   CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs                                    ) ! Snow mass change through dynamics(kg/m2/s) 
    187        
     188 
    188189      ! Global ice diagnostics 
    189190      IF(  iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & 
    … …  
    220221   END SUBROUTINE ice_wri 
    221222 
    222   
     223 
    223224   SUBROUTINE ice_wri_state( kid ) 
    224225      !!--------------------------------------------------------------------- 
    225226      !!                 ***  ROUTINE ice_wri_state  *** 
    226       !!         
    227       !! ** Purpose :   create a NetCDF file named cdfile_name which contains  
     227      !! 
     228      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
    228229      !!      the instantaneous ice state and forcing fields for ice model 
    229230      !!        Used to find errors in the initial state or save the last 
    … …  
    232233      !! History :   4.0  !  2013-06  (C. Rousset) 
    233234      !!---------------------------------------------------------------------- 
    234       INTEGER, INTENT( in ) ::   kid  
     235      INTEGER, INTENT( in ) ::   kid 
    235236      !!---------------------------------------------------------------------- 
    236237      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/C1D/step_c1d.F90

    r14017 r14021  
    104104      IF( ln_tradmp )   CALL tra_dmp( kstp, Nbb, Nnn, ts, Nrhs  )  ! internal damping trends- tracers 
    105105      IF(.NOT.ln_linssh)CALL tra_adv( kstp, Nbb, Nnn, ts, Nrhs  )  ! horizontal & vertical advection 
     106      IF( ln_zdfmfc  )  CALL tra_mfc( kstp, Nbb     , ts, Nrhs  )  ! Mass Flux Convection 
    106107      IF( ln_zdfosm  )  CALL tra_osm( kstp, Nnn     , ts, Nrhs  )  ! OSMOSIS non-local tracer fluxes 
    107108                        CALL tra_zdf( kstp, Nbb, Nnn, Nrhs, ts, Naa   )         ! vertical mixing 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DYN/dynspg.F90

    r13497 r14021  
    66   !! History :  1.0  ! 2005-12  (C. Talandier, G. Madec, V. Garnier)  Original code 
    77   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option 
    8    !!---------------------------------------------------------------------- 
    9  
    10    !!---------------------------------------------------------------------- 
    11    !!   dyn_spg     : update the dynamics trend with surface pressure gradient  
     8   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) add Bernoulli Head for 
     9   !!                            wave coupling 
     10   !!---------------------------------------------------------------------- 
     11 
     12   !!---------------------------------------------------------------------- 
     13   !!   dyn_spg     : update the dynamics trend with surface pressure gradient 
    1214   !!   dyn_spg_init: initialization, namelist read, and parameters control 
    1315   !!---------------------------------------------------------------------- 
    … …  
    1921   USE sbc_ice , ONLY : snwice_mass, snwice_mass_b 
    2022   USE sbcapr         ! surface boundary condition: atmospheric pressure 
     23   USE sbcwave,  ONLY : bhd_wave 
    2124   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine) 
    2225   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine) 
    … …  
    3639   PUBLIC   dyn_spg_init   ! routine called by opa module 
    3740 
    38    INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...  
     41   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_... 
    3942 
    4043   !                       ! Parameter to control the surface pressure gradient scheme 
    … …  
    4952   !!---------------------------------------------------------------------- 
    5053   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    51    !! $Id$  
     54   !! $Id$ 
    5255   !! Software governed by the CeCILL license (see ./LICENSE) 
    5356   !!---------------------------------------------------------------------- 
    … …  
    5861      !!                  ***  ROUTINE dyn_spg  *** 
    5962      !! 
    60       !! ** Purpose :   compute surface pressure gradient including the  
     63      !! ** Purpose :   compute surface pressure gradient including the 
    6164      !!              atmospheric pressure forcing (ln_apr_dyn=T). 
    6265      !! 
    … …  
    6568      !!              - split-explicit : a time splitting technique is used 
    6669      !! 
    67       !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied  
     70      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
    6871      !!             as the gradient of the inverse barometer ssh: 
    6972      !!                apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 
    … …  
    8689      ! 
    8790      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    88          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
     91         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    8992         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
    9093         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    … …  
    140143               spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
    141144            END_2D 
    142             DEALLOCATE( zpice )          
     145            DEALLOCATE( zpice ) 
     146         ENDIF 
     147         ! 
     148         IF( ln_wave .and. ln_bern_srfc ) THEN          !== Add J terms: depth-independent Bernoulli head 
     149            DO_2D( 0, 0, 0, 0 ) 
     150               spgu(ji,jj) = spgu(ji,jj) + ( bhd_wave(ji+1,jj) - bhd_wave(ji,jj) ) / e1u(ji,jj)   !++ bhd_wave from wave model in m2/s2 [BHD parameters in WW3] 
     151               spgv(ji,jj) = spgv(ji,jj) + ( bhd_wave(ji,jj+1) - bhd_wave(ji,jj) ) / e2v(ji,jj) 
     152            END_2D 
    143153         ENDIF 
    144154         ! 
    … …  
    149159         ! 
    150160!!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 
    151          !     
     161         ! 
    152162      ENDIF 
    153163      ! 
    … …  
    156166      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting 
    157167      END SELECT 
    158       !                     
     168      ! 
    159169      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
    160170         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
    161171         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
    162172         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm ) 
    163          DEALLOCATE( ztrdu , ztrdv )  
     173         DEALLOCATE( ztrdu , ztrdv ) 
    164174      ENDIF 
    165175      !                                      ! print mean trends (used for debugging) 
    … …  
    175185      !!--------------------------------------------------------------------- 
    176186      !!                  ***  ROUTINE dyn_spg_init  *** 
    177       !!                 
    178       !! ** Purpose :   Control the consistency between namelist options for  
     187      !! 
     188      !! ** Purpose :   Control the consistency between namelist options for 
    179189      !!              surface pressure gradient schemes 
    180190      !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DYN/dynvor.F90

    r13546 r14021  
    1515   !!            3.2  ! 2009-04  (R. Benshila)  vvl: correction of een scheme 
    1616   !!            3.3  ! 2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase 
    17    !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity  
     17   !!            3.7  ! 2014-04  (G. Madec)  trend simplification: suppress jpdyn_trd_dat vorticity 
    1818   !!             -   ! 2014-06  (G. Madec)  suppression of velocity curl from in-core memory 
    1919   !!             -   ! 2016-12  (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) 
    … …  
    2121   !!             -   ! 2018-03  (G. Madec)  add two new schemes (ln_dynvor_enT and ln_dynvor_eet) 
    2222   !!             -   ! 2018-04  (G. Madec)  add pre-computed gradient for metric term calculation 
     23   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T) 
    2324   !!---------------------------------------------------------------------- 
    2425 
    … …  
    3738   USE trddyn         ! trend manager: dynamics 
    3839   USE sbcwave        ! Surface Waves (add Stokes-Coriolis force) 
    39    USE sbc_oce , ONLY : ln_stcor    ! use Stoke-Coriolis force 
     40   USE sbc_oce,  ONLY : ln_stcor, ln_vortex_force   ! use Stoke-Coriolis force 
    4041   ! 
    4142   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    … …  
    7071   INTEGER, PUBLIC, PARAMETER ::   np_MIX = 5   ! MIX scheme 
    7172 
    72    INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity  
     73   INTEGER ::   ncor, nrvm, ntot   ! choice of calculated vorticity 
    7374   !                               ! associated indices: 
    7475   INTEGER, PUBLIC, PARAMETER ::   np_COR = 1         ! Coriolis (planetary) 
    … …  
    7980 
    8081   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation 
    81    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -  
     82   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       - 
    8283   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2v)/(2*e1e2f)  used in F-point metric term calculation 
    83    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1u)/(2*e1e2f)   -        -      -       -  
    84     
     84   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1u)/(2*e1e2f)   -        -      -       - 
     85 
    8586   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 
    8687   REAL(wp) ::   r1_8  = 0.125_wp         ! =1/8 
    8788   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! 1/12 
    88     
     89 
    8990   !! * Substitutions 
    9091#  include "do_loop_substitute.h90" 
    … …  
    105106      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now vorticity term trend 
    106107      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    107       !!               and planetary vorticity trends) and send them to trd_dyn  
     108      !!               and planetary vorticity trends) and send them to trd_dyn 
    108109      !!               for futher diagnostics (l_trddyn=T) 
    109110      !!---------------------------------------------------------------------- 
    … …  
    121122         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
    122123         ! 
    123          ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend (including Stokes-Coriolis force) 
     124         ztrdu(:,:,:) = puu(:,:,:,Krhs)            !* planetary vorticity trend 
    124125         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    125126         SELECT CASE( nvor_scheme ) 
    126127         CASE( np_ENS )           ;   CALL vor_ens( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! enstrophy conserving scheme 
    127             IF( ln_stcor )            CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    128128         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme 
    129             IF( ln_stcor )            CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    130129         CASE( np_ENT )           ;   CALL vor_enT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (T-pts) 
    131             IF( ln_stcor )            CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    132130         CASE( np_EET )           ;   CALL vor_eeT( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy conserving scheme (een with e3t) 
    133             IF( ln_stcor )            CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    134131         CASE( np_EEN )           ;   CALL vor_een( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! energy & enstrophy scheme 
    135             IF( ln_stcor )            CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
    136132         END SELECT 
    137133         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
    … …  
    161157         CASE( np_ENT )                        !* energy conserving scheme  (T-pts) 
    162158                             CALL vor_enT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    163             IF( ln_stcor )   CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     159            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     160                             CALL vor_enT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     161            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     162                             CALL vor_enT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     163            ENDIF 
    164164         CASE( np_EET )                        !* energy conserving scheme (een scheme using e3t) 
    165165                             CALL vor_eeT( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    166             IF( ln_stcor )   CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     166            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     167                             CALL vor_eeT( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     168            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     169                             CALL vor_eeT( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     170            ENDIF 
    167171         CASE( np_ENE )                        !* energy conserving scheme 
    168172                             CALL vor_ene( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    169             IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     173            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     174                             CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     175            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     176                             CALL vor_ene( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     177            ENDIF 
    170178         CASE( np_ENS )                        !* enstrophy conserving scheme 
    171179                             CALL vor_ens( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! total vorticity trend 
    172             IF( ln_stcor )   CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend 
     180 
     181            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     182                             CALL vor_ens( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend 
     183            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     184                             CALL vor_ens( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )  ! add the Stokes-Coriolis trend and vortex force 
     185            ENDIF 
    173186         CASE( np_MIX )                        !* mixed ene-ens scheme 
    174187                             CALL vor_ens( kt, Kmm, nrvm, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! relative vorticity or metric trend (ens) 
    175188                             CALL vor_ene( kt, Kmm, ncor, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! planetary vorticity trend (ene) 
    176             IF( ln_stcor )   CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     189            IF( ln_stcor )        CALL vor_ene( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )        ! add the Stokes-Coriolis trend 
     190            IF( ln_vortex_force ) CALL vor_ens( kt, Kmm, nrvm, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add vortex force 
    177191         CASE( np_EEN )                        !* energy and enstrophy conserving scheme 
    178192                             CALL vor_een( kt, Kmm, ntot, puu(:,:,:,Kmm) , pvv(:,:,:,Kmm) , puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! total vorticity trend 
    179             IF( ln_stcor )   CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     193            IF( ln_stcor .AND. .NOT. ln_vortex_force )  THEN 
     194                             CALL vor_een( kt, Kmm, ncor, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend 
     195            ELSE IF( ln_stcor .AND. ln_vortex_force )   THEN 
     196                             CALL vor_een( kt, Kmm, ntot, usd, vsd, puu(:,:,:,Krhs), pvv(:,:,:,Krhs) )   ! add the Stokes-Coriolis trend and vortex force 
     197            ENDIF 
    180198         END SELECT 
    181199         ! 
    … …  
    195213      !!                  ***  ROUTINE vor_enT  *** 
    196214      !! 
    197       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     215      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    198216      !!      the general trend of the momentum equation. 
    199217      !! 
    200       !! ** Method  :   Trend evaluated using now fields (centered in time)  
     218      !! ** Method  :   Trend evaluated using now fields (centered in time) 
    201219      !!       and t-point evaluation of vorticity (planetary and relative). 
    202220      !!       conserves the horizontal kinetic energy. 
    203       !!         The general trend of momentum is increased due to the vorticity  
     221      !!         The general trend of momentum is increased due to the vorticity 
    204222      !!       term which is given by: 
    205223      !!          voru = 1/bu  mj[ ( mi(mj(bf*rvor))+bt*f_t)/e3t  mj[vn] ] 
    … …  
    235253                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    236254            END_2D 
    237             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity  
     255            IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity 
    238256               DO_2D( 1, 0, 1, 0 ) 
    239257                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    250268                  &              - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)   ) * r1_e1e2f(ji,jj) 
    251269            END_2D 
    252             IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity  
     270            IF( ln_dynvor_msk ) THEN                     ! mask/unmask relative vorticity 
    253271               DO_2D( 1, 0, 1, 0 ) 
    254272                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    … …  
    304322               ! 
    305323            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)                    & 
    306                &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   &  
    307                &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   )  
     324               &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   & 
     325               &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   ) 
    308326         END_2D 
    309327         !                                             ! =============== 
    … …  
    317335      !!                  ***  ROUTINE vor_ene  *** 
    318336      !! 
    319       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     337      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    320338      !!      the general trend of the momentum equation. 
    321339      !! 
    322       !! ** Method  :   Trend evaluated using now fields (centered in time)  
     340      !! ** Method  :   Trend evaluated using now fields (centered in time) 
    323341      !!       and the Sadourny (1975) flux form formulation : conserves the 
    324342      !!       horizontal kinetic energy. 
    325       !!         The general trend of momentum is increased due to the vorticity  
     343      !!         The general trend of momentum is increased due to the vorticity 
    326344      !!       term which is given by: 
    327345      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v pvv(:,:,:,Kmm)) ] 
    … …  
    356374         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    357375         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    358             zwz(:,:) = ff_f(:,:)  
     376            zwz(:,:) = ff_f(:,:) 
    359377         CASE ( np_RVO )                           !* relative vorticity 
    360378            DO_2D( 1, 0, 1, 0 ) 
    … …  
    402420            zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    403421            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    404             pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     422            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    405423         END_2D 
    406424         !                                             ! =============== 
    … …  
    452470         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    453471         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    454             zwz(:,:) = ff_f(:,:)  
     472            zwz(:,:) = ff_f(:,:) 
    455473         CASE ( np_RVO )                           !* relative vorticity 
    456474            DO_2D( 1, 0, 1, 0 ) 
    … …  
    510528      !!                ***  ROUTINE vor_een  *** 
    511529      !! 
    512       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     530      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    513531      !!      the general trend of the momentum equation. 
    514532      !! 
    515       !! ** Method  :   Trend evaluated using now fields (centered in time)  
    516       !!      and the Arakawa and Lamb (1980) flux form formulation : conserves  
     533      !! ** Method  :   Trend evaluated using now fields (centered in time) 
     534      !!      and the Arakawa and Lamb (1980) flux form formulation : conserves 
    517535      !!      both the horizontal kinetic energy and the potential enstrophy 
    518536      !!      when horizontal divergence is zero (see the NEMO documentation) 
    … …  
    654672      !!                ***  ROUTINE vor_eeT  *** 
    655673      !! 
    656       !! ** Purpose :   Compute the now total vorticity trend and add it to  
     674      !! ** Purpose :   Compute the now total vorticity trend and add it to 
    657675      !!      the general trend of the momentum equation. 
    658676      !! 
    659       !! ** Method  :   Trend evaluated using now fields (centered in time)  
    660       !!      and the Arakawa and Lamb (1980) vector form formulation using  
     677      !! ** Method  :   Trend evaluated using now fields (centered in time) 
     678      !!      and the Arakawa and Lamb (1980) vector form formulation using 
    661679      !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een). 
    662       !!      The change consists in  
     680      !!      The change consists in 
    663681      !!      Add this trend to the general momentum trend (pu_rhs,pv_rhs). 
    664682      !! 
    … …  
    677695      REAL(wp) ::   zua, zva       ! local scalars 
    678696      REAL(wp) ::   zmsk, z1_e3t   ! local scalars 
    679       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy  
     697      REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy 
    680698      REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
    681699      REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
    … …  
    837855      ! 
    838856      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' ) 
    839       !                       
     857      ! 
    840858      IF(lwp) WRITE(numout,*)        ! type of calculated vorticity (set ncor, nrvm, ntot) 
    841859      ncor = np_COR                       ! planetary vorticity 
    … …  
    846864         ntot = np_COR        !     -         - 
    847865      CASE( np_VEC_c2  ) 
    848          IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'  
     866         IF(lwp) WRITE(numout,*) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity' 
    849867         nrvm = np_RVO        ! relative vorticity 
    850          ntot = np_CRV        ! relative + planetary vorticity          
     868         ntot = np_CRV        ! relative + planetary vorticity 
    851869      CASE( np_FLX_c2 , np_FLX_ubs  ) 
    852870         IF(lwp) WRITE(numout,*) '   ==>>>   flux form dynamics : total vorticity = Coriolis + metric term' 
    … …  
    873891         ! 
    874892      END SELECT 
    875        
     893 
    876894      IF(lwp) THEN                   ! Print the choice 
    877895         WRITE(numout,*) 
    … …  
    883901         CASE( np_EEN )   ;   WRITE(numout,*) '   ==>>>   energy and enstrophy conserving scheme (EEN)' 
    884902         CASE( np_MIX )   ;   WRITE(numout,*) '   ==>>>   mixed enstrophy/energy conserving scheme (MIX)' 
    885          END SELECT          
     903         END SELECT 
    886904      ENDIF 
    887905      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/DYN/dynzad.F90

    r13497 r14021  
    77   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90 
    88   !!---------------------------------------------------------------------- 
    9     
     9 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   dyn_zad       : vertical advection momentum trend 
    … …  
    1616   USE trd_oce        ! trends: ocean variables 
    1717   USE trddyn         ! trend manager: dynamics 
     18   USE sbcwave, ONLY: wsd   ! Surface Waves (add vertical Stokes-drift) 
    1819   ! 
    1920   USE in_out_manager ! I/O manager 
    … …  
    2425   IMPLICIT NONE 
    2526   PRIVATE 
    26     
     27 
    2728   PUBLIC   dyn_zad       ! routine called by dynadv.F90 
    2829 
    … …  
    4041      !!---------------------------------------------------------------------- 
    4142      !!                  ***  ROUTINE dynzad  *** 
    42       !!  
    43       !! ** Purpose :   Compute the now vertical momentum advection trend and  
     43      !! 
     44      !! ** Purpose :   Compute the now vertical momentum advection trend and 
    4445      !!      add it to the general trend of momentum equation. 
    4546      !! 
    … …  
    7273 
    7374      IF( l_trddyn )   THEN           ! Save puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends 
    74          ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    75          ztrdu(:,:,:) = puu(:,:,:,Krhs)  
    76          ztrdv(:,:,:) = pvv(:,:,:,Krhs)  
     75         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
     76         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
     77         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    7778      ENDIF 
    78        
     79 
    7980      DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical 
    8081         DO_2D( 0, 1, 0, 1 )              ! vertical fluxes 
     82          IF( ln_vortex_force ) THEN 
     83            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) 
     84          ELSE 
    8185            zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     86          ENDIF 
    8287         END_2D 
    8388         DO_2D( 0, 0, 0, 0 )              ! vertical momentum advection at w-point 
    … …  
    106111         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
    107112         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt, Kmm ) 
    108          DEALLOCATE( ztrdu, ztrdv )  
     113         DEALLOCATE( ztrdu, ztrdv ) 
    109114      ENDIF 
    110115      !                               ! Control print 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/cpl_oasis3.F90

    r13415 r14021  
    1414   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT 
    1515   !!---------------------------------------------------------------------- 
    16     
     16 
    1717   !!---------------------------------------------------------------------- 
    1818   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT 
    … …  
    6363#endif 
    6464 
    65    INTEGER                    ::   nrcv         ! total number of fields received  
    66    INTEGER                    ::   nsnd         ! total number of fields sent  
     65   INTEGER                    ::   nrcv         ! total number of fields received 
     66   INTEGER                    ::   nsnd         ! total number of fields sent 
    6767   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    68    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=60   ! Maximum number of coupling fields 
     68   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=62   ! Maximum number of coupling fields 
    6969   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    7070   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    71     
     71 
    7272   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
    7373      LOGICAL               ::   laction   ! To be coupled or not 
    74       CHARACTER(len = 8)    ::   clname    ! Name of the coupling field    
    75       CHARACTER(len = 1)    ::   clgrid    ! Grid type   
     74      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field 
     75      CHARACTER(len = 1)    ::   clgrid    ! Grid type 
    7676      REAL(wp)              ::   nsgn      ! Control of the sign change 
    7777      INTEGER, DIMENSION(nmaxcat,nmaxcpl) ::   nid   ! Id of the field (no more than 9 categories and 9 extrena models) 
    … …  
    9898      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 
    9999      !! 
    100       !! ** Method  :   OASIS3 MPI communication  
     100      !! ** Method  :   OASIS3 MPI communication 
    101101      !!-------------------------------------------------------------------- 
    102102      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file 
    … …  
    132132      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 
    133133      !! 
    134       !! ** Method  :   OASIS3 MPI communication  
     134      !! ** Method  :   OASIS3 MPI communication 
    135135      !!-------------------------------------------------------------------- 
    136136      INTEGER, INTENT(in) ::   krcv, ksnd     ! Number of received and sent coupling fields 
    … …  
    180180      ! 
    181181      ! ----------------------------------------------------------------- 
    182       ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis     
     182      ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 
    183183      ! ----------------------------------------------------------------- 
    184        
     184 
    185185      paral(1) = 2                                      ! box partitioning 
    186       paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls)   ! NEMO lower left corner global offset, without halos  
     186      paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls)   ! NEMO lower left corner global offset, without halos 
    187187      paral(3) = Ni_0                                   ! local extent in i, excluding halos 
    188188      paral(4) = Nj_0                                   ! local extent in j, excluding halos 
    189189      paral(5) = Ni0glo                                 ! global extent in x, excluding halos 
    190        
     190 
    191191      IF( sn_cfctl%l_oasout ) THEN 
    192192         WRITE(numout,*) ' multiexchg: paral (1:5)', paral 
    … …  
    195195         WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 
    196196      ENDIF 
    197     
     197 
    198198      CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo )   ! global number of points, excluding halos 
    199199      ! 
    200       ! ... Announce send variables.  
     200      ! ... Announce send variables. 
    201201      ! 
    202202      ssnd(:)%ncplmodel = kcplmodel 
    … …  
    210210               RETURN 
    211211            ENDIF 
    212              
     212 
    213213            DO jc = 1, ssnd(ji)%nct 
    214214               DO jm = 1, kcplmodel 
    … …  
    225225                  ENDIF 
    226226#if defined key_agrif 
    227                   IF( agrif_fixed() /= 0 ) THEN  
     227                  IF( agrif_fixed() /= 0 ) THEN 
    228228                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    229229                  ENDIF 
    … …  
    243243      END DO 
    244244      ! 
    245       ! ... Announce received variables.  
     245      ! ... Announce received variables. 
    246246      ! 
    247247      srcv(:)%ncplmodel = kcplmodel 
    248248      ! 
    249249      DO ji = 1, krcv 
    250          IF( srcv(ji)%laction ) THEN  
    251              
     250         IF( srcv(ji)%laction ) THEN 
     251 
    252252            IF( srcv(ji)%nct > nmaxcat ) THEN 
    253253               CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '//   & 
    … …  
    255255               RETURN 
    256256            ENDIF 
    257              
     257 
    258258            DO jc = 1, srcv(ji)%nct 
    259259               DO jm = 1, kcplmodel 
    260                    
     260 
    261261                  IF( srcv(ji)%nct .GT. 1 ) THEN 
    262262                     WRITE(cli2,'(i2.2)') jc 
    … …  
    270270                  ENDIF 
    271271#if defined key_agrif 
    272                   IF( agrif_fixed() /= 0 ) THEN  
     272                  IF( agrif_fixed() /= 0 ) THEN 
    273273                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    274274                  ENDIF 
    … …  
    288288         ENDIF 
    289289      END DO 
    290        
     290 
    291291      !------------------------------------------------------------------ 
    292292      ! End of definition phase 
    293293      !------------------------------------------------------------------ 
    294       !      
     294      ! 
    295295#if defined key_agrif 
    296296      IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 
    … …  
    303303      ! 
    304304   END SUBROUTINE cpl_define 
    305     
    306     
     305 
     306 
    307307   SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 
    308308      !!--------------------------------------------------------------------- 
    … …  
    324324      DO jc = 1, ssnd(kid)%nct 
    325325         DO jm = 1, ssnd(kid)%ncplmodel 
    326          
     326 
    327327            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN   ! exclude halos from data sent to oasis 
    328328               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 
    329                 
    330                IF ( sn_cfctl%l_oasout ) THEN         
     329 
     330               IF ( sn_cfctl%l_oasout ) THEN 
    331331                  IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
    332332                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
    … …  
    342342                  ENDIF 
    343343               ENDIF 
    344                 
     344 
    345345            ENDIF 
    346              
     346 
    347347         ENDDO 
    348348      ENDDO 
    … …  
    379379            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    380380 
    381                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
    382                 
     381               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 
     382 
    383383               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    384384                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    385                 
     385 
    386386               IF ( sn_cfctl%l_oasout )   & 
    387387                  &  WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    388                 
     388 
    389389               IF( llaction ) THEN   ! data received from oasis do not include halos 
    390                    
     390 
    391391                  kinfo = OASIS_Rcv 
    392                   IF( ll_1st ) THEN  
     392                  IF( ll_1st ) THEN 
    393393                     pdata(Nis0:Nie0,Njs0:Nje0,jc) =   exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    394394                     ll_1st = .FALSE. 
    … …  
    397397                        &                                + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    398398                  ENDIF 
    399                    
    400                   IF ( sn_cfctl%l_oasout ) THEN         
     399 
     400                  IF ( sn_cfctl%l_oasout ) THEN 
    401401                     WRITE(numout,*) '****************' 
    402402                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
    … …  
    409409                     WRITE(numout,*) '****************' 
    410410                  ENDIF 
    411                    
     411 
    412412               ENDIF 
    413                 
     413 
    414414            ENDIF 
    415              
     415 
    416416         ENDDO 
    417417 
    418418         !--- we must call lbc_lnk to fill the halos that where not received. 
    419419         IF( .NOT. ll_1st ) THEN 
    420             CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
     420            CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 
    421421         ENDIF 
    422   
     422 
    423423      ENDDO 
    424424      ! 
    … …  
    426426 
    427427 
    428    INTEGER FUNCTION cpl_freq( cdfieldname )   
     428   INTEGER FUNCTION cpl_freq( cdfieldname ) 
    429429      !!--------------------------------------------------------------------- 
    430430      !!              ***  ROUTINE cpl_freq  *** 
    … …  
    491491      DEALLOCATE( exfld ) 
    492492      IF(nstop == 0) THEN 
    493          CALL oasis_terminate( nerror )          
     493         CALL oasis_terminate( nerror ) 
    494494      ELSE 
    495495         CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 
    496       ENDIF        
     496      ENDIF 
    497497      ! 
    498498   END SUBROUTINE cpl_finalize 
    … …  
    544544      WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 
    545545   END SUBROUTINE oasis_enddef 
    546    
     546 
    547547   SUBROUTINE oasis_put(k1,k2,p1,k3) 
    548548      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::  p1 
    … …  
    574574      WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 
    575575   END SUBROUTINE oasis_terminate 
    576     
     576 
    577577#endif 
    578578 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbc_oce.F90

    r14017 r14021  
    1212   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk) 
    1313   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode 
     14   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave parameters in namelist 
    1415   !!---------------------------------------------------------------------- 
    1516 
    … …  
    3637   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation 
    3738   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model 
     39   LOGICAL , PUBLIC ::   ln_wave        !: wave in the system (forced or coupled) 
    3840#if defined key_oasis3 
    3941   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    … …  
    5658   !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step 
    5759   !                                             !:  = 2 annual global mean of e-p-r set to zero 
    58    LOGICAL , PUBLIC ::   ln_wave        !: true if some coupling with wave model 
    59    LOGICAL , PUBLIC ::   ln_cdgw        !: true if neutral drag coefficient from wave model 
    60    LOGICAL , PUBLIC ::   ln_sdw         !: true if 3d stokes drift from wave model 
    61    LOGICAL , PUBLIC ::   ln_tauwoc       !: true if normalized stress from wave is used 
    62    LOGICAL , PUBLIC ::   ln_tauw        !: true if ocean stress components from wave is used 
    63    LOGICAL , PUBLIC ::   ln_stcor       !: true if Stokes-Coriolis term is used 
    64    ! 
    65    INTEGER , PUBLIC ::   nn_sdrift      ! type of parameterization to calculate vertical Stokes drift 
    66    ! 
    6760   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs 
    6861   ! 
    … …  
    7164   !                                   !!* namsbc_cpl namelist * 
    7265   INTEGER , PUBLIC ::   nn_cats_cpl    !: Number of sea ice categories over which the coupling is carried out 
    73  
     66   ! 
     67   !                                   !!* namsbc_wave namelist * 
     68   LOGICAL , PUBLIC ::   ln_sdw         !: =T 3d stokes drift from wave model 
     69   LOGICAL , PUBLIC ::   ln_stcor       !: =T if Stokes-Coriolis and tracer advection terms are used 
     70   LOGICAL , PUBLIC ::   ln_cdgw        !: =T neutral drag coefficient from wave model 
     71   LOGICAL , PUBLIC ::   ln_tauoc       !: =T if normalized stress from wave is used 
     72   LOGICAL , PUBLIC ::   ln_wave_test   !: =T wave test case (constant Stokes drift) 
     73   LOGICAL , PUBLIC ::   ln_charn       !: =T Chranock coefficient from wave model 
     74   LOGICAL , PUBLIC ::   ln_taw         !: =T wind stress corrected by wave intake 
     75   LOGICAL , PUBLIC ::   ln_phioc       !: =T TKE surface BC from wave model 
     76   LOGICAL , PUBLIC ::   ln_bern_srfc   !: Bernoulli head, waves' inuced pressure 
     77   LOGICAL , PUBLIC ::   ln_breivikFV_2016 !: Breivik 2016 profile 
     78   LOGICAL , PUBLIC ::   ln_vortex_force !: vortex force activation 
     79   LOGICAL , PUBLIC ::   ln_stshear     !: Stoked Drift shear contribution in zdftke 
     80   ! 
    7481   !!---------------------------------------------------------------------- 
    7582   !!           switch definition (improve readability) 
    … …  
    8188   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation 
    8289   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OPA when doing coupling via SAS module 
    83  
    84    !!---------------------------------------------------------------------- 
    85    !!           Stokes drift parametrization definition 
    86    !!---------------------------------------------------------------------- 
    87    INTEGER , PUBLIC, PARAMETER ::   jp_breivik_2014 = 0     !: Breivik  2014: v_z=v_0*[exp(2*k*z)/(1-8*k*z)] 
    88    INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016) 
    89    !  with depth averaged profile 
    90    INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead 
    91    !  of the inverse depth scale 
    92    LOGICAL , PUBLIC            ::   ll_st_bv2014  = .FALSE. !  logical indicator, .true. if Breivik 2014 parameterisation is active. 
    93    LOGICAL , PUBLIC            ::   ll_st_li2017  = .FALSE. !  logical indicator, .true. if Li 2017 parameterisation is active. 
    94    LOGICAL , PUBLIC            ::   ll_st_bv_li   = .FALSE. !  logical indicator, .true. if either Breivik or Li parameterisation is active. 
    95    LOGICAL , PUBLIC            ::   ll_st_peakfr  = .FALSE. !  logical indicator, .true. if using Li 2017 with peak wave number 
    96  
     90   ! 
    9791   !!---------------------------------------------------------------------- 
    9892   !!           component definition 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk.F90

    r14017 r14021  
    1919   !!            4.0  !  2016-10  (M. Vancoppenolle)  Introduce conduction flux emulator (M. Vancoppenolle) 
    2020   !!            4.0  !  2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
     21   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    2122   !!---------------------------------------------------------------------- 
    2223 
    … …  
    383384            ! 
    384385            IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 )   & 
    385                &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    386                &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
     386         &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rn_Dt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
     387         &                 '               This is not ideal. You should consider changing either rn_Dt or nn_fsbc value...' ) 
    387388         ENDIF 
    388389      END DO 
    389       ! 
    390       IF( ln_wave ) THEN 
    391          !Activated wave module but neither drag nor stokes drift activated 
    392          IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
    393             CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 
    394             !drag coefficient read from wave model definable only with mfs bulk formulae and core 
    395          ELSEIF(ln_cdgw .AND. .NOT. ln_NCAR )       THEN 
    396             CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR bulk formulae') 
    397          ELSEIF(ln_stcor .AND. .NOT. ln_sdw)                             THEN 
    398             CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
    399          ENDIF 
    400       ELSE 
    401          IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                & 
    402             &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
    403             &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
    404             &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
    405             &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      & 
    406             &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
    407       ENDIF 
    408390      ! 
    409391      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r14017 r14021  
    1515   !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    1616   !!---------------------------------------------------------------------- 
    17    !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     17   !! History :  4.0  ! 2016-02  (L.Brodeau)   Original code 
     18   !!            4.2  ! 2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1819   !!---------------------------------------------------------------------- 
    1920 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r14017 r14021  
    1616   !!---------------------------------------------------------------------- 
    1717   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     18   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1819   !!---------------------------------------------------------------------- 
    1920 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r14017 r14021  
    1717   !!---------------------------------------------------------------------- 
    1818   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     19   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1920   !!---------------------------------------------------------------------- 
    2021 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_an05.F90

    r13830 r14021  
    1919   !!---------------------------------------------------------------------- 
    2020   USE par_kind, ONLY: wp 
    21    USE par_oce,  ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls 
     21   USE par_oce,  ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls, ntsi, ntsj, ntei, ntej 
    2222   USE lib_mpp,  ONLY: ctl_stop         ! distribued memory computing library 
    2323   USE phycst          ! physical constants 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ice_cdn.F90

    r13830 r14021  
    1313   !!==================================================================================== 
    1414   USE par_kind, ONLY: wp 
    15    USE par_oce,  ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls 
     15   USE par_oce,  ONLY: jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls, ntsi, ntsj, ntei, ntej 
    1616   USE phycst          ! physical constants 
    1717   USE sbc_phy         ! Catalog of functions for physical/meteorological parameters in the marine boundary layer 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_algo_ncar.F90

    r14017 r14021  
    1616   !!===================================================================== 
    1717   !! History :  3.6  !  2016-02  (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90 
     18   !!            4.2  !  2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    1819   !!---------------------------------------------------------------------- 
    1920 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_skin_coare.F90

    r13719 r14021  
    1313   !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    1414   !!---------------------------------------------------------------------- 
    15    !! History :  4.x  !  2019-11  (L.Brodeau)   Original code 
     15   !! History :  4.0  !  2019-11  (L.Brodeau)   Original code 
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and tracers 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcblk_skin_ecmwf.F90

    r13806 r14021  
    2828   !! ** Author: L. Brodeau, November 2019 / AeroBulk (https://github.com/brodeau/aerobulk) 
    2929   !!---------------------------------------------------------------------- 
    30    !! History :  4.x  !  2019-11  (L.Brodeau)   Original code 
     30   !! History :  4.0  ! 2019-11  (L.Brodeau)   Original code 
     31   !!            4.2  ! 2020-12  (L. Brodeau) Introduction of various air-ice bulk parameterizations + improvements 
    3132   !!---------------------------------------------------------------------- 
    3233   USE oce             ! ocean dynamics and tracers 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbccpl.F90

    r13655 r14021  
    88   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface 
    99   !!            3.4  ! 2011_11  (C. Harris) more flexibility + multi-category fields 
     10   !!            4.2  ! 2020-12  (G. Madec, E. Clementi)  wave coupling updates 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    108109   INTEGER, PARAMETER ::   jpr_fraqsr = 42   ! fraction of solar net radiation absorbed in the first ocean level 
    109110   INTEGER, PARAMETER ::   jpr_mslp   = 43   ! mean sea level pressure 
     111   !**  surface wave coupling  ** 
    110112   INTEGER, PARAMETER ::   jpr_hsig   = 44   ! Hsig 
    111113   INTEGER, PARAMETER ::   jpr_phioc  = 45   ! Wave=>ocean energy flux 
    … …  
    114116   INTEGER, PARAMETER ::   jpr_wper   = 48   ! Mean wave period 
    115117   INTEGER, PARAMETER ::   jpr_wnum   = 49   ! Mean wavenumber 
    116    INTEGER, PARAMETER ::   jpr_tauwoc = 50   ! Stress fraction adsorbed by waves 
     118   INTEGER, PARAMETER ::   jpr_wstrf = 50   ! Stress fraction adsorbed by waves 
    117119   INTEGER, PARAMETER ::   jpr_wdrag  = 51   ! Neutral surface drag coefficient 
    118    INTEGER, PARAMETER ::   jpr_isf    = 52 
    119    INTEGER, PARAMETER ::   jpr_icb    = 53 
    120    INTEGER, PARAMETER ::   jpr_wfreq  = 54   ! Wave peak frequency 
    121    INTEGER, PARAMETER ::   jpr_tauwx  = 55   ! x component of the ocean stress from waves 
    122    INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves 
    123    INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp 
    124  
    125    INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received 
     120   INTEGER, PARAMETER ::   jpr_charn  = 52   ! Chranock coefficient 
     121   INTEGER, PARAMETER ::   jpr_twox   = 53   ! wave to ocean momentum flux 
     122   INTEGER, PARAMETER ::   jpr_twoy   = 54   ! wave to ocean momentum flux 
     123   INTEGER, PARAMETER ::   jpr_tawx   = 55   ! net wave-supported stress 
     124   INTEGER, PARAMETER ::   jpr_tawy   = 56   ! net wave-supported stress 
     125   INTEGER, PARAMETER ::   jpr_bhd    = 57   ! Bernoulli head. waves' induced surface pressure 
     126   INTEGER, PARAMETER ::   jpr_tusd   = 58   ! zonal stokes transport 
     127   INTEGER, PARAMETER ::   jpr_tvsd   = 59   ! meridional stokes tranmport 
     128   INTEGER, PARAMETER ::   jpr_isf    = 60 
     129   INTEGER, PARAMETER ::   jpr_icb    = 61 
     130   INTEGER, PARAMETER ::   jpr_ts_ice = 62   ! Sea ice surface temp 
     131 
     132   INTEGER, PARAMETER ::   jprcv      = 62   ! total number of fields received 
    126133 
    127134   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
    … …  
    186193      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 
    187194   !                                   ! Received from the atmosphere 
    188    TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
     195   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
    189196      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice 
    190197   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 
    191    ! Send to waves 
     198   !                                   ! Send to waves 
    192199   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev 
    193    ! Received from waves 
    194    TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_tauwoc, & 
    195                     sn_rcv_wdrag, sn_rcv_wfreq 
     200   !                                   ! Received from waves 
     201   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, & 
     202      &             sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 
    196203   !                                   ! Other namelist parameters 
    197204   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    … …  
    276283         &                  sn_snd_ifrac , sn_snd_crtw  , sn_snd_wlev , sn_rcv_hsig  , sn_rcv_phioc ,  & 
    277284         &                  sn_rcv_w10m  , sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr   ,  & 
    278          &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_tauwoc,  & 
    279          &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal   ,  & 
    280          &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
    281          &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 & 
    282          &                  sn_rcv_ts_ice 
     285         &                  sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum  , sn_rcv_wstrf ,  & 
     286         &                  sn_rcv_charn , sn_rcv_taw   , sn_rcv_bhd  , sn_rcv_tusd  , sn_rcv_tvsd,    & 
     287         &                  sn_rcv_wdrag , sn_rcv_qns   , sn_rcv_emp  , sn_rcv_rnf   , sn_rcv_cal  ,   & 
     288         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_icb  , sn_rcv_isf   , sn_rcv_ts_ice 
     289 
    283290      !!--------------------------------------------------------------------- 
    284291      ! 
    … …  
    321328         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    322329         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
     330         WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
     331         WRITE(numout,*)'      surface waves:' 
    323332         WRITE(numout,*)'      significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
    324333         WRITE(numout,*)'      wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
    … …  
    327336         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
    328337         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
    329          WRITE(numout,*)'      Wave peak frequency             = ', TRIM(sn_rcv_wfreq%cldes ), ' (', TRIM(sn_rcv_wfreq%clcat ), ')' 
    330          WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_tauwoc%cldes), ' (', TRIM(sn_rcv_tauwoc%clcat ), ')' 
    331          WRITE(numout,*)'      Stress components by waves      = ', TRIM(sn_rcv_tauw%cldes  ), ' (', TRIM(sn_rcv_tauw%clcat  ), ')' 
     338         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
    332339         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
    333          WRITE(numout,*)'      Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' 
     340         WRITE(numout,*)'      Charnock coefficient            = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 
    334341         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    335342         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
    … …  
    353360         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
    354361      ENDIF 
    355  
     362      IF( lwp .AND. ln_wave) THEN                        ! control print 
     363      WRITE(numout,*)'      surface waves:' 
     364         WRITE(numout,*)'      Significant wave heigth         = ', TRIM(sn_rcv_hsig%cldes  ), ' (', TRIM(sn_rcv_hsig%clcat  ), ')' 
     365         WRITE(numout,*)'      Wave to oce energy flux         = ', TRIM(sn_rcv_phioc%cldes ), ' (', TRIM(sn_rcv_phioc%clcat ), ')' 
     366         WRITE(numout,*)'      Surface Stokes drift grid u     = ', TRIM(sn_rcv_sdrfx%cldes ), ' (', TRIM(sn_rcv_sdrfx%clcat ), ')' 
     367         WRITE(numout,*)'      Surface Stokes drift grid v     = ', TRIM(sn_rcv_sdrfy%cldes ), ' (', TRIM(sn_rcv_sdrfy%clcat ), ')' 
     368         WRITE(numout,*)'      Mean wave period                = ', TRIM(sn_rcv_wper%cldes  ), ' (', TRIM(sn_rcv_wper%clcat  ), ')' 
     369         WRITE(numout,*)'      Mean wave number                = ', TRIM(sn_rcv_wnum%cldes  ), ' (', TRIM(sn_rcv_wnum%clcat  ), ')' 
     370         WRITE(numout,*)'      Stress frac adsorbed by waves   = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 
     371         WRITE(numout,*)'      Neutral surf drag coefficient   = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 
     372         WRITE(numout,*)'      Charnock coefficient            = ', TRIM(sn_rcv_charn%cldes ), ' (', TRIM(sn_rcv_charn%clcat ), ')' 
     373         WRITE(numout,*)' Transport associated to Stokes drift grid u = ', TRIM(sn_rcv_tusd%cldes ), ' (', TRIM(sn_rcv_tusd%clcat ), ')' 
     374         WRITE(numout,*)' Transport associated to Stokes drift grid v = ', TRIM(sn_rcv_tvsd%cldes ), ' (', TRIM(sn_rcv_tvsd%clcat ), ')' 
     375         WRITE(numout,*)'      Bernouilli pressure head        = ', TRIM(sn_rcv_bhd%cldes   ), ' (', TRIM(sn_rcv_bhd%clcat  ), ')' 
     376         WRITE(numout,*)'Wave to ocean momentum flux and Net wave-supported stress = ', TRIM(sn_rcv_taw%cldes ), ' (', TRIM(sn_rcv_taw%clcat ), ')' 
     377         WRITE(numout,*)'      Surface current to waves        = ', TRIM(sn_snd_crtw%cldes  ), ' (', TRIM(sn_snd_crtw%clcat  ), ')' 
     378         WRITE(numout,*)'                      - referential   = ', sn_snd_crtw%clvref 
     379         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor 
     380         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd 
     381      ENDIF 
    356382      !                                   ! allocate sbccpl arrays 
    357383      IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    … …  
    631657         cpl_wper = .TRUE. 
    632658      ENDIF 
    633       srcv(jpr_wfreq)%clname = 'O_WFreq'     ! wave peak frequency 
    634       IF( TRIM(sn_rcv_wfreq%cldes ) == 'coupled' )  THEN 
    635          srcv(jpr_wfreq)%laction = .TRUE. 
    636          cpl_wfreq = .TRUE. 
    637       ENDIF 
    638659      srcv(jpr_wnum)%clname = 'O_WNum'       ! mean wave number 
    639660      IF( TRIM(sn_rcv_wnum%cldes ) == 'coupled' )  THEN 
    … …  
    641662         cpl_wnum = .TRUE. 
    642663      ENDIF 
    643       srcv(jpr_tauwoc)%clname = 'O_TauOce'   ! stress fraction adsorbed by the wave 
    644       IF( TRIM(sn_rcv_tauwoc%cldes ) == 'coupled' )  THEN 
    645          srcv(jpr_tauwoc)%laction = .TRUE. 
    646          cpl_tauwoc = .TRUE. 
    647       ENDIF 
    648       srcv(jpr_tauwx)%clname = 'O_Tauwx'      ! ocean stress from wave in the x direction 
    649       srcv(jpr_tauwy)%clname = 'O_Tauwy'      ! ocean stress from wave in the y direction 
    650       IF( TRIM(sn_rcv_tauw%cldes ) == 'coupled' )  THEN 
    651          srcv(jpr_tauwx)%laction = .TRUE. 
    652          srcv(jpr_tauwy)%laction = .TRUE. 
    653          cpl_tauw = .TRUE. 
     664      srcv(jpr_wstrf)%clname = 'O_WStrf'     ! stress fraction adsorbed by the wave 
     665      IF( TRIM(sn_rcv_wstrf%cldes ) == 'coupled' )  THEN 
     666         srcv(jpr_wstrf)%laction = .TRUE. 
     667         cpl_wstrf = .TRUE. 
    654668      ENDIF 
    655669      srcv(jpr_wdrag)%clname = 'O_WDrag'     ! neutral surface drag coefficient 
    … …  
    658672         cpl_wdrag = .TRUE. 
    659673      ENDIF 
    660       IF( srcv(jpr_tauwoc)%laction .AND. srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction ) & 
    661             CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 
    662                                      '(sn_rcv_tauwoc=coupled and sn_rcv_tauw=coupled)' ) 
     674      srcv(jpr_charn)%clname = 'O_Charn'     ! Chranock coefficient 
     675      IF( TRIM(sn_rcv_charn%cldes ) == 'coupled' )  THEN 
     676         srcv(jpr_charn)%laction = .TRUE. 
     677         cpl_charn = .TRUE. 
     678      ENDIF 
     679      srcv(jpr_bhd)%clname = 'O_Bhd'     ! Bernoulli head. waves' induced surface pressure 
     680      IF( TRIM(sn_rcv_bhd%cldes ) == 'coupled' )  THEN 
     681         srcv(jpr_bhd)%laction = .TRUE. 
     682         cpl_bhd = .TRUE. 
     683      ENDIF 
     684      srcv(jpr_tusd)%clname = 'O_Tusd'     ! zonal stokes transport 
     685      IF( TRIM(sn_rcv_tusd%cldes ) == 'coupled' )  THEN 
     686         srcv(jpr_tusd)%laction = .TRUE. 
     687         cpl_tusd = .TRUE. 
     688      ENDIF 
     689      srcv(jpr_tvsd)%clname = 'O_Tvsd'     ! meridional stokes tranmport 
     690      IF( TRIM(sn_rcv_tvsd%cldes ) == 'coupled' )  THEN 
     691         srcv(jpr_tvsd)%laction = .TRUE. 
     692         cpl_tvsd = .TRUE. 
     693      ENDIF 
     694 
     695      srcv(jpr_twox)%clname = 'O_Twox'     ! wave to ocean momentum flux in the u direction 
     696      srcv(jpr_twoy)%clname = 'O_Twoy'     ! wave to ocean momentum flux in the v direction 
     697      srcv(jpr_tawx)%clname = 'O_Tawx'     ! Net wave-supported stress in the u direction 
     698      srcv(jpr_tawy)%clname = 'O_Tawy'     ! Net wave-supported stress in the v direction 
     699      IF( TRIM(sn_rcv_taw%cldes ) == 'coupled' )  THEN 
     700         srcv(jpr_twox)%laction = .TRUE. 
     701         srcv(jpr_twoy)%laction = .TRUE. 
     702         srcv(jpr_tawx)%laction = .TRUE. 
     703         srcv(jpr_tawy)%laction = .TRUE. 
     704         cpl_taw = .TRUE. 
     705      ENDIF 
    663706      ! 
    664707      !                                                      ! ------------------------------- ! 
    … …  
    10601103      !   initialisation of the coupler  ! 
    10611104      ! ================================ ! 
    1062  
    10631105      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
    10641106 
    … …  
    10731115      ENDIF 
    10741116      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     1117      ! 
    10751118      ! 
    10761119   END SUBROUTINE sbc_cpl_init 
    … …  
    11481191         IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 
    11491192 
     1193         IF ( ln_wave .AND. nn_components == 0 ) THEN 
     1194            ncpl_qsr_freq = 1; 
     1195            WRITE(numout,*) 'ncpl_qsr_freq is set to 1 when coupling NEMO with wave (without SAS) ' 
     1196         ENDIF 
    11501197      ENDIF 
    11511198      ! 
    … …  
    13231370      ! 
    13241371      !                                                      ! ========================= ! 
    1325       !                                                      !    Wave peak frequency    ! 
    1326       !                                                      ! ========================= ! 
    1327          IF( srcv(jpr_wfreq)%laction ) wfreq(:,:) = frcv(jpr_wfreq)%z3(:,:,1) 
    1328       ! 
    1329       !                                                      ! ========================= ! 
    13301372      !                                                      !    Vertical mixing Qiao   ! 
    13311373      !                                                      ! ========================= ! 
    … …  
    13331375 
    13341376         ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 
    1335          IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 
    1336                                       .OR. srcv(jpr_hsig)%laction   .OR. srcv(jpr_wfreq)%laction) THEN 
     1377         IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. & 
     1378             srcv(jpr_wper)%laction .OR. srcv(jpr_hsig)%laction )  THEN 
    13371379            CALL sbc_stokes( Kmm ) 
    13381380         ENDIF 
    … …  
    13411383      !                                                      ! Stress adsorbed by waves  ! 
    13421384      !                                                      ! ========================= ! 
    1343       IF( srcv(jpr_tauwoc)%laction .AND. ln_tauwoc ) tauoc_wave(:,:) = frcv(jpr_tauwoc)%z3(:,:,1) 
    1344  
    1345       !                                                      ! ========================= ! 
    1346       !                                                      ! Stress component by waves ! 
    1347       !                                                      ! ========================= ! 
    1348       IF( srcv(jpr_tauwx)%laction .AND. srcv(jpr_tauwy)%laction .AND. ln_tauw ) THEN 
    1349          tauw_x(:,:) = frcv(jpr_tauwx)%z3(:,:,1) 
    1350          tauw_y(:,:) = frcv(jpr_tauwy)%z3(:,:,1) 
    1351       ENDIF 
    1352  
     1385      IF( srcv(jpr_wstrf)%laction .AND. ln_tauoc )  tauoc_wave(:,:) = frcv(jpr_wstrf)%z3(:,:,1) 
     1386      ! 
    13531387      !                                                      ! ========================= ! 
    13541388      !                                                      !   Wave drag coefficient   ! 
    13551389      !                                                      ! ========================= ! 
    13561390      IF( srcv(jpr_wdrag)%laction .AND. ln_cdgw )   cdn_wave(:,:) = frcv(jpr_wdrag)%z3(:,:,1) 
    1357  
     1391      ! 
     1392      !                                                      ! ========================= ! 
     1393      !                                                      !   Chranock coefficient    ! 
     1394      !                                                      ! ========================= ! 
     1395      IF( srcv(jpr_charn)%laction .AND. ln_charn )  charn(:,:) = frcv(jpr_charn)%z3(:,:,1) 
     1396      ! 
     1397      !                                                      ! ========================= ! 
     1398      !                                                      ! net wave-supported stress ! 
     1399      !                                                      ! ========================= ! 
     1400      IF( srcv(jpr_tawx)%laction .AND. ln_taw )     tawx(:,:) = frcv(jpr_tawx)%z3(:,:,1) 
     1401      IF( srcv(jpr_tawy)%laction .AND. ln_taw )     tawy(:,:) = frcv(jpr_tawy)%z3(:,:,1) 
     1402      ! 
     1403      !                                                      ! ========================= ! 
     1404      !                                                      !wave to ocean momentum flux! 
     1405      !                                                      ! ========================= ! 
     1406      IF( srcv(jpr_twox)%laction .AND. ln_taw )     twox(:,:) = frcv(jpr_twox)%z3(:,:,1) 
     1407      IF( srcv(jpr_twoy)%laction .AND. ln_taw )     twoy(:,:) = frcv(jpr_twoy)%z3(:,:,1) 
     1408      ! 
     1409      !                                                      ! ========================= ! 
     1410      !                                                      !    wave TKE flux at sfc   ! 
     1411      !                                                      ! ========================= ! 
     1412      IF( srcv(jpr_phioc)%laction .AND. ln_phioc )     phioc(:,:) = frcv(jpr_phioc)%z3(:,:,1) 
     1413      ! 
     1414      !                                                      ! ========================= ! 
     1415      !                                                      !      Bernoulli head       ! 
     1416      !                                                      ! ========================= ! 
     1417      IF( srcv(jpr_bhd)%laction .AND. ln_bern_srfc )   bhd_wave(:,:) = frcv(jpr_bhd)%z3(:,:,1) 
     1418      ! 
     1419      !                                                      ! ========================= ! 
     1420      !                                                      !   Stokes transport u dir  ! 
     1421      !                                                      ! ========================= ! 
     1422      IF( srcv(jpr_tusd)%laction .AND. ln_breivikFV_2016 )    tusd(:,:) = frcv(jpr_tusd)%z3(:,:,1) 
     1423      ! 
     1424      !                                                      ! ========================= ! 
     1425      !                                                      !   Stokes transport v dir  ! 
     1426      !                                                      ! ========================= ! 
     1427      IF( srcv(jpr_tvsd)%laction .AND. ln_breivikFV_2016 )     tvsd(:,:) = frcv(jpr_tvsd)%z3(:,:,1) 
     1428      ! 
    13581429      !  Fields received by SAS when OASIS coupling 
    13591430      !  (arrays no more filled at sbcssm stage) 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcmod.F90

    r14017 r14021  
    1616   !!            4.0  ! 2016-06  (L. Brodeau) new general bulk formulation 
    1717   !!            4.0  ! 2019-03  (F. Lemarié & G. Samson)  add ABL compatibility (ln_abl=TRUE) 
     18   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave forcing and coupling 
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    5556   USE usrdef_sbc     ! user defined: surface boundary condition 
    5657   USE closea         ! closed sea 
     58   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    5759   ! 
    5860   USE prtctl         ! Print control                    (prt_ctl routine) 
    … …  
    7173 
    7274   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations) 
    73  
     75   !! * Substitutions 
     76#  include "do_loop_substitute.h90" 
    7477   !!---------------------------------------------------------------------- 
    7578   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    100103         &             nn_ice   , ln_ice_embd,                                       & 
    101104         &             ln_traqsr, ln_dm2dc ,                                         & 
    102          &             ln_rnf   , nn_fwb   , ln_ssr   , ln_apr_dyn,                  & 
    103          &             ln_wave  , ln_cdgw  , ln_sdw   , ln_tauwoc , ln_stcor  ,      & 
    104          &             ln_tauw  , nn_lsm, nn_sdrift 
     105         &             ln_rnf   , nn_fwb     , ln_ssr   , ln_apr_dyn,                & 
     106         &             ln_wave  , nn_lsm 
    105107      !!---------------------------------------------------------------------- 
    106108      ! 
    … …  
    134136         WRITE(numout,*) '         bulk         formulation                   ln_blk        = ', ln_blk 
    135137         WRITE(numout,*) '         ABL          formulation                   ln_abl        = ', ln_abl 
     138         WRITE(numout,*) '         Surface wave (forced or coupled)           ln_wave       = ', ln_wave 
    136139         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : ' 
    137140         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    … …  
    151154         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
    152155         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
    153          WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave 
    154          WRITE(numout,*) '               Stokes drift corr. to vert. velocity ln_sdw        = ', ln_sdw 
    155          WRITE(numout,*) '                  vertical parametrization          nn_sdrift     = ', nn_sdrift 
    156          WRITE(numout,*) '               wave modified ocean stress           ln_tauwoc     = ', ln_tauwoc 
    157          WRITE(numout,*) '               wave modified ocean stress component ln_tauw       = ', ln_tauw 
    158          WRITE(numout,*) '               Stokes coriolis term                 ln_stcor      = ', ln_stcor 
    159          WRITE(numout,*) '               neutral drag coefficient (CORE,NCAR) ln_cdgw       = ', ln_cdgw 
    160       ENDIF 
    161       ! 
    162       IF( .NOT.ln_wave ) THEN 
    163          ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 
    164       ENDIF 
    165       IF( ln_sdw ) THEN 
    166          IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & 
    167             CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' ) 
    168       ENDIF 
    169       ll_st_bv2014  = ( nn_sdrift==jp_breivik_2014 ) 
    170       ll_st_li2017  = ( nn_sdrift==jp_li_2017 ) 
    171       ll_st_bv_li   = ( ll_st_bv2014 .OR. ll_st_li2017 ) 
    172       ll_st_peakfr  = ( nn_sdrift==jp_peakfr ) 
    173       IF( ln_tauwoc .AND. ln_tauw ) & 
    174          CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', & 
    175                                   '(ln_tauwoc=.true. and ln_tauw=.true.)' ) 
    176       IF( ln_tauwoc ) & 
    177          CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' ) 
    178       IF( ln_tauw ) & 
    179          CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', & 
    180                               'This will override any other specification of the ocean stress' ) 
     156      ENDIF 
    181157      ! 
    182158      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case) 
    … …  
    358334      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization 
    359335      ! 
    360       IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation 
     336      IF( ln_wave     ) THEN 
     337                          CALL sbc_wave_init                     ! surface wave initialisation 
     338      ELSE 
     339                          IF(lwp) WRITE(numout,*) 
     340                          IF(lwp) WRITE(numout,*) '   No surface waves : all wave related logical set to false' 
     341                          ln_sdw       = .false. 
     342                          ln_stcor     = .false. 
     343                          ln_cdgw      = .false. 
     344                          ln_tauoc     = .false. 
     345                          ln_wave_test = .false. 
     346                          ln_charn     = .false. 
     347                          ln_taw       = .false. 
     348                          ln_phioc     = .false. 
     349                          ln_bern_srfc = .false. 
     350                          ln_breivikFV_2016 = .false. 
     351                          ln_vortex_force = .false. 
     352                          ln_stshear  = .false. 
     353      ENDIF 
    361354      ! 
    362355   END SUBROUTINE sbc_init 
    … …  
    381374      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    382375      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     376      INTEGER  ::   jj, ji          ! dummy loop argument 
    383377      ! 
    384378      LOGICAL ::   ll_sas, ll_opa   ! local logical 
    … …  
    413407      ! 
    414408      IF( .NOT.ll_sas )   CALL sbc_ssm ( kt, Kbb, Kmm )  ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 
    415       IF( ln_wave     )   CALL sbc_wave( kt, Kmm )       ! surface waves 
    416  
    417409      ! 
    418410      !                                            !==  sbc formulation  ==! 
     411      ! 
    419412      ! 
    420413      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    … …  
    424417      CASE( jp_blk     ) 
    425418         IF( ll_sas    )       CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-SAS coupling: SAS receiving fields from OPA 
     419!!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     420         IF( ln_wave )   THEN 
     421             IF ( lk_oasis )  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm )   ! OPA-wave coupling 
     422             CALL sbc_wave ( kt, Kmm ) 
     423         ENDIF 
    426424                               CALL sbc_blk       ( kt )                    ! bulk formulation for the ocean 
    427425                               ! 
    … …  
    437435      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing 
    438436      ! 
    439       IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( )              ! Wind stress provided by waves 
     437      IF( ln_wave .AND. ln_tauoc )  THEN            ! Wave stress reduction 
     438         DO_2D( 0, 0, 0, 0) 
     439            utau(ji,jj) = utau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji-1,jj) ) * 0.5_wp 
     440            vtau(ji,jj) = vtau(ji,jj) * ( tauoc_wave(ji,jj) + tauoc_wave(ji,jj-1) ) * 0.5_wp 
     441         END_2D 
     442         ! 
     443         CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
     444         CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     445         ! 
     446         taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
     447         ! 
     448         IF( kt == nit000 )   CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.',   & 
     449            &                                'If not requested select ln_tauoc=.false.' ) 
     450         ! 
     451      ELSEIF( ln_wave .AND. ln_taw ) THEN                  ! Wave stress reduction 
     452         utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 
     453         vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 
     454         CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 
     455         CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 
     456         ! 
     457         DO_2D( 0, 0, 0, 0) 
     458             taum(ji,jj) = sqrt((.5*(utau(ji-1,jj)+utau(ji,jj)))**2 + (.5*(vtau(ji,jj-1)+vtau(ji,jj)))**2) 
     459         END_2D 
     460         ! 
     461         IF( kt == nit000 )   CALL ctl_warn( 'sbc: You are subtracting the wave stress to the ocean.',   & 
     462            &                                'If not requested select ln_taw=.false.' ) 
     463         ! 
     464      ENDIF 
     465      CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. ) 
    440466      ! 
    441467      !                                            !==  Misc. Options  ==! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/SBC/sbcwave.F90

    r13546 r14021  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  sbcwave  *** 
    4    !! Wave module  
     4   !! Wave module 
    55   !!====================================================================== 
    6    !! History :  3.3  !  2011-09  (M. Adani)  Original code: Drag Coefficient  
    7    !!         :  3.4  !  2012-10  (M. Adani)  Stokes Drift  
     6   !! History :  3.3  !  2011-09  (M. Adani)  Original code: Drag Coefficient 
     7   !!         :  3.4  !  2012-10  (M. Adani)  Stokes Drift 
    88   !!            3.6  !  2014-09  (E. Clementi,P. Oddo) New Stokes Drift Computation 
    99   !!             -   !  2016-12  (G. Madec, E. Clementi) update Stoke drift computation 
    1010   !!                                                    + add sbc_wave_ini routine 
     11   !!            4.2  !  2020-12  (G. Madec, E. Clementi) updates, new Stoke drift computation 
     12   !!                                                    according to Couvelard et al.,2019 
    1113   !!---------------------------------------------------------------------- 
    1214 
    1315   !!---------------------------------------------------------------------- 
    1416   !!   sbc_stokes    : calculate 3D Stokes-drift velocities 
    15    !!   sbc_wave      : wave data from wave model in netcdf files  
    16    !!   sbc_wave_init : initialisation fo surface waves  
     17   !!   sbc_wave      : wave data from wave model: forced (netcdf files) or coupled mode 
     18   !!   sbc_wave_init : initialisation fo surface waves 
    1719   !!---------------------------------------------------------------------- 
    18    USE phycst         ! physical constants  
     20   USE phycst         ! physical constants 
    1921   USE oce            ! ocean variables 
    20    USE sbc_oce        ! Surface boundary condition: ocean fields 
    21    USE zdf_oce,  ONLY : ln_zdfswm 
     22   USE dom_oce        ! ocean domain variables 
     23   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2224   USE bdy_oce        ! open boundary condition variables 
    2325   USE domvvl         ! domain: variable volume layers 
    … …  
    2628   USE in_out_manager ! I/O manager 
    2729   USE lib_mpp        ! distribued memory computing library 
    28    USE fldread        ! read input fields 
     30   USE fldread        ! read input fields 
    2931 
    3032   IMPLICIT NONE 
    … …  
    3234 
    3335   PUBLIC   sbc_stokes      ! routine called in sbccpl 
    34    PUBLIC   sbc_wstress     ! routine called in sbcmod  
    3536   PUBLIC   sbc_wave        ! routine called in sbcmod 
    3637   PUBLIC   sbc_wave_init   ! routine called in sbcmod 
    37     
     38 
    3839   ! Variables checking if the wave parameters are coupled (if not, they are read from file) 
    39    LOGICAL, PUBLIC ::   cpl_hsig   = .FALSE. 
    40    LOGICAL, PUBLIC ::   cpl_phioc  = .FALSE. 
    41    LOGICAL, PUBLIC ::   cpl_sdrftx = .FALSE. 
    42    LOGICAL, PUBLIC ::   cpl_sdrfty = .FALSE. 
    43    LOGICAL, PUBLIC ::   cpl_wper   = .FALSE. 
    44    LOGICAL, PUBLIC ::   cpl_wfreq  = .FALSE. 
    45    LOGICAL, PUBLIC ::   cpl_wnum   = .FALSE. 
    46    LOGICAL, PUBLIC ::   cpl_tauwoc = .FALSE. 
    47    LOGICAL, PUBLIC ::   cpl_tauw   = .FALSE. 
    48    LOGICAL, PUBLIC ::   cpl_wdrag  = .FALSE. 
     40   LOGICAL, PUBLIC ::   cpl_hsig          = .FALSE. 
     41   LOGICAL, PUBLIC ::   cpl_phioc         = .FALSE. 
     42   LOGICAL, PUBLIC ::   cpl_sdrftx        = .FALSE. 
     43   LOGICAL, PUBLIC ::   cpl_sdrfty        = .FALSE. 
     44   LOGICAL, PUBLIC ::   cpl_wper          = .FALSE. 
     45   LOGICAL, PUBLIC ::   cpl_wnum          = .FALSE. 
     46   LOGICAL, PUBLIC ::   cpl_wstrf         = .FALSE. 
     47   LOGICAL, PUBLIC ::   cpl_wdrag         = .FALSE. 
     48   LOGICAL, PUBLIC ::   cpl_charn         = .FALSE. 
     49   LOGICAL, PUBLIC ::   cpl_taw           = .FALSE. 
     50   LOGICAL, PUBLIC ::   cpl_bhd           = .FALSE. 
     51   LOGICAL, PUBLIC ::   cpl_tusd          = .FALSE. 
     52   LOGICAL, PUBLIC ::   cpl_tvsd          = .FALSE. 
    4953 
    5054   INTEGER ::   jpfld    ! number of files to read for stokes drift 
    … …  
    5357   INTEGER ::   jp_hsw   ! index of significant wave hight      (m)      at T-point 
    5458   INTEGER ::   jp_wmp   ! index of mean wave period            (s)      at T-point 
    55    INTEGER ::   jp_wfr   ! index of wave peak frequency         (1/s)    at T-point 
    5659 
    5760   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_cd      ! structure of input fields (file informations, fields read) Drag Coefficient 
    5861   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sd      ! structure of input fields (file informations, fields read) Stokes Drift 
    5962   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_wn      ! structure of input fields (file informations, fields read) wave number for Qiao 
    60    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauwoc  ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 
    61    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauw    ! structure of input fields (file informations, fields read) ocean stress components from wave model 
    62  
    63    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   cdn_wave            !: 
    64    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   hsw, wmp, wnum      !:  
    65    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   wfreq               !:  
    66    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wave          !:   
    67    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauw_x, tauw_y      !:   
    68    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tsd2d               !:  
    69    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   div_sd              !: barotropic stokes drift divergence 
    70    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ut0sd, vt0sd        !: surface Stokes drift velocities at t-point 
    71    REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd  , vsd  , wsd   !: Stokes drift velocities at u-, v- & w-points, resp. 
    72  
     63   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tauoc   ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 
     64 
     65   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   cdn_wave        !: Neutral drag coefficient at t-point 
     66   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   hsw             !: Significant Wave Height at t-point 
     67   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   wmp             !: Wave Mean Period at t-point 
     68   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   wnum            !: Wave Number at t-point 
     69   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wave      !: stress reduction factor  at t-point 
     70   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tsd2d           !: Surface Stokes Drift module at t-point 
     71   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   div_sd          !: barotropic stokes drift divergence 
     72   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   ut0sd, vt0sd    !: surface Stokes drift velocities at t-point 
     73   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   usd, vsd, wsd   !: Stokes drift velocities at u-, v- & w-points, resp.u 
     74! 
     75   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   charn           !: charnock coefficient at t-point 
     76   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tawx            !: Net wave-supported stress, u 
     77   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tawy            !: Net wave-supported stress, v 
     78   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   twox            !: wave-ocean momentum flux, u 
     79   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   twoy            !: wave-ocean momentum flux, v 
     80   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wavex     !: stress reduction factor  at, u component 
     81   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tauoc_wavey     !: stress reduction factor  at, v component 
     82   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   phioc           !: tke flux from wave model 
     83   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   KZN2            !: Kz*N2 
     84   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   bhd_wave        !: Bernoulli head. wave induce pression 
     85   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:)   ::   tusd, tvsd      !: Stokes drift transport 
     86   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   ZMX             !: Kz*N2 
    7387   !! * Substitutions 
    7488#  include "do_loop_substitute.h90" 
    … …  
    88102      !!                2014 (DOI: 10.1175/JPO-D-14-0020.1) 
    89103      !! 
    90       !! ** Method  : - Calculate Stokes transport speed  
    91       !!              - Calculate horizontal divergence  
    92       !!              - Integrate the horizontal divergenze from the bottom  
    93       !! ** action   
     104      !! ** Method  : - Calculate the horizontal Stokes drift velocity (Breivik et al. 2014) 
     105      !!              - Calculate its horizontal divergence 
     106      !!              - Calculate the vertical Stokes drift velocity 
     107      !!              - Calculate the barotropic Stokes drift divergence 
     108      !! 
     109      !! ** action  : - tsd2d         : module of the surface Stokes drift velocity 
     110      !!              - usd, vsd, wsd : 3 components of the Stokes drift velocity 
     111      !!              - div_sd        : barotropic Stokes drift divergence 
    94112      !!--------------------------------------------------------------------- 
    95113      INTEGER, INTENT(in) :: Kmm ! ocean time level index 
    96114      INTEGER  ::   jj, ji, jk   ! dummy loop argument 
    97       INTEGER  ::   ik           ! local integer  
    98       REAL(wp) ::  ztransp, zfac, zsp0 
    99       REAL(wp) ::  zdepth, zsqrt_depth,  zexp_depth, z_two_thirds, zsqrtpi !sqrt of pi 
    100       REAL(wp) ::  zbot_u, zbot_v, zkb_u, zkb_v, zke3_u, zke3_v, zda_u, zda_v 
    101       REAL(wp) ::  zstokes_psi_u_bot, zstokes_psi_v_bot 
    102       REAL(wp) ::  zdep_u, zdep_v, zkh_u, zkh_v 
    103       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zk_t, zk_u, zk_v, zu0_sd, zv0_sd     ! 2D workspace 
    104       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zstokes_psi_u_top, zstokes_psi_v_top ! 2D workspace 
    105       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3divh                              ! 3D workspace 
    106       !!--------------------------------------------------------------------- 
    107       ! 
    108       ALLOCATE( ze3divh(jpi,jpj,jpkm1) )   ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     115      INTEGER  ::   ik           ! local integer 
     116      REAL(wp) ::  ztransp, zfac, ztemp, zsp0, zsqrt, zbreiv16_w 
     117      REAL(wp) ::  zdep_u, zdep_v, zkh_u, zkh_v, zda_u, zda_v, sdtrp 
     118      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zk_t, zk_u, zk_v, zu0_sd, zv0_sd ! 2D workspace 
     119      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3divh, zInt_w                  ! 3D workspace 
     120      !!--------------------------------------------------------------------- 
     121      ! 
     122      ALLOCATE( ze3divh(jpi,jpj,jpkm1) ) ! jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     123      ALLOCATE( zInt_w(jpi,jpj,jpk) ) 
    109124      ALLOCATE( zk_t(jpi,jpj), zk_u(jpi,jpj), zk_v(jpi,jpj), zu0_sd(jpi,jpj), zv0_sd(jpi,jpj) ) 
     125      zk_t    (:,:) = 0._wp 
     126      zk_u    (:,:) = 0._wp 
     127      zk_v    (:,:) = 0._wp 
     128      zu0_sd  (:,:) = 0._wp 
     129      zv0_sd  (:,:) = 0._wp 
     130      ze3divh (:,:,:) = 0._wp 
     131 
    110132      ! 
    111133      ! select parameterization for the calculation of vertical Stokes drift 
    112134      ! exp. wave number at t-point 
    113       IF( ll_st_bv_li ) THEN   ! (Eq. (19) in Breivik et al. (2014) ) 
     135      IF( ln_breivikFV_2016 ) THEN 
     136      ! Assumptions :  ut0sd and vt0sd are surface Stokes drift at T-points 
     137      !                sdtrp is the norm of Stokes transport 
     138      ! 
     139         zfac = 0.166666666667_wp 
     140         DO_2D( 1, 1, 1, 1 ) ! In the deep-water limit we have ke = ||ust0||/( 6 * ||transport|| ) 
     141            zsp0          = SQRT( ut0sd(ji,jj)*ut0sd(ji,jj) + vt0sd(ji,jj)*vt0sd(ji,jj) ) !<-- norm of Surface Stokes drift 
     142            tsd2d(ji,jj)  = zsp0 
     143            IF( cpl_tusd .AND. cpl_tvsd ) THEN  !stokes transport is provided in coupled mode 
     144               sdtrp      = SQRT( tusd(ji,jj)*tusd(ji,jj) + tvsd(ji,jj)*tvsd(ji,jj) )  !<-- norm of Surface Stokes drift transport 
     145            ELSE 
     146               ! Stokes drift transport estimated from Hs and Tmean 
     147               sdtrp      = 2.0_wp * rpi / 16.0_wp *                             & 
     148                   &        hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp ) 
     149            ENDIF 
     150            zk_t (ji,jj)  = zfac * zsp0 / MAX ( sdtrp, 0.0000001_wp ) !<-- ke = ||ust0||/( 6 * ||transport|| ) 
     151         END_2D 
     152      !# define zInt_w ze3divh 
     153         DO_3D( 1, 1, 1, 1, 1, jpk ) ! Compute the primitive of Breivik 2016 function at W-points 
     154            zfac             = - 2._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm)  !<-- zfac should be negative definite 
     155            ztemp            = EXP ( zfac ) 
     156            zsqrt            = SQRT( -zfac ) 
     157            zbreiv16_w       = ztemp - SQRT(rpi)*zsqrt*ERFC(zsqrt) !Eq. 16 Breivik 2016 
     158            zInt_w(ji,jj,jk) = ztemp - 4._wp * zk_t (ji,jj) * gdepw(ji,jj,jk,Kmm) * zbreiv16_w 
     159         END_3D 
     160! 
     161         DO jk = 1, jpkm1 
     162            zfac = 0.166666666667_wp 
     163            DO_2D( 1, 1, 1, 1 ) !++ Compute the FV Breivik 2016 function at T-points 
     164               zsp0          = zfac / MAX(zk_t (ji,jj),0.0000001_wp) 
     165               ztemp         = zInt_w(ji,jj,jk) - zInt_w(ji,jj,jk+1) 
     166               zu0_sd(ji,jj) = ut0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk) 
     167               zv0_sd(ji,jj) = vt0sd(ji,jj) * zsp0 * ztemp * tmask(ji,jj,jk) 
     168            END_2D 
     169            DO_2D( 1, 0, 1, 0 ) ! ++ Interpolate at U/V points 
     170               zfac          =  1.0_wp / e3u(ji  ,jj,jk,Kmm) 
     171               usd(ji,jj,jk) =  0.5_wp * zfac * ( zu0_sd(ji,jj)+zu0_sd(ji+1,jj) ) * umask(ji,jj,jk) 
     172               zfac          =  1.0_wp / e3v(ji  ,jj,jk,Kmm) 
     173               vsd(ji,jj,jk) =  0.5_wp * zfac * ( zv0_sd(ji,jj)+zv0_sd(ji,jj+1) ) * vmask(ji,jj,jk) 
     174            END_2D 
     175         ENDDO 
     176      !# undef zInt_w 
     177      ! 
     178      ELSE 
    114179         zfac = 2.0_wp * rpi / 16.0_wp 
    115180         DO_2D( 1, 1, 1, 1 ) 
    … …  
    128193            zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) ) 
    129194         END_2D 
    130       ELSE IF( ll_st_peakfr ) THEN    ! peak wave number calculated from the peak frequency received by the wave model 
    131          DO_2D( 1, 1, 1, 1 ) 
    132             zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav 
    133          END_2D 
    134          DO_2D( 1, 0, 1, 0 ) 
    135             zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 
    136             zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) 
    137             ! 
    138             zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) ) 
    139             zv0_sd(ji,jj) = 0.5_wp * ( vt0sd(ji,jj) + vt0sd(ji,jj+1) ) 
    140          END_2D 
    141       ENDIF 
    142       ! 
     195 
    143196      !                       !==  horizontal Stokes Drift 3D velocity  ==! 
    144       IF( ll_st_bv2014 ) THEN 
     197 
    145198         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    146199            zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) ) 
    147200            zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) ) 
    148             !                           
     201            ! 
    149202            zkh_u = zk_u(ji,jj) * zdep_u     ! k * depth 
    150203            zkh_v = zk_v(ji,jj) * zdep_v 
    … …  
    156209            vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 
    157210         END_3D 
    158       ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN 
    159          ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) ) 
    160          DO_2D( 1, 0, 1, 0 ) 
    161             zstokes_psi_u_top(ji,jj) = 0._wp 
    162             zstokes_psi_v_top(ji,jj) = 0._wp 
    163          END_2D 
    164          zsqrtpi = SQRT(rpi) 
    165          z_two_thirds = 2.0_wp / 3.0_wp 
    166          DO_3D( 0, 0, 0, 0, 1, jpkm1 )       ! exp. wave number & Stokes drift velocity at u- & v-points 
    167             zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) )  ! 2 * bottom depth 
    168             zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) )  ! 2 * bottom depth 
    169             zkb_u  = zk_u(ji,jj) * zbot_u                             ! 2 * k * bottom depth 
    170             zkb_v  = zk_v(ji,jj) * zbot_v                             ! 2 * k * bottom depth 
    171             ! 
    172             zke3_u = MAX(1.e-8_wp, 2.0_wp * zk_u(ji,jj) * e3u(ji,jj,jk,Kmm))     ! 2k * thickness 
    173             zke3_v = MAX(1.e-8_wp, 2.0_wp * zk_v(ji,jj) * e3v(ji,jj,jk,Kmm))     ! 2k * thickness 
    174  
    175             ! Depth attenuation .... do u component first.. 
    176             zdepth      = zkb_u 
    177             zsqrt_depth = SQRT(zdepth) 
    178             zexp_depth  = EXP(-zdepth) 
    179             zstokes_psi_u_bot = 1.0_wp - zexp_depth  & 
    180                  &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) & 
    181                  &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth ) 
    182             zda_u                    = ( zstokes_psi_u_bot - zstokes_psi_u_top(ji,jj) ) / zke3_u 
    183             zstokes_psi_u_top(ji,jj) =   zstokes_psi_u_bot 
    184  
    185             !         ... and then v component 
    186             zdepth      =zkb_v 
    187             zsqrt_depth = SQRT(zdepth) 
    188             zexp_depth  = EXP(-zdepth) 
    189             zstokes_psi_v_bot = 1.0_wp - zexp_depth  & 
    190                  &              - z_two_thirds * ( zsqrtpi*zsqrt_depth*zdepth*ERFC(zsqrt_depth) & 
    191                  &              + 1.0_wp - (1.0_wp + zdepth)*zexp_depth ) 
    192             zda_v                    = ( zstokes_psi_v_bot - zstokes_psi_v_top(ji,jj) ) / zke3_v 
    193             zstokes_psi_v_top(ji,jj) =   zstokes_psi_v_bot 
    194             ! 
    195             usd(ji,jj,jk) = zda_u * zu0_sd(ji,jj) * umask(ji,jj,jk) 
    196             vsd(ji,jj,jk) = zda_v * zv0_sd(ji,jj) * vmask(ji,jj,jk) 
    197          END_3D 
    198          DEALLOCATE( zstokes_psi_u_top, zstokes_psi_v_top ) 
    199211      ENDIF 
    200212 
    … …  
    228240      !                       !==  Horizontal divergence of barotropic Stokes transport  ==! 
    229241      div_sd(:,:) = 0._wp 
    230       DO jk = 1, jpkm1                                 !  
     242      DO jk = 1, jpkm1                                 ! 
    231243        div_sd(:,:) = div_sd(:,:) + ze3divh(:,:,jk) 
    232244      END DO 
    … …  
    235247      CALL iom_put( "vstokes",  vsd  ) 
    236248      CALL iom_put( "wstokes",  wsd  ) 
    237       ! 
    238       DEALLOCATE( ze3divh ) 
     249!      ! 
     250      DEALLOCATE( ze3divh, zInt_w ) 
    239251      DEALLOCATE( zk_t, zk_u, zk_v, zu0_sd, zv0_sd ) 
    240252      ! 
    241253   END SUBROUTINE sbc_stokes 
    242  
    243  
    244    SUBROUTINE sbc_wstress( ) 
    245       !!--------------------------------------------------------------------- 
    246       !!                     ***  ROUTINE sbc_wstress  *** 
    247       !! 
    248       !! ** Purpose :   Updates the ocean momentum modified by waves 
    249       !! 
    250       !! ** Method  : - Calculate u,v components of stress depending on stress 
    251       !!                model  
    252       !!              - Calculate the stress module 
    253       !!              - The wind module is not modified by waves  
    254       !! ** action   
    255       !!--------------------------------------------------------------------- 
    256       INTEGER  ::   jj, ji   ! dummy loop argument 
    257       ! 
    258       IF( ln_tauwoc ) THEN 
    259          utau(:,:) = utau(:,:)*tauoc_wave(:,:) 
    260          vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 
    261          taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
    262       ENDIF 
    263       ! 
    264       IF( ln_tauw ) THEN 
    265          DO_2D( 1, 0, 1, 0 ) 
    266             ! Stress components at u- & v-points 
    267             utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) ) 
    268             vtau(ji,jj) = 0.5_wp * ( tauw_y(ji,jj) + tauw_y(ji,jj+1) ) 
    269             ! 
    270             ! Stress module at t points 
    271             taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) ) 
    272          END_2D 
    273          CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1.0_wp , vtau(:,:), 'V', -1.0_wp , taum(:,:) , 'T', -1.0_wp ) 
    274       ENDIF 
    275       ! 
    276    END SUBROUTINE sbc_wstress 
    277  
    278  
     254! 
     255! 
    279256   SUBROUTINE sbc_wave( kt, Kmm ) 
    280257      !!--------------------------------------------------------------------- 
    281258      !!                     ***  ROUTINE sbc_wave  *** 
    282259      !! 
    283       !! ** Purpose :   read wave parameters from wave model  in netcdf files. 
    284       !! 
    285       !! ** Method  : - Read namelist namsbc_wave 
    286       !!              - Read Cd_n10 fields in netcdf files  
    287       !!              - Read stokes drift 2d in netcdf files  
    288       !!              - Read wave number in netcdf files  
    289       !!              - Compute 3d stokes drift using Breivik et al.,2014 
    290       !!                formulation 
    291       !! ** action   
     260      !! ** Purpose :   read wave parameters from wave model in netcdf files 
     261      !!                or from a coupled wave mdoel 
     262      !! 
    292263      !!--------------------------------------------------------------------- 
    293264      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    294265      INTEGER, INTENT(in   ) ::   Kmm  ! ocean time index 
    295266      !!--------------------------------------------------------------------- 
     267      ! 
     268      IF( kt == nit000 .AND. lwp ) THEN 
     269         WRITE(numout,*) 
     270         WRITE(numout,*) 'sbc_wave : update the read waves fields' 
     271         WRITE(numout,*) '~~~~~~~~ ' 
     272      ENDIF 
    296273      ! 
    297274      IF( ln_cdgw .AND. .NOT. cpl_wdrag ) THEN     !==  Neutral drag coefficient  ==! 
    … …  
    300277      ENDIF 
    301278 
    302       IF( ln_tauwoc .AND. .NOT. cpl_tauwoc ) THEN  !==  Wave induced stress  ==! 
    303          CALL fld_read( kt, nn_fsbc, sf_tauwoc )         ! read wave norm stress from external forcing 
    304          tauoc_wave(:,:) = sf_tauwoc(1)%fnow(:,:,1) * tmask(:,:,1) 
    305       ENDIF 
    306  
    307       IF( ln_tauw .AND. .NOT. cpl_tauw ) THEN      !==  Wave induced stress  ==! 
    308          CALL fld_read( kt, nn_fsbc, sf_tauw )           ! read ocean stress components from external forcing (T grid) 
    309          tauw_x(:,:) = sf_tauw(1)%fnow(:,:,1) * tmask(:,:,1) 
    310          tauw_y(:,:) = sf_tauw(2)%fnow(:,:,1) * tmask(:,:,1) 
    311       ENDIF 
    312  
    313       IF( ln_sdw )  THEN                           !==  Computation of the 3d Stokes Drift  ==!  
     279      IF( ln_tauoc .AND. .NOT. cpl_wstrf ) THEN    !==  Wave induced stress  ==! 
     280         CALL fld_read( kt, nn_fsbc, sf_tauoc )          ! read stress reduction factor due to wave from external forcing 
     281         tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) * tmask(:,:,1) 
     282      ELSEIF ( ln_taw .AND. cpl_taw ) THEN 
     283         IF (kt < 1) THEN ! The first fields gave by OASIS have very high erroneous values .... 
     284            twox(:,:)=0._wp 
     285            twoy(:,:)=0._wp 
     286            tawx(:,:)=0._wp 
     287            tawy(:,:)=0._wp 
     288            tauoc_wavex(:,:) = 1._wp 
     289            tauoc_wavey(:,:) = 1._wp 
     290         ELSE 
     291            tauoc_wavex(:,:) = abs(twox(:,:)/tawx(:,:)) 
     292            tauoc_wavey(:,:) = abs(twoy(:,:)/tawy(:,:)) 
     293         ENDIF 
     294      ENDIF 
     295 
     296      IF ( ln_phioc .and. cpl_phioc .and.  kt == nit000 ) THEN 
     297         WRITE(numout,*) 
     298         WRITE(numout,*) 'sbc_wave : PHIOC from wave model' 
     299         WRITE(numout,*) '~~~~~~~~ ' 
     300      ENDIF 
     301 
     302      IF( ln_sdw .AND. .NOT. cpl_sdrftx)  THEN       !==  Computation of the 3d Stokes Drift  ==! 
    314303         ! 
    315304         IF( jpfld > 0 ) THEN                            ! Read from file only if the field is not coupled 
    316305            CALL fld_read( kt, nn_fsbc, sf_sd )          ! read wave parameters from external forcing 
     306            !                                            ! NB: test case mode, not read as jpfld=0 
    317307            IF( jp_hsw > 0 )   hsw  (:,:) = sf_sd(jp_hsw)%fnow(:,:,1) * tmask(:,:,1)  ! significant wave height 
    318308            IF( jp_wmp > 0 )   wmp  (:,:) = sf_sd(jp_wmp)%fnow(:,:,1) * tmask(:,:,1)  ! wave mean period 
    319             IF( jp_wfr > 0 )   wfreq(:,:) = sf_sd(jp_wfr)%fnow(:,:,1) * tmask(:,:,1)  ! Peak wave frequency 
    320309            IF( jp_usd > 0 )   ut0sd(:,:) = sf_sd(jp_usd)%fnow(:,:,1) * tmask(:,:,1)  ! 2D zonal Stokes Drift at T point 
    321310            IF( jp_vsd > 0 )   vt0sd(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) * tmask(:,:,1)  ! 2D meridional Stokes Drift at T point 
    322311         ENDIF 
    323312         ! 
    324          ! Read also wave number if needed, so that it is available in coupling routines 
    325          IF( ln_zdfswm .AND. .NOT.cpl_wnum ) THEN 
    326             CALL fld_read( kt, nn_fsbc, sf_wn )          ! read wave parameters from external forcing 
    327             wnum(:,:) = sf_wn(1)%fnow(:,:,1) * tmask(:,:,1) 
    328          ENDIF 
    329             
    330          ! Calculate only if required fields have been read 
    331          ! In coupled wave model-NEMO case the call is done after coupling 
     313         IF( jpfld == 4 .OR. ln_wave_test )   & 
     314            &      CALL sbc_stokes( Kmm )                 ! Calculate only if all required fields are read 
     315            !                                            ! or in wave test case 
     316         !  !                                            ! In coupled case the call is done after (in sbc_cpl) 
     317      ENDIF 
    332318         ! 
    333          IF( ( ll_st_bv_li   .AND. jp_hsw>0 .AND. jp_wmp>0 .AND. jp_usd>0 .AND. jp_vsd>0 ) .OR. & 
    334            & ( ll_st_peakfr  .AND. jp_wfr>0 .AND. jp_usd>0 .AND. jp_vsd>0                ) ) CALL sbc_stokes( Kmm ) 
    335          ! 
    336       ENDIF 
    337       ! 
    338319   END SUBROUTINE sbc_wave 
    339320 
    … …  
    343324      !!                     ***  ROUTINE sbc_wave_init  *** 
    344325      !! 
    345       !! ** Purpose :   read wave parameters from wave model  in netcdf files. 
     326      !! ** Purpose :   Initialisation fo surface waves 
    346327      !! 
    347328      !! ** Method  : - Read namelist namsbc_wave 
    348       !!              - Read Cd_n10 fields in netcdf files  
    349       !!              - Read stokes drift 2d in netcdf files  
    350       !!              - Read wave number in netcdf files  
    351       !!              - Compute 3d stokes drift using Breivik et al.,2014 
    352       !!                formulation 
    353       !! ** action   
     329      !!              - create the structure used to read required wave fields 
     330      !!                (its size depends on namelist options) 
     331      !! ** action 
    354332      !!--------------------------------------------------------------------- 
    355333      INTEGER ::   ierror, ios   ! local integer 
    … …  
    357335      !! 
    358336      CHARACTER(len=100)     ::  cn_dir                            ! Root directory for location of drag coefficient files 
    359       TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i, slf_j     ! array of namelist informations on the fields to read 
     337      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   slf_i            ! array of namelist informations on the fields to read 
    360338      TYPE(FLD_N)            ::  sn_cdg, sn_usd, sn_vsd,  & 
    361                              &   sn_hsw, sn_wmp, sn_wfr, sn_wnum, & 
    362                              &   sn_tauwoc, sn_tauwx, sn_tauwy     ! informations about the fields to be read 
    363       ! 
    364       NAMELIST/namsbc_wave/  sn_cdg, cn_dir, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wfr, & 
    365                              sn_wnum, sn_tauwoc, sn_tauwx, sn_tauwy 
    366       !!--------------------------------------------------------------------- 
     339                             &   sn_hsw, sn_wmp, sn_wnum, sn_tauoc    ! informations about the fields to be read 
     340      ! 
     341      NAMELIST/namsbc_wave/ cn_dir, sn_cdg, sn_usd, sn_vsd, sn_hsw, sn_wmp, sn_wnum, sn_tauoc,   & 
     342         &                  ln_cdgw, ln_sdw, ln_tauoc, ln_stcor, ln_charn, ln_taw, ln_phioc,     & 
     343         &                  ln_wave_test, ln_bern_srfc, ln_breivikFV_2016, ln_vortex_force, ln_stshear 
     344      !!--------------------------------------------------------------------- 
     345      IF(lwp) THEN 
     346         WRITE(numout,*) 
     347         WRITE(numout,*) 'sbc_wave_init : surface waves in the system' 
     348         WRITE(numout,*) '~~~~~~~~~~~~~ ' 
     349      ENDIF 
    367350      ! 
    368351      READ  ( numnam_ref, namsbc_wave, IOSTAT = ios, ERR = 901) 
    369 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist' ) 
    370           
     352901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_wave in reference namelist') 
     353 
    371354      READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
    372355902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist' ) 
    373356      IF(lwm) WRITE ( numond, namsbc_wave ) 
    374357      ! 
    375       IF( ln_cdgw ) THEN 
    376          IF( .NOT. cpl_wdrag ) THEN 
    377             ALLOCATE( sf_cd(1), STAT=ierror )               !* allocate and fill sf_wave with sn_cdg 
    378             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     358      IF(lwp) THEN 
     359         WRITE(numout,*) '   Namelist namsbc_wave' 
     360         WRITE(numout,*) '      Stokes drift                                  ln_sdw = ', ln_sdw 
     361         WRITE(numout,*) '      Breivik 2016                       ln_breivikFV_2016 = ', ln_breivikFV_2016 
     362         WRITE(numout,*) '      Stokes Coriolis & tracer advection terms    ln_stcor = ', ln_stcor 
     363         WRITE(numout,*) '      Vortex Force                         ln_vortex_force = ', ln_vortex_force 
     364         WRITE(numout,*) '      Bernouilli Head Pressure                ln_bern_srfc = ', ln_bern_srfc 
     365         WRITE(numout,*) '      wave modified ocean stress                  ln_tauoc = ', ln_tauoc 
     366         WRITE(numout,*) '      neutral drag coefficient (CORE bulk only)    ln_cdgw = ', ln_cdgw 
     367         WRITE(numout,*) '      charnock coefficient                        ln_charn = ', ln_charn 
     368         WRITE(numout,*) '      Stress modificated by wave                    ln_taw = ', ln_taw 
     369         WRITE(numout,*) '      TKE flux from wave                          ln_phioc = ', ln_phioc 
     370         WRITE(numout,*) '      Surface shear with Stokes drift           ln_stshear = ', ln_stshear 
     371         WRITE(numout,*) '      Test with constant wave fields          ln_wave_test = ', ln_wave_test 
     372      ENDIF 
     373 
     374      !                                ! option check 
     375      IF( .NOT.( ln_cdgw .OR. ln_sdw .OR. ln_tauoc .OR. ln_stcor .OR. ln_charn) )   & 
     376         &     CALL ctl_warn( 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauoc=F, ln_stcor=F') 
     377      IF( ln_cdgw .AND. ln_blk )   & 
     378         &     CALL ctl_stop( 'drag coefficient read from wave model NOT available yet with aerobulk package') 
     379      IF( ln_stcor .AND. .NOT.ln_sdw )   & 
     380         &     CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     381 
     382      !                             !==  Allocate wave arrays  ==! 
     383      ALLOCATE( ut0sd (jpi,jpj)    , vt0sd (jpi,jpj) ) 
     384      ALLOCATE( hsw   (jpi,jpj)    , wmp   (jpi,jpj) ) 
     385      ALLOCATE( wnum  (jpi,jpj) ) 
     386      ALLOCATE( tsd2d (jpi,jpj)    , div_sd(jpi,jpj)    , bhd_wave(jpi,jpj)     ) 
     387      ALLOCATE( usd   (jpi,jpj,jpk), vsd   (jpi,jpj,jpk), wsd     (jpi,jpj,jpk) ) 
     388      ALLOCATE( tusd  (jpi,jpj)    , tvsd  (jpi,jpj)    , ZMX     (jpi,jpj,jpk) ) 
     389      usd   (:,:,:) = 0._wp 
     390      vsd   (:,:,:) = 0._wp 
     391      wsd   (:,:,:) = 0._wp 
     392      hsw     (:,:) = 0._wp 
     393      wmp     (:,:) = 0._wp 
     394      ut0sd   (:,:) = 0._wp 
     395      vt0sd   (:,:) = 0._wp 
     396      tusd    (:,:) = 0._wp 
     397      tvsd    (:,:) = 0._wp 
     398      bhd_wave(:,:) = 0._wp 
     399      ZMX   (:,:,:) = 0._wp 
     400! 
     401      IF( ln_wave_test ) THEN       !==  Wave TEST case  ==!   set uniform waves fields 
     402         jpfld    = 0                   ! No field read 
     403         ln_cdgw  = .FALSE.             ! No neutral wave drag input 
     404         ln_tauoc = .FALSE.             ! No wave induced drag reduction factor 
     405         ut0sd(:,:) = 0.13_wp * tmask(:,:,1)   ! m/s 
     406         vt0sd(:,:) = 0.00_wp                  ! m/s 
     407         hsw  (:,:) = 2.80_wp                  ! meters 
     408         wmp  (:,:) = 8.00_wp                  ! seconds 
     409         ! 
     410      ELSE                          !==  create the structure associated with fields to be read  ==! 
     411         IF( ln_cdgw ) THEN                       ! wave drag 
     412            IF( .NOT. cpl_wdrag ) THEN 
     413               ALLOCATE( sf_cd(1), STAT=ierror )               !* allocate and fill sf_wave with sn_cdg 
     414               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     415               ! 
     416                                      ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   ) 
     417               IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 
     418               CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
     419            ENDIF 
     420            ALLOCATE( cdn_wave(jpi,jpj) ) 
     421            cdn_wave(:,:) = 0._wp 
     422         ENDIF 
     423         IF( ln_charn ) THEN                     ! wave drag 
     424            IF( .NOT. cpl_charn ) THEN 
     425               CALL ctl_stop( 'STOP', 'Charnock based wind stress can be used in coupled mode only' ) 
     426            ENDIF 
     427            ALLOCATE( charn(jpi,jpj) ) 
     428            charn(:,:) = 0._wp 
     429         ENDIF 
     430         IF( ln_taw ) THEN                     ! wind stress 
     431            IF( .NOT. cpl_taw ) THEN 
     432               CALL ctl_stop( 'STOP', 'wind stress from wave model can be used in coupled mode only, use ln_cdgw instead' ) 
     433            ENDIF 
     434            ALLOCATE( tawx(jpi,jpj) ) 
     435            ALLOCATE( tawy(jpi,jpj) ) 
     436            ALLOCATE( twox(jpi,jpj) ) 
     437            ALLOCATE( twoy(jpi,jpj) ) 
     438            ALLOCATE( tauoc_wavex(jpi,jpj) ) 
     439            ALLOCATE( tauoc_wavey(jpi,jpj) ) 
     440            tawx(:,:) = 0._wp 
     441            tawy(:,:) = 0._wp 
     442            twox(:,:) = 0._wp 
     443            twoy(:,:) = 0._wp 
     444            tauoc_wavex(:,:) = 1._wp 
     445            tauoc_wavey(:,:) = 1._wp 
     446         ENDIF 
     447 
     448         IF( ln_phioc ) THEN                     ! TKE flux 
     449            IF( .NOT. cpl_phioc ) THEN 
     450                CALL ctl_stop( 'STOP', 'phioc can be used in coupled mode only' ) 
     451            ENDIF 
     452            ALLOCATE( phioc(jpi,jpj) ) 
     453            phioc(:,:) = 0._wp 
     454         ENDIF 
     455 
     456         IF( ln_tauoc ) THEN                    ! normalized wave stress into the ocean 
     457            IF( .NOT. cpl_wstrf ) THEN 
     458               ALLOCATE( sf_tauoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauoc 
     459               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauoc structure' ) 
     460               ! 
     461                                       ALLOCATE( sf_tauoc(1)%fnow(jpi,jpj,1)   ) 
     462               IF( sn_tauoc%ln_tint )  ALLOCATE( sf_tauoc(1)%fdta(jpi,jpj,1,2) ) 
     463               CALL fld_fill( sf_tauoc, (/ sn_tauoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' ) 
     464            ENDIF 
     465            ALLOCATE( tauoc_wave(jpi,jpj) ) 
     466            tauoc_wave(:,:) = 0._wp 
     467         ENDIF 
     468 
     469         IF( ln_sdw ) THEN                      ! Stokes drift 
     470            ! 1. Find out how many fields have to be read from file if not coupled 
     471            jpfld=0 
     472            jp_usd=0   ;   jp_vsd=0   ;   jp_hsw=0   ;   jp_wmp=0 
     473            IF( .NOT. cpl_sdrftx ) THEN 
     474               jpfld  = jpfld + 1 
     475               jp_usd = jpfld 
     476            ENDIF 
     477            IF( .NOT. cpl_sdrfty ) THEN 
     478               jpfld  = jpfld + 1 
     479               jp_vsd = jpfld 
     480            ENDIF 
     481            IF( .NOT. cpl_hsig ) THEN 
     482               jpfld  = jpfld + 1 
     483               jp_hsw = jpfld 
     484            ENDIF 
     485            IF( .NOT. cpl_wper ) THEN 
     486               jpfld  = jpfld + 1 
     487               jp_wmp = jpfld 
     488            ENDIF 
     489            ! 2. Read from file only the non-coupled fields 
     490            IF( jpfld > 0 ) THEN 
     491               ALLOCATE( slf_i(jpfld) ) 
     492               IF( jp_usd > 0 )   slf_i(jp_usd) = sn_usd 
     493               IF( jp_vsd > 0 )   slf_i(jp_vsd) = sn_vsd 
     494               IF( jp_hsw > 0 )   slf_i(jp_hsw) = sn_hsw 
     495               IF( jp_wmp > 0 )   slf_i(jp_wmp) = sn_wmp 
     496               ALLOCATE( sf_sd(jpfld), STAT=ierror )   !* allocate and fill sf_sd with stokes drift 
     497               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     498               ! 
     499               DO ifpr= 1, jpfld 
     500                  ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 
     501                  IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 
     502               END DO 
     503               ! 
     504               CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
     505            ENDIF 
    379506            ! 
    380                                    ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1)   ) 
    381             IF( sn_cdg%ln_tint )   ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 
    382             CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
    383          ENDIF 
    384          ALLOCATE( cdn_wave(jpi,jpj) ) 
    385       ENDIF 
    386  
    387       IF( ln_tauwoc ) THEN 
    388          IF( .NOT. cpl_tauwoc ) THEN 
    389             ALLOCATE( sf_tauwoc(1), STAT=ierror )           !* allocate and fill sf_wave with sn_tauwoc 
    390             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
     507            ! 3. Wave number (only needed for Qiao parametrisation, ln_zdfqiao=T) 
     508            IF( .NOT. cpl_wnum ) THEN 
     509               ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
     510               IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wn structure' ) 
     511                                      ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1)   ) 
     512               IF( sn_wnum%ln_tint )  ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 
     513               CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 
     514            ENDIF 
    391515            ! 
    392                                      ALLOCATE( sf_tauwoc(1)%fnow(jpi,jpj,1)   ) 
    393             IF( sn_tauwoc%ln_tint )  ALLOCATE( sf_tauwoc(1)%fdta(jpi,jpj,1,2) ) 
    394             CALL fld_fill( sf_tauwoc, (/ sn_tauwoc /), cn_dir, 'sbc_wave_init', 'Wave module', 'namsbc_wave' ) 
    395          ENDIF 
    396          ALLOCATE( tauoc_wave(jpi,jpj) ) 
    397       ENDIF 
    398  
    399       IF( ln_tauw ) THEN 
    400          IF( .NOT. cpl_tauw ) THEN 
    401             ALLOCATE( sf_tauw(2), STAT=ierror )           !* allocate and fill sf_wave with sn_tauwx/y 
    402             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_tauw structure' ) 
    403             ! 
    404             ALLOCATE( slf_j(2) ) 
    405             slf_j(1) = sn_tauwx 
    406             slf_j(2) = sn_tauwy 
    407                                     ALLOCATE( sf_tauw(1)%fnow(jpi,jpj,1)   ) 
    408                                     ALLOCATE( sf_tauw(2)%fnow(jpi,jpj,1)   ) 
    409             IF( slf_j(1)%ln_tint )  ALLOCATE( sf_tauw(1)%fdta(jpi,jpj,1,2) ) 
    410             IF( slf_j(2)%ln_tint )  ALLOCATE( sf_tauw(2)%fdta(jpi,jpj,1,2) ) 
    411             CALL fld_fill( sf_tauw, (/ slf_j /), cn_dir, 'sbc_wave_init', 'read wave input', 'namsbc_wave' ) 
    412          ENDIF 
    413          ALLOCATE( tauw_x(jpi,jpj) ) 
    414          ALLOCATE( tauw_y(jpi,jpj) ) 
    415       ENDIF 
    416  
    417       IF( ln_sdw ) THEN   ! Find out how many fields have to be read from file if not coupled 
    418          jpfld=0 
    419          jp_usd=0   ;   jp_vsd=0   ;   jp_hsw=0   ;   jp_wmp=0   ;   jp_wfr=0 
    420          IF( .NOT. cpl_sdrftx ) THEN 
    421             jpfld  = jpfld + 1 
    422             jp_usd = jpfld 
    423          ENDIF 
    424          IF( .NOT. cpl_sdrfty ) THEN 
    425             jpfld  = jpfld + 1 
    426             jp_vsd = jpfld 
    427          ENDIF 
    428          IF( .NOT. cpl_hsig  .AND. ll_st_bv_li  ) THEN 
    429             jpfld  = jpfld + 1 
    430             jp_hsw = jpfld 
    431          ENDIF 
    432          IF( .NOT. cpl_wper  .AND. ll_st_bv_li  ) THEN 
    433             jpfld  = jpfld + 1 
    434             jp_wmp = jpfld 
    435          ENDIF 
    436          IF( .NOT. cpl_wfreq .AND. ll_st_peakfr ) THEN 
    437             jpfld  = jpfld + 1 
    438             jp_wfr = jpfld 
    439          ENDIF 
    440  
    441          ! Read from file only the non-coupled fields  
    442          IF( jpfld > 0 ) THEN 
    443             ALLOCATE( slf_i(jpfld) ) 
    444             IF( jp_usd > 0 )   slf_i(jp_usd) = sn_usd 
    445             IF( jp_vsd > 0 )   slf_i(jp_vsd) = sn_vsd 
    446             IF( jp_hsw > 0 )   slf_i(jp_hsw) = sn_hsw 
    447             IF( jp_wmp > 0 )   slf_i(jp_wmp) = sn_wmp 
    448             IF( jp_wfr > 0 )   slf_i(jp_wfr) = sn_wfr 
    449  
    450             ALLOCATE( sf_sd(jpfld), STAT=ierror )   !* allocate and fill sf_sd with stokes drift 
    451             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable to allocate sf_wave structure' ) 
    452             ! 
    453             DO ifpr= 1, jpfld 
    454                ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 
    455                IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 
    456             END DO 
    457             ! 
    458             CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
    459          ENDIF 
    460          ALLOCATE( usd  (jpi,jpj,jpk), vsd  (jpi,jpj,jpk), wsd(jpi,jpj,jpk) ) 
    461          ALLOCATE( hsw  (jpi,jpj)    , wmp  (jpi,jpj)     ) 
    462          ALLOCATE( wfreq(jpi,jpj) ) 
    463          ALLOCATE( ut0sd(jpi,jpj)    , vt0sd(jpi,jpj)     ) 
    464          ALLOCATE( div_sd(jpi,jpj) ) 
    465          ALLOCATE( tsd2d (jpi,jpj) ) 
    466  
    467          ut0sd(:,:) = 0._wp 
    468          vt0sd(:,:) = 0._wp 
    469          hsw(:,:) = 0._wp 
    470          wmp(:,:) = 0._wp 
    471  
    472          usd(:,:,:) = 0._wp 
    473          vsd(:,:,:) = 0._wp 
    474          wsd(:,:,:) = 0._wp 
    475          ! Wave number needed only if ln_zdfswm=T 
    476          IF( .NOT. cpl_wnum ) THEN 
    477             ALLOCATE( sf_wn(1), STAT=ierror )           !* allocate and fill sf_wave with sn_wnum 
    478             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave_init: unable toallocate sf_wave structure' ) 
    479                                    ALLOCATE( sf_wn(1)%fnow(jpi,jpj,1)   ) 
    480             IF( sn_wnum%ln_tint )  ALLOCATE( sf_wn(1)%fdta(jpi,jpj,1,2) ) 
    481             CALL fld_fill( sf_wn, (/ sn_wnum /), cn_dir, 'sbc_wave', 'Wave module', 'namsbc_wave' ) 
    482          ENDIF 
    483          ALLOCATE( wnum(jpi,jpj) ) 
     516         ENDIF 
     517         ! 
    484518      ENDIF 
    485519      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/TRA/eosbn2.F90

    r14017 r14021  
    5656   !                  !! * Interface 
    5757   INTERFACE eos 
    58       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
     58      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 
    5959   END INTERFACE 
    6060   ! 
    … …  
    574574      ! 
    575575   END SUBROUTINE eos_insitu_2d_t 
     576 
     577 
     578   SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 
     579      !!---------------------------------------------------------------------- 
     580      !!                  ***  ROUTINE eos_insitu_pot  *** 
     581      !! 
     582      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
     583      !!      potential volumic mass (Kg/m3) from potential temperature and 
     584      !!      salinity fields using an equation of state selected in the 
     585      !!     namelist. 
     586      !! 
     587      !! ** Action  : 
     588      !!              - prhop, the potential volumic mass (Kg/m3) 
     589      !! 
     590      !!---------------------------------------------------------------------- 
     591      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     592      !                                                                ! 2 : salinity               [psu] 
     593      REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     594      ! 
     595      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     596      INTEGER  ::   jdof 
     597      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     598      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     599      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
     600      !!---------------------------------------------------------------------- 
     601      ! 
     602      IF( ln_timing )   CALL timing_start('eos-pot') 
     603      ! 
     604      SELECT CASE ( neos ) 
     605      ! 
     606      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     607         ! 
     608            DO_2D( 1, 1, 1, 1 ) 
     609               ! 
     610               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     611               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     612               ztm = tmask(ji,jj,1)                                         ! tmask 
     613               ! 
     614               zn0 = (((((EOS060*zt   & 
     615                  &   + EOS150*zs+EOS050)*zt   & 
     616                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     617                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     618                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     619                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     620                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     621                  ! 
     622               ! 
     623               prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface 
     624               ! 
     625            END_2D 
     626 
     627      CASE( np_seos )                !==  simplified EOS  ==! 
     628         ! 
     629         DO_2D( 1, 1, 1, 1 ) 
     630            zt  = pts  (ji,jj,jp_tem) - 10._wp 
     631            zs  = pts  (ji,jj,jp_sal) - 35._wp 
     632            ztm = tmask(ji,jj,1) 
     633            !                                                     ! potential density referenced at the surface 
     634            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     635               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     636               &  - rn_nu * zt * zs 
     637            prhop(ji,jj) = ( rho0 + zn ) * ztm 
     638            ! 
     639         END_2D 
     640         ! 
     641      END SELECT 
     642      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' pot: ', kdim=1 ) 
     643      ! 
     644      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 
     645      ! 
     646      IF( ln_timing )   CALL timing_stop('eos-pot') 
     647      ! 
     648   END SUBROUTINE eos_insitu_pot_2d 
    576649 
    577650 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/TRA/trazdf.F90

    r14017 r14021  
    1717   USE phycst         ! physical constant 
    1818   USE zdf_oce        ! ocean vertical physics variables 
     19   USE zdfmfc         ! Mass FLux Convection 
    1920   USE sbc_oce        ! surface boundary condition: ocean 
    2021   USE ldftra         ! lateral diffusion: eddy diffusivity 
    … …  
    198199            ENDIF 
    199200            ! 
     201            ! Modification of diagonal to add MF scheme 
     202            IF ( ln_zdfmfc ) THEN 
     203               CALL diag_mfc( zwi, zwd, zws, p2dt, Kaa ) 
     204            END IF 
     205            ! 
    200206            !! Matrix inversion from the first level 
    201207            !!---------------------------------------------------------------------- 
    … …  
    225231            ! 
    226232         ENDIF 
     233         ! 
     234         ! Modification of rhs to add MF scheme 
     235         IF ( ln_zdfmfc ) THEN 
     236            CALL rhs_mfc( pt(:,:,:,jn,Krhs), jn ) 
     237         END IF 
    227238         ! 
    228239         DO_2D( 0, 0, 0, 0 )         !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdf_oce.F90

    r10425 r14021  
    4040   LOGICAL , PUBLIC ::   ln_zdfswm   !: surface  wave-induced mixing flag 
    4141   LOGICAL , PUBLIC ::   ln_zdfiwm   !: internal wave-induced mixing flag 
    42    !                             ! coefficients  
     42   LOGICAL , PUBLIC ::   ln_zdfmfc   !: convection: eddy diffusivity Mass Flux Convection 
     43   !                             ! coefficients 
    4344   REAL(wp), PUBLIC ::   rn_avm0     !: vertical eddy viscosity (m2/s) 
    4445   REAL(wp), PUBLIC ::   rn_avt0     !: vertical eddy diffusivity (m2/s) 
    … …  
    5556   !!---------------------------------------------------------------------- 
    5657   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    57    !! $Id$  
     58   !! $Id$ 
    5859   !! Software governed by the CeCILL license (see ./LICENSE) 
    5960   !!---------------------------------------------------------------------- 
    … …  
    6667      ! 
    6768      ALLOCATE( avm (jpi,jpj,jpk) , avm_k(jpi,jpj,jpk) , avs(jpi,jpj,jpk) ,   & 
    68          &      avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) ,   &  
     69         &      avt (jpi,jpj,jpk) , avt_k(jpi,jpj,jpk) , en (jpi,jpj,jpk) ,   & 
    6970         &      avmb(jpk)         , avtb(jpk)          , avtb_2d(jpi,jpj) , STAT = zdf_oce_alloc ) 
    7071         ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdfphy.F90

    r13558 r14021  
    99   !!---------------------------------------------------------------------- 
    1010   !!   zdf_phy_init  : initialization of all vertical physics packages 
    11    !!   zdf_phy       : upadate at each time-step the vertical mixing coeff.  
     11   !!   zdf_phy       : upadate at each time-step the vertical mixing coeff. 
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers variables 
    14    USE zdf_oce        ! vertical physics: shared variables          
     14   USE zdf_oce        ! vertical physics: shared variables 
    1515   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    1616   USE zdfsh2         ! vertical physics: shear production term of TKE 
    17    USE zdfric         ! vertical physics: RIChardson dependent vertical mixing    
     17   USE zdfric         ! vertical physics: RIChardson dependent vertical mixing 
    1818   USE zdftke         ! vertical physics: TKE vertical mixing 
    1919   USE zdfgls         ! vertical physics: GLS vertical mixing 
    2020   USE zdfosm         ! vertical physics: OSMOSIS vertical mixing 
    21    USE zdfddm         ! vertical physics: double diffusion mixing       
    22    USE zdfevd         ! vertical physics: convection via enhanced vertical diffusion   
    23    USE zdfiwm         ! vertical physics: internal wave-induced mixing   
     21   USE zdfddm         ! vertical physics: double diffusion mixing 
     22   USE zdfevd         ! vertical physics: convection via enhanced vertical diffusion 
     23   USE zdfmfc         ! vertical physics: Mass Flux Convection 
     24   USE zdfiwm         ! vertical physics: internal wave-induced mixing 
    2425   USE zdfswm         ! vertical physics: surface  wave-induced mixing 
    2526   USE zdfmxl         ! vertical physics: mixed layer 
    2627   USE tranpc         ! convection: non penetrative adjustment 
    27    USE trc_oce        ! variables shared between passive tracer & ocean            
     28   USE trc_oce        ! variables shared between passive tracer & ocean 
    2829   USE sbc_oce        ! surface module (only for nn_isf in the option compatibility test) 
    2930   USE sbcrnf         ! surface boundary condition: runoff variables 
    … …  
    4546   PUBLIC   zdf_phy       ! called by step.F90 
    4647 
    47    INTEGER ::   nzdf_phy   ! type of vertical closure used  
     48   INTEGER ::   nzdf_phy   ! type of vertical closure used 
    4849   !                       ! associated indicators 
    4950   INTEGER, PARAMETER ::   np_CST = 1   ! Constant Kz 
    … …  
    6566      !!---------------------------------------------------------------------- 
    6667      !!                  ***  ROUTINE zdf_phy_init  *** 
    67       !!  
     68      !! 
    6869      !! ** Purpose :   initializations of the vertical ocean physics 
    6970      !! 
    70       !! ** Method  :   Read namelist namzdf, control logicals  
     71      !! ** Method  :   Read namelist namzdf, control logicals 
    7172      !!                set horizontal shape and vertical profile of background mixing coef. 
    7273      !!---------------------------------------------------------------------- 
    … …  
    7879      NAMELIST/namzdf/ ln_zdfcst, ln_zdfric, ln_zdftke, ln_zdfgls,   &     ! type of closure scheme 
    7980         &             ln_zdfosm,                                    &     ! type of closure scheme 
     81         &             ln_zdfmfc,                                    &     ! convection : mass flux 
    8082         &             ln_zdfevd, nn_evdm, rn_evd ,                  &     ! convection : evd 
    8183         &             ln_zdfnpc, nn_npc , nn_npcp,                  &     ! convection : npc 
    … …  
    112114         WRITE(numout,*) '         OSMOSIS-OBL closure (OSM)               ln_zdfosm = ', ln_zdfosm 
    113115         WRITE(numout,*) '      convection: ' 
     116         WRITE(numout,*) '         convection mass flux (mfc)              ln_zdfmfc = ', ln_zdfmfc 
    114117         WRITE(numout,*) '         enhanced vertical diffusion             ln_zdfevd = ', ln_zdfevd 
    115118         WRITE(numout,*) '            applied on momentum (=1/0)             nn_evdm = ', nn_evdm 
    … …  
    140143      IF( nn_avb == 0 ) THEN             ! Define avmb, avtb from namelist parameter 
    141144         avmb(:) = rn_avm0 
    142          avtb(:) = rn_avt0                      
     145         avtb(:) = rn_avt0 
    143146      ELSE                               ! Background profile of avt (fit a theoretical/observational profile (Krauss 1990) 
    144147         avmb(:) = rn_avm0 
    … …  
    147150      ENDIF 
    148151      !                                  ! 2D shape of the avtb 
    149       avtb_2d(:,:) = 1._wp                   ! uniform  
     152      avtb_2d(:,:) = 1._wp                   ! uniform 
    150153      ! 
    151154      IF( nn_havtb == 1 ) THEN               ! decrease avtb by a factor of ten in the equatorial band 
    … …  
    172175      IF( ln_zdfnpc .AND. ln_zdfevd )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfnpc and ln_zdfevd' ) 
    173176      IF( ln_zdfosm .AND. ln_zdfevd )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfosm and ln_zdfevd' ) 
     177      IF( ln_zdfmfc .AND. ln_zdfevd )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfevd' ) 
     178      IF( ln_zdfmfc .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfnpc' ) 
     179      IF( ln_zdfmfc .AND. ln_zdfosm )   CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfosm' ) 
    174180      IF( lk_top    .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 
    175181      IF( lk_top    .AND. ln_zdfosm )   CALL ctl_stop( 'zdf_phy_init: osmosis scheme is not working with key_top' ) 
     182      IF( lk_top    .AND. ln_zdfmfc )   CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 
    176183      IF(lwp) THEN 
    177184         WRITE(numout,*) 
    178185         IF    ( ln_zdfnpc ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use non penetrative convective scheme' 
    179186         ELSEIF( ln_zdfevd ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use enhanced vertical diffusion scheme' 
     187         ELSEIF( ln_zdfmfc ) THEN  ;   WRITE(numout,*) '   ==>>>   convection: use Mass Flux scheme' 
    180188         ELSE                      ;   WRITE(numout,*) '   ==>>>   convection: no specific scheme used' 
    181189         ENDIF 
    … …  
    190198 
    191199      !                          !==  type of vertical turbulent closure  ==!    (set nzdf_phy) 
    192       ioptio = 0  
     200      ioptio = 0 
    193201      IF( ln_zdfcst ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_CST   ;   ENDIF 
    194202      IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init          ;   ENDIF 
    … …  
    205213      ELSE                   ;   l_zdfsh2 = .TRUE. 
    206214      ENDIF 
    207  
     215      !                          !== Mass Flux Convectiive algorithm  ==! 
     216      IF( ln_zdfmfc )   CALL zdf_mfc_init       ! Convection computed with eddy diffusivity mass flux 
     217      ! 
    208218      !                          !== gravity wave-driven mixing  ==! 
    209219      IF( ln_zdfiwm )   CALL zdf_iwm_init       ! internal wave-driven mixing 
    … …  
    226236      !! ** Purpose :  Update ocean physics at each time-step 
    227237      !! 
    228       !! ** Method  :  
     238      !! ** Method  : 
    229239      !! 
    230240      !! ** Action  :   avm, avt vertical eddy viscosity and diffusivity at w-points 
    … …  
    244254         ! 
    245255         !                       !* bottom drag 
    246          CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in  
     256         CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in 
    247257            &              r_z0_bot,   r_ke0_bot,    rCd0_bot,   & 
    248258            &                                        rCdU_bot  )     ! ==>> out : bottom drag [m/s] 
    249259         IF( ln_isfcav ) THEN    !* top drag   (ocean cavities) 
    250             CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
     260            CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in 
    251261               &              r_z0_top,   r_ke0_top,    rCd0_top,   & 
    252262               &                                        rCdU_top  )     ! ==>> out : bottom drag [m/s] 
    … …  
    263273      ENDIF 
    264274#endif 
    265       !  
     275      ! 
    266276      !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
    267277      ! 
    … …  
    280290!!gm         avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    281291      END SELECT 
    282       !   
     292      ! 
    283293      !                          !==  ocean Kz  ==!   (avt, avs, avm) 
    284294      ! 
    … …  
    302312      ENDIF 
    303313      ! 
    304       !                                         !* wave-induced mixing  
    305       IF( ln_zdfswm )   CALL zdf_swm( kt, Kmm, avm, avt, avs )   ! surface  wave (Qiao et al. 2004)  
     314      !                                         !* wave-induced mixing 
     315      IF( ln_zdfswm )   CALL zdf_swm( kt, Kmm, avm, avt, avs )   ! surface  wave (Qiao et al. 2004) 
    306316      IF( ln_zdfiwm )   CALL zdf_iwm( kt, Kmm, avm, avt, avs )   ! internal wave (de Lavergne et al 2017) 
    307317 
    308 #if defined key_agrif  
     318#if defined key_agrif 
    309319      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
    310320      IF( l_zdfsh2 )   CALL Agrif_avm 
    … …  
    330340         IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
    331341         IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    332          IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' )  
     342         IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
    333343         ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
    334344      ENDIF 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdfsh2.F90

    r13497 r14021  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  zdfsh2  *** 
    4    !! Ocean physics:  shear production term of TKE  
     4   !! Ocean physics:  shear production term of TKE 
    55   !!===================================================================== 
    66   !! History :   -   !  2014-10  (A. Barthelemy, G. Madec)  original code 
    77   !!   NEMO     4.0  !  2017-04  (G. Madec)  remove u-,v-pts avm 
     8   !!   NEMO     4.2  !  2020-12  (G. Madec, E. Clementi) add Stokes Drift Shear 
     9   !                  !           for wave coupling 
    810   !!---------------------------------------------------------------------- 
    911 
    … …  
    1315   USE oce 
    1416   USE dom_oce        ! domain: ocean 
     17   USE sbcwave        ! Surface Waves (add Stokes shear) 
     18   USE sbc_oce , ONLY: ln_stshear  !Stoked Drift shear contribution 
    1519   ! 
    1620   USE in_out_manager ! I/O manager 
    … …  
    2125 
    2226   PUBLIC   zdf_sh2        ! called by zdftke, zdfglf, and zdfric 
    23     
     27 
    2428   !! * Substitutions 
    2529#  include "do_loop_substitute.h90" 
    … …  
    3236CONTAINS 
    3337 
    34    SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2  )  
     38   SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2  ) 
    3539      !!---------------------------------------------------------------------- 
    3640      !!                   ***  ROUTINE zdf_sh2  *** 
    … …  
    4044      !! ** Method  : - a stable discretization of this term is linked to the 
    4145      !!                time-space discretization of the vertical diffusion 
    42       !!                of the OGCM. NEMO uses C-grid, a leap-frog environment  
     46      !!                of the OGCM. NEMO uses C-grid, a leap-frog environment 
    4347      !!                and an implicit computation of vertical mixing term, 
    4448      !!                so the shear production at w-point is given by: 
    45       !!                   sh2 = mi[   mi(avm) * dk[ub]/e3ub * dk[un]/e3un   ]  
    46       !!                       + mj[   mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn   ]  
     49      !!                   sh2 = mi[   mi(avm) * dk[ub]/e3ub * dk[un]/e3un   ] 
     50      !!                       + mj[   mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn   ] 
    4751      !!                NB: wet-point only horizontal averaging of shear 
    4852      !! 
    … …  
    5963      !!-------------------------------------------------------------------- 
    6064      ! 
    61       DO jk = 2, jpkm1 
    62          DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
    63             zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    64                &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
    65                &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) &  
    66                &         / ( e3uw(ji,jj,jk  ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 
    67                &         * wumask(ji,jj,jk) 
    68             zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
    69                &         * (   vv(ji,jj,jk-1,Kmm) -   vv(ji,jj,jk,Kmm) ) & 
    70                &         * (   vv(ji,jj,jk-1,Kbb) -   vv(ji,jj,jk,Kbb) ) & 
    71                &         / ( e3vw(ji,jj,jk  ,Kmm) * e3vw(ji,jj,jk,Kbb) ) & 
    72                &         * wvmask(ji,jj,jk) 
    73          END_2D 
     65      DO jk = 2, jpkm1                 !* Shear production at uw- and vw-points (energy conserving form) 
     66         IF ( cpl_sdrftx .AND. ln_stshear )  THEN       ! Surface Stokes Drift available  ===>>>  shear + stokes drift contibution 
     67            DO_2D( 1, 0, 1, 0 ) 
     68               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )        & 
     69                  &         * ( uu (ji,jj,jk-1,Kmm) -   uu (ji,jj,jk,Kmm)    & 
     70                  &           + usd(ji,jj,jk-1) -   usd(ji,jj,jk) )  & 
     71                  &         * ( uu (ji,jj,jk-1,Kbb) -   uu (ji,jj,jk,Kbb) )  & 
     72                  &         / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) 
     73               zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) )         & 
     74                  &         * ( vv (ji,jj,jk-1,Kmm) -   vv (ji,jj,jk,Kmm)     & 
     75                  &           + vsd(ji,jj,jk-1) -   vsd(ji,jj,jk) )   & 
     76                  &         * ( vv (ji,jj,jk-1,Kbb) -   vv (ji,jj,jk,Kbb) )   & 
     77                  &/ ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) 
     78            END_2D 
     79         ELSE 
     80            DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
     81               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
     82                  &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
     83                  &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) & 
     84                  &         / ( e3uw(ji,jj,jk  ,Kmm) * e3uw(ji,jj,jk,Kbb) ) & 
     85                  &         * wumask(ji,jj,jk) 
     86               zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
     87                  &         * (   vv(ji,jj,jk-1,Kmm) -   vv(ji,jj,jk,Kmm) ) & 
     88                  &         * (   vv(ji,jj,jk-1,Kbb) -   vv(ji,jj,jk,Kbb) ) & 
     89                  &         / ( e3vw(ji,jj,jk  ,Kmm) * e3vw(ji,jj,jk,Kbb) ) & 
     90                  &         * wvmask(ji,jj,jk) 
     91            END_2D 
     92         ENDIF 
    7493         DO_2D( 0, 0, 0, 0 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    7594            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
    7695               &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
    7796         END_2D 
    78       END DO  
     97      END DO 
    7998      ! 
    8099   END SUBROUTINE zdf_sh2 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/ZDF/zdftke.F90

    r14017 r14021  
    2929   !!            4.0  !  2017-04  (G. Madec)  remove CPP ddm key & avm at t-point only 
    3030   !!             -   !  2017-05  (G. Madec)  add top/bottom friction as boundary condition 
     31   !!            4.2  !  2020-12  (G. Madec, E. Clementi) add wave coupling 
     32   !                  !           following Couvelard et al., 2019 
    3133   !!---------------------------------------------------------------------- 
    3234 
    … …  
    5860   USE prtctl         ! Print control 
    5961   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     62   USE sbcwave        ! Surface boundary waves 
    6063 
    6164   IMPLICIT NONE 
    … …  
    6871   !                      !!** Namelist  namzdf_tke  ** 
    6972   LOGICAL  ::   ln_mxl0   ! mixing length scale surface value as function of wind stress or not 
     73   LOGICAL  ::   ln_mxhsw  ! mixing length scale surface value as a fonction of wave height 
    7074   INTEGER  ::   nn_mxlice ! type of scaling under sea-ice (=0/1/2/3) 
    7175   REAL(wp) ::   rn_mxlice ! ice thickness value when scaling under sea-ice 
    … …  
    8185   INTEGER  ::   nn_etau   ! type of depth penetration of surface tke (=0/1/2/3) 
    8286   INTEGER  ::      nn_htau   ! type of tke profile of penetration (=0/1) 
     87   INTEGER  ::   nn_bc_surf! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling 
     88   INTEGER  ::   nn_bc_bot ! surface condition (0/1=Dir/Neum) ! Only applicable for wave coupling 
    8389   REAL(wp) ::      rn_efr    ! fraction of TKE surface value which penetrates in the ocean 
    8490   LOGICAL  ::   ln_lc     ! Langmuir cells (LC) as a source term of TKE or not 
    … …  
    209215      REAL(wp) ::   zus   , zwlc  , zind       !   -      - 
    210216      REAL(wp) ::   zzd_up, zzd_lw             !   -      - 
     217      REAL(wp) ::   ztaui, ztauj, z1_norm 
    211218      INTEGER , DIMENSION(jpi,jpj)     ::   imlc 
    212       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3 
     219      REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3, zWlc2 
    213220      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw 
    214221      !!-------------------------------------------------------------------- 
    … …  
    219226      zfact2  = 1.5_wp * rn_Dt * rn_ediss 
    220227      zfact3  = 0.5_wp         * rn_ediss 
     228      ! 
     229      zpelc(:,:,:) = 0._wp ! need to be initialised in case ln_lc is not used 
    221230      ! 
    222231      ! ice fraction considered for attenuation of langmuir & wave breaking 
    … …  
    232241      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    233242      ! 
    234       DO_2D( 0, 0, 0, 0 )         ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    235 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 
    236 !!       one way around would be to increase zbbirau 
    237 !!          en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + & 
    238 !!             &                                     fr_i(ji,jj)   * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1) 
     243      DO_2D( 0, 0, 0, 0 ) 
    239244         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
     245         zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) 
     246         zd_lw(ji,jj,1) = 1._wp 
     247         zd_up(ji,jj,1) = 0._wp 
    240248      END_2D 
    241249      ! 
    … …  
    274282      ! 
    275283      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    276       IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke   !   (Axell JGR 2002) 
     284      IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke (Axell JGR 2002) 
    277285         !                  !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    278286         ! 
    279          !                        !* total energy produce by LC : cumulative sum over jk 
     287         !                       !* Langmuir velocity scale 
     288         ! 
     289         IF ( cpl_sdrftx )  THEN       ! Surface Stokes Drift available 
     290            !                                ! Craik-Leibovich velocity scale Wlc = ( u* u_s )^1/2    with u* = (taum/rho0)^1/2 
     291            !                                ! associated kinetic energy : 1/2 (Wlc)^2 = u* u_s 
     292            !                                ! more precisely, it is the dot product that must be used : 
     293            !                                !     1/2  (W_lc)^2 = MAX( u* u_s + v* v_s , 0 )   only the positive part 
     294!!gm  ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 
     295!!gm  ! so we will overestimate the LC velocity....   !!gm I will do the work if !LC have an effect ! 
     296            DO_2D( 0, 0, 0, 0 ) 
     297!!XC                  zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )  ) 
     298                  zWlc2(ji,jj) = 0.5_wp *  ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) 
     299            END_2D 
     300! 
     301!  Projection of Stokes drift in the wind stress direction 
     302! 
     303            DO_2D( 0, 0, 0, 0 ) 
     304                  ztaui   = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 
     305                  ztauj   = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) 
     306                  z1_norm = 1._wp / MAX( SQRT(ztaui*ztaui+ztauj*ztauj), 1.e-12 ) * tmask(ji,jj,1) 
     307                  zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 
     308            END_2D 
     309         CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
     310! 
     311         ELSE                          ! Surface Stokes drift deduced from surface stress 
     312            !                                ! Wlc = u_s   with u_s = 0.016*U_10m, the surface stokes drift  (Axell 2002, Eq.44) 
     313            !                                ! using |tau| = rho_air Cd |U_10m|^2 , it comes: 
     314            !                                ! Wlc = 0.016 * [|tau|/(rho_air Cdrag) ]^1/2   and thus: 
     315            !                                ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 
     316            zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )      ! to convert stress in 10m wind using a constant drag 
     317            DO_2D( 1, 1, 1, 1 ) 
     318               zWlc2(ji,jj) = zcof * taum(ji,jj) 
     319            END_2D 
     320            ! 
     321         ENDIF 
     322         ! 
     323         !                       !* Depth of the LC circulation  (Axell 2002, Eq.47) 
     324         !                             !- LHS of Eq.47 
    280325         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 
    281326         DO jk = 2, jpk 
    … …  
    283328               &        MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 
    284329         END DO 
    285          !                        !* finite Langmuir Circulation depth 
    286          zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
     330         ! 
     331         !                             !- compare LHS to RHS of Eq.47 
    287332         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    288          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )   ! Last w-level at which zpelc>=0.5*us*us 
    289             zus = zcof * taum(ji,jj)          !      with us=0.016*wind(starting from jpk-1) 
    290             IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk 
     333         DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
     334            IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) )   imlc(ji,jj) = jk 
    291335         END_3D 
    292336         !                               ! finite LC depth 
    … …  
    294338            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
    295339         END_2D 
     340         ! 
    296341         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    297342         DO_2D( 0, 0, 0, 0 ) 
    298             zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
     343            zus = SQRT( 2. * zWlc2(ji,jj) )             ! Stokes drift 
    299344            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    300345         END_2D 
    … …  
    351396            &                                ) * wmask(ji,jj,jk) 
    352397      END_3D 
     398      ! 
     399      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     400      !                     !  Surface boundary condition on tke if 
     401      !                     !  coupling with waves 
     402      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     403      ! 
     404      IF ( cpl_phioc .and. ln_phioc )  THEN 
     405         SELECT CASE (nn_bc_surf) ! Boundary Condition using surface TKE flux from waves 
     406 
     407         CASE ( 0 ) ! Dirichlet BC 
     408            DO_2D( 0, 0, 0, 0 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
     409               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
     410               en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) )  * tmask(ji,jj,1) 
     411               zdiag(ji,jj,1) = 1._wp/en(ji,jj,1)  ! choose to keep coherence with former estimation of 
     412            END_2D 
     413 
     414         CASE ( 1 ) ! Neumann BC 
     415            DO_2D( 0, 0, 0, 0 ) 
     416               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
     417               en(ji,jj,2)    = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm) 
     418               en(ji,jj,1)    = en(ji,jj,2) + (2 * e3t(ji,jj,1,Kmm) * phioc(ji,jj)/rho0) / ( p_avm(ji,jj,1) + p_avm(ji,jj,2) ) 
     419               zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) 
     420               zdiag(ji,jj,1) = 1._wp 
     421               zd_lw(ji,jj,2) = 0._wp 
     422            END_2D 
     423 
     424         END SELECT 
     425 
     426      ENDIF 
     427      ! 
    353428      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    354       DO_3D( 0, 0, 0, 0, 3, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     429      DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    355430         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    356431      END_3D 
    357       DO_2D( 0, 0, 0, 0 )                          ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    358          zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    359       END_2D 
    360       DO_3D( 0, 0, 0, 0, 3, jpkm1 ) 
     432!XC : commented to allow for neumann boundary condition 
     433!      DO_2D( 0, 0, 0, 0 ) 
     434!         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
     435!      END_2D 
     436      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    361437         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 
    362438      END_3D 
    … …  
    461537      zmxld(:,:,:)  = rmxl_min 
    462538      ! 
    463      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
    464          ! 
    465          zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
     539      IF(ln_sdw .AND. ln_mxhsw) THEN 
     540         zmxlm(:,:,1)= vkarmn * MAX ( 1.6 * hsw(:,:) , 0.02 )        ! surface mixing length = F(wave height) 
     541         ! from terray et al 1999 and mellor and blumberg 2004 it should be 0.85 and not 1.6 
     542         zcoef       = vkarmn * ( (rn_ediff*rn_ediss)**0.25 ) / rn_ediff 
     543         zmxlm(:,:,1)= zcoef * MAX ( 1.6 * hsw(:,:) , 0.02 )        ! surface mixing length = F(wave height) 
     544      ELSE 
     545      ! 
     546         IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 
     547         ! 
     548            zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    466549#if ! defined key_si3 && ! defined key_cice 
    467          DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
    468             zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    469          END_2D 
     550            DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
     551               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
     552            END_2D 
    470553#else 
    471          SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
    472          ! 
    473          CASE( 0 )                      ! No scaling under sea-ice 
     554            SELECT CASE( nn_mxlice )             ! Type of scaling under sea-ice 
     555            ! 
     556            CASE( 0 )                      ! No scaling under sea-ice 
     557               DO_2D( 0, 0, 0, 0 ) 
     558                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     559               END_2D 
     560               ! 
     561            CASE( 1 )                      ! scaling with constant sea-ice thickness 
     562               DO_2D( 0, 0, 0, 0 ) 
     563                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     564                     &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
     565               END_2D 
     566               ! 
     567            CASE( 2 )                      ! scaling with mean sea-ice thickness 
     568               DO_2D( 0, 0, 0, 0 ) 
     569#if defined key_si3 
     570                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     571                     &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 
     572#elif defined key_cice 
     573                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     574                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     575                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
     576#endif 
     577               END_2D 
     578               ! 
     579            CASE( 3 )                      ! scaling with max sea-ice thickness 
     580               DO_2D( 0, 0, 0, 0 ) 
     581                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
     582                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     583                     &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
     584               END_2D 
     585               ! 
     586            END SELECT 
     587#endif 
     588            ! 
    474589            DO_2D( 0, 0, 0, 0 ) 
    475                zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
     590               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    476591            END_2D 
    477592            ! 
    478          CASE( 1 )                      ! scaling with constant sea-ice thickness 
    479             DO_2D( 0, 0, 0, 0 ) 
    480                zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    481                   &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
    482             END_2D 
    483             ! 
    484          CASE( 2 )                      ! scaling with mean sea-ice thickness 
    485             DO_2D( 0, 0, 0, 0 ) 
    486 #if defined key_si3 
    487                zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    488                   &                         fr_i(ji,jj)   * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 
    489 #elif defined key_cice 
    490                zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    491                zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    492                   &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
    493 #endif 
    494             END_2D 
    495             ! 
    496          CASE( 3 )                      ! scaling with max sea-ice thickness 
    497             DO_2D( 0, 0, 0, 0 ) 
    498                zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    499                zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    500                   &                         fr_i(ji,jj)   * zmaxice             ) * tmask(ji,jj,1) 
    501             END_2D 
    502             ! 
    503          END SELECT 
    504 #endif 
    505          ! 
    506          DO_2D( 0, 0, 0, 0 ) 
    507             zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    508          END_2D 
    509          ! 
    510       ELSE 
    511          zmxlm(:,:,1) = rn_mxl0 
    512       ENDIF 
    513  
     593         ELSE 
     594            zmxlm(:,:,1) = rn_mxl0 
     595         ENDIF 
     596      ENDIF 
    514597      ! 
    515598      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    … …  
    624707         &                 rn_mxl0 , nn_mxlice, rn_mxlice,             & 
    625708         &                 nn_pdl  , ln_lc    , rn_lc    ,             & 
    626          &                 nn_etau , nn_htau  , rn_efr   , nn_eice 
     709         &                 nn_etau , nn_htau  , rn_efr   , nn_eice  ,  & 
     710         &                 nn_bc_surf, nn_bc_bot, ln_mxhsw 
    627711      !!---------------------------------------------------------------------- 
    628712      ! 
    … …  
    666750         WRITE(numout,*) '      Langmuir cells parametrization              ln_lc     = ', ln_lc 
    667751         WRITE(numout,*) '         coef to compute vertical velocity of LC     rn_lc  = ', rn_lc 
     752         IF ( cpl_phioc .and. ln_phioc )  THEN 
     753            SELECT CASE( nn_bc_surf)             ! Type of scaling under sea-ice 
     754            CASE( 0 )   ;   WRITE(numout,*) '  nn_bc_surf=0 ==>>> DIRICHLET SBC using surface TKE flux from waves' 
     755            CASE( 1 )   ;   WRITE(numout,*) '  nn_bc_surf=1 ==>>> NEUMANN SBC using surface TKE flux from waves' 
     756            END SELECT 
     757         ENDIF 
    668758         WRITE(numout,*) '      test param. to add tke induced by wind      nn_etau   = ', nn_etau 
    669759         WRITE(numout,*) '          type of tke penetration profile            nn_htau   = ', nn_htau 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/step.F90

    r14017 r14021  
    296296 
    297297                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
     298         IF( ln_zdfmfc  )   CALL tra_mfc    ( kstp, Nbb,      ts, Nrhs )  ! Mass Flux Convection 
    298299         IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
    299300         IF( lrst_oce .AND. ln_zdfosm ) & 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/step_oce.F90

    r14017 r14021  
    7070   USE zdfphy          ! vertical physics manager      (zdf_phy_init routine) 
    7171   USE zdfosm  , ONLY : osm_rst, dyn_osm, tra_osm      ! OSMOSIS routines used in step.F90 
     72   USE zdfmfc          ! Mass FLux Convection routine used in step.F90 
    7273 
    7374   USE diu_layers      ! diurnal SST bulk and coolskin routines 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/CANAL/MY_SRC/domvvl.F90

    r13458 r14021  
    282282      ENDIF 
    283283      ! 
    284       IF(lwxios) THEN 
    285 ! define variables in restart file when writing with XIOS 
    286          CALL iom_set_rstw_var_active('e3t_b') 
    287          CALL iom_set_rstw_var_active('e3t_n') 
    288          !                                           ! ----------------------- ! 
    289          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    290             !                                        ! ----------------------- ! 
    291             CALL iom_set_rstw_var_active('tilde_e3t_b') 
    292             CALL iom_set_rstw_var_active('tilde_e3t_n') 
    293          END IF 
    294          !                                           ! -------------!     
    295          IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    296             !                                        ! ------------ ! 
    297             CALL iom_set_rstw_var_active('hdiv_lf') 
    298          ENDIF 
    299          ! 
    300       ENDIF 
    301       ! 
    302284   END SUBROUTINE dom_vvl_zgr 
    303285 
    … …  
    803785         IF( ln_rstart ) THEN                   !* Read the restart file 
    804786            CALL rst_read_open                  !  open the restart file if necessary 
    805             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     787            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    806788            ! 
    807789            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    816798            ! 
    817799            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    818                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    819                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     800               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
     801               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    820802               ! needed to restart if land processor not computed  
    821803               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    831813               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    832814               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    833                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     815               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    834816               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    835817               l_1st_euler = .true. 
    … …  
    838820               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    839821               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    840                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     822               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    841823               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    842824               l_1st_euler = .true. 
    … …  
    863845               !                          ! ----------------------- ! 
    864846               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    865                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    866                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     847                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     848                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    867849               ELSE                            ! one at least array is missing 
    868850                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    873855                  !                       ! ------------ ! 
    874856                  IF( id5 > 0 ) THEN  ! required array exists 
    875                      CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     857                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    876858                  ELSE                ! array is missing 
    877859                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    947929         !                                   ! =================== 
    948930         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    949          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    950931         !                                           ! --------- ! 
    951932         !                                           ! all cases ! 
    952933         !                                           ! --------- ! 
    953          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    954          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
     934         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 
     935         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 
    955936         !                                           ! ----------------------- ! 
    956937         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    957938            !                                        ! ----------------------- ! 
    958             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    959             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     939            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 
     940            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    960941         END IF 
    961942         !                                           ! -------------!     
    962943         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    963944            !                                        ! ------------ ! 
    964             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     945            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 
    965946         ENDIF 
    966947         ! 
    967          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    968948      ENDIF 
    969949      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/CANAL/MY_SRC/trazdf.F90

    r13295 r14021  
    5454      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts                 ! active tracers and RHS of tracer equation 
    5555      ! 
    56       INTEGER  ::   jk   ! Dummy loop indices 
     56      INTEGER  ::   ji, jj, jk   ! Dummy loop indices 
    5757      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
    5858      !!--------------------------------------------------------------------- 
    … …  
    6161      ! 
    6262      IF( kt == nit000 )  THEN 
    63          IF(lwp)WRITE(numout,*) 
    64          IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 
    65          IF(lwp)WRITE(numout,*) '~~~~~~~ ' 
     63         IF( ntile == 0 .OR. ntile == 1 )  THEN                   ! Do only on the first tile 
     64            IF(lwp)WRITE(numout,*) 
     65            IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 
     66            IF(lwp)WRITE(numout,*) '~~~~~~~ ' 
     67         ENDIF 
    6668      ENDIF 
    6769      ! 
    … …  
    8385 
    8486      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    85          DO jk = 1, jpkm1 
    86             ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 
    87                &          / (e3t(:,:,jk,Kmm)*rDt) ) - ztrdt(:,:,jk) 
    88             ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 
    89               &           / (e3t(:,:,jk,Kmm)*rDt) ) - ztrds(:,:,jk) 
     87         DO jk = 1, jpk 
     88            ztrdt(:,:,jk) = (   (  pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa)     & 
     89               &                 - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb)  )  & 
     90               &              / (  e3t(:,:,jk,Kmm)*rDt  )   )                 & 
     91               &          - ztrdt(:,:,jk) 
     92            ztrds(:,:,jk) = (   (  pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa)     & 
     93               &                 - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb)  )  & 
     94               &             / (   e3t(:,:,jk,Kmm)*rDt  )   )                 & 
     95               &          - ztrds(:,:,jk) 
    9096         END DO 
    9197!!gm this should be moved in trdtra.F90 and done on all trends 
    … …  
    135141      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    136142      REAL(wp) ::  zrhs, zzwi, zzws ! local scalars 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwi, zwt, zwd, zws 
     143      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zwi, zwt, zwd, zws 
    138144      !!--------------------------------------------------------------------- 
    139145      ! 
    … …  
    149155            ! 
    150156            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 
    151             IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt(:,:,2:jpk) 
    152             ELSE                                            ;   zwt(:,:,2:jpk) = avs(:,:,2:jpk) 
     157            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 
     158               DO_3D( 1, 1, 1, 1, 2, jpk ) 
     159                  zwt(ji,jj,jk) = avt(ji,jj,jk) 
     160               END_3D 
     161            ELSE 
     162               DO_3D( 1, 1, 1, 1, 2, jpk ) 
     163                  zwt(ji,jj,jk) = avs(ji,jj,jk) 
     164               END_3D 
    153165            ENDIF 
    154166            zwt(:,:,1) = 0._wp 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90

    r13472 r14021  
    1818   USE sbc_ice         ! Surface boundary condition: ice fields 
    1919   USE phycst          ! physical constants 
    20    USE ice, ONLY       : at_i_b, a_i_b 
     20   USE ice, ONLY       : jpl, at_i_b, a_i_b 
    2121   USE icethd_dh       ! for CALL ice_thd_snwblow 
    2222   ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/dtatsd.F90

    r13583 r14021  
    1818   USE phycst          ! physical constants 
    1919   USE dom_oce         ! ocean space and time domain 
     20   USE domain, ONLY : dom_tile 
    2021   USE fldread         ! read input fields 
    2122   ! 
    … …  
    163164      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step 
    164165      CHARACTER(LEN=3)                     , INTENT(in   ) ::   cddta  ! dmp or ini 
    165       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
     166      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    166167      ! 
    167168      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    168169      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
     170      INTEGER ::   itile 
    169171      REAL(wp)::   zl, zi                             ! local scalars 
    170172      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace 
    171173      !!---------------------------------------------------------------------- 
    172174      ! 
     175      IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     176         itile = ntile 
     177         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     178 
     179         SELECT CASE(cddta) 
     180         CASE('ini') 
     181            CALL fld_read( kt, 1, sf_tsdini ) !==   read T & S data at kt time step   ==! 
     182         CASE('dmp') 
     183            CALL fld_read( kt, 1, sf_tsddmp ) !==   read T & S data at kt time step   ==! 
     184         CASE DEFAULT 
     185            CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 
     186         END SELECT 
     187 
     188         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
     189      ENDIF 
     190      ! 
    173191      SELECT CASE(cddta) 
    174       CASE('ini')  
    175          CALL fld_read( kt, 1, sf_tsdini ) !==   read T & S data at kt time step   ==! 
    176          ptsd(:,:,:,jp_tem) = sf_tsdini(jp_tem)%fnow(:,:,:)    ! NO mask 
    177          ptsd(:,:,:,jp_sal) = sf_tsdini(jp_sal)%fnow(:,:,:)  
     192      CASE('ini') 
     193         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     194            ptsd(ji,jj,jk,jp_tem) = sf_tsdini(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     195            ptsd(ji,jj,jk,jp_sal) = sf_tsdini(jp_sal)%fnow(ji,jj,jk) 
     196         END_3D 
    178197      CASE('dmp') 
    179          CALL fld_read( kt, 1, sf_tsddmp ) !==   read T & S data at kt time step   ==! 
    180          ptsd(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:)    ! NO mask 
    181          ptsd(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:)  
     198         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     199            ptsd(ji,jj,jk,jp_tem) = sf_tsddmp(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     200            ptsd(ji,jj,jk,jp_sal) = sf_tsddmp(jp_sal)%fnow(ji,jj,jk) 
     201         END_3D 
    182202      CASE DEFAULT 
    183203         CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 
    … …  
    186206      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    187207         ! 
    188          IF( kt == nit000 .AND. lwp )THEN 
    189             WRITE(numout,*) 
    190             WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     208         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     209            IF( kt == nit000 .AND. lwp )THEN 
     210               WRITE(numout,*) 
     211               WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     212            ENDIF 
    191213         ENDIF 
    192214         ! 
    … …  
    220242      ELSE                                !==   z- or zps- coordinate   ==! 
    221243         !                              
    222          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
    223          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
     244         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     245            ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
     246            ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     247         END_3D 
    224248         ! 
    225249         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/eosbn2.F90

    r13583 r14021  
    3939   !!---------------------------------------------------------------------- 
    4040   USE dom_oce        ! ocean space and time domain 
     41   USE domutl, ONLY : is_tile 
    4142   USE phycst         ! physical constants 
    4243   USE stopar         ! Stochastic T/S fluctuations 
    … …  
    5556   !                  !! * Interface 
    5657   INTERFACE eos 
    57       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 
     58      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 
    5859   END INTERFACE 
    5960   ! 
    … …  
    191192 
    192193   SUBROUTINE eos_insitu( pts, prd, pdep ) 
     194      !! 
     195      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     196      !                                                      ! 2 : salinity               [psu] 
     197      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
     198      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
     199      !! 
     200      CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 
     201   END SUBROUTINE eos_insitu 
     202 
     203   SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 
    193204      !!---------------------------------------------------------------------- 
    194205      !!                   ***  ROUTINE eos_insitu  *** 
    … …  
    228239      !!                TEOS-10 Manual, 2010 
    229240      !!---------------------------------------------------------------------- 
    230       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     241      INTEGER                                 , INTENT(in   ) ::   ktts, ktrd, ktdep 
     242      REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    231243      !                                                               ! 2 : salinity               [psu] 
    232       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
    233       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     244      REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK     ), INTENT(  out) ::   prd   ! in situ density            [-] 
     245      REAL(wp), DIMENSION(A2D_T(ktdep),JPK     ), INTENT(in   ) ::   pdep  ! depth                      [m] 
    234246      ! 
    235247      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    312324      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    313325      ! 
    314    END SUBROUTINE eos_insitu 
     326   END SUBROUTINE eos_insitu_t 
    315327 
    316328 
    317329   SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 
     330      !! 
     331      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     332      !                                                       ! 2 : salinity               [psu] 
     333      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd    ! in situ density            [-] 
     334      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     335      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pdep   ! depth                      [m] 
     336      !! 
     337      CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 
     338   END SUBROUTINE eos_insitu_pot 
     339 
     340 
     341   SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 
    318342      !!---------------------------------------------------------------------- 
    319343      !!                  ***  ROUTINE eos_insitu_pot  *** 
    … …  
    328352      !! 
    329353      !!---------------------------------------------------------------------- 
    330       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     354      INTEGER                                  , INTENT(in   ) ::   ktts, ktrd, ktrhop, ktdep 
     355      REAL(wp), DIMENSION(A2D_T(ktts)  ,JPK,JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    331356      !                                                                ! 2 : salinity               [psu] 
    332       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    333       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    334       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
     357      REAL(wp), DIMENSION(A2D_T(ktrd)  ,JPK     ), INTENT(  out) ::   prd    ! in situ density            [-] 
     358      REAL(wp), DIMENSION(A2D_T(ktrhop),JPK     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     359      REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK     ), INTENT(in   ) ::   pdep   ! depth                      [m] 
    335360      ! 
    336361      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    … …  
    482507      IF( ln_timing )   CALL timing_stop('eos-pot') 
    483508      ! 
    484    END SUBROUTINE eos_insitu_pot 
     509   END SUBROUTINE eos_insitu_pot_t 
    485510 
    486511 
    487512   SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 
     513      !! 
     514      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     515      !                                                    ! 2 : salinity               [psu] 
     516      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pdep  ! depth                      [m] 
     517      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   prd   ! in situ density 
     518      !! 
     519      CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 
     520   END SUBROUTINE eos_insitu_2d 
     521 
     522 
     523   SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 
    488524      !!---------------------------------------------------------------------- 
    489525      !!                  ***  ROUTINE eos_insitu_2d  *** 
    … …  
    496532      !! 
    497533      !!---------------------------------------------------------------------- 
    498       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
     534      INTEGER                            , INTENT(in   ) ::   ktts, ktdep, ktrd 
     535      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    499536      !                                                           ! 2 : salinity               [psu] 
    500       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    501       REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
     537      REAL(wp), DIMENSION(A2D_T(ktdep)    ), INTENT(in   ) ::   pdep  ! depth                      [m] 
     538      REAL(wp), DIMENSION(A2D_T(ktrd)     ), INTENT(  out) ::   prd   ! in situ density 
    502539      ! 
    503540      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    584621      IF( ln_timing )   CALL timing_stop('eos2d') 
    585622      ! 
    586    END SUBROUTINE eos_insitu_2d 
     623   END SUBROUTINE eos_insitu_2d_t 
     624 
     625 
     626   SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 
     627      !!---------------------------------------------------------------------- 
     628      !!                  ***  ROUTINE eos_insitu_pot  *** 
     629      !! 
     630      !! ** Purpose :   Compute the in situ density (ratio rho/rho0) and the 
     631      !!      potential volumic mass (Kg/m3) from potential temperature and 
     632      !!      salinity fields using an equation of state selected in the 
     633      !!     namelist. 
     634      !! 
     635      !! ** Action  : 
     636      !!              - prhop, the potential volumic mass (Kg/m3) 
     637      !! 
     638      !!---------------------------------------------------------------------- 
     639      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     640      !                                                                ! 2 : salinity               [psu] 
     641      REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     642      ! 
     643      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
     644      INTEGER  ::   jdof 
     645      REAL(wp) ::   zt , zh , zstemp, zs , ztm   ! local scalars 
     646      REAL(wp) ::   zn , zn0, zn1, zn2, zn3      !   -      - 
     647      REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign    ! local vectors 
     648      !!---------------------------------------------------------------------- 
     649      ! 
     650      IF( ln_timing )   CALL timing_start('eos-pot') 
     651      ! 
     652      SELECT CASE ( neos ) 
     653      ! 
     654      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
     655         ! 
     656            DO_2D( 1, 1, 1, 1 ) 
     657               ! 
     658               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     659               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     660               ztm = tmask(ji,jj,1)                                         ! tmask 
     661               ! 
     662               zn0 = (((((EOS060*zt   & 
     663                  &   + EOS150*zs+EOS050)*zt   & 
     664                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     665                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     666                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     667                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     668                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     669                  ! 
     670               ! 
     671               prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface 
     672               ! 
     673            END_2D 
     674 
     675      CASE( np_seos )                !==  simplified EOS  ==! 
     676         ! 
     677         DO_2D( 1, 1, 1, 1 ) 
     678            zt  = pts  (ji,jj,jp_tem) - 10._wp 
     679            zs  = pts  (ji,jj,jp_sal) - 35._wp 
     680            ztm = tmask(ji,jj,1) 
     681            !                                                     ! potential density referenced at the surface 
     682            zn =  - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt   & 
     683               &  + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs   & 
     684               &  - rn_nu * zt * zs 
     685            prhop(ji,jj) = ( rho0 + zn ) * ztm 
     686            ! 
     687         END_2D 
     688         ! 
     689      CASE( np_leos )                !==  ISOMIP EOS  ==! 
     690         ! 
     691         DO_2D( 1, 1, 1, 1 ) 
     692            ! 
     693            zt    = pts  (ji,jj,jp_tem)  - (-1._wp) 
     694            zs    = pts  (ji,jj,jp_sal)  - 34.2_wp 
     695            !zh    = pdep (ji,jj)                         ! depth at the partial step level 
     696            ! 
     697            zn =  rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 
     698            ! 
     699            prhop(ji,jj) = zn * r1_rho0               ! unmasked in situ density anomaly 
     700            ! 
     701         END_2D 
     702         ! 
     703      END SELECT 
     704      ! 
     705      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 
     706      ! 
     707      IF( ln_timing )   CALL timing_stop('eos-pot') 
     708      ! 
     709   END SUBROUTINE eos_insitu_pot_2d 
    587710 
    588711 
    589712   SUBROUTINE rab_3d( pts, pab, Kmm ) 
     713      !! 
     714      INTEGER                     , INTENT(in   ) ::   Kmm   ! time level index 
     715      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     716      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     717      !! 
     718      CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 
     719   END SUBROUTINE rab_3d 
     720 
     721 
     722   SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 
    590723      !!---------------------------------------------------------------------- 
    591724      !!                 ***  ROUTINE rab_3d  *** 
    … …  
    598731      !!---------------------------------------------------------------------- 
    599732      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    600       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
    601       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
     733      INTEGER                                , INTENT(in   ) ::   ktts, ktab 
     734      REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in   ) ::   pts   ! pot. temperature & salinity 
     735      REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(  out) ::   pab   ! thermal/haline expansion ratio 
    602736      ! 
    603737      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    706840      IF( ln_timing )   CALL timing_stop('rab_3d') 
    707841      ! 
    708    END SUBROUTINE rab_3d 
     842   END SUBROUTINE rab_3d_t 
    709843 
    710844 
    711845   SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 
     846      !! 
     847      INTEGER                   , INTENT(in   ) ::   Kmm   ! time level index 
     848      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     849      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pdep   ! depth                  [m] 
     850      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     851      !! 
     852      CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 
     853   END SUBROUTINE rab_2d 
     854 
     855 
     856   SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 
    712857      !!---------------------------------------------------------------------- 
    713858      !!                 ***  ROUTINE rab_2d  *** 
    … …  
    718863      !!---------------------------------------------------------------------- 
    719864      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
    720       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(in   ) ::   pts    ! pot. temperature & salinity 
    721       REAL(wp), DIMENSION(jpi,jpj)         , INTENT(in   ) ::   pdep   ! depth                  [m] 
    722       REAL(wp), DIMENSION(jpi,jpj,jpts)    , INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
     865      INTEGER                            , INTENT(in   ) ::   ktts, ktdep, ktab 
     866      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts    ! pot. temperature & salinity 
     867      REAL(wp), DIMENSION(A2D_T(ktdep)    ), INTENT(in   ) ::   pdep   ! depth                  [m] 
     868      REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT(  out) ::   pab    ! thermal/haline expansion ratio 
    723869      ! 
    724870      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    … …  
    829975      IF( ln_timing )   CALL timing_stop('rab_2d') 
    830976      ! 
    831    END SUBROUTINE rab_2d 
     977   END SUBROUTINE rab_2d_t 
    832978 
    833979 
    … …  
    9421088 
    9431089   SUBROUTINE bn2( pts, pab, pn2, Kmm ) 
     1090      !! 
     1091      INTEGER                              , INTENT(in   ) ::  Kmm   ! time level index 
     1092      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
     1093      REAL(wp), DIMENSION(:,:,:,:)         , INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
     1094      REAL(wp), DIMENSION(:,:,:)           , INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     1095      !! 
     1096      CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 
     1097   END SUBROUTINE bn2 
     1098 
     1099 
     1100   SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 
    9441101      !!---------------------------------------------------------------------- 
    9451102      !!                  ***  ROUTINE bn2  *** 
    … …  
    9561113      !!---------------------------------------------------------------------- 
    9571114      INTEGER                              , INTENT(in   ) ::   Kmm   ! time level index 
     1115      INTEGER                                , INTENT(in   ) ::  ktab, ktn2 
    9581116      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
    959       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
    960       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
     1117      REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
     1118      REAL(wp), DIMENSION(A2D_T(ktn2),JPK     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
    9611119      ! 
    9621120      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    … …  
    9821140      IF( ln_timing )   CALL timing_stop('bn2') 
    9831141      ! 
    984    END SUBROUTINE bn2 
     1142   END SUBROUTINE bn2_t 
    9851143 
    9861144 
    … …  
    10431201 
    10441202   SUBROUTINE  eos_fzp_2d( psal, ptf, pdep ) 
     1203      !! 
     1204      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
     1205      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
     1206      REAL(wp), DIMENSION(:,:)    , INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
     1207      !! 
     1208      CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 
     1209   END SUBROUTINE eos_fzp_2d 
     1210 
     1211 
     1212   SUBROUTINE  eos_fzp_2d_t( psal, ptf, kttf, pdep ) 
    10451213      !!---------------------------------------------------------------------- 
    10461214      !!                 ***  ROUTINE eos_fzp  *** 
    … …  
    10541222      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978 
    10551223      !!---------------------------------------------------------------------- 
     1224      INTEGER                       , INTENT(in   )           ::   kttf 
    10561225      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
    10571226      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
    1058       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
     1227      REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
    10591228      ! 
    10601229      INTEGER  ::   ji, jj          ! dummy loop indices 
    … …  
    10891258      END SELECT       
    10901259      ! 
    1091   END SUBROUTINE eos_fzp_2d 
     1260  END SUBROUTINE eos_fzp_2d_t 
    10921261 
    10931262 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/tradmp.F90

    r13295 r14021  
    9595      ! 
    9696      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    97       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
     97      REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta 
    9898      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
    9999      !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r13655 r14021  
    271271      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
    272272      ! 
    273       CALL     phy_cst         ! Physical constants 
    274       CALL     eos_init        ! Equation of state 
     273                           CALL     phy_cst         ! Physical constants 
     274                           CALL     eos_init        ! Equation of state 
    275275      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration 
    276       CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
     276                           CALL     dom_init( Nbb, Nnn, Naa ) ! Domain 
    277277      IF( sn_cfctl%l_prtctl )   & 
    278278         &                 CALL prt_ctl_init        ! Print control 
    279279 
    280       CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
     280                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
    281281 
    282282      !                                      ! external forcing 
    283       CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
     283                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    284284 
    285285      !#LB: 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/VORTEX/MY_SRC/domvvl.F90

    r13458 r14021  
    282282      ENDIF 
    283283      ! 
    284       IF(lwxios) THEN 
    285 ! define variables in restart file when writing with XIOS 
    286          CALL iom_set_rstw_var_active('e3t_b') 
    287          CALL iom_set_rstw_var_active('e3t_n') 
    288          !                                           ! ----------------------- ! 
    289          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    290             !                                        ! ----------------------- ! 
    291             CALL iom_set_rstw_var_active('tilde_e3t_b') 
    292             CALL iom_set_rstw_var_active('tilde_e3t_n') 
    293          END IF 
    294          !                                           ! -------------!     
    295          IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    296             !                                        ! ------------ ! 
    297             CALL iom_set_rstw_var_active('hdiv_lf') 
    298          ENDIF 
    299          ! 
    300       ENDIF 
    301       ! 
    302284   END SUBROUTINE dom_vvl_zgr 
    303285 
    … …  
    803785         IF( ln_rstart ) THEN                   !* Read the restart file 
    804786            CALL rst_read_open                  !  open the restart file if necessary 
    805             CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     787            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    806788            ! 
    807789            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    816798            ! 
    817799            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    818                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    819                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     800               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
     801               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    820802               ! needed to restart if land processor not computed  
    821803               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    831813               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    832814               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    833                CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     815               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    834816               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    835817               l_1st_euler = .true. 
    … …  
    838820               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    839821               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    840                CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     822               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    841823               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    842824               l_1st_euler = .true. 
    … …  
    863845               !                          ! ----------------------- ! 
    864846               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    865                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    866                   CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     847                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     848                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    867849               ELSE                            ! one at least array is missing 
    868850                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    873855                  !                       ! ------------ ! 
    874856                  IF( id5 > 0 ) THEN  ! required array exists 
    875                      CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     857                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    876858                  ELSE                ! array is missing 
    877859                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    947929         !                                   ! =================== 
    948930         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    949          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    950931         !                                           ! --------- ! 
    951932         !                                           ! all cases ! 
    952933         !                                           ! --------- ! 
    953          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    954          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
     934         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 
     935         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 
    955936         !                                           ! ----------------------- ! 
    956937         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    957938            !                                        ! ----------------------- ! 
    958             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    959             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     939            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 
     940            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    960941         END IF 
    961942         !                                           ! -------------!     
    962943         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    963944            !                                        ! ------------ ! 
    964             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     945            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 
    965946         ENDIF 
    966947         ! 
    967          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    968948      ENDIF 
    969949      ! 

  • NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/demo_cfgs.txt

    r13675 r14021  
    1212STATION_ASF OCE ICE 
    1313CPL_OASIS  OCE TOP ICE NST 
     14C1D_ASICS OCE 
     15ICE_RHEO OCE SAS ICE 
Note: See TracChangeset for help on using the changeset viewer.