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 4921 for branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM – NEMO

Ignore:
Timestamp:
2014-11-28T14:59:01+01:00 (10 years ago)
Author:
timgraham
Message:

merged with revision 4879 of trunk

Location:
branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM
Files:
131 edited
8 copied

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm

    r4230 r4921  
    1717%NCDF_INC            -I/usr/local/netcdf-3.6.3/include 
    1818%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf 
     19%CPP                 cpp 
    1920%FC                  mpxlf90_r 
    2021%FCFLAGS             -O3 -qsuffix=f=f90  -qstrict -qalias=intptr -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm

    r4230 r4921  
    1717%NCDF_INC            -I/usr/local/netcdf-3.6.3/include 
    1818%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf 
     19%CPP                 cpp 
    1920%FC                  mpxlf90_r 
    2021%FCFLAGS             -g -qsuffix=f=f90  -qstrict -qalias=intptr -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm

    r4230 r4921  
    1717%NCDF_INC            -I/usr/local/netcdf-3.6.3/include 
    1818%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf 
     19%CPP                 cpp 
    1920%FC                  xlf90 
    2021%FCFLAGS             -O3 -qsuffix=f=f90  -qstrict -qsuppress=1501-245 -qarch=pwr6 -q64 -qrealsize=8 -qtune=pwr6 -qextname -qlargepage -qmaxmem=-1 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm

    r4274 r4921  
    4444%XIOS_LIB            -L%XIOS_HOME/lib -lxios 
    4545 
     46%CPP                 cpp 
    4647%FC                  mpif90 
    4748%FCFLAGS             -fdefault-real-8 -fno-second-underscore -Dgfortran -ffree-line-length-none 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm

    r4230 r4921  
    1717%NCDF_INC -I$NETCDF/include 
    1818%NCDF_LIB -L$NETCDF/lib -lnetcdf -lnetcdff 
     19%CPP                 cpp 
    1920%FC mpiifort 
    2021%FCFLAGS -r8 -O3 -xHost -fp-model source -traceback 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm

    r4230 r4921  
    1717%NCDF_INC -I$NETCDF/include 
    1818%NCDF_LIB -L$NETCDF/lib -lnetcdf -lnetcdff 
     19%CPP                 cpp 
    1920%FC mpiifort 
    2021%FCFLAGS -fpe0 -g -r8 -O1 -xHost -fp-model source -traceback 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm

    r4230 r4921  
    1717%NCDF_INC -I$NETCDF/include 
    1818%NCDF_LIB -L$NETCDF/lib -lnetcdf -lnetcdff 
     19%CPP                 cpp 
    1920%FC ifort 
    2021%FCFLAGS -r8 -O3 -xHost -fp-model source -traceback 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm

    r4494 r4921  
    4141%XIOS_INC            -I/users/home/ans040/SOFTWARE/XIOS_athena/trunk/inc 
    4242%XIOS_LIB            -L/users/home/ans040/SOFTWARE/XIOS_athena/trunk/lib -lxios 
     43%CPP                 cpp 
    4344%FC                  mpiifort 
    4445%FCFLAGS         -g -r8 -O3 -xHost -fp-model source -traceback 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm

    r4277 r4921  
    2020%XIOS_ROOT           /home/delrosso/XIOS_447/trunk 
    2121%MPI_INTEL           -I/srv/intel/impi/4.1.0.024/include 
     22%CPP                 cpp 
    2223%FC                  mpiifort 
    2324%FCFLAGS             -r8 -O3 -g -traceback  

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm

    r4306 r4921  
    4242%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    4343 
     44%CPP               cpp 
    4445%FC                  ifort 
    4546%FCFLAGS             -r8 -O3 -fp-model precise -xT -ip -vec-report0 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm

    r4148 r4921  
    3535 
    3636%XLF90_LIB           -lxlf90_r 
     37 
     38%CPP               cpp 
    3739%FC                  mpxlf90_r 
    3840%FCFLAGS             -qsuffix=f=f90 -qsuffix=cpp=F90 -qfree=f90 -O3 -qrealsize=8 -qarch=auto -qtune=auto -qinitauto 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-PW7_METO.fcm

    r4377 r4921  
    2121%XIOS_INC            -I/data/nwp/ofrd/share/NEMO/xios_lib/seq/xios_r451/inc 
    2222%XIOS_LIB            -L/data/nwp/ofrd/share/NEMO/xios_lib/seq/xios_r451/lib -lxios 
     23%CPP               cpp 
    2324%FC                  mpxlf90_r 
    2425%FCFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF 
    25 %FFLAGS              -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF 
     26%FFLAGS              -qrealsize=8 -qextname -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF -qfixed 
    2627%LD                  mpCC_r 
    2728%LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-X64_CURIE.fcm

    r4153 r4921  
    4141%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    4242 
     43%CPP               cpp 
    4344%FC                  mpif90 -c -cpp 
    4445# for Curie Fat Node 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm

    r4624 r4921  
    4646%OASIS_LIB            
    4747 
     48%CPP               cpp 
    4849%FC                  mpif90 -c -cpp 
    4950%FCFLAGS             -i4 -r8 -O3 -fp-model source -xAVX 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-X64_VAYU.fcm

    r4148 r4921  
    4141%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    4242 
     43%CPP               cpp 
    4344%FC                  mpif90 -c -cpp 
    4445%FCFLAGS             -i4 -r8 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm

    r4153 r4921  
    4141%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    4242 
     43%CPP               cpp 
    4344%FC                  mpif90 -c -cpp 
    4445%FCFLAGS            -i4 -r8 -O3 -fp-model precise -xAVX 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-XC_ARCHER.fcm

    r4624 r4921  
    4141#OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    4242 
     43%CPP               cpp 
    4344%FC                  ftn 
    4445#FCFLAGS             -em -s integer32 -s real64 -O3 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-macport_osx.fcm

    r4148 r4921  
    5050%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    5151 
     52%CPP               cpp-mp-4.8 
    5253%FC                mpif90  
    5354%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer  

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm

    r4524 r4921  
    1919%NCDF_LIB            -L$NETCDF_LIB -lnetcdff -lnetcdf -L$HDF5_LIB -lhdf5_hl -lhdf5 -lz 
    2020 
     21%CPP               cpp 
    2122%FC                  mpif90 
    2223%FCFLAGS             -O2 -fp-model precise  -traceback -r8  -convert big_endian -assume byterecl 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/ARCH/arch-x3750_ADA.fcm

    r4148 r4921  
    4141%OASIS_LIB           -L%OASIS_HOME/lib -lpsmile.MPI1 -lmct -lmpeu -lscrip 
    4242 
     43%CPP               cpp 
    4344%FC                  mpiifort -c -cpp 
    4445%FCFLAGS             -DCPP_PARA -i4 -r8 -O3 -xAVX -fp-model precise 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml

    r4343 r4921  
    8585   </file> 
    8686    
    87    <file id="file8" name_suffix="_icemod" description="ice variables" > 
    88      <field field_ref="ice_pres"                     /> 
    89      <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
    90      <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
    91      <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
    92      <field field_ref="ist_ipa"      /> 
    93      <field field_ref="ioceflxb"     /> 
    94      <field field_ref="uice_ipa"     /> 
    95      <field field_ref="vice_ipa"     /> 
    96      <field field_ref="utau_ice"     /> 
    97      <field field_ref="vtau_ice"     /> 
    98      <field field_ref="qsr_io_cea"   /> 
    99      <field field_ref="qns_io_cea"   /> 
    100      <field field_ref="snowpre"      /> 
    101    </file> 
    102     
    10387      </file_group> 
    10488 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r4493 r4921  
    1414   cn_ocerst_in   = "amm12_restart_oce"   !  suffix of ocean restart name (input) 
    1515   cn_ocerst_out  = "restart_oce_out"   !  suffix of ocean restart name (input) 
    16    nn_istate   =       1   !  output the initial state (1) or not (0) 
    1716   nn_stock    =    1296   !  frequency of creation of a restart file (modulo referenced to 1) 
    1817   nn_write    =     144   !  frequency of write in the output file   (modulo referenced to nit000)  

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/C1D_PAPA/EXP00/iodef.xml

    r4158 r4921  
    2121    --> 
    2222     
    23     <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4"> 
     23    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4"> 
    2424     
    2525      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r4370 r4921  
    77   cn_exp      =  "PAPA"   !  experience name 
    88   nn_it000    =       1   !  first time step 
    9    nn_itend    =   78840   !  last  time step 
     9   nn_itend    =   87600   !  last  time step 
    1010   nn_date0    =  20100615 !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 
    1111   nn_leapy    =       1   !  Leap year calendar (1) or not (0) 
    12    nn_stock    =   78840   !  frequency of creation of a restart file (modulo referenced to 1) 
    13    nn_write    =      60   !  frequency of write in the output file   (modulo referenced to nn_it000) 
     12   nn_stock    =   87600   !  frequency of creation of a restart file (modulo referenced to 1) 
     13   nn_write    =     240   !  frequency of write in the output file   (modulo referenced to nn_it000) 
    1414/ 
    1515!----------------------------------------------------------------------- 
    … …  
    3838&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3939!----------------------------------------------------------------------- 
     40   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file 
    4041   rn_bathy    = 4198.     !  value of the bathymetry. if (=0) bottom flat at jpkm1 
    41    nn_msh      =    3      !  create (=1) a mesh file or not (=0) 
    42    rn_rdt      =  400.     !  time step for the dynamics (and tracer if nn_acc=0) 
     42   nn_msh      =    0      !  create (=1) a mesh file or not (=0) 
     43   rn_rdt      =  360.     !  time step for the dynamics (and tracer if nn_acc=0) 
    4344   rn_rdtmin   =  360.           !  minimum time step on tracers (used if nn_acc=1) 
    4445   rn_rdtmax   =  360.           !  maximum time step on tracers (used if nn_acc=1) 
    … …  
    7273/ 
    7374!----------------------------------------------------------------------- 
     75&namc1d        !   1D configuration options                             ("key_c1d") 
     76!----------------------------------------------------------------------- 
     77   ln_c1d_locpt= .false.   ! Localization of 1D config in a grid (T) or independant point (F) 
     78/ 
     79!----------------------------------------------------------------------- 
    7480&namtsd    !   data : Temperature  & Salinity 
    7581!----------------------------------------------------------------------- 
    … …  
    8187   cn_dir        = './'     !  root directory for the location of the runoff files 
    8288   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
    83    ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     89   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
    8490/ 
    8591!----------------------------------------------------------------------- 
    … …  
    112118!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    113119!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    114    sn_wndi     = 'forcing_PAPASTATION' ,         1         , 'wndwe'   ,   .true.     , .false. , 'yearly' , '' , '', '' 
    115    sn_wndj     = 'forcing_PAPASTATION' ,         1         , 'wndsn'   ,   .true.     , .false. , 'yearly' , '' , '', '' 
    116    sn_qsr      = 'forcing_PAPASTATION' ,         1         , 'qsr'     ,   .false.    , .false. , 'yearly' , '' , '', '' 
    117    sn_qlw      = 'forcing_PAPASTATION' ,         1         , 'qlw'     ,   .false.    , .false. , 'yearly' , '' , '', '' 
    118    sn_tair     = 'forcing_PAPASTATION' ,         1         , 'tair'    ,   .true.     , .false. , 'yearly' , '' , '', '' 
    119    sn_humi     = 'forcing_PAPASTATION' ,         1         , 'humi'    ,   .true.     , .false. , 'yearly' , '' , '', '' 
    120    sn_prec     = 'forcing_PAPASTATION' ,         1         , 'prec'    ,   .false.    , .false. , 'yearly' , '' , '', '' 
    121    sn_snow     = 'forcing_PAPASTATION' ,         1         , 'snow'    ,   .false.    , .false. , 'yearly' , '' , '', '' 
     120   sn_wndi     = 'forcing_PAPASTATION_1h' ,         1         , 'wndwe'   ,   .true.     , .false. , 'yearly' , '' , '', '' 
     121   sn_wndj     = 'forcing_PAPASTATION_1h' ,         1         , 'wndsn'   ,   .true.     , .false. , 'yearly' , '' , '', '' 
     122   sn_qsr      = 'forcing_PAPASTATION_1h' ,         1         , 'qsr'     ,   .false.    , .false. , 'yearly' , '' , '', '' 
     123   sn_qlw      = 'forcing_PAPASTATION_1h' ,         1         , 'qlw'     ,   .false.    , .false. , 'yearly' , '' , '', '' 
     124   sn_tair     = 'forcing_PAPASTATION_1h' ,         1         , 'tair'    ,   .true.     , .false. , 'yearly' , '' , '', '' 
     125   sn_humi     = 'forcing_PAPASTATION_1h' ,         1         , 'humi'    ,   .true.     , .false. , 'yearly' , '' , '', '' 
     126   sn_prec     = 'forcing_PAPASTATION_1h' ,         1         , 'prec'    ,   .false.    , .false. , 'yearly' , '' , '', '' 
     127   sn_snow     = 'forcing_PAPASTATION_1h' ,         1         , 'snow'    ,   .false.    , .false. , 'yearly' , '' , '', '' 
    122128   ln_2m         = .true.    !  air temperature and humidity referenced at 2m (T) instead 10m (F) 
    123129/ 
    … …  
    225231&namtra_ldf    !   lateral diffusion scheme for tracers 
    226232!---------------------------------------------------------------------------------- 
     233!---------------------------------------------------------------------------------- 
     234   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T) 
     235   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp") 
    227236   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s] 
    228237   rn_aht_0         =     0.    !  horizontal eddy diffusivity for tracers [m2/s] 
    … …  
    244253/ 
    245254!----------------------------------------------------------------------- 
     255&namc1d_uvd    !   data: U & V currents                                 ("key_c1d") 
     256!----------------------------------------------------------------------- 
     257/ 
     258!----------------------------------------------------------------------- 
    246259&namdyn_hpg    !   Hydrostatic pressure gradient option 
    247260!----------------------------------------------------------------------- 
    … …  
    258271&namzdf        !   vertical physics 
    259272!----------------------------------------------------------------------- 
    260    rn_avm0     =   5.0e-6  !rbb 1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst") 
    261    rn_avt0     =   5.0e-6  !rbb 1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst") 
     273!   rn_avm0     =   5.0e-6  !rbb 1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst") 
     274!   rn_avt0     =   5.0e-6  !rbb 1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst") 
    262275   ln_zdfevd   = .false. !rbb .true.    !  enhanced vertical diffusion (evd) (T) or not (F) 
    263276/ 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/C1D_PAPA/cpp_C1D_PAPA.fcm

    r4247 r4921  
    1  bld::tool::fppkeys key_c1d key_dynspg_flt key_diahth key_zdfgls key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_c1d key_zdfgls 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml

    r4272 r4921  
    8282     <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
    8383     <field field_ref="ist_ipa"      /> 
    84      <field field_ref="ioceflxb"     /> 
    8584     <field field_ref="uice_ipa"     /> 
    8685     <field field_ref="vice_ipa"     /> 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README

    r4394 r4921  
    2424 
    2525 
    26  
    27  
     26#---------------------------------------------------------------------- 
     27# HOW TO USE  
     28#---------------------------------------------------------------------- 
     29./std_main.sh -plot -pdf 
     30or 
     31./std_main.sh -ts -pdf 
    2832 
    2933 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceFrac.pro

    r4559 r4921  
    2121   
    2222  IF keyword_set(arc) THEN BEGIN  
    23     domdef, 20, 380, 50, 90 
     23    domdef, 20, 380, 40, 90 
    2424    map = [90, 0, 0] 
    2525  ENDIF 
    2626  IF keyword_set(ant) THEN BEGIN  
    27     domdef, 20, 380, -90, -50 
     27    domdef, 20, 380, -90, -40 
    2828    map = [-90, 0, 0] 
    2929  ENDIF 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_all.pro

    r4559 r4921  
    172172  Ithi_april_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(april)],nxt,nyt,cnt), 3), unit:Ithi_1.unit} 
    173173  jan = where(mm EQ 1, cnt) 
     174  Ithi_jan_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_1.unit}  
    174175  sept = where(mm EQ 9, cnt) 
    175   Ithi_jan_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(jan)],nxt,nyt,cnt), 3), unit:Ithi_1.unit}  
    176176  Ithi_sept_1 = {arr:1./float(cnt) * total(reform(Ithi_1.arr[*, *, temporary(sept)],nxt,nyt,cnt), 3), unit:Ithi_1.unit}  
    177177  undefine, Ithi_1 
    … …  
    288288     Isal_sept_2 = {arr:-1} 
    289289   ENDELSE 
    290 ; 
     290 
    291291  IvelU_1 = read_ncdf(getenv('VAR1_IvelU'), allrecords = allrec, filename = std_file1_I )  
    292292  IvelV_1 = read_ncdf(getenv('VAR1_IvelV'), allrecords = allrec, filename = std_file1_I )  
    … …  
    335335    Ivelo_sept_2 = {arr:-1} 
    336336  ENDELSE 
    337 ; 
     337 
    338338  Iage_1 = read_ncdf(getenv('VAR1_Iage'), allrecords = allrec, filename = std_file1_I )  
    339339  caldat, time, mm 
    … …  
    396396  cnt = cnt+1   &   blabla = 'Erp salinity damping term' 
    397397  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_erp, ERP1, ERP2, _extra = ex 
    398 ; 
     398;; 
    399399  cnt = cnt+1   &   blabla = 'Evaporation - Precipitation - Runoff term' 
    400400  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_emp, EMP1, EMP2, _extra = ex 
    … …  
    439439  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_mld, MLD1, MLD2, MLD, _extra = ex 
    440440; 
     441  cnt = cnt+1   &   blabla = 'Mixed layer depth ortho plan ARCTIC' 
     442  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_MLD_ortho, MLD1, MLD2, /ARC, _extra = ex 
     443;sf 
     444  cnt = cnt+1   &   blabla = 'Mixed layer depth ortho plan ANTARTIC' 
     445  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_MLD_ortho, MLD1, MLD2, /ANT, _extra = ex 
     446;sf 
    441447  cnt = cnt+1   &   blabla = 'Zonal mean Mixed layer depth' 
    442448  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_ZonMld, MLD1, MLD2, MLD, _extra = ex 
    … …  
    564570  cnt = cnt+1   &   blabla = 'Antartic Ice Velocity: SEPT' 
    565571  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceVel, IvelU_sept_1, IvelU_sept_2, IvelV_sept_1, IvelV_sept_2, Ivelo_sept_1, Ivelo_sept_2, /ANT,  /SEPT, _extra = ex 
    566 ; 
     572 
    567573  cnt = cnt+1   &   blabla = 'Arctic Ice Age: MARCH' 
    568574  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceAge, Iage_march_1, Iage_march_2, Ifra_march_1, Ifra_march_2, /ARC, /MARCH, _extra = ex 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh

    r4562 r4921  
    2121#idl_command=idl71 
    2222# 
    23 PS_DIR=$( pwd )/OR2LPv36_ps_plot 
    24 PDF_DIR=$( pwd )/OR2LPv36_pdf_plot 
     23PS_DIR=$( pwd )/p4H25a50-testht_ps_plot 
     24PDF_DIR=$( pwd )/p4H25a50-testht_pdf_plot 
    2525HTML_DIR=$( pwd )/html_plot 
    2626SAXO_DIR=/Users/sflod/SAXO_DIR 
    2727# 
    28 DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/500y_pisces     # path of data in NetCDF format 
     28DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format 
    2929DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data 
    3030DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins) 
    … …  
    5454# 
    5555#===================== EXP1 ===================== 
    56 # 23610101_23701231 
    57 FILE1_T=OR2LPv36_23610101_23701231_1Y_grid_T.nc   # exp1 grid T input file 
    58 FILE1_U=OR2LPv36_23610101_23701231_1Y_grid_U.nc   # exp1 grid U input file 
    59 FILE1_V=OR2LPv36_23610101_23701231_1Y_grid_V.nc   # exp1 grid V input file 
    60 FILE1_I=OR2LPv36_23610101_23701231_1M_icemod.nc   # exp1 ice    input file 
     56# 
     57FILE1_T=p4H25a50_20410101_20501231_1Y_grid_T.nc   # exp1 grid T input file 
     58FILE1_U=p4H25a50_20410101_20501231_1Y_grid_U.nc   # exp1 grid U input file 
     59FILE1_V=p4H25a50_20410101_20501231_1Y_grid_V.nc   # exp1 grid V input file 
     60FILE1_I=p4H25a50_20410101_20501231_1M_icemod.nc   # exp1 ice    input file 
    6161VAR1_T=thetao 
    6262VAR1_S=so         
    63 VAR1_QNET=tohfls 
    64 VAR1_ERP=sowafldp       
     63VAR1_QNET=qt 
     64VAR1_ERP=wfcorr 
    6565VAR1_EMP=wfo 
    6666VAR1_MLD=mldr10_1 
    6767VAR1_U=uocetr_eff 
    6868VAR1_V=vocetr_eff 
    69 VAR1_Ithick=iicethic 
    70 VAR1_Ifrac=soicecov 
    71 VAR1_Isnow=isnowthi 
    72 #VAR1_Isal=sisali 
    73 #VAR1_Iage=siages 
    74 VAR1_IvelU=iicevelu 
    75 VAR1_IvelV=iicevelv 
    76 #VAR1_Ivelo=sivelo 
     69VAR1_Ithick=sithic 
     70VAR1_Ifrac=siconc 
     71VAR1_Isnow=snvolu 
     72VAR1_Isal=sisali 
     73VAR1_Iage=siages 
     74VAR1_IvelU=sivelu 
     75VAR1_IvelV=sivelv 
     76VAR1_Ivelo=sivelo 
    7777# 
    7878#===================== EXP2 ===================== 
    7979# 
    80 FILE2_T=OR2LPv36_23610101_23701231_1Y_grid_T.nc   # exp1 grid T input file 
    81 FILE2_U=OR2LPv36_23610101_23701231_1Y_grid_U.nc   # exp1 grid U input file 
    82 FILE2_V=OR2LPv36_23610101_23701231_1Y_grid_V.nc   # exp1 grid V input file 
    83 FILE2_I=OR2LPv36_23610101_23701231_1M_icemod.nc   # exp1 ice    input file 
     80FILE2_T=testht_20410101_20501231_1Y_grid_T.nc   # exp1 grid T input file 
     81FILE2_U=testht_20410101_20501231_1Y_grid_U.nc   # exp1 grid U input file 
     82FILE2_V=testht_20410101_20501231_1Y_grid_V.nc   # exp1 grid V input file 
     83FILE2_I=testht_20410101_20501231_1M_icemod.nc   # exp1 ice    input file 
    8484VAR2_T=thetao 
    8585VAR2_S=so 
    86 VAR2_QNET=tohfls 
    87 VAR2_ERP=sowafldp 
     86VAR2_QNET=qt 
     87VAR2_ERP=wfcorr 
    8888VAR2_EMP=wfo 
    8989VAR2_MLD=mldr10_1 
    9090VAR2_U=uocetr_eff 
    9191VAR2_V=vocetr_eff 
    92 VAR2_Ithick=iicethic 
    93 VAR2_Ifrac=soicecov 
    94 VAR2_Isnow=isnowthi 
    95 #VAR2_Isal=sisali 
    96 #VAR2_Iage=siages 
    97 VAR2_IvelU=iicevelu 
    98 VAR2_IvelV=iicevelv 
    99 #VAR2_Ivelo=sivelo 
     92VAR2_Ithick=sithic 
     93VAR2_Ifrac=siconc 
     94VAR2_Isnow=snvolu 
     95VAR2_Isal=sisali 
     96VAR2_Iage=siages 
     97VAR2_IvelU=sivelu 
     98VAR2_IvelV=sivelv 
     99VAR2_Ivelo=sivelo 
    100100# 
    101101######################### Export Variables ############################### 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh.old_names

    r4559 r4921  
    7474VAR1_IvelU=iicevelu 
    7575VAR1_IvelV=iicevelv 
    76 VAR1_Ivelo=iicevelo 
     76#VAR1_Ivelo=iicevelo 
    7777# 
    7878#===================== EXP2 ===================== 
    … …  
    9999VAR2_IvelU=iicevelu 
    100100VAR2_IvelV=iicevelv 
    101 VAR2_Ivelo=iicevelo 
     101#VAR2_Ivelo=iicevelo 
    102102# 
    103103######################### Export Variables ############################### 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_ICE.pro

    r4497 r4921  
    8888  ICE_S_15 = {arr:ICE_S_15 * 1.e-12, unit : '10^12 m^2'} 
    8989  ; 
    90   title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)' 
     90  ;;title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)' 
     91  title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (DASHED) '+'!C'+ 'and Extend minus 15% (CONTINUOUS)' 
    9192  jpt=12 
    9293  time=julday(1,15,1900)+30*lindgen(12) 
    93   pltt, ICE_N, 't', MIN = 4., MAX = 16., /REMPLI, /PORTRAIT, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $ 
     94  pltt, ICE_N, 't', MIN = 4., MAX = 16., /REMPLI, /PORTRAIT, LINESTYLE=2, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $ 
    9495       , COLOR = 000 , small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    95   pltt, ICE_N_15, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $       ;;; dashed lines is LINESTYLE=2  $ 
     96  pltt, ICE_N_15, 't', /REMPLI, /PORTRAIT $       ;;; dashed lines is LINESTYLE=2  $ 
    9697        , /ov1d, COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  
    97   pltt, vICE_area_NH, 't',  /REMPLI, /PORTRAIT  $  
     98  pltt, vICE_area_NH, 't',  /REMPLI, /PORTRAIT, LINESTYLE=2  $  
    9899        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    99   pltt, vICE_ext_NH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $   ;;; dashed lines is LINESTYLE=2  $ 
     100  pltt, vICE_ext_NH, 't', /REMPLI, /PORTRAIT $   ;;; dashed lines is LINESTYLE=2  $ 
    100101        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    101102; 
    102   title = 'Southern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)' 
    103   pltt, ICE_S, 't', MIN = 0., MAX = 20., /REMPLI, /NOERASE , XGRIDSTYLE = 1 , DATE_FORMAT = '%M' $ 
     103  title = 'Southern Hemisphere'+'!C'+prefix+' (BLACK) '+d1_d2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (DASHED) '+'!C'+ 'and Extend minus 15% (CONTINUOUS)' 
     104  pltt, ICE_S, 't', MIN = 0., MAX = 20., /REMPLI, LINESTYLE=2, /NOERASE , XGRIDSTYLE = 1 , DATE_FORMAT = '%M' $ 
    104105        ,COLOR = 000, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    105   pltt, ICE_S_15, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $  
     106  pltt, ICE_S_15, 't', /REMPLI, /PORTRAIT $  
    106107        , /ov1d, COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  
    107   pltt,  vICE_area_SH, 't', /REMPLI, /PORTRAIT  $  
     108  pltt,  vICE_area_SH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2  $  
    108109         , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    109   pltt,  vICE_ext_SH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $  
     110  pltt,  vICE_ext_SH, 't', /REMPLI, /PORTRAIT $  
    110111        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    111112; 
    … …  
    159160 
    160161 
    161   title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)' 
     162  ;;title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (CONTINUOUS) '+'!C'+ 'and Extend minus 15% (DASHED)' 
     163  title = 'Northern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+' Global Annual Mean Ice Area (DASHED) '+'!C'+ 'and Extend minus 15% (CONTINUOUS)' 
    162164  jpt=12 
    163165  time=julday(1,15,1900)+30*lindgen(12) 
    164   pltt, ICE_N, 't', MIN = 4, MAX = 16,  /REMPLI, /PORTRAIT, XGRIDSTYLE = 1, window = 2, DATE_FORMAT = '%M' $ 
     166  pltt, ICE_N, 't', MIN = 4, MAX = 16,  /REMPLI, /PORTRAIT, LINESTYLE=2, XGRIDSTYLE = 1, window = 2, DATE_FORMAT = '%M' $ 
    165167        , COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex ; BLACK 
    166   pltt, ICE_N2, 't', /REMPLI, /PORTRAIT $ 
     168  pltt, ICE_N2, 't', /REMPLI, /PORTRAIT , LINESTYLE=2 $ 
    167169        , /ov1d, COLOR = 250, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  ; RED 
    168   pltt, ICE_N_15, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $ ; linee tratteggiate LINESTYLE=2  $ 
     170  pltt, ICE_N_15, 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $ 
    169171        , /ov1d, COLOR = 000, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  
    170   pltt, ICE_N2_15, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $ ; linee tratteggiate LINESTYLE=2  $ 
     172  pltt, ICE_N2_15, 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $ 
    171173        , /ov1d, COLOR = 250, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    172   pltt, vICE_area_NH, 't', /REMPLI, /PORTRAIT  $  
     174  pltt, vICE_area_NH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2  $  
    173175        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  ; light blue 
    174   pltt, vICE_ext_NH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $  
     176  pltt, vICE_ext_NH, 't', /REMPLI, /PORTRAIT $  
    175177        , /ov1d, COLOR = 100, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex  ; blu scuro 
    176178; 
    177   title ='Southern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+'Global Annual Mean Ice Area (CONTINUS)'+'!C'+ 'and Extend minus 15% (DASHED)' 
     179  title ='Southern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'OBSERVATION (light blue) '+'!C'+'Global Annual Mean Ice Area (DASHED)'+'!C'+ 'and Extend minus 15% (CONTINUOUS)' 
    178180;  title ='Southern Hemisphere'+'!C' 
    179   pltt, ICE_S, 't', MIN = 0., MAX = 20.,  /REMPLI, /NOERASE, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $ 
     181  pltt, ICE_S, 't', MIN = 0., MAX = 20., /REMPLI, LINESTYLE=2, /NOERASE, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $ 
    180182         , COLOR = 000, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    181   pltt, ICE_S2, 't', /REMPLI, /NOERASE $ 
     183  pltt, ICE_S2, 't', /REMPLI, /NOERASE, LINESTYLE=2 $ 
    182184        , /ov1d, COLOR = 250, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    183   pltt, ICE_S_15 , 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $ ; linee tratteggiate LINESTYLE=2  $ 
     185  pltt, ICE_S_15 , 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $ 
    184186        , /ov1d, COLOR = 000, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    185   pltt, ICE_S2_15, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $ ; linee tratteggiate LINESTYLE=2  $ 
     187  pltt, ICE_S2_15, 't', /REMPLI, /PORTRAIT $ ; linee tratteggiate LINESTYLE=2  $ 
    186188        , /ov1d, COLOR = 250, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    187   pltt,  vICE_area_SH, 't', /REMPLI, /PORTRAIT $  
     189  pltt,  vICE_area_SH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $  
    188190          , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    189   pltt,  vICE_ext_SH, 't', /REMPLI, /PORTRAIT, LINESTYLE=2 $  
     191  pltt,  vICE_ext_SH, 't', /REMPLI, /PORTRAIT $  
    190192        , /ov1d, COLOR = 100, small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex 
    191193; 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_ICE_FRAM.pro

    r4514 r4921  
    55arr2d = arr2d[t1:t2] 
    66arr2d = reform(arr2d,12,nyear) ; put in 2D array 
    7 arr2d = total(arr2d,2)/nyear ; total over 2th dimension (i.e.years) 
     7;arr2d = total(arr2d,2)/nyear ; total over 2th dimension (i.e.years) 
     8arr2d = arr2d[*, nyear-1] ;  select last year 
    89 
    910return, arr2d 
    … …  
    3435; 
    3536  d1_d2 = '('+strtrim(date1, 1)+' - '+strtrim(date2, 1)+')' 
     37  d2 = '('+strtrim(date2, 1)+')' 
    3638; 
    3739  iodir = std_iodir_data 
    … …  
    7476  ;; AREA 
    7577  ICE_area_export = reform(ICE_area_export, 12, nyr) 
    76   ICE_area_export = total(ICE_area_export,2)/nyr 
     78  ;ICE_area_export = total(ICE_area_export,2)/nyr  ; old version monthly mean average  over all years 
     79  ICE_area_export = ICE_area_export[*,nyr-1]  ; dim= 12, index 0-11; last year choosen 
    7780  ; ICE_area_export = {arr:ICE_area_export * 1.e-12 * 86400 * 365 , unit : '10^6 Km^2/year'}  ; annual mean 
    7881  ICE_area_export = {arr:ICE_area_export * 1.e-12 * 86400 * 30 , unit : '10^6 Km^2/month'}    ; monthly mean 
    … …  
    8083  ; 
    8184  ICE_vol_export = reform(ICE_vol_export, 12, nyr) 
    82   ICE_vol_export = total(ICE_vol_export,2)/nyr 
     85  ;ICE_vol_export = total(ICE_vol_export,2)/nyr 
     86  ICE_vol_export = ICE_vol_export[*,nyr-1] 
    8387  ; ICE_vol_export = {arr:ICE_vol_export * 1.e-9 * 86400 * 365 , unit : '10^3 Km^3/year'}      ; annual mean 
    8488  ICE_vol_export = {arr:ICE_vol_export * 1.e-9 * 86400 * 30 , unit : '10^3 Km^3/month'}      ; monthly mean 
    8589 
    8690  ; 
    87   title = 'Fram Strait Areal Export'+'!C'+prefix+' '+d1_d2 
     91  ;title = 'Fram Strait Areal Export: LAST YEAR'+'!C'+prefix+' '+d1_d2 
     92  title = 'Fram Strait Areal Export: LAST YEAR'+'!C'+prefix+' '+d2 
    8893  jpt=12 
    8994  time=julday(1,15,1900)+30*lindgen(12) 
    … …  
    99104  xyouts, julday(7,15,1900), 0.41, 'Data from Kwok et al.(2004), 1979-2002 ', ALIGN = 0, CHARTHICK = 2, CHARSIZE=0.8, COLOR=2 
    100105  ; 
    101   title = 'Fram Strait Volume Export'+'!C'+prefix+' '+d1_d2 
     106  ;title = 'Fram Strait Volume Export LAST YEAR'+'!C'+prefix+' '+d1_d2 
     107  title = 'Fram Strait Volume Export LAST YEAR'+'!C'+prefix+' '+d2 
    102108  pltt, ICE_vol_export, 't',  /REMPLI, MIN = 60., MAX = 500. , /NOERASE, XGRIDSTYLE = 1 $ 
    103109       , small = [1, 2, 2], YTITLE = '10^3 Km^3/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex 
    … …  
    118124 
    119125    d1_d2_2 = '('+strtrim(date1_2, 1)+' - '+strtrim(date2_2, 1)+')' 
     126    d2_2 = '('+strtrim(date2_2, 1)+')' 
    120127    tsave = time 
    121128    domdef, indx1, indx2, indy1, indy2, /xindex, /yindex,/memeindices 
    … …  
    140147    ;; AREA 
    141148    ICE_area_export_2 = reform(ICE_area_export_2, 12, nyr) 
    142     ICE_area_export_2 = total(ICE_area_export_2,2)/nyr 
     149    ;ICE_area_export_2 = total(ICE_area_export_2,2)/nyr 
     150    ICE_area_export_2 = ICE_area_export_2[*,nyr-1] 
    143151    ; ICE_area_export_2 = {arr:ICE_area_export_2 * 1.e-12 * 86400 * 365 , unit : '10^6 Km^2/year'}   ; annual mean 
    144152    ICE_area_export_2 = {arr:ICE_area_export_2 * 1.e-12 * 86400 * 30 , unit : '10^6 Km^2/month'}     ; monthly mean 
    145153    ; 
    146154    ICE_vol_export_2 = reform(ICE_vol_export_2, 12, nyr) 
    147     ICE_vol_export_2 = total(ICE_vol_export_2,2)/nyr 
     155    ;ICE_vol_export_2 = total(ICE_vol_export_2,2)/nyr 
     156    ICE_vol_export_2 = ICE_vol_export_2[*,nyr-1] 
    148157    ; ICE_vol_export_2 = {arr:ICE_vol_export_2 * 1.e-12 * 86400 * 365 , unit : '10^3 Km^3/year'}     ; annual mean 
    149158    ICE_vol_export_2 = {arr:ICE_vol_export_2 * 1.e-9 * 86400 * 30 , unit : '10^3 Km^3/month'}       ; monthly mean 
    … …  
    152161    if KEYWORD_SET(postscript) then openps, filename+'_2.ps', portrait = 1 
    153162 
    154     title = 'Fram Strait Areal Export'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 
     163    ;title = 'Fram Strait Areal Export'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 
     164    title = 'Fram Strait Areal Export LAST YEAR'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d2_2 
    155165    jpt=12 
    156166    time=julday(1,15,1900)+30*lindgen(12) 
    … …  
    170180    xyouts, julday(7,15,1900), 0.41, 'Data from Kwok et al.(2004), 1979-2002 ', ALIGN = 0, CHARTHICK = 2, CHARSIZE=0.8, COLOR=2 
    171181    ; 
    172     title = 'Fram Strait Volume Export'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 
     182    ;title = 'Fram Strait Volume Export'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2 
     183    title = 'Fram Strait Volume Export LAST YEAR'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d2_2 
    173184    pltt, ICE_vol_export, 't', /REMPLI,  MIN = 60., MAX = 500., /NOERASE, XGRIDSTYLE = 1 $ 
    174185        , small = [1, 2, 2], YTITLE = '10^3 Km^3/month', TITLE = title, DATE_FORMAT = '%M', _extra = ex 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_ICE_Vol.pro

    r4504 r4921  
    7070; 
    7171  title ='Southern Hemisphere' +'!C'+prefix+' '+d1_d2+' - '+'!C'+'Global Annual Mean Ice Volume (BLACK)' 
    72   pltt, ICE_vol_S, 't', MIN = 0., MAX = 11000., /REMPLI, /NOERASE, XGRIDSTYLE = 1 , DATE_FORMAT = '%M' $ 
     72  pltt, ICE_vol_S, 't', MIN = 0., MAX = 12000., /REMPLI, /NOERASE, XGRIDSTYLE = 1 , DATE_FORMAT = '%M' $ 
    7373        , small = [1, 2, 2], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex 
    7474; 
    … …  
    119119    ; 
    120120    title = 'Southern Hemisphere'+'!C'+prefix+' (BLACK) - '+prefix2+' (RED) '+d1_d2_2+'!C'+'Global Annual Mean Ice Volume' 
    121     pltt, ICE_vol_S, 't', MIN = 0., MAX = 11000., /REMPLI, /NOERASE, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $ 
     121    pltt, ICE_vol_S, 't', MIN = 0., MAX = 12000., /REMPLI, /NOERASE, XGRIDSTYLE = 1, DATE_FORMAT = '%M' $ 
    122122          , small = [1, 2, 2], YTITLE = '10^9 Km^3 ', TITLE = title, _extra = ex    
    123123    pltt, ICE_vol_S2, 't',  /REMPLI, /NOERASE $ 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_all.pro

    r4559 r4921  
    6060  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_SSH, masknp, POSTSCRIPT = postscript, _extra = ex 
    6161; 
    62   cnt = cnt+1   &   blabla = 'Global Mean Q net' 
    63   IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_Q, masknp, POSTSCRIPT = postscript, _extra = ex 
     62;;;;  cnt = cnt+1   &   blabla = 'Global Mean Q net' 
     63;;;;  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_Q, masknp, POSTSCRIPT = postscript, _extra = ex 
    6464; 
    6565  cnt = cnt+1   &   blabla = 'Global Mean EMP' 
    … …  
    7777  cnt = cnt+1   &   blabla = 'Sea-Ice Volume' 
    7878  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_Vol, masknp, POSTSCRIPT = postscript, _extra = ex 
    79 ; 
    80   cnt = cnt+1   &   blabla = 'ICE Velocity ' 
    81   IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_Vel, masknp, POSTSCRIPT = postscript, _extra = ex 
    82 ; 
     79;SF; and probably useless 
     80;SF  cnt = cnt+1   &   blabla = 'ICE Velocity ' 
     81;SF  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_Vel, masknp, POSTSCRIPT = postscript, _extra = ex 
     82;SF; 
    8383  cnt = cnt+1   &   blabla = 'Sea-Ice Volume Export at Fram Strait' 
    8484  IF doplot EQ cnt OR doplot EQ 0 THEN std_ts_ICE_FRAM, masknp, POSTSCRIPT = postscript, _extra = ex 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh

    r4559 r4921  
    1818idl_command=/Applications/itt/idl64/bin/idl 
    1919# 
    20 PS_DIR=$( pwd )/ts_heatbug_ps 
    21 PDF_DIR=$( pwd )/ts_heatbug_pdf 
     20PS_DIR=$( pwd )/ts_p4H25a50-testht_ps 
     21PDF_DIR=$( pwd )/ts_p4H25a50-testht_pdf 
    2222HTML_DIR=$( pwd )/html 
    2323SAXO_DIR=/Users/sflod/SAXO_DIR 
    2424# 
    25 DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada      # path of data in NetCDF format 
     25DIR_DATA=/Users/sflod/idl_PLOTS/DATA_STORE/RUN_CLIMATO/lim3_ada     # path of data in NetCDF format 
    2626DIR_CLIMATO=/Users/sflod/idl_PLOTS/CLIMATOLOGIES    # path of climatological data 
    2727DIR_MASK=/Users/sflod/idl_PLOTS/MASK  # path of mask files (ex: subbasins) 
    … …  
    5252READ_ONLY_FIRST_RECORD=0   # if 0 then read all records in files else read only the first reacord in each file 
    5353# 
    54 #DATE1=20010101   ;   DATE2=25001231 
    55 DATE1=20310101   ;   DATE2=20401231 
    56 #DATE1=00010101      ;   DATE2=00101231 
     54DATE1=20010101         ;   DATE2=20501231 
    5755# 
    58 VAR1_T=thetao        ;   V1T_PREF=heatbug       ;   V1T_SUFF=_1Y_grid_T.nc 
    59 VAR1_S=so            ;   V1S_PREF=heatbug      ;   V1S_SUFF=_1Y_grid_T.nc 
    60 VAR1_SSH=zos         ;   V1SSH_PREF=heatbug    ;   V1SSH_SUFF=_1Y_grid_T.nc 
    61 VAR1_Q=tohfls        ;   V1Q_PREF=heatbug      ;   V1Q_SUFF=_1Y_grid_T.nc 
    62 VAR1_EMP=wfo         ;   V1EMP_PREF=heatbug    ;   V1EMP_SUFF=_1Y_grid_T.nc 
    63 VAR1_U=uocetr_eff    ;   V1U_PREF=heatbug      ;   V1U_SUFF=_1Y_grid_U.nc 
    64 VAR1_V=vocetr_eff    ;   V1V_PREF=heatbug      ;   V1V_SUFF=_1Y_grid_V.nc 
    65 VAR1_ICE=siconc      ;   V1ICE_PREF=heatbug    ;   V1ICE_SUFF=_1M_icemod.nc 
    66 VAR1_Ithick=sithic   ;   V1It_PREF=heatbug     ;   V1It_SUFF=_1M_icemod.nc 
    67 VAR1_SNOW=sndept     ;   V1SNOW_PREF=heatbug   ;   V1SNOW_SUFF=_1M_icemod.nc 
    68 VAR1_IvelV=sivelv    ;   V1IvV_PREF=heatbug    ;   V1IvV_SUFF=_1M_icemod.nc 
    69 VAR1_Ivel=sivelo     ;   V1Iv_PREF=heatbug     ;   V1Iv_SUFF=_1M_icemod.nc 
     56VAR1_T=thetao          ;   V1T_PREF=p4H25a50      ;   V1T_SUFF=_1Y_grid_T.nc 
     57VAR1_S=so              ;   V1S_PREF=p4H25a50      ;   V1S_SUFF=_1Y_grid_T.nc 
     58VAR1_SSH=zos         ;   V1SSH_PREF=p4H25a50    ;   V1SSH_SUFF=_1Y_grid_T.nc 
     59##VAR1_Q=qt              ;   V1Q_PREF=p4H25a50      ;   V1Q_SUFF=_1Y_grid_T.nc 
     60VAR1_EMP=wfo         ;   V1EMP_PREF=p4H25a50    ;   V1EMP_SUFF=_1Y_grid_T.nc 
     61VAR1_U=uocetr_eff      ;   V1U_PREF=p4H25a50      ;   V1U_SUFF=_1Y_grid_U.nc 
     62VAR1_V=vocetr_eff      ;   V1V_PREF=p4H25a50      ;   V1V_SUFF=_1Y_grid_V.nc 
     63VAR1_ICE=siconc      ;   V1ICE_PREF=p4H25a50    ;   V1ICE_SUFF=_1M_icemod.nc 
     64VAR1_Ithick=sithic    ;   V1It_PREF=p4H25a50     ;   V1It_SUFF=_1M_icemod.nc 
     65VAR1_SNOW=snthic    ;   V1SNOW_PREF=p4H25a50   ;   V1SNOW_SUFF=_1M_icemod.nc 
     66VAR1_IvelV=sivelv    ;   V1IvV_PREF=p4H25a50    ;   V1IvV_SUFF=_1M_icemod.nc  
     67VAR1_Ivel=sivelo      ;   V1Iv_PREF=p4H25a50     ;   V1Iv_SUFF=_1M_icemod.nc 
    7068# 
    7169#===================== EXP2 ===================== 
    7270# 
    73 #DATE1_2=20010101   ;   DATE2_2=20101231 
    74 DATE1_2=20310101   ;   DATE2_2=20401231 
    75 #DATE1_2=20010101   ;   DATE2_2=25001231 
     71DATE1_2=20010101       ;   DATE2_2=20501231 
    7672# 
    77 VAR2_T=thetao      ;   V2T_PREF=heatbug      ;   V2T_SUFF=_1Y_grid_T.nc 
    78 VAR2_S=so          ;   V2S_PREF=heatbug      ;   V2S_SUFF=_1Y_grid_T.nc 
    79 VAR2_SSH=zos       ;   V2SSH_PREF=heatbug    ;   V2SSH_SUFF=_1Y_grid_T.nc 
    80 VAR2_Q=tohfls      ;   V2Q_PREF=heatbug      ;   V2Q_SUFF=_1Y_grid_T.nc 
    81 VAR2_EMP=wfo       ;   V2EMP_PREF=heatbug    ;   V2EMP_SUFF=_1Y_grid_T.nc 
    82 VAR2_U=uocetr_eff  ;   V2U_PREF=heatbug      ;   V2U_SUFF=_1Y_grid_U.nc 
    83 VAR2_V=vocetr_eff  ;   V2V_PREF=heatbug      ;   V2V_SUFF=_1Y_grid_V.nc 
    84 VAR2_ICE=siconc    ;   V2ICE_PREF=heatbug    ;   V2ICE_SUFF=_1M_icemod.nc 
    85 VAR2_Ithick=sithic ;   V2It_PREF=heatbug     ;   V2It_SUFF=_1M_icemod.nc 
    86 VAR2_SNOW=sndept   ;   V2SNOW_PREF=heatbug   ;   V2SNOW_SUFF=_1M_icemod.nc 
    87 VAR2_IvelV=sivelv  ;   V2IvV_PREF=heatbug    ;   V2IvV_SUFF=_1M_icemod.nc 
    88 VAR2_Ivel=sivelo   ;   V2Iv_PREF=heatbug     ;   V2Iv_SUFF=_1M_icemod.nc 
     73VAR2_T=thetao          ;   V2T_PREF=testht     ;   V2T_SUFF=_1Y_grid_T.nc 
     74VAR2_S=so           ;   V2S_PREF=testht     ;   V2S_SUFF=_1Y_grid_T.nc 
     75VAR2_SSH=zos         ;   V2SSH_PREF=testht   ;   V2SSH_SUFF=_1Y_grid_T.nc 
     76##VAR2_Q=qt            ;   V2Q_PREF=testht     ;   V2Q_SUFF=_1Y_grid_T.nc 
     77VAR2_EMP=wfo            ;   V2EMP_PREF=testht   ;   V2EMP_SUFF=_1Y_grid_T.nc 
     78VAR2_U=uocetr_eff      ;   V2U_PREF=testht     ;   V2U_SUFF=_1Y_grid_U.nc 
     79VAR2_V=vocetr_eff      ;   V2V_PREF=testht     ;   V2V_SUFF=_1Y_grid_V.nc 
     80VAR2_ICE=siconc         ;   V2ICE_PREF=testht   ;   V2ICE_SUFF=_1M_icemod.nc 
     81VAR2_Ithick=sithic       ;   V2It_PREF=testht    ;   V2It_SUFF=_1M_icemod.nc 
     82VAR2_SNOW=snthic       ;   V2SNOW_PREF=testht  ;   V2SNOW_SUFF=_1M_icemod.nc 
     83VAR2_IvelV=sivelv       ;   V2IvV_PREF=testht   ;   V2IvV_SUFF=_1M_icemod.nc  
     84VAR2_Ivel=sivelo        ;   V2IvV_PREF=testht   ;   V2IvV_SUFF=_1M_icemod.nc  
    8985# 
    9086######################### Export Variables ############################### 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml

    r4100 r4921  
    4747     <field field_ref="mldkz5"       /> 
    4848     <field field_ref="mldr10_1"     /> 
     49      <field field_ref="heatc"        name="heatc"    long_name="Heat content vertically integrated"            /> 
     50      <field field_ref="saltc"        name="saltc"    long_name="Salt content vertically integrated"            /> 
    4951   </file> 
    5052 
    5153   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    5254     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
    53      <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
    54      <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
    55      <field field_ref="saltflx"      name="sosflxdo"  /> 
     55     <field field_ref="qsr_oce"      name="qsr_oce"  long_name="downward shortwave flux at ocean surface"           /> 
     56     <field field_ref="qns_oce"      name="qns_oce"  long_name="downward non solar flux at ocean surface"           /> 
     57     <field field_ref="qt_oce"       name="qt_oce"   long_name="downward total flux at ocean surface"           /> 
     58     <field field_ref="qsr_ice"      name="qsr_ice"  long_name="downward shortwave flux at ice surface"           /> 
     59     <field field_ref="qns_ice"      name="qns_ice"  long_name="downward non solar flux at ice surface"           /> 
     60     <field field_ref="qtr_ice"      name="qtr_ice"  long_name="shortwave flux transmitted thru the ice"           /> 
     61     <field field_ref="qt_ice"       name="qt_ice"   long_name="downward total flux at ice surface"           /> 
     62     <field field_ref="saltflx"      name="sfx"  /> 
    5663     <field field_ref="taum"         name="taum" /> 
    57      <field field_ref="wspd"         name="sowindsp"  /> 
    58           <field field_ref="precip"       name="soprecip" /> 
     64     <field field_ref="wspd"         name="windsp"  /> 
     65      <field field_ref="precip"       name="precip" /> 
    5966     <!-- ice and snow --> 
    6067     <field field_ref="snowpre"      /> 
    61           <field field_ref="qsr_io"           name="iicesflx" /> 
    62           <field field_ref="qns_io"           name="iicenflx" /> 
    63           <field field_ref="utau_ice"         name="iicestru" /> 
    64           <field field_ref="vtau_ice"         name="iicestrv" /> 
     68      <field field_ref="utau_ice"         name="utau_ice" /> 
     69      <field field_ref="vtau_ice"         name="vtau_ice" /> 
    6570 
    6671   </file> 
    … …  
    7378     <field field_ref="u_masstr"     name="vozomatr"  /> 
    7479     <field field_ref="u_heattr"     name="sozohetr"  /> 
     80      <field field_ref="u_salttr"     name="sozosatr"  /> 
    7581   </file> 
    7682    
    … …  
    8288     <field field_ref="v_masstr"     name="vomematr"  /> 
    8389     <field field_ref="v_heattr"     name="somehetr"  /> 
     90      <field field_ref="v_salttr"     name="somesatr"  /> 
    8491   </file> 
    8592    
    … …  
    9097   </file> 
    9198 
    92    <file id="file6" name_suffix="_icemod" description="ice variables" > 
    93      <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
    94      <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
    95           <field field_ref="icevolu"      name="iicevolu" /> 
    96           <field field_ref="snowvol"      name="isnowvol" /> 
    97           <field field_ref="iceconc"      name="iiceconc"  /> 
    98  
    99           <field field_ref="icebopr"          name="iicebopr" /> 
    100           <field field_ref="icedypr"          name="iicedypr" /> 
    101           <field field_ref="ioceflxb"         name="ioceflxb" /> 
    102           <field field_ref="uice_ipa"         name="iicevelu" /> 
    103           <field field_ref="vice_ipa"         name="iicevelv" /> 
    104           <field field_ref="isst"             name="isstempe" /> 
    105           <field field_ref="isss"             name="isssalin" /> 
    106           <field field_ref="micesalt"         name="iicesali" /> 
    107           <field field_ref="miceage"          name="iiceages" /> 
    108           <field field_ref="icelapr"          name="iicelapr" /> 
    109           <field field_ref="icesipr"          name="iicesipr" /> 
    110           <field field_ref="micet"            name="iicetemp" /> 
    111           <field field_ref="icehc"            name="iiceheco" /> 
    112           <field field_ref="isnowhc"          name="isnoheco" /> 
    113           <field field_ref="icest"            name="iicesurt" /> 
    114           <field field_ref="sfxbri"            name="iicefsbr" /> 
    115           <field field_ref="sfxthd"            name="iicefseq" /> 
    116           <field field_ref="ibrinv"           name="ibrinvol" /> 
    117           <field field_ref="icecolf"          name="iicecolf" /> 
    118           <field field_ref="icestr"           name="iicestre" /> 
    119           <field field_ref="icevel"           name="iicevelo" /> 
    120           <field field_ref="isume"            name="iicesume" /> 
    121           <field field_ref="ibome"            name="iicebome" /> 
    122           <field field_ref="idive"            name="iicedive" /> 
    123           <field field_ref="ishear"           name="iiceshea" /> 
    124           <field field_ref="icerepr"          name="iicerepr" /> 
    125           <field field_ref="sfxmec"            name="iicefsrp" /> 
    126           <field field_ref="sfxres"            name="iicefsre" /> 
    127           <field field_ref="icetrp"           name="iicevtrp" /> 
    128    </file> 
    129  
    130  
    131    <file id="file7" name_suffix="_scalar" description="scalar variables" > 
     99   <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 
     100     <field field_ref="snowthic_cea"     name="snthic"     long_name="surface_snow_thickness"   /> 
     101     <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        /> 
     102          <field field_ref="icevolu"          name="sivolu" /> 
     103          <field field_ref="snowvol"          name="snvolu" /> 
     104          <field field_ref="iceconc"          name="siconc"  /> 
     105 
     106          <field field_ref="vfxbog"          name="vfxbog" /> 
     107          <field field_ref="vfxdyn"          name="vfxdyn" /> 
     108          <field field_ref="vfxopw"          name="vfxopw" /> 
     109          <field field_ref="vfxsni"          name="vfxsni" /> 
     110          <field field_ref="vfxsum"          name="vfxsum" /> 
     111          <field field_ref="vfxbom"          name="vfxbom" /> 
     112          <field field_ref="vfxres"          name="vfxres" /> 
     113          <field field_ref="vfxice"          name="vfxice" /> 
     114          <field field_ref="vfxsnw"          name="vfxsnw" /> 
     115          <field field_ref="vfxsub"          name="vfxsub" /> 
     116          <field field_ref="vfxspr"          name="vfxspr" /> 
     117 
     118          <field field_ref="icetrp"          name="sivtrp" /> 
     119          <field field_ref="snwtrp"          name="snvtrp" /> 
     120          <field field_ref="deitrp"          name="deitrp" /> 
     121          <field field_ref="destrp"          name="destrp" /> 
     122 
     123          <field field_ref="sfxbri"           name="sfxbri" /> 
     124          <field field_ref="sfxdyn"           name="sfxdyn" /> 
     125          <field field_ref="sfxres"           name="sfxres" /> 
     126          <field field_ref="sfxbog"           name="sfxbog" /> 
     127          <field field_ref="sfxbom"           name="sfxbom" /> 
     128          <field field_ref="sfxsum"           name="sfxsum" /> 
     129          <field field_ref="sfxsni"           name="sfxsni" /> 
     130          <field field_ref="sfxopw"           name="sfxopw" /> 
     131          <field field_ref="sfx"              name="sfx" /> 
     132 
     133          <field field_ref="hfxsum"          name="hfxsum"    /> 
     134          <field field_ref="hfxbom"          name="hfxbom"    /> 
     135          <field field_ref="hfxbog"          name="hfxbog"    /> 
     136          <field field_ref="hfxdif"          name="hfxdif"    /> 
     137          <field field_ref="hfxopw"          name="hfxopw"    /> 
     138          <field field_ref="hfxout"          name="hfxout"    /> 
     139          <field field_ref="hfxin"           name="hfxin"    /> 
     140          <field field_ref="hfxsnw"          name="hfxsnw"    /> 
     141          <field field_ref="hfxerr"          name="hfxerr"    /> 
     142          <field field_ref="hfxerr_rem"      name="hfxerr_rem"    /> 
     143 
     144     <!-- ice-ocean heat flux from mass exchange --> 
     145          <field field_ref="hfxdyn"          name="hfxdyn"    /> 
     146          <field field_ref="hfxres"          name="hfxres"    /> 
     147          <field field_ref="hfxthd"          name="hfxthd"    /> 
     148     <!-- ice-atm. heat flux from mass exchange --> 
     149          <field field_ref="hfxsub"          name="hfxsub"    /> 
     150          <field field_ref="hfxspr"          name="hfxspr"    /> 
     151 
     152     <!-- diags --> 
     153          <field field_ref="hfxdhc"          name="hfxdhc"    /> 
     154          <field field_ref="hfxtur"          name="hfxtur"    /> 
     155 
     156          <field field_ref="isst"             name="sst" /> 
     157          <field field_ref="isss"             name="sss" /> 
     158          <field field_ref="micesalt"         name="sisali" /> 
     159          <field field_ref="micet"            name="sitemp" /> 
     160          <field field_ref="icest"            name="sistem" /> 
     161          <field field_ref="icehc"            name="siheco" /> 
     162          <field field_ref="isnowhc"          name="snheco" /> 
     163          <field field_ref="miceage"          name="siages" /> 
     164 
     165          <field field_ref="uice_ipa"         name="sivelu" /> 
     166          <field field_ref="vice_ipa"         name="sivelv" /> 
     167          <field field_ref="icevel"           name="sivelo" /> 
     168          <field field_ref="idive"            name="sidive" /> 
     169          <field field_ref="ishear"           name="sishea" /> 
     170          <field field_ref="icestr"           name="sistre" /> 
     171 
     172          <field field_ref="ibrinv"           name="sibrin" /> 
     173          <field field_ref="icecolf"          name="sicolf" /> 
     174 
     175          <field field_ref="iceage_cat"       name="siagecat"/> 
     176          <field field_ref="iceconc_cat"      name="siconcat"/> 
     177          <field field_ref="icethic_cat"      name="sithicat"/> 
     178          <field field_ref="snowthic_cat"     name="snthicat"/> 
     179          <field field_ref="salinity_cat"     name="salincat"/> 
     180          <field field_ref="brinevol_cat"     name="sibricat"/> 
     181 
     182   </file> 
     183 
     184        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 
    132185          <field field_ref="voltot"       name="scvoltot"  /> 
    133186          <field field_ref="sshtot"       name="scsshtot"  /> 
    … …  
    137190          <field field_ref="temptot"      name="sctemtot"  /> 
    138191          <field field_ref="saltot"       name="scsaltot"  /> 
    139     
    140           <!-- available with ln_diahsb --> 
    141      <field field_ref="bgtemper"     name="bgtemper"    /> 
    142      <field field_ref="bgsaline"     name="bgsaline"    /> 
    143      <field field_ref="bgheatco"     name="bgheatco"    /> 
    144      <field field_ref="bgsaltco"     name="bgsaltco"    /> 
    145      <field field_ref="bgvolssh"     name="bgvolssh"    /> 
    146      <field field_ref="bgvoltot"     name="bgvoltot"    /> 
    147      <field field_ref="bgsshtot"     name="bgsshtot"    /> 
    148      <field field_ref="bgfrcvol"     name="bgfrcvol"    /> 
    149      <field field_ref="bgfrctem"     name="bgfrctem"    /> 
    150      <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
    151      <!-- available with ln_limdiahsb --> 
    152      <field field_ref="ibgvoltot"    name="ibgvoltot"   /> 
    153      <field field_ref="sbgvoltot"    name="sbgvoltot"   /> 
    154      <field field_ref="ibgarea"      name="ibgarea"     /> 
    155      <field field_ref="ibgsaline"    name="ibgsaline"   /> 
    156      <field field_ref="ibgtemper"    name="ibgtemper"   /> 
    157      <field field_ref="ibgheatco"    name="ibgheatco"   /> 
    158      <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
    159      <field field_ref="sbgheatco"    name="sbgheatco"   /> 
    160      <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
    161      <field field_ref="ibgfrcemp"    name="ibgfrcemp"   /> 
    162      <field field_ref="ibgsfx"       name="ibgsfx"     /> 
    163      <field field_ref="ibgemp"       name="ibgemp"      /> 
    164      <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
    165      <field field_ref="ibgsfxthd"    name="ibgsfxthd"    /> 
    166      <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
    167      <field field_ref="ibgsfxmec"    name="ibgsfxmec" /> 
    168      <field field_ref="ibggrpme"     name="ibggrpme"    /> 
    169  
    170    </file> 
     192 
     193          <field field_ref="bgtemper"     name="bgtemper"    /> 
     194          <field field_ref="bgsaline"     name="bgsaline"    /> 
     195          <field field_ref="bgheatco"     name="bgheatco"    /> 
     196          <field field_ref="bgsaltco"     name="bgsaltco"    /> 
     197          <field field_ref="bgvolssh"     name="bgvolssh"    />  
     198          <field field_ref="bgvole3t"     name="bgvole3t"    /> 
     199          <field field_ref="bgfrcvol"     name="bgfrcvol"    /> 
     200          <field field_ref="bgfrctem"     name="bgfrctem"    /> 
     201          <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
     202 
     203          <field field_ref="ibgvoltot"    name="ibgvoltot"   /> 
     204          <field field_ref="sbgvoltot"    name="sbgvoltot"   /> 
     205          <field field_ref="ibgarea"      name="ibgarea"     /> 
     206          <field field_ref="ibgsaline"    name="ibgsaline"   /> 
     207          <field field_ref="ibgtemper"    name="ibgtemper"   /> 
     208          <field field_ref="ibgheatco"    name="ibgheatco"   /> 
     209          <field field_ref="sbgheatco"    name="sbgheatco"   /> 
     210          <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
     211 
     212          <field field_ref="ibgvfx"       name="ibgvfx"      /> 
     213          <field field_ref="ibgvfxbog"    name="ibgvfxbog"      /> 
     214          <field field_ref="ibgvfxopw"    name="ibgvfxopw"      /> 
     215          <field field_ref="ibgvfxsni"    name="ibgvfxsni"      /> 
     216          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"      /> 
     217          <field field_ref="ibgvfxbom"    name="ibgvfxbom"      /> 
     218          <field field_ref="ibgvfxsum"    name="ibgvfxsum"      /> 
     219          <field field_ref="ibgvfxres"    name="ibgvfxres"      /> 
     220          <field field_ref="ibgvfxspr"    name="ibgvfxspr"      /> 
     221          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"      /> 
     222          <field field_ref="ibgvfxsub"    name="ibgvfxsub"      /> 
     223 
     224          <field field_ref="ibgsfx"       name="ibgsfx"     /> 
     225          <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
     226          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn" /> 
     227          <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
     228          <field field_ref="ibgsfxbog"    name="ibgsfxbog"      /> 
     229          <field field_ref="ibgsfxopw"    name="ibgsfxopw"      /> 
     230          <field field_ref="ibgsfxsni"    name="ibgsfxsni"      /> 
     231          <field field_ref="ibgsfxbom"    name="ibgsfxbom"      /> 
     232          <field field_ref="ibgsfxsum"    name="ibgsfxsum"      /> 
     233 
     234          <field field_ref="ibghfxdhc"    name="ibghfxdhc"    /> 
     235          <field field_ref="ibghfxspr"    name="ibghfxspr"    /> 
     236 
     237          <field field_ref="ibghfxres"    name="ibghfxres"    /> 
     238          <field field_ref="ibghfxsub"    name="ibghfxsub"    /> 
     239          <field field_ref="ibghfxdyn"    name="ibghfxdyn"    /> 
     240          <field field_ref="ibghfxthd"    name="ibghfxthd"    /> 
     241          <field field_ref="ibghfxsum"    name="ibghfxsum"    /> 
     242          <field field_ref="ibghfxbom"    name="ibghfxbom"    /> 
     243          <field field_ref="ibghfxbog"    name="ibghfxbog"    /> 
     244          <field field_ref="ibghfxdif"    name="ibghfxdif"    /> 
     245          <field field_ref="ibghfxopw"    name="ibghfxopw"    /> 
     246          <field field_ref="ibghfxout"    name="ibghfxout"    /> 
     247          <field field_ref="ibghfxin"    name="ibghfxin"    /> 
     248          <field field_ref="ibghfxsnw"    name="ibghfxsnw"    /> 
     249 
     250          <field field_ref="ibgfrcvol"    name="ibgfrcvol"   /> 
     251          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
     252          <field field_ref="ibgvolgrm"    name="ibgvolgrm"    /> 
     253 
     254        </file> 
    171255 
    172256   <!-- 
    … …  
    214298      <axis id="nfloat" long_name="Float number"      unit="-"  /> 
    215299      <axis id="icbcla" long_name="Iceberg class"     unit="-"  /> 
     300      <axis id="ncatice" long_name="Ice categories"   unit="-"  /> 
    216301   </axis_definition>  
    217302     
    … …  
    241326     <variable id="buffer_server_factor_size" type="integer">2</variable> 
    242327     <variable id="info_level"                type="integer">0</variable> 
    243      <variable id="using_server"              type="boolean">true</variable> 
     328     <variable id="using_server"              type="boolean">false</variable> 
    244329     <variable id="using_oasis"               type="boolean">false</variable> 
    245330     <variable id="oasis_codes_id"            type="string" >oceanx</variable> 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef_default.xml

    r4100 r4921  
    4747     <field field_ref="mldkz5"       /> 
    4848     <field field_ref="mldr10_1"     /> 
     49      <field field_ref="heatc"        name="heatc"    long_name="Heat content vertically integrated"            /> 
     50      <field field_ref="saltc"        name="saltc"    long_name="Salt content vertically integrated"            /> 
    4951   </file> 
    5052 
    5153   <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 
    5254     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
    53      <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
    54      <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
    55      <field field_ref="saltflx"      name="sosflxdo"  /> 
     55     <field field_ref="qsr_oce"      name="qsr_oce"  long_name="downward shortwave flux at ocean surface"           /> 
     56     <field field_ref="qns_oce"      name="qns_oce"  long_name="downward non solar flux at ocean surface"           /> 
     57     <field field_ref="qt_oce"       name="qt_oce"   long_name="downward total flux at ocean surface"           /> 
     58     <field field_ref="qsr_ice"      name="qsr_ice"  long_name="downward shortwave flux at ice surface"           /> 
     59     <field field_ref="qns_ice"      name="qns_ice"  long_name="downward non solar flux at ice surface"           /> 
     60     <field field_ref="qtr_ice"      name="qtr_ice"  long_name="shortwave flux transmitted thru the ice"           /> 
     61     <field field_ref="qt_ice"       name="qt_ice"   long_name="downward total flux at ice surface"           /> 
     62     <field field_ref="saltflx"      name="sfx"  /> 
    5663     <field field_ref="taum"         name="taum" /> 
    57      <field field_ref="wspd"         name="sowindsp"  /> 
    58           <field field_ref="precip"       name="soprecip" /> 
     64     <field field_ref="wspd"         name="windsp"  /> 
     65      <field field_ref="precip"       name="precip" /> 
    5966     <!-- ice and snow --> 
    6067     <field field_ref="snowpre"      /> 
    61           <field field_ref="qsr_io"           name="iicesflx" /> 
    62           <field field_ref="qns_io"           name="iicenflx" /> 
    63           <field field_ref="utau_ice"         name="iicestru" /> 
    64           <field field_ref="vtau_ice"         name="iicestrv" /> 
     68      <field field_ref="utau_ice"         name="utau_ice" /> 
     69      <field field_ref="vtau_ice"         name="vtau_ice" /> 
    6570 
    6671   </file> 
    … …  
    7378     <field field_ref="u_masstr"     name="vozomatr"  /> 
    7479     <field field_ref="u_heattr"     name="sozohetr"  /> 
     80      <field field_ref="u_salttr"     name="sozosatr"  /> 
    7581   </file> 
    7682    
    … …  
    8288     <field field_ref="v_masstr"     name="vomematr"  /> 
    8389     <field field_ref="v_heattr"     name="somehetr"  /> 
     90      <field field_ref="v_salttr"     name="somesatr"  /> 
    8491   </file> 
    8592    
    … …  
    9097   </file> 
    9198 
    92    <file id="file6" name_suffix="_icemod" description="ice variables" > 
    93      <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
    94      <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
    95           <field field_ref="icevolu"      name="iicevolu" /> 
    96           <field field_ref="snowvol"      name="isnowvol" /> 
    97           <field field_ref="iceconc"      name="iiceconc"  /> 
    98  
    99           <field field_ref="icebopr"          name="iicebopr" /> 
    100           <field field_ref="icedypr"          name="iicedypr" /> 
    101           <field field_ref="ioceflxb"         name="ioceflxb" /> 
    102           <field field_ref="uice_ipa"         name="iicevelu" /> 
    103           <field field_ref="vice_ipa"         name="iicevelv" /> 
    104           <field field_ref="isst"             name="isstempe" /> 
    105           <field field_ref="isss"             name="isssalin" /> 
    106           <field field_ref="micesalt"         name="iicesali" /> 
    107           <field field_ref="miceage"          name="iiceages" /> 
    108           <field field_ref="icelapr"          name="iicelapr" /> 
    109           <field field_ref="icesipr"          name="iicesipr" /> 
    110           <field field_ref="micet"            name="iicetemp" /> 
    111           <field field_ref="icehc"            name="iiceheco" /> 
    112           <field field_ref="isnowhc"          name="isnoheco" /> 
    113           <field field_ref="icest"            name="iicesurt" /> 
    114           <field field_ref="sfxbri"            name="iicefsbr" /> 
    115           <field field_ref="sfxthd"            name="iicefseq" /> 
    116           <field field_ref="ibrinv"           name="ibrinvol" /> 
    117           <field field_ref="icecolf"          name="iicecolf" /> 
    118           <field field_ref="icestr"           name="iicestre" /> 
    119           <field field_ref="icevel"           name="iicevelo" /> 
    120           <field field_ref="isume"            name="iicesume" /> 
    121           <field field_ref="ibome"            name="iicebome" /> 
    122           <field field_ref="idive"            name="iicedive" /> 
    123           <field field_ref="ishear"           name="iiceshea" /> 
    124           <field field_ref="icerepr"          name="iicerepr" /> 
    125           <field field_ref="sfxmec"            name="iicefsrp" /> 
    126           <field field_ref="sfxres"            name="iicefsre" /> 
    127           <field field_ref="icetrp"           name="iicevtrp" /> 
    128    </file> 
    129  
    130  
    131    <file id="file7" name_suffix="_scalar" description="scalar variables" > 
     99   <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 
     100     <field field_ref="snowthic_cea"     name="snthic"     long_name="surface_snow_thickness"   /> 
     101     <field field_ref="icethic_cea"      name="sithic"     long_name="sea_ice_thickness"        /> 
     102          <field field_ref="icevolu"          name="sivolu" /> 
     103          <field field_ref="snowvol"          name="snvolu" /> 
     104          <field field_ref="iceconc"          name="siconc"  /> 
     105 
     106          <field field_ref="vfxbog"          name="vfxbog" /> 
     107          <field field_ref="vfxdyn"          name="vfxdyn" /> 
     108          <field field_ref="vfxopw"          name="vfxopw" /> 
     109          <field field_ref="vfxsni"          name="vfxsni" /> 
     110          <field field_ref="vfxsum"          name="vfxsum" /> 
     111          <field field_ref="vfxbom"          name="vfxbom" /> 
     112          <field field_ref="vfxres"          name="vfxres" /> 
     113          <field field_ref="vfxice"          name="vfxice" /> 
     114          <field field_ref="vfxsnw"          name="vfxsnw" /> 
     115          <field field_ref="vfxsub"          name="vfxsub" /> 
     116          <field field_ref="vfxspr"          name="vfxspr" /> 
     117 
     118          <field field_ref="icetrp"          name="sivtrp" /> 
     119          <field field_ref="snwtrp"          name="snvtrp" /> 
     120          <field field_ref="deitrp"          name="deitrp" /> 
     121          <field field_ref="destrp"          name="destrp" /> 
     122 
     123          <field field_ref="sfxbri"           name="sfxbri" /> 
     124          <field field_ref="sfxdyn"           name="sfxdyn" /> 
     125          <field field_ref="sfxres"           name="sfxres" /> 
     126          <field field_ref="sfxbog"           name="sfxbog" /> 
     127          <field field_ref="sfxbom"           name="sfxbom" /> 
     128          <field field_ref="sfxsum"           name="sfxsum" /> 
     129          <field field_ref="sfxsni"           name="sfxsni" /> 
     130          <field field_ref="sfxopw"           name="sfxopw" /> 
     131          <field field_ref="sfx"              name="sfx" /> 
     132 
     133          <field field_ref="hfxsum"          name="hfxsum"    /> 
     134          <field field_ref="hfxbom"          name="hfxbom"    /> 
     135          <field field_ref="hfxbog"          name="hfxbog"    /> 
     136          <field field_ref="hfxdif"          name="hfxdif"    /> 
     137          <field field_ref="hfxopw"          name="hfxopw"    /> 
     138          <field field_ref="hfxout"          name="hfxout"    /> 
     139          <field field_ref="hfxin"           name="hfxin"    /> 
     140          <field field_ref="hfxsnw"          name="hfxsnw"    /> 
     141          <field field_ref="hfxerr"          name="hfxerr"    /> 
     142          <field field_ref="hfxerr_rem"      name="hfxerr_rem"    /> 
     143 
     144     <!-- ice-ocean heat flux from mass exchange --> 
     145          <field field_ref="hfxdyn"          name="hfxdyn"    /> 
     146          <field field_ref="hfxres"          name="hfxres"    /> 
     147          <field field_ref="hfxthd"          name="hfxthd"    /> 
     148     <!-- ice-atm. heat flux from mass exchange --> 
     149          <field field_ref="hfxsub"          name="hfxsub"    /> 
     150          <field field_ref="hfxspr"          name="hfxspr"    /> 
     151 
     152     <!-- diags --> 
     153          <field field_ref="hfxdhc"          name="hfxdhc"    /> 
     154          <field field_ref="hfxtur"          name="hfxtur"    /> 
     155 
     156          <field field_ref="isst"             name="sst" /> 
     157          <field field_ref="isss"             name="sss" /> 
     158          <field field_ref="micesalt"         name="sisali" /> 
     159          <field field_ref="micet"            name="sitemp" /> 
     160          <field field_ref="icest"            name="sistem" /> 
     161          <field field_ref="icehc"            name="siheco" /> 
     162          <field field_ref="isnowhc"          name="snheco" /> 
     163          <field field_ref="miceage"          name="siages" /> 
     164 
     165          <field field_ref="uice_ipa"         name="sivelu" /> 
     166          <field field_ref="vice_ipa"         name="sivelv" /> 
     167          <field field_ref="icevel"           name="sivelo" /> 
     168          <field field_ref="idive"            name="sidive" /> 
     169          <field field_ref="ishear"           name="sishea" /> 
     170          <field field_ref="icestr"           name="sistre" /> 
     171 
     172          <field field_ref="ibrinv"           name="sibrin" /> 
     173          <field field_ref="icecolf"          name="sicolf" /> 
     174 
     175          <field field_ref="iceage_cat"       name="siagecat"/> 
     176          <field field_ref="iceconc_cat"      name="siconcat"/> 
     177          <field field_ref="icethic_cat"      name="sithicat"/> 
     178          <field field_ref="snowthic_cat"     name="snthicat"/> 
     179          <field field_ref="salinity_cat"     name="salincat"/> 
     180          <field field_ref="brinevol_cat"     name="sibricat"/> 
     181 
     182   </file> 
     183 
     184        <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." > 
    132185          <field field_ref="voltot"       name="scvoltot"  /> 
    133186          <field field_ref="sshtot"       name="scsshtot"  /> 
    … …  
    137190          <field field_ref="temptot"      name="sctemtot"  /> 
    138191          <field field_ref="saltot"       name="scsaltot"  /> 
    139     
    140           <!-- available with ln_diahsb --> 
    141      <field field_ref="bgtemper"     name="bgtemper"    /> 
    142      <field field_ref="bgsaline"     name="bgsaline"    /> 
    143      <field field_ref="bgheatco"     name="bgheatco"    /> 
    144      <field field_ref="bgsaltco"     name="bgsaltco"    /> 
    145      <field field_ref="bgvolssh"     name="bgvolssh"    /> 
    146      <field field_ref="bgvoltot"     name="bgvoltot"    /> 
    147      <field field_ref="bgsshtot"     name="bgsshtot"    /> 
    148      <field field_ref="bgfrcvol"     name="bgfrcvol"    /> 
    149      <field field_ref="bgfrctem"     name="bgfrctem"    /> 
    150      <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
    151      <!-- available with ln_limdiahsb --> 
    152      <field field_ref="ibgvoltot"    name="ibgvoltot"   /> 
    153      <field field_ref="sbgvoltot"    name="sbgvoltot"   /> 
    154      <field field_ref="ibgarea"      name="ibgarea"     /> 
    155      <field field_ref="ibgsaline"    name="ibgsaline"   /> 
    156      <field field_ref="ibgtemper"    name="ibgtemper"   /> 
    157      <field field_ref="ibgheatco"    name="ibgheatco"   /> 
    158      <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
    159      <field field_ref="sbgheatco"    name="sbgheatco"   /> 
    160      <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
    161      <field field_ref="ibgfrcemp"    name="ibgfrcemp"   /> 
    162      <field field_ref="ibgsfx"       name="ibgsfx"     /> 
    163      <field field_ref="ibgemp"       name="ibgemp"      /> 
    164      <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
    165      <field field_ref="ibgsfxthd"    name="ibgsfxthd"    /> 
    166      <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
    167      <field field_ref="ibgsfxmec"    name="ibgsfxmec" /> 
    168      <field field_ref="ibggrpme"     name="ibggrpme"    /> 
    169  
    170    </file> 
     192 
     193          <field field_ref="bgtemper"     name="bgtemper"    /> 
     194          <field field_ref="bgsaline"     name="bgsaline"    /> 
     195          <field field_ref="bgheatco"     name="bgheatco"    /> 
     196          <field field_ref="bgsaltco"     name="bgsaltco"    /> 
     197          <field field_ref="bgvolssh"     name="bgvolssh"    />  
     198          <field field_ref="bgvole3t"     name="bgvole3t"    /> 
     199          <field field_ref="bgfrcvol"     name="bgfrcvol"    /> 
     200          <field field_ref="bgfrctem"     name="bgfrctem"    /> 
     201          <field field_ref="bgfrcsal"     name="bgfrcsal"    /> 
     202 
     203          <field field_ref="ibgvoltot"    name="ibgvoltot"   /> 
     204          <field field_ref="sbgvoltot"    name="sbgvoltot"   /> 
     205          <field field_ref="ibgarea"      name="ibgarea"     /> 
     206          <field field_ref="ibgsaline"    name="ibgsaline"   /> 
     207          <field field_ref="ibgtemper"    name="ibgtemper"   /> 
     208          <field field_ref="ibgheatco"    name="ibgheatco"   /> 
     209          <field field_ref="sbgheatco"    name="sbgheatco"   /> 
     210          <field field_ref="ibgsaltco"    name="ibgsaltco"   /> 
     211 
     212          <field field_ref="ibgvfx"       name="ibgvfx"      /> 
     213          <field field_ref="ibgvfxbog"    name="ibgvfxbog"      /> 
     214          <field field_ref="ibgvfxopw"    name="ibgvfxopw"      /> 
     215          <field field_ref="ibgvfxsni"    name="ibgvfxsni"      /> 
     216          <field field_ref="ibgvfxdyn"    name="ibgvfxdyn"      /> 
     217          <field field_ref="ibgvfxbom"    name="ibgvfxbom"      /> 
     218          <field field_ref="ibgvfxsum"    name="ibgvfxsum"      /> 
     219          <field field_ref="ibgvfxres"    name="ibgvfxres"      /> 
     220          <field field_ref="ibgvfxspr"    name="ibgvfxspr"      /> 
     221          <field field_ref="ibgvfxsnw"    name="ibgvfxsnw"      /> 
     222          <field field_ref="ibgvfxsub"    name="ibgvfxsub"      /> 
     223 
     224          <field field_ref="ibgsfx"       name="ibgsfx"     /> 
     225          <field field_ref="ibgsfxbri"    name="ibgsfxbri"    /> 
     226          <field field_ref="ibgsfxdyn"    name="ibgsfxdyn" /> 
     227          <field field_ref="ibgsfxres"    name="ibgsfxres" /> 
     228          <field field_ref="ibgsfxbog"    name="ibgsfxbog"      /> 
     229          <field field_ref="ibgsfxopw"    name="ibgsfxopw"      /> 
     230          <field field_ref="ibgsfxsni"    name="ibgsfxsni"      /> 
     231          <field field_ref="ibgsfxbom"    name="ibgsfxbom"      /> 
     232          <field field_ref="ibgsfxsum"    name="ibgsfxsum"      /> 
     233 
     234          <field field_ref="ibghfxdhc"    name="ibghfxdhc"    /> 
     235          <field field_ref="ibghfxspr"    name="ibghfxspr"    /> 
     236 
     237          <field field_ref="ibghfxres"    name="ibghfxres"    /> 
     238          <field field_ref="ibghfxsub"    name="ibghfxsub"    /> 
     239          <field field_ref="ibghfxdyn"    name="ibghfxdyn"    /> 
     240          <field field_ref="ibghfxthd"    name="ibghfxthd"    /> 
     241          <field field_ref="ibghfxsum"    name="ibghfxsum"    /> 
     242          <field field_ref="ibghfxbom"    name="ibghfxbom"    /> 
     243          <field field_ref="ibghfxbog"    name="ibghfxbog"    /> 
     244          <field field_ref="ibghfxdif"    name="ibghfxdif"    /> 
     245          <field field_ref="ibghfxopw"    name="ibghfxopw"    /> 
     246          <field field_ref="ibghfxout"    name="ibghfxout"    /> 
     247          <field field_ref="ibghfxin"    name="ibghfxin"    /> 
     248          <field field_ref="ibghfxsnw"    name="ibghfxsnw"    /> 
     249 
     250          <field field_ref="ibgfrcvol"    name="ibgfrcvol"   /> 
     251          <field field_ref="ibgfrcsfx"    name="ibgfrcsfx"  /> 
     252          <field field_ref="ibgvolgrm"    name="ibgvolgrm"    /> 
     253 
     254        </file> 
    171255 
    172256   <!-- 
    … …  
    214298      <axis id="nfloat" long_name="Float number"      unit="-"  /> 
    215299      <axis id="icbcla" long_name="Iceberg class"     unit="-"  /> 
     300      <axis id="ncatice" long_name="Ice categories"   unit="-"  /> 
    216301   </axis_definition>  
    217302     

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_ice_cfg

    r4161 r4921  
    1616/ 
    1717!----------------------------------------------------------------------- 
    18 &namicetrp     !   ice transport 
     18&namicethd     !   ice thermodynamic 
    1919!----------------------------------------------------------------------- 
    2020/ 
    2121!----------------------------------------------------------------------- 
    22 &namicethd     !   ice thermodynamic 
     22&namicesal     !   ice salinity 
    2323!----------------------------------------------------------------------- 
    2424/ 
     25!----------------------------------------------------------------------- 
     26&namiceitdme   !   parameters for mechanical redistribution of ice  
     27!----------------------------------------------------------------------- 
     28/ 
     29!----------------------------------------------------------------------- 
     30&namicedia     !   ice diagnostics 
     31!----------------------------------------------------------------------- 
     32/ 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml

    r4245 r4921  
    101101     <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
    102102     <field field_ref="ist_ipa"      /> 
    103      <field field_ref="ioceflxb"     /> 
    104103     <field field_ref="uice_ipa"     /> 
    105104     <field field_ref="vice_ipa"     /> 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/iodef.xml

    r4186 r4921  
    8484     <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
    8585     <field field_ref="ist_ipa"      /> 
    86      <field field_ref="ioceflxb"     /> 
    8786     <field field_ref="uice_ipa"     /> 
    8887     <field field_ref="vice_ipa"     /> 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/SHARED/1_namelist_ref

    r4347 r4921  
    3131   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    3232   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     33   nn_euler    =       1   !  = 0 : start with forward time step if ln_rstart=.true. 
    3334   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T 
    3435                           !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 
    … …  
    119120                           ! 
    120121   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0) 
    121    nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts") 
    122122   rn_atfp     =    0.1    !  asselin time filter parameter 
    123123   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k) 
    … …  
    152152/ 
    153153!----------------------------------------------------------------------- 
     154&namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
     155!----------------------------------------------------------------------- 
     156   ln_bt_fw      =    .TRUE.           !  Forward integration of barotropic equations 
     157   ln_bt_av      =    .TRUE.           !  Time filtering of barotropic variables 
     158   ln_bt_nn_auto =    .TRUE.           !  Set nn_baro automatically to be just below 
     159                                       !  a user defined maximum courant number (rn_bt_cmax) 
     160   nn_baro       =    30               !  Number of iterations of barotropic mode 
     161                                       !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F 
     162   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T  
     163   nn_bt_flt     =    1                !  Time filter choice 
     164                                       !  = 0 None 
     165                                       !  = 1 Boxcar over   nn_baro barotropic steps 
     166                                       !  = 2 Boxcar over 2*nn_baro     "        "   
     167/ 
     168!----------------------------------------------------------------------- 
    154169&namcrs        !   Grid coarsening for dynamics output and/or 
    155170               !   passive tracer coarsened online simulations 
    … …  
    168183/ 
    169184!----------------------------------------------------------------------- 
     185&namc1d        !   1D configuration options                             ("key_c1d") 
     186!----------------------------------------------------------------------- 
     187   rn_lat1d    =      50   !  Column latitude (default at PAPA station) 
     188   rn_lon1d    =    -145   !  Column longitude (default at PAPA station) 
     189   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F) 
     190/ 
     191!----------------------------------------------------------------------- 
    170192&namtsd    !   data : Temperature  & Salinity 
    171193!----------------------------------------------------------------------- 
    … …  
    173195!          !  file name                            ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    174196!          !                                       !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    175    sn_tem  = 'data_1m_potential_temperature_nomask',         -1        ,'votemper' ,    .true.    , .true. , 'yearly'   , ''      ,   ''     ,    '' 
    176    sn_sal  = 'data_1m_salinity_nomask'             ,         -1        ,'vosaline' ,    .true.    , .true. , 'yearly'   , ''      ,   ''     ,    '' 
     197   sn_tem  = 'data_1m_potential_temperature_nomask',         -1        ,'votemper' ,    .true.    , .true. , 'yearly'   , ''       ,   ''    ,    '' 
     198   sn_sal  = 'data_1m_salinity_nomask'             ,         -1        ,'vosaline' ,    .true.    , .true. , 'yearly'   , ''       ,   ''    ,    '' 
    177199   ! 
    178200   cn_dir        = './'     !  root directory for the location of the runoff files 
    179201   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
    180    ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     202   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
    181203/ 
    182204!!====================================================================== 
    … …  
    225247   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave) 
    226248   ln_sdw  = .false.       !  Computation of 3D stokes drift                (T => fill namsbc_wave) 
     249   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
     250                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    227251   cn_iceflx = 'linear'    !  redistribution of solar input into ice categories during coupling ice/atm. 
    228252/ 
    … …  
    268292&namsbc_core   !   namsbc_core  CORE bulk formulae 
    269293!----------------------------------------------------------------------- 
    270 !              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                            ! rotation ! land/sea mask ! 
    271 !              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                           ! pairing  ! filename      ! 
    272    sn_wndi     = 'u_10.15JUNE2009_fill'        ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'   , 'Uwnd'   , '' 
    273    sn_wndj     = 'v_10.15JUNE2009_fill'        ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'   , 'Vwnd'   , '' 
     294!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights                               ! rotation ! land/sea mask ! 
     295!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename                              ! pairing  ! filename      ! 
     296   sn_wndi     = 'u_10.15JUNE2009_fill'        ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'      , 'Uwnd'   , '' 
     297   sn_wndj     = 'v_10.15JUNE2009_fill'        ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bicubic.nc'      , 'Vwnd'   , '' 
    274298   sn_qsr      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
    275299   sn_qlw      = 'ncar_rad.15JUNE2009_fill'    ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_core2_agrif_bilinear.nc'     , ''       , '' 
    … …  
    346370&namtra_qsr    !   penetrative solar radiation 
    347371!----------------------------------------------------------------------- 
    348 !              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights          ! rotation ! land/sea mask ! 
    349 !              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename         ! pairing  ! filename      ! 
    350    sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , 'weights_bilin'  , ''       , '' 
     372!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights         ! rotation ! land/sea mask ! 
     373!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename        ! pairing  ! filename      ! 
     374   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , 'weights_bilin' , ''       , '' 
    351375 
    352376   cn_dir      = './'      !  root directory for the location of the runoff files 
    … …  
    544568    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state 
    545569                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     570    cn_ice_lim      =  'none'             !   
     571    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state 
     572                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     573    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice 
     574    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           -- 
     575    rn_ice_age      = 30.                 !  lim3 only:      --   age                -- 
     576 
    546577    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers 
    547578    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities 
    … …  
    564595   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    565596   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     597! for lim2 
     598!   bn_frld  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     599!   bn_hicif =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     600!   bn_hsnif =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     601! for lim3 
     602!   bn_a_i  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     603!   bn_ht_i =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     604!   bn_ht_s =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    566605   cn_dir  =    'bdydta/' 
    567606   ln_full_vel = .false. 
    … …  
    588627                           !                              = 2 : nonlinear friction 
    589628   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case) 
    590    rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case) 
     629   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case). Minimum coeft if ln_loglayer=T 
     630   rn_bfri2_max =   1.e-1  !  max. bottom drag coefficient (non linear case and ln_loglayer=T) 
    591631   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2) 
    592    rn_bfrz0    =    3.e-3  ! bottom roughness for loglayer bfr coeff  
     632   rn_bfrz0    =    3.e-3  !  bottom roughness [m] if ln_loglayer=T  
     633   ln_loglayer = .false.   !  logarithmic formulation (non linear case) 
    593634   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file ) 
    594635   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T) 
    … …  
    724765   ln_vvl_layer  = .false.          !  full layer vertical coordinate 
    725766   ln_vvl_ztilde_as_zstar = .false. !  ztilde vertical coordinate emulating zstar 
     767   ln_vvl_zstar_at_eqtor = .false.  !  ztilde near the equator 
    726768   rn_ahe3       = 0.0e0            !  thickness diffusion coefficient 
    727769   rn_rst_e3t    = 30.e0            !  ztilde to zstar restoration timescale [days] 
    … …  
    939981                           !     (no physical validity of the results) 
    940982   nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0) 
    941 / 
    942 !----------------------------------------------------------------------- 
    943 &namc1d        !   1D configuration options                             ("key_c1d") 
    944 !----------------------------------------------------------------------- 
    945    rn_lat      =    50     !  Column latitude 
    946    rn_lon      =    -145   !  Column longitude 
    947983/ 
    948984!----------------------------------------------------------------------- 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/SHARED/domain_def.xml

    r3771 r4921  
    55    <!--   My zoom: example of hand defined zoom   --> 
    66         <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" /> 
    7     <!--   Eq section   --> 
     7         <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" /> 
     8         <!--   Eq section   --> 
    89         <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" /> 
    910         <!--   TAO   --> 
    … …  
    170171      <domain_group id="scalarpoint"> 
    171172         <domain id="scalarpoint" long_name="scalar"/> 
     173         <!-- 
    172174         <domain id="1point" zoom_ibegin="1" zoom_jbegin="1" zoom_ni="1" zoom_nj="1" /> 
     175         --> 
    173176      </domain_group> 
    174177 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/SHARED/field_def.xml

    r4565 r4921  
    2929         <field id="mldr10_1"     long_name="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        /> 
    3030         <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3" grid_ref="grid_T_3D"/> 
     31         <field id="heatc"        long_name="Heat content vertically integrated"        unit="J/m2"                      /> 
     32         <field id="saltc"        long_name="Salt content vertically integrated"        unit="PSU*kg/m2"                /> 
    3133    <field id="eken"         long_name="kinetic energy"                            unit="m2/s2" grid_ref="grid_T_3D"/> 
    3234    <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"   grid_ref="grid_T_3D"/> 
    … …  
    158160    
    159161         <!-- *_oce variables available with ln_blk_clio or ln_blk_core --> 
    160          <field id="qns_oce"      long_name="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     /> 
    161162         <field id="qlw_oce"      long_name="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    162163         <field id="qsb_oce"      long_name="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     /> 
    … …  
    194195         <field id="ice_cover"    long_name="Ice fraction"                                                 unit="1"        /> 
    195196 
    196          <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    197197         <field id="qsr_ai_cea"   long_name="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     /> 
    198198         <field id="qns_ai_cea"   long_name="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     /> 
    … …  
    222222          
    223223         <field id="iceconc"      long_name="ice concentration"                                            unit="%"        /> 
    224          <field id="icebopr"      long_name="daily bottom thermo ice prod."                                unit="km3/day"   /> 
    225          <field id="icedypr"      long_name="daily  dynamic ice prod."                                     unit="km3/day"   /> 
    226     <field id="ioceflxb"     long_name="Oceanic flux at the ice base"                                 unit="W/m2"     /> 
    227224         <field id="uice_ipa"     long_name="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      /> 
    228225         <field id="vice_ipa"     long_name="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      /> 
    … …  
    232229         <field id="qsr_oce"      long_name="solar heat flux at ocean surface"                             unit="W/m2"     /> 
    233230         <field id="qns_oce"      long_name="non-solar heat flux at ocean surface"                         unit="W/m2"     /> 
    234          <field id="hfbri"        long_name="heat flux due to brine release"                               unit="W/m2"     /> 
     231         <field id="qt_ice"       long_name="total flux at ice surface"                                    unit="W/m2"     /> 
     232         <field id="qsr_ice"      long_name="solar heat flux at ice surface"                               unit="W/m2"     /> 
     233         <field id="qns_ice"      long_name="non-solar heat flux at ice surface"                           unit="W/m2"     /> 
     234         <field id="qtr_ice"      long_name="solar heat flux transmitted thru the ice"                     unit="W/m2"     /> 
    235235         <field id="utau_ice"     long_name="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     /> 
    236236         <field id="vtau_ice"     long_name="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     /> 
    237     <field id="qsr_io"       long_name="Ice-Oce downward solar heat flux"                             unit="W/m2"     /> 
    238     <field id="qns_io"       long_name="Ice-Oce downward non-solar heat flux"                         unit="W/m2"     /> 
    239237         <field id="micesalt"     long_name="Mean ice salinity"                                            unit="psu"      /> 
    240238         <field id="miceage"      long_name="Mean ice age"                                                 unit="years"    /> 
    241          <field id="icelapr"      long_name="daily lateral thermo ice prod."                               unit="km3/day"   /> 
    242          <field id="icesipr"      long_name="daily snowice ice prod."                                      unit="km3/day"   /> 
     239 
     240         <field id="iceage_cat"   long_name="Ice age for categories"                                       unit="days"   axis_ref="ncatice" /> 
     241         <field id="iceconc_cat"  long_name="Ice concentration for categories"                             unit="%"      axis_ref="ncatice" /> 
     242         <field id="icethic_cat"  long_name="Ice thickness for categories"                                 unit="m"      axis_ref="ncatice" /> 
     243         <field id="snowthic_cat" long_name="Snow thicknessi for categories"                               unit="m"      axis_ref="ncatice" /> 
     244         <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories"                         unit="ppt"    axis_ref="ncatice" /> 
     245         <field id="brinevol_cat" long_name="Brine volume for categories"                                  unit="%"      axis_ref="ncatice" /> 
     246 
    243247         <field id="micet"        long_name="Mean ice temperature"                                         unit="degC"     /> 
    244          <field id="icehc"        long_name="ice total heat content"                                       unit="10^9 J"   />  
     248         <field id="icehc"        long_name="ice total heat content"                                       unit="10^9J"   />  
    245249         <field id="isnowhc"      long_name="snow total heat content"                                      unit="10^9J"    /> 
    246250         <field id="icest"        long_name="ice surface temperature"                                      unit="degC"     /> 
    247          <field id="sfxbri"       long_name="brine salt flux"                                              unit="psu*kg/m2/day" /> 
    248          <field id="sfxthd"       long_name="equivalent FW salt flux"                                      unit="psu*kg/m2/day" /> 
    249251         <field id="ibrinv"       long_name="brine volume"                                                 unit="%"        /> 
    250252         <field id="icecolf"      long_name="frazil ice collection thickness"                              unit="m"        /> 
    251253         <field id="icestr"       long_name="ice strength"                                                 unit="N/m"      /> 
    252254         <field id="icevel"       long_name="ice velocity"                                                 unit="m/s"      /> 
    253          <field id="isume"        long_name="surface melt"                                                 unit="km3/day"   /> 
    254          <field id="ibome"        long_name="bottom melt"                                                  unit="km3/day"   /> 
    255255         <field id="idive"        long_name="divergence"                                                   unit="10-8s-1"  /> 
    256256         <field id="ishear"       long_name="shear"                                                        unit="10-8s-1"  /> 
    257          <field id="icerepr"      long_name="daily resultant ice prod./melting from limupdate"             unit="km3/day"   /> 
    258          <field id="icevolu"      long_name="ice volume"                                                   unit="km3"      /> 
    259          <field id="snowvol"      long_name="snow volume"                                                  unit="km3"      /> 
    260          <field id="sfxmec"       long_name="salt flux from ridging rafting"                               unit="psu*kg/m2/day" /> 
     257         <field id="icevolu"      long_name="ice volume"                                                   unit="m"      /> 
     258         <field id="snowvol"      long_name="snow volume"                                                  unit="m"      /> 
     259 
     260         <field id="icetrp"       long_name="ice volume transport"                                         unit="m/day"   /> 
     261         <field id="snwtrp"       long_name="snw volume transport"                                         unit="m/day"   /> 
     262         <field id="deitrp"       long_name="advected ice enhalpy"                                         unit="W/m2"   /> 
     263         <field id="destrp"       long_name="advected snw enhalpy"                                         unit="W/m2"   /> 
     264 
     265         <field id="sfxbri"       long_name="brine salt flux"                                              unit="psu*kg/m2/day" /> 
     266         <field id="sfxdyn"       long_name="salt flux from ridging rafting"                               unit="psu*kg/m2/day" /> 
    261267         <field id="sfxres"       long_name="salt flux from lipupdate (resultant)"                         unit="psu*kg/m2/day" /> 
    262          <field id="icetrp"       long_name="ice volume transport"                                         unit="km3/day"   /> 
    263  
     268         <field id="sfxbog"       long_name="salt flux from bot growth"                                    unit="psu*kg/m2/day" /> 
     269         <field id="sfxbom"       long_name="salt flux from bot melt"                                      unit="psu*kg/m2/day" /> 
     270         <field id="sfxsum"       long_name="salt flux from surf melt"                                     unit="psu*kg/m2/day" /> 
     271         <field id="sfxsni"       long_name="salt flux from snow-ice formation"                            unit="psu*kg/m2/day" /> 
     272         <field id="sfxopw"       long_name="salt flux from open water ice formation"                      unit="psu*kg/m2/day" /> 
     273         <field id="sfx"          long_name="salt flux total"                                              unit="psu*kg/m2/day" /> 
     274 
     275         <field id="vfxbog"       long_name="daily bottom thermo ice prod."                                unit="m/day"   /> 
     276         <field id="vfxdyn"       long_name="daily  dynamic ice prod."                                     unit="m/day"   /> 
     277         <field id="vfxopw"       long_name="daily lateral thermo ice prod."                               unit="m/day"   /> 
     278         <field id="vfxsni"       long_name="daily snowice ice prod."                                      unit="m/day"   /> 
     279         <field id="vfxsum"       long_name="surface melt"                                                 unit="m/day"   /> 
     280         <field id="vfxbom"       long_name="bottom melt"                                                  unit="m/day"   /> 
     281         <field id="vfxres"       long_name="daily resultant ice prod./melting from limupdate"             unit="m/day"   /> 
     282         <field id="vfxice"       long_name="ice melt/growth"                                              unit="m/day"   /> 
     283         <field id="vfxsnw"       long_name="snw melt/growth"                                              unit="m/day"   /> 
     284         <field id="vfxsub"       long_name="snw sublimation"                                              unit="m/day"   /> 
     285         <field id="vfxspr"       long_name="snw precipitation on ice"                                     unit="m/day"   /> 
     286 
     287         <field id="hfxsum"   long_name="heat fluxes causing surface ice melt"            unit="W/m2"  /> 
     288         <field id="hfxbom"   long_name="heat fluxes causing bottom ice melt"             unit="W/m2"  /> 
     289         <field id="hfxbog"   long_name="heat fluxes causing bottom ice growth"           unit="W/m2"  /> 
     290         <field id="hfxdif"   long_name="heat fluxes causing ice temperature change"      unit="W/m2"  /> 
     291         <field id="hfxopw"   long_name="heat fluxes causing open water ice formation"    unit="W/m2"  /> 
     292         <field id="hfxsnw"   long_name="heat fluxes causing snow melt"                   unit="W/m2"  /> 
     293         <field id="hfxerr"   long_name="heat fluxes error after heat diffusion"          unit="W/m2"  /> 
     294         <field id="hfxerr_rem" long_name="heat fluxes error after remapping"             unit="W/m2"  /> 
     295         <field id="hfxout"   long_name="total heat fluxes received by the ocean"         unit="W/m2"  /> 
     296         <field id="hfxin"    long_name="total heat fluxes at the ice/ocean surface"      unit="W/m2"  /> 
     297 
     298    <!-- heat flux associated with mass exchange --> 
     299         <field id="hfxthd"   long_name="heat fluxes from ice-ocean mass exchange during thermo"              unit="W/m2"  /> 
     300         <field id="hfxdyn"   long_name="heat fluxes from ice-ocean mass exchange during dynamic"             unit="W/m2"  /> 
     301         <field id="hfxres"   long_name="heat fluxes from ice-ocean mass exchange during resultant"           unit="W/m2"  /> 
     302         <field id="hfxsub"   long_name="heat fluxes from ice-atm. mass exchange during sublimation"          unit="W/m2"  /> 
     303         <field id="hfxspr"   long_name="heat fluxes from ice-atm. mass exchange during snow precip"          unit="W/m2" /> 
     304 
     305    <!-- diags --> 
     306         <field id="hfxdhc"    long_name="Heat content variation in snow and ice"   unit="W/m2" /> 
     307         <field id="hfxtur"    long_name="turbulent heat flux at the ice base"      unit="W/m2"  /> 
    264308 
    265309      </field_group> 
    … …  
    284328         <field id="u_masstr"     long_name="ocean eulerian mass transport along i-axis"  unit="kg/s" grid_ref="grid_U_3D" /> 
    285329         <field id="u_heattr"     long_name="ocean eulerian heat transport along i-axis"  unit="W"    /> 
     330         <field id="u_salttr"     long_name="ocean eulerian salt transport along i-axis"  unit="PSU*kg/s"    /> 
    286331         <field id="ueiv_heattr"  long_name="ocean bolus heat transport along i-axis"     unit="W"    /> 
    287332         <field id="udiff_heattr" long_name="ocean diffusion heat transport along i-axis" unit="W"    /> 
    … …  
    307352         <field id="v_masstr"     long_name="ocean eulerian mass transport along j-axis"  unit="kg/s" grid_ref="grid_V_3D" /> 
    308353         <field id="v_heattr"     long_name="ocean eulerian heat transport along j-axis"  unit="W"     /> 
     354         <field id="v_salttr"     long_name="ocean eulerian salt transport along i-axis"  unit="PSU*kg/s"    /> 
    309355         <field id="veiv_heattr"  long_name="ocean bolus heat transport along j-axis"     unit="W"     /> 
    310356         <field id="vdiff_heattr" long_name="ocean diffusion heat transport along j-axis" unit="W"     /> 
    … …  
    340386 
    341387      <field_group id="scalar"  domain_ref="1point" > 
    342          <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
    343          <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
    344          <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
    345          <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
    346          <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
    347          <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
    348          <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
    349          <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
    350  
     388     <field id="voltot"     long_name="global mean volume"                         unit="m3"   /> 
     389     <field id="sshtot"     long_name="global mean ssh"                            unit="m"    /> 
     390     <field id="sshsteric"  long_name="global mean ssh steric"                     unit="m"    /> 
     391     <field id="sshthster"  long_name="global mean ssh thermosteric"               unit="m"    /> 
     392     <field id="masstot"    long_name="global mean mass"                           unit="kg"   /> 
     393     <field id="temptot"    long_name="global mean temperature"                    unit="degC" /> 
     394     <field id="saltot"     long_name="global mean salinity"                       unit="psu"  /> 
     395     <field id="fram_trans" long_name="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" /> 
    351396       <!-- available with ln_diahsb --> 
    352     <field id="bgtemper"     long_name="global mean temperature"                  unit="degC"   /> 
    353     <field id="bgsaline"     long_name="global mean salinity"                     unit="psu"    /> 
    354     <field id="bgheatco"     long_name="global mean heat content"                 unit="10^9J"  /> 
    355     <field id="bgsaltco"     long_name="global mean salt content"                 unit="psu*m3" /> 
    356     <field id="bgvolssh"     long_name="global mean ssh volume"                   unit="km3"     /> 
    357     <field id="bgvoltot"     long_name="global mean volume"                       unit="km3"     /> 
    358     <field id="bgsshtot"     long_name="global mean ssh"                          unit="m"      /> 
    359     <field id="bgfrcvol"     long_name="global mean volume from forcing"          unit="km3"     /> 
    360     <field id="bgfrctem"     long_name="global mean heat content from forcing"    unit="10^9J"  /> 
    361     <field id="bgfrcsal"     long_name="global mean salt content from forcing"    unit="psu*km3" /> 
    362     <field id="bgmistem"     long_name="global mean temperature error due to free surface" unit="degC" /> 
    363     <field id="bgmissal"     long_name="global mean salinity error due to free surface"    unit="psu"  /> 
     397    <field id="bgtemper" long_name="global mean temperature variation"            unit="degC"/> 
     398    <field id="bgsaline" long_name="global mean salinity variation"               unit="psu"/> 
     399    <field id="bgheatco" long_name="global mean heat content variation"           unit="10^20J"/> 
     400    <field id="bgsaltco" long_name="global mean salt content variation"           unit="psu*km3" /> 
     401    <field id="bgvolssh" long_name="global mean volume variation (ssh)"           unit="km3"/> 
     402    <field id="bgvole3t" long_name="global mean volume variation (e3t)"           unit="km3"/> 
     403    <field id="bgfrcvol" long_name="global mean volume variation from forcing"    unit="km3"/> 
     404    <field id="bgfrctem" long_name="global mean forcing from heat content variation"   unit="degC"/> 
     405    <field id="bgfrcsal" long_name="global mean forcing salt content variation"        unit="psu"/> 
     406    <field id="bgmistem" long_name="global mean temperature error due to free surface" unit="degC"/> 
     407    <field id="bgmissal" long_name="global mean salinity error due to free surface"    unit="psu"/> 
    364408      </field_group> 
    365409 
    366410      <field_group id="SBC_scalar"  domain_ref="1point" > 
    367          <!-- available with ln_limdiahsb --> 
     411         <!-- available with ln_limdiaout --> 
    368412    <field id="ibgvoltot"    long_name="global mean ice volume"                   unit="km3"   /> 
    369413    <field id="sbgvoltot"    long_name="global mean snow volume"                  unit="km3"   /> 
    … …  
    371415    <field id="ibgsaline"    long_name="global mean ice salinity"                 unit="psu"   /> 
    372416    <field id="ibgtemper"    long_name="global mean ice temperature"              unit="degC"   /> 
    373     <field id="ibgheatco"    long_name="global mean ice heat content"             unit="10^9J"   /> 
     417    <field id="ibgheatco"    long_name="global mean ice heat content"             unit="10^20J"   /> 
     418    <field id="sbgheatco"    long_name="global mean snow heat content"            unit="10^20J"   /> 
    374419    <field id="ibgsaltco"    long_name="global mean ice salt content"             unit="psu*km3"   /> 
    375     <field id="sbgheatco"    long_name="global mean snow heat content"            unit="10^9J"   /> 
    376     <field id="ibgfrcsfx"    long_name="global mean salt content from sfx"        unit="psu*km3"   /> 
    377     <field id="ibgfrcemp"    long_name="global mean volume from emp"              unit="km3"      /> 
    378     <field id="ibgsfx"       long_name="global mean emps"                         unit="psu*kg/m2/day"   /> 
    379     <field id="ibgemp"       long_name="global mean emp"                          unit="kg/m2/day"   /> 
    380     <field id="ibgsfxbri"    long_name="global mean ice sfx_bri"                  unit="psu*kg/m2/day"   /> 
    381     <field id="ibgsfxthd"    long_name="global mean ice sfx_thd"                  unit="psu*kg/m2/day"   /> 
    382     <field id="ibgsfxres"    long_name="global mean ice sfx_res"                  unit="psu*kg/m2/day"   /> 
    383     <field id="ibgsfxmec"    long_name="global mean ice fsalt_rpo"                unit="psu*kg/m2/day"   /> 
    384     <field id="ibggrpme"     long_name="global mean ice growth+melt volume"       unit="km3"      /> 
     420 
     421    <field id="ibgvfx"       long_name="global mean volume flux (emp)"               unit="m/day"   /> 
     422    <field id="ibgvfxbog"    long_name="global mean volume flux (bottom growth)"     unit="m/day"   /> 
     423    <field id="ibgvfxopw"    long_name="global mean volume flux (open water growth)" unit="m/day"   /> 
     424    <field id="ibgvfxsni"    long_name="global mean volume flux (snow-ice growth)"   unit="m/day"   /> 
     425    <field id="ibgvfxdyn"    long_name="global mean volume flux (dynamic growth)"    unit="m/day"   /> 
     426    <field id="ibgvfxbom"    long_name="global mean volume flux (bottom melt)"       unit="m/day"   /> 
     427    <field id="ibgvfxsum"    long_name="global mean volume flux (surface melt)"      unit="m/day"   /> 
     428    <field id="ibgvfxres"    long_name="global mean volume flux (resultant)"         unit="m/day"   /> 
     429    <field id="ibgvfxspr"    long_name="global mean volume flux (snow precip)"       unit="m/day"   /> 
     430    <field id="ibgvfxsnw"    long_name="global mean volume flux (snow melt)"         unit="m/day"   /> 
     431    <field id="ibgvfxsub"    long_name="global mean volume flux (snow sublimation)"  unit="m/day"   /> 
     432 
     433    <field id="ibgsfx"       long_name="global mean salt flux (total)"            unit="psu*m/day"   /> 
     434    <field id="ibgsfxbri"    long_name="global mean salt flux (brines)"           unit="psu*m/day"   /> 
     435    <field id="ibgsfxdyn"    long_name="global mean salt flux (dynamic)"          unit="psu*m/day"   /> 
     436    <field id="ibgsfxres"    long_name="global mean salt flux (resultant)"        unit="psu*m/day"   /> 
     437    <field id="ibgsfxbog"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     438    <field id="ibgsfxopw"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     439    <field id="ibgsfxsni"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     440    <field id="ibgsfxbom"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     441    <field id="ibgsfxsum"    long_name="global mean salt flux (thermo)"           unit="psu*m/day"   /> 
     442 
     443 
     444        <field id="ibghfxdhc"    long_name="Heat content variation in snow and ice"   unit="W" /> 
     445        <field id="ibghfxspr"    long_name="Heat content of snow precip"              unit="W" /> 
     446 
     447        <field id="ibghfxthd"   long_name="heat fluxes from ice-ocean exchange during thermo"              unit="W"  /> 
     448        <field id="ibghfxsum"   long_name="heat fluxes causing surface ice melt"              unit="W"  /> 
     449        <field id="ibghfxbom"   long_name="heat fluxes causing bottom ice melt"              unit="W"  /> 
     450        <field id="ibghfxbog"   long_name="heat fluxes causing bottom ice growth"              unit="W"  /> 
     451        <field id="ibghfxdif"   long_name="heat fluxes causing ice temperature change"              unit="W"  /> 
     452        <field id="ibghfxopw"   long_name="heat fluxes causing open water ice formation"              unit="W"  /> 
     453        <field id="ibghfxdyn"   long_name="heat fluxes from ice-ocean exchange during dynamic"             unit="W"  /> 
     454        <field id="ibghfxres"   long_name="heat fluxes from ice-ocean exchange during resultant"           unit="W"  /> 
     455        <field id="ibghfxsub"   long_name="heat fluxes from sublimation"                                   unit="W"  /> 
     456        <field id="ibghfxsnw"   long_name="heat fluxes from snow-ocean exchange"                           unit="W"  /> 
     457        <field id="ibghfxout"   long_name="non solar heat fluxes received by the ocean"                    unit="W"  /> 
     458        <field id="ibghfxin"    long_name="total heat fluxes at the ice surface"                           unit="W"  /> 
     459 
     460    <field id="ibgfrcvol"    long_name="global mean forcing volume (emp)"         unit="km3"      /> 
     461    <field id="ibgfrcsfx"    long_name="global mean forcing salt   (sfx)"         unit="psu*km3"   /> 
     462    <field id="ibgvolgrm"    long_name="global mean ice growth+melt volume"       unit="km3"      /> 
    385463      </field_group> 
    386464   

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r4205 r4921  
    1515!----------------------------------------------------------------------- 
    1616   cn_icerst_in  = "restart_ice"   !  suffix of ice restart name (input) 
    17    cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output) 
    18    ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F) 
    19    amax        = 0.999      !  maximum ice concentration 
    20    cai         =  1.40e-3  !  atmospheric drag over sea ice 
    21    cao         =  1.00e-3  !  atmospheric drag over ocean 
    22    ln_nicep    = .false.   !  Ice points output for debug (yes or no) 
    23    ln_limdiahsb  = .false.    !  check the heat and salt budgets (T) or not (F) 
    24    ln_limdiaout  = .false.    !  output the heat and salt budgets (T) or not (F) 
     17   cn_icerst_out = "restart_ice"   !  suffix of ice restart name (output) 
     18   ln_limdyn     = .true.          !  ice dynamics (T) or thermodynamics only (F) 
     19   amax          = 0.999           !  maximum ice concentration 
     20   cai           = 1.40e-3         !  atmospheric drag over sea ice (clio) 
     21   cao           = 1.00e-3         !  atmospheric drag over ocean   (clio) 
     22   ln_nicep      = .false.         !  Ice points output for debug (yes or no) 
     23   ln_limdiahsb  = .false.          !  check the heat and salt budgets (T) or not (F) 
     24   ln_limdiaout  = .true.          !  output the heat and salt budgets (T) or not (F) 
    2525/ 
    2626!----------------------------------------------------------------------- 
    2727&namiceini     !   ice initialisation 
    2828!----------------------------------------------------------------------- 
    29    ttest       =  2.0      !  threshold water temperature for initial sea ice 
    30    hninn       =  0.3      !  initial snow thickness in the north 
    31    hnins       =  0.1      !        "            "          south 
    32    hginn       =  3.50     !  initial undeformed ice thickness in the north 
    33    hgins       =  1.0      !        "            "              "     south 
    34    aginn       =  0.95     !  initial undeformed ice concentration in the north 
    35    agins       =  0.9      !        "            "              "         south 
    36    sinn        =  6.301    !  initial salinity in the north 
    37    sins        =  6.301    !        "            "    south 
     29   ln_limini   = .false.   !  activate ice initialization (T) or not (F) 
     30   thres_sst   =  0.0      !  threshold water temperature for initial sea ice 
     31   hts_ini_n   =  0.3      !  initial snow thickness in the north 
     32   hts_ini_s   =  0.3      !        "            "          south 
     33   hti_ini_n   =  1.0      !  initial ice thickness in the north 
     34   hti_ini_s   =  1.0      !        "            "         south 
     35   ati_ini_n   =  0.9      !  initial ice concentration in the north 
     36   ati_ini_s   =  0.9      !        "            "             south 
     37   smi_ini_n   =  6.301    !  initial ice salinity in the north 
     38   smi_ini_s   =  6.301    !        "            "    south 
     39   tmi_ini_n   =  270.     !  initial ice/snw temp in the north 
     40   tmi_ini_s   =  270.     !  initial ice/snw temp in the south 
    3841/ 
    3942!----------------------------------------------------------------------- 
    … …  
    4144!----------------------------------------------------------------------- 
    4245   epsd        =   1.0e-20 !  tolerance parameter 
    43    alpha       =   0.5     !  coefficient for semi-implicit coriolis 
    44    dm          =   0.6e+03 !  diffusion constant for dynamics 
    45    nbiter      =   1       !  number of sub-time steps for relaxation 
    46    nbitdr      = 500       !  maximum number of iterations for relaxation 
    4746   om          =   0.5     !  relaxation constant  
    48    resl        =   5.0e-05 !  maximum value for the residual of relaxation 
    4947   cw          =   5.0e-03 !  drag coefficient for oceanic stress 
    5048   angvg       =   0.0     !  turning angle for oceanic stress 
    5149   pstar       =   2.0e+04 !  1st bulk-rheology parameter 
    5250   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter 
    53    etamn       =   0.0e+07 !  minimun value for viscosity 
    5451   creepl      =   1.0e-12 !  creep limit 
    5552   ecc         =   2.0     !  eccentricity of the elliptical yield curve 
    5653   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s] 
    57    nevp        = 300       !  number of iterations for subcycling in EVP, SB, 400 
    58    telast      =9600.0     !  timescale for elastic waves, SB, 720.0 
     54   nevp        = 120       !  number of iterations for subcycling in EVP 
     55   relast      = 0.333     !  ratio of elastic timescale over ice time step (1/3 if nevp=120 ; 1/9 if nevp=300) 
    5956   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses 
    6057   hminrhg     =   0.001   !  ice volume (a*h in m) below which ice velocity equal ocean velocity 
    61 / 
    62 !----------------------------------------------------------------------- 
    63 &namicetrp     !   ice transport 
    64 !----------------------------------------------------------------------- 
    65    bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip) 
    6658/ 
    6759!----------------------------------------------------------------------- 
    … …  
    6961!----------------------------------------------------------------------- 
    7062   hmelt       = -0.15     !  maximum melting at the bottom 
    71    hiccrit     = 0.1 , 0.1 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere 
     63   hiccrit     = 0.1       !  ice thickness for lateral accretion  
    7264                           !         caution 1.0, 1.0 best value to be used!!! (gilles G.)  ???? 
    73    fraz_swi    = 0.0       !  use of frazil ice collection thickness in function of wind (1.0) or not (0.0) 
     65   fraz_swi    = 0         !  use of frazil ice collection thickness in function of wind (1.0) or not (0.0) 
    7466   maxfrazb    = 0.0       !  maximum portion of frazil ice collecting at the ice bottom 
    7567   vfrazb      = 0.4166667 !  thresold drift speed for frazil ice collecting at the ice bottom 
    7668   Cfrazb      = 5.0       !  squeezing coefficient for frazil ice collecting at the ice bottom 
    77    hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket 
    7869   hiclim      = 0.10      !  minimum ice thickness 
    79    sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice 
    80                            !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0) 
    81    parlat      = 0.0       !  percentage of energy used for lateral ablation 
    82    hakspl      = 0.25      !  slope of distr. for Hakkinen-Mellor's lateral melting 
    83    hibspl      = 0.5       !  slope of distribution for Hibler's lateral melting 
    84    exld        = 2.0       !  exponent for leads-closure rate 
    85    hakdif      = 1.0       !  coefficient for diffusions of ice and snow 
    86    thth        = 0.2       !  threshold thickness for comp. of eq. thermal conductivity 
    8770   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation 
    8871   parsub      = 1.0       !  switch for snow sublimation or not 
    89    alphs       = 1.0       !  coefficient for snow density when snow ice formation 
    9072   betas       = 0.6       !  exponent in lead-ice fractionation of snow precipitation 0.66 
    9173                           !        betas = 1 -> equipartition, betas < 1 -> more on leads 
    … …  
    124106   astar            =   0.05 !  equivalent of gstar (0.05 for TH75 and 0.03 for weaker ice) 
    125107   Hstar            = 100.0  !  parameter determining the maximum thickness of ridged ice 
    126    raftswi          =   1    !  rafting or not 
     108   raft_swi         =   1    !  rafting or not 
    127109   hparmeter        =   0.75 !  threshold thickness for rafting or not 
    128110   Craft            =   5.0  !  coefficient used in the rafting function 
    129111   ridge_por        =   0.3  !  initial porosity of the ridged ice (typically 0.30) 
    130    sal_max_ridge    =  15.0  !  maximum ridged ice salinity 
    131112   partfun_swi      =   1    !  participation function linear, TH75 (0) or exponential Letal07 (1) 
    132    transfun_swi     =   0    !  transfer function uniform of H80 (0) or exponential Letal07 (1) 
    133113   brinstren_swi    =   0    !  (1) use brine volume to diminish ice strength 
    134114/ 
    … …  
    144124!&namicehsb       !  Heat and salt budgets  
    145125!!----------------------------------------------------------------------- 
    146 ! 
    147126!/ 
    148 !----------------------------------------------------------------------- 
    149 &namiceout     !   parameters for outputs 
    150 !----------------------------------------------------------------------- 
    151    noumef      =   43      !  number of fields 
    152    add_diag_swi=    1      !  1 -> diagnose distribution in thickness space 
    153                            !  0 -> only simple diagnostics 
    154 ! 
    155 !           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive ! 
    156 !           !                                      !           !           ! or not !  factor  !  factor  ! 
    157    field_1  = 'Ice concentration                  ', 'iiceconc', '%       ',    1   ,  1.0     ,    0.0 
    158    field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0 
    159    field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0 
    160    field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'km3/day ',    1   , 1.0e-9   ,    0.0 
    161    field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'km3/day ',    1   , 1.0e-9   ,    0.0 
    162    field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0 
    163    field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0 
    164    field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0 
    165    field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15 
    166    field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0 
    167    field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    168    field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    169    field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0 
    170    field_14 = 'Heat flux due to brine release     ', 'iocehebr', 'w/m2    ',    1   ,  1.0     ,    0.0 
    171    field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0 
    172    field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0  
    173    field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    174    field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0 
    175    field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    176    field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0 
    177    field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0 
    178    field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    179    field_23 = 'Daily snowice ice production       ', 'iicesipr', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    180    field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15 
    181    field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0 
    182    field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15 
    183    field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15 
    184    field_28 = 'Fsbri - brine salt flux            ', 'iicefsbr', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    185    field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicefseq', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    186    field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0 
    187    field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0 
    188    field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0 
    189    field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0 
    190    field_34 = 'Surface melt                       ', 'iicesume', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    191    field_35 = 'Bottom melt                        ', 'iicebome', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    192    field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    193    field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0 
    194    field_38 = 'Daily resultant ice prod/melt      ', 'iicerepr', 'km3/day ',    1   ,  1.0e-9  ,    0.0 
    195    field_39 = 'Ice volume                         ', 'iicevolu', 'km3     ',    1   ,  1.0e-9  ,    0.0 
    196    field_40 = 'Snow volume                        ', 'isnowvol', 'km3     ',    1   ,  1.0e-9  ,    0.0 
    197    field_41 = 'Fsrpo - salt flux from ridg/raft   ', 'iicefsrp', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    198    field_42 = 'Fsres - salt flux from limupdate   ', 'iicefsre', 'kg/m2/d ',    1   ,  1.0     ,    0.0 
    199    field_43 = 'Ice volume transport               ', 'iicevtrp', 'km3/day ',    1   ,1.0e-9    ,    0.0 
    200 /  
    201127 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/SHARED/namelist_ref

    r4384 r4921  
    183183/ 
    184184!----------------------------------------------------------------------- 
     185&namc1d        !   1D configuration options                             ("key_c1d") 
     186!----------------------------------------------------------------------- 
     187   rn_lat1d    =      50   !  Column latitude (default at PAPA station) 
     188   rn_lon1d    =    -145   !  Column longitude (default at PAPA station) 
     189   ln_c1d_locpt=  .true.   ! Localization of 1D config in a grid (T) or independant point (F) 
     190/ 
     191!----------------------------------------------------------------------- 
    185192&namtsd    !   data : Temperature  & Salinity 
    186193!----------------------------------------------------------------------- 
    … …  
    240247   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave) 
    241248   ln_sdw  = .false.       !  Computation of 3D stokes drift                (T => fill namsbc_wave) 
     249   nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
     250                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    242251   cn_iceflx = 'linear'    !  redistribution of solar input into ice categories during coupling ice/atm. 
    243252/ 
    … …  
    559568    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state 
    560569                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     570    cn_ice_lim      =  'none'             !   
     571    nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state 
     572                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     573    rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice 
     574    rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           -- 
     575    rn_ice_age      = 30.                 !  lim3 only:      --   age                -- 
     576 
    561577    ln_tra_dmp    =.false.                !  open boudaries conditions for tracers 
    562578    ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities 
    … …  
    579595   bn_tem  =    'amm12_bdyT_tra' ,         24        , 'votemper' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    580596   bn_sal  =    'amm12_bdyT_tra' ,         24        , 'vosaline' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     597! for lim2 
     598!   bn_frld  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     599!   bn_hicif =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     600!   bn_hsnif =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     601! for lim3 
     602!   bn_a_i  =    'amm12_bdyT_ice' ,         24        , 'ileadfra' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     603!   bn_ht_i =    'amm12_bdyT_ice' ,         24        , 'iicethic' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
     604!   bn_ht_s =    'amm12_bdyT_ice' ,         24        , 'isnowthi' ,     .true.     , .false. ,  'daily'  ,    ''    ,   ''     , '' 
    581605   cn_dir  =    'bdydta/' 
    582606   ln_full_vel = .false. 
    … …  
    957981                           !     (no physical validity of the results) 
    958982   nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0) 
    959 / 
    960 !----------------------------------------------------------------------- 
    961 &namc1d        !   1D configuration options                             ("key_c1d") 
    962 !----------------------------------------------------------------------- 
    963    rn_lat      =    50     !  Column latitude 
    964    rn_lon      =    -145   !  Column longitude 
    965983/ 
    966984!----------------------------------------------------------------------- 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/CONFIG/cfg.txt

    r4529 r4921  
    66ORCA2_SAS_LIM OPA_SRC SAS_SRC LIM_SRC_2 NST_SRC 
    77C1D_PAPA OPA_SRC 
    8 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 
    98ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    109AMM12 OPA_SRC 
    1110GYRE_BFM OPA_SRC TOP_SRC 
    1211ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     12ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r4624 r4921  
    440440      !-------------------------------------------------------------------------------- 
    441441      ztmp(:,:) = 1. - pfrld(:,:)                                ! fraction of ice after the dynamic, before the thermodynamic 
    442       CALL iom_put( 'ioceflxb', fbif )                           ! Oceanic flux at the ice base           [W/m2 ???] 
    443442      CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) )   ! Ice surface temperature                [Celius] 
    444443      CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice                [W/m2] 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r4624 r4921  
    333333      CALL histdef( kid, "ileadfra", "Ice concentration"       , "-"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    334334      CALL histdef( kid, "iicetemp", "Ice temperature"         , "K"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    335       CALL histdef( kid, "ioceflxb", "flux at ice base"        , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    336335      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    337336      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    … …  
    351350      CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) ) 
    352351      CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) ) 
    353       CALL histwrite( kid, "ioceflxb", kt, fbif           , jpi*jpj, (/1/) ) 
    354352      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) ) 
    355353      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) ) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r4333 r4921  
    105105   !! ** Global variables                                                 | 
    106106   !!-------------|-------------|---------------------------------|-------| 
    107    !! a_i         | a_i_b       |    Ice concentration            |       | 
     107   !! a_i         | a_i_1d      |    Ice concentration            |       | 
    108108   !! v_i         |      -      |    Ice volume per unit area     | m     | 
    109109   !! v_s         |      -      |    Snow volume per unit area    | m     | 
    … …  
    111111   !! oa_i        !      -      !    Sea ice areal age content    | day   | 
    112112   !! e_i         !      -      !    Ice enthalpy                 | 10^9 J|  
    113    !!      -      ! q_i_b       !    Ice enthalpy per unit vol.   | J/m3  |  
     113   !!      -      ! q_i_1d      !    Ice enthalpy per unit vol.   | J/m3  |  
    114114   !! e_s         !      -      !    Snow enthalpy                | 10^9 J|  
    115    !!      -      ! q_s_b       !    Snow enthalpy per unit vol.  | J/m3  |  
     115   !!      -      ! q_s_1d      !    Snow enthalpy per unit vol.  | J/m3  |  
    116116   !!                                                                     | 
    117117   !!-------------|-------------|---------------------------------|-------| 
    … …  
    120120   !!-------------|-------------|---------------------------------|-------| 
    121121   !!                                                                     | 
    122    !! ht_i        | ht_i_b      |    Ice thickness                | m     | 
    123    !! ht_s        ! ht_s_b      |    Snow depth                   | m     | 
    124    !! sm_i        ! sm_i_b      |    Sea ice bulk salinity        ! ppt   | 
    125    !! s_i         ! s_i_b       |    Sea ice salinity profile     ! ppt   | 
     122   !! ht_i        | ht_i_1d     |    Ice thickness                | m     | 
     123   !! ht_s        ! ht_s_1d     |    Snow depth                   | m     | 
     124   !! sm_i        ! sm_i_1d     |    Sea ice bulk salinity        ! ppt   | 
     125   !! s_i         ! s_i_1d      |    Sea ice salinity profile     ! ppt   | 
    126126   !! o_i         !      -      |    Sea ice Age                  ! days  | 
    127    !! t_i         ! t_i_b       |    Sea ice temperature          ! K     | 
    128    !! t_s         ! t_s_b       |    Snow temperature             ! K     | 
    129    !! t_su        ! t_su_b      |    Sea ice surface temperature  ! K     | 
     127   !! t_i         ! t_i_1d      |    Sea ice temperature          ! K     | 
     128   !! t_s         ! t_s_1d      |    Snow temperature             ! K     | 
     129   !! t_su        ! t_su_1d     |    Sea ice surface temperature  ! K     | 
    130130   !!                                                                     | 
    131131   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   | 
    … …  
    142142   !! ***         Category-summed state variables (diagnostic)        *** | 
    143143   !! ******************************************************************* | 
    144    !! at_i        | at_i_b      |    Total ice concentration      |       | 
     144   !! at_i        | at_i_1d     |    Total ice concentration      |       | 
    145145   !! vt_i        |      -      |    Total ice vol. per unit area | m     | 
    146146   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     | 
    … …  
    166166 
    167167   !                                     !!** ice-dynamic namelist (namicedyn) ** 
    168    INTEGER , PUBLIC ::   nbiter           !: number of sub-time steps for relaxation 
    169    INTEGER , PUBLIC ::   nbitdr           !: maximum number of iterations for relaxation 
    170168   INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling 
    171    INTEGER , PUBLIC ::   nlay_i = 5            !: number of layers in the ice 
    172  
    173    !                                     !!** ice-dynamic namelist (namicedyn) ** 
    174169   REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic 
    175    REAL(wp), PUBLIC ::   alpha            !: coefficient for semi-implicit coriolis 
    176    REAL(wp), PUBLIC ::   dm               !: diffusion constant for dynamics 
    177170   REAL(wp), PUBLIC ::   om               !: relaxation constant 
    178    REAL(wp), PUBLIC ::   resl             !: maximum value for the residual of relaxation 
    179171   REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress 
    180172   REAL(wp), PUBLIC ::   angvg            !: turning angle for oceanic stress 
    181173   REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79 
    182174   REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength 
    183    REAL(wp), PUBLIC ::   etamn            !: minimun value for viscosity : has to be 0 
    184175   REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9 
    185176   REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve 
    186177   REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    187    REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) !SB 
    188    REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses !SB 
     178   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s) 
     179   REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)  
     180   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses  
    189181   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy 
    190    REAL(wp), PUBLIC ::   hminrhg = 0.001_wp    !: clem : ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
     182   REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity 
    191183 
    192184   !                                     !!** ice-salinity namelist (namicesal) ** 
    … …  
    202194 
    203195   !                                     !!** ice-salinity namelist (namicesal) ** 
    204    INTEGER , PUBLIC ::   num_sal          !: salinity configuration used in the model 
     196   INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model 
    205197   !                                         ! 1 - constant salinity in both space and time 
    206198   !                                         ! 2 - prognostic salinity (s(z,t)) 
    207199   !                                         ! 3 - salinity profile, constant in time 
    208    INTEGER , PUBLIC ::   sal_prof    = 1           !: salinity profile or not  
    209    INTEGER , PUBLIC ::   thcon_i_swi          !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007) 
     200   INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 
    210201 
    211202   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    … …  
    220211   REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting 
    221212   REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value) 
    222    REAL(wp), PUBLIC ::   sal_max_ridge    !: maximum ridged ice salinity (ppt) 
    223213   REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice 
    224214   REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 
    … …  
    228218   !                                     !!** ice-mechanical redistribution namelist (namiceitdme) 
    229219   INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging 
    230    INTEGER , PUBLIC ::   raftswi          !: rafting of ice or not                         
     220   INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                         
    231221   INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 
    232    INTEGER , PUBLIC ::   transfun_swi     !: transfer function: =0 Hibler 1980, =1 Lipscomb et al. 2007 
    233222   INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength 
    234223 
    … …  
    249238   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1] 
    250239   ! 
    251    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   firic       !: IR flux over the ice (diag only) 
    252    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcsic       !: Sensible heat flux over the ice (diag only) 
    253    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fleic       !: Latent heat flux over the ice (diag only) 
    254    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlatic      !: latent flux 
    255    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif     !: Variation of volume at surface (diag only) 
    256    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif     !: Variation of ice volume at the bottom ice (diag only) 
    257    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif     !: Total variation of ice volume (diag only) 
    258    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif     !: Lateral Variation of ice volume (diag only) 
    259240   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin] 
    260241   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only) 
    261242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]      
    262    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp      !: Ice production/melting==>!obsolete... can be removed 
    263243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction 
    264244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time   
    265245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness 
    266    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif        !: Heat flux at the ice base 
    267    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_snw     !: Variation of snow mass over 1 time step     [Kg/m2] 
    268    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_snw     !: Heat content associated with rdm_snw        [J/m2] 
    269    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdm_ice     !: Variation of ice mass over 1 time step      [Kg/m2] 
    270    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdq_ice     !: Heat content associated with rdm_ice        [J/m2] 
    271    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif       !: heat balance of the lead (or of the open ocean) 
    272    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif       !: Energy needed to bring the ocean to freezing  
    273    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn       !: net downward heat flux from the ice to the ocean 
    274    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn       !: energy from the ice to the ocean 
    275    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric      !: transmitted solar radiation under ice 
    276    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq      !: associated with lead chipotage with solar flux 
    277    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif     !: related to max heat contained in brine pockets (?) 
    278    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq       !: Also linked with the solar flux below the ice (?) 
    279    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq       !: store energy in case of total lateral ablation (?) 
    280    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi       !: Variation of the mass of snow ice 
    281    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_thd     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean) 
     247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean 
     248   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting 
     249 
     250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2] 
     251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2] 
     252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2] 
     253 
     254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2] 
     255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2] 
     256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2] 
     257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2] 
     258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2] 
     259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2] 
     260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2] 
     261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2] 
     262 
     263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
     267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s] 
    282268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                      [PSU/m2/s] 
    283    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_mec     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s] 
    284270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s] 
    285    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhbri       !: heat flux due to brine rejection 
    286    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_mec   !: heat flux associated with porous ridged ice formation [???] 
    287    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_res   !: residual heat flux due to correction of ice thickness 
    288    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmec       !: mass flux due to snow loss during compression         [Kg/m2/s] 
    289    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhmec       !: heat flux due to snow loss during compression 
     271 
     272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth  
     273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt  
     274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt  
     275   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation 
     276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice  
     277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt  
     278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion  
     279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping  
     280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations  
     281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations  
     282 
     283   ! heat flux associated with ice-atmosphere mass exchange 
     284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation  
     285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation  
     286 
     287   ! heat flux associated with ice-ocean mass exchange 
     288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)  
     289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)  
     290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness 
     291 
     292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice 
    290293 
    291294   ! temporary arrays for dummy version of the code 
    292    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s 
     295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s 
    293296 
    294297   !!-------------------------------------------------------------------------- 
    … …  
    321324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i          !: mean sea ice salinity averaged over all categories [PSU] 
    322325 
    323    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   at_i_typ     !: total area   contained in each ice type [m^2] 
    324    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vt_i_typ     !: total volume contained in each ice type [m^3] 
    325  
    326326   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s        !: Snow temperatures [K] 
    327327   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s        !: Snow ...       
    328  
    329    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e_i_cat    !: ! go to trash 
    330328       
    331329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K] 
    … …  
    348346   !! * Old values of global variables 
    349347   !!-------------------------------------------------------------------------- 
    350    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_v_s, old_v_i               !: snow and ice volumes 
    351    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_a_i, old_smv_i, old_oa_i   !: ??? 
    352    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_s                        !: snow heat content 
    353    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_i                        !: ice temperatures 
    354    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   old_u_ice, old_v_ice           !: ice velocity (gv6 and gv7) 
     348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   v_s_b, v_i_b               !: snow and ice volumes 
     349   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   a_i_b, smv_i_b, oa_i_b     !: 
     350   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s_b                      !: snow heat content 
     351   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i_b                      !: ice temperatures 
     352   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   u_ice_b, v_ice_b           !: ice velocity 
    355353       
    356354 
    … …  
    375373   !! * Ice thickness distribution variables 
    376374   !!-------------------------------------------------------------------------- 
    377    ! REMOVE 
    378    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_types      !: Vector connecting types and categories 
    379    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ice_cat_bounds !: Matrix containing the integer upper and  
    380    !                                                                       !  lower boundaries of ice thickness categories 
    381    ! REMOVE 
    382    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_ncat_types !: nb of thickness categories in each ice type 
    383375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space 
    384376   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories  
    385    ! REMOVE 
    386    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_max_typ     !: Boundary of ice thickness categories in thickness space 
    387377 
    388378   !!-------------------------------------------------------------------------- 
    … …  
    404394   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F) 
    405395   LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F) 
    406    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   v_newice   !: volume of ice formed in the leads 
    407    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd  !: thermodynamic growth rates  
    408    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero, fstroc, fhbricat 
    409    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sni_gr   ! snow ice growth  
    410    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_lat_gr   ! lateral ice growth  
    411    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_gr   ! bottom ice growth  
    412    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_dyn_gr   ! dynamical ice growth  
    413    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_me   ! vertical bottom melt  
    414    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sur_me   ! vertical surface melt 
    415    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_res_pr   ! production (growth+melt) due to limupdate 
    416    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   ! transport of ice volume 
     396   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates  
     397   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero 
     398   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume 
     399   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume 
     400   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2) 
     401   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2) 
     402   ! 
     403   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]  
     404   ! 
    417405   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point 
    418406 
    … …  
    447435 
    448436      ii = ii + 1 
    449       ALLOCATE( firic    (jpi,jpj) , fcsic  (jpi,jpj) , fleic  (jpi,jpj) , qlatic   (jpi,jpj) ,     & 
    450          &      rdvosif  (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif(jpi,jpj) , rdvonif  (jpi,jpj) ,     & 
    451          &      sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) , hicifp   (jpi,jpj) ,     & 
    452          &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) , fbif     (jpi,jpj) ,     & 
    453          &      rdm_snw  (jpi,jpj) , rdq_snw(jpi,jpj) , rdm_ice(jpi,jpj) , rdq_ice  (jpi,jpj) ,     & 
    454          &                                              qldif  (jpi,jpj) , qcmif    (jpi,jpj) ,     & 
    455          &      fdtcn    (jpi,jpj) , qdtcn  (jpi,jpj) , fstric (jpi,jpj) , fscmbq   (jpi,jpj) ,     & 
    456          &      ffltbif  (jpi,jpj) , fsbbq  (jpi,jpj) , qfvbq  (jpi,jpj) , dmgwi    (jpi,jpj) ,     & 
    457          &      sfx_res  (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_mec(jpi,jpj) , fheat_mec(jpi,jpj) ,    & 
    458          &      fhbri    (jpi,jpj) , fmmec  (jpi,jpj) , sfx_thd(jpi,jpj) , fhmec    (jpi,jpj) ,     & 
    459          &      fheat_res(jpi,jpj)                                                            , STAT=ierr(ii) ) 
    460  
    461       ii = ii + 1 
    462       ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) ,     & 
    463          &      fsup2D     (jpi,jpj) , focea2D    (jpi,jpj) , q_s   (jpi,jpj) , STAT=ierr(ii) ) 
     437      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      & 
     438         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      & 
     439         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    & 
     440         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     & 
     441         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     & 
     442         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      & 
     443         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      & 
     444         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   & 
     445         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 
     446         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  & 
     447         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & 
     448         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) ) 
     449 
     450      ii = ii + 1 
     451      ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) ) 
    464452 
    465453      ! * Ice global state variables 
    … …  
    475463         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) ) 
    476464      ii = ii + 1 
    477       ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,                            & 
    478          &      e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) ) 
    479       ii = ii + 1 
    480       ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) ) 
     465      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) ,                            & 
     466         &      e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 
     467      ii = ii + 1 
     468      ALLOCATE( t_i(jpi,jpj,nlay_i+1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) ) 
    481469 
    482470      ! * Moments for advection 
    … …  
    494482         &      STAT=ierr(ii) ) 
    495483      ii = ii + 1 
    496       ALLOCATE( sxe (jpi,jpj,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) ,     & 
    497          &      syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl)                           , STAT=ierr(ii) ) 
     484      ALLOCATE( sxe (jpi,jpj,nlay_i+1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) ,     & 
     485         &      syye(jpi,jpj,nlay_i+1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl)                           , STAT=ierr(ii) ) 
    498486 
    499487      ! * Old values of global variables 
    500488      ii = ii + 1 
    501       ALLOCATE( old_v_s  (jpi,jpj,jpl) , old_v_i  (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) ,     & 
    502          &      old_a_i  (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) ,     & 
    503          &      old_oa_i (jpi,jpj,jpl)                                                        ,     & 
    504          &      old_u_ice(jpi,jpj)     , old_v_ice(jpi,jpj)                                   , STAT=ierr(ii) ) 
     489      ALLOCATE( v_s_b  (jpi,jpj,jpl) , v_i_b  (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,     & 
     490         &      a_i_b  (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i+1 ,jpl) ,     & 
     491         &      oa_i_b (jpi,jpj,jpl)                                                        ,     & 
     492         &      u_ice_b(jpi,jpj)     , v_ice_b(jpi,jpj)                                   , STAT=ierr(ii) ) 
    505493 
    506494      ! * Increment of global variables 
    … …  
    512500         &     STAT=ierr(ii) ) 
    513501      ii = ii + 1 
    514       ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
    515          &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
     502      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,nlay_i+1,jpl) , d_u_ice_dyn(jpi,jpj) ,     & 
     503         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,nlay_i+1,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) ) 
    516504       
    517505      ! * Ice thickness distribution variables 
    518506      ii = ii + 1 
    519       ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types  (jpm) ,     & 
    520          &      hi_max (0:jpl) , hi_mean(jpl)          , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) ) 
     507      ALLOCATE( hi_max(0:jpl), hi_mean(jpl),  STAT=ierr(ii) ) 
    521508 
    522509      ! * Ice diagnostics 
    523510      ii = ii + 1 
    524       ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) ,     & 
    525          &      izero    (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) ,     & 
    526          &      fstroc   (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) ,     & 
    527          &      fhbricat (jpi,jpj,jpl) , diag_res_pr(jpi,jpj) , diag_trp_vi(jpi,jpj) , v_newice(jpi,jpj) , STAT=ierr(ii) ) 
     511      ALLOCATE( dv_dt_thd(jpi,jpj,jpl), izero (jpi,jpj,jpl),    & 
     512         &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   &  
     513         &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) ) 
    528514 
    529515      ice_alloc = MAXVAL( ierr(:) ) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90

    r4624 r4921  
    6666      ! 
    6767      !                                ! adequation jpk versus ice/snow layers/categories 
    68       IF( jpl   > jpk  .OR.  jpm    > jpk .OR.                                    & 
    69           jkmax > jpk  .OR.  nlay_s > jpk      )   CALL ctl_stop( 'STOP',         & 
     68      IF( jpl > jpk .OR. (nlay_i+1) > jpk .OR. nlay_s > jpk )   & 
     69         &      CALL ctl_stop( 'STOP',                     & 
    7070         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   & 
    7171         &     'use more ocean levels or less ice/snow layers/categories.' ) 
    … …  
    8989      CALL lim_itd_ini                 ! ice thickness distribution initialization 
    9090      ! 
     91      CALL lim_itd_me_init             ! ice thickness distribution initialization 
    9192      !                                ! Initial sea-ice state 
    9293      IF( .NOT. ln_rstart ) THEN              ! start from rest 
    … …  
    173174      !!              limistate (only) and is changed to 99 m in ice_init 
    174175      !!------------------------------------------------------------------ 
    175       INTEGER  ::   jl, jm               ! dummy loop index 
     176      INTEGER  ::   jl                   ! dummy loop index 
    176177      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars 
    177178      !!------------------------------------------------------------------ 
    … …  
    184185      ! 1) Ice thickness distribution parameters initialization     
    185186      !------------------------------------------------------------------------------! 
    186  
    187       !- Types boundaries (integer) 
    188       !---------------------------- 
    189       ice_cat_bounds(1,1) = 1 
    190       ice_cat_bounds(1,2) = jpl 
    191  
    192       !- Number of ice thickness categories in each ice type 
    193       DO jm = 1, jpm 
    194          ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1  
    195       END DO 
    196  
    197       !- Make the correspondence between thickness categories and ice types 
    198       !--------------------------------------------------------------------- 
    199       DO jm = 1, jpm       !over types 
    200          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories 
    201             ice_types(jl) = jm 
    202          END DO 
    203       END DO 
    204  
    205187      IF(lwp) THEN   
    206          WRITE(numout,*) ' Number of ice types jpm =      ', jpm 
    207188         WRITE(numout,*) ' Number of ice categories jpl = ', jpl 
    208          DO jm = 1, jpm 
    209             WRITE(numout,*) ' Ice type ', jm 
    210             WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm) 
    211             WRITE(numout,*) ' Thickness category boundaries  ', ice_cat_bounds(jm,1:2) 
    212          END DO 
    213          WRITE(numout,*) 'Ice type vector', ice_types(1:jpl) 
    214          WRITE(numout,*) 
    215189      ENDIF 
    216190 
    … …  
    218192      !---------------------------------- 
    219193      hi_max(:) = 0._wp 
    220       hi_max_typ(:,:) = 0._wp 
    221  
    222       !- Type 1 - undeformed ice 
    223       zc1 =  3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp ) 
     194 
     195      zc1 =  3._wp / REAL( jpl, wp ) 
    224196      zc2 = 10._wp * zc1 
    225197      zc3 =  3._wp 
    226198 
    227       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    228          zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp ) 
     199      DO jl = 1, jpl 
     200         zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 
    229201         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 
    230202      END DO 
    231203 
    232       !- Fill in the hi_max_typ vector, useful in other circumstances 
    233       ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a 
    234       ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08) 
    235       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
    236          hi_max_typ(jl,1) = hi_max(jl) 
    237       END DO 
    238  
    239       IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type ' 
     204      IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 
    240205      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 
    241206 
    242       IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types ' 
    243       IF(lwp) THEN  
    244          DO jm = 1, jpm 
    245             WRITE(numout,*) ' Type number ', jm 
    246             WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm) 
    247          END DO 
    248       ENDIF 
    249207      ! 
    250208      DO jl = 1, jpl 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90

    r4161 r4921  
    3232 
    3333   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values 
    34    REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    35    REAL(wp)  ::   rone   = 1._wp       !    -       - 
    3634 
    3735   !! * Substitutions 
    … …  
    8482      DO jj = 1, jpj 
    8583         DO ji = 1, jpi 
    86             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     84            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    8785            zs1max  = 1.5 * zslpmax 
    8886            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) ) 
    8987            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      & 
    9088               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  ) 
    91             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     89            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    9290 
    9391            ps0 (ji,jj) = zslpmax   
    … …  
    106104      DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0  
    107105         DO ji = 1, jpi 
    108             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) ) 
    109             zalf         =  MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
     106            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 
     107            zalf         =  MAX( 0._wp, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj) 
    110108            zalfq        =  zalf * zalf 
    111109            zalf1        =  1.0 - zalf 
    … …  
    133131      DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0. 
    134132         DO ji = 1, fs_jpim1 
    135             zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
     133            zalf          = MAX( 0._wp, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj)  
    136134            zalg  (ji,jj) = zalf 
    137135            zalfq         = zalf * zalf 
    … …  
    269267      DO jj = 1, jpj 
    270268         DO ji = 1, jpi 
    271             zslpmax = MAX( rzero, ps0(ji,jj) ) 
     269            zslpmax = MAX( 0._wp, ps0(ji,jj) ) 
    272270            zs1max  = 1.5 * zslpmax 
    273271            zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) ) 
    274272            zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   & 
    275273               &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  ) 
    276             zin0    = ( 1.0 - MAX( rzero, SIGN( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
     274            zin0    = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask 
    277275            ! 
    278276            ps0 (ji,jj) = zslpmax   
    … …  
    291289      DO jj = 1, jpj                     !  Flux from j to j+1 WHEN v GT 0    
    292290         DO ji = 1, jpi 
    293             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) ) 
    294             zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
     291            zbet(ji,jj)  =  MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 
     292            zalf         =  MAX( 0._wp, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj) 
    295293            zalfq        =  zalf * zalf 
    296294            zalf1        =  1.0 - zalf 
    … …  
    318316      DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0. 
    319317         DO ji = 1, jpi 
    320             zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
     318            zalf          = ( MAX(0._wp, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1)  
    321319            zalg  (ji,jj) = zalf 
    322320            zalfq         = zalf * zalf 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90

    r4161 r4921  
    77   !!            3.0  ! 2004-06  (M. Vancoppenolle)   Energy Conservation  
    88   !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations 
     9   !!             -   ! 2014-05  (C. Rousset) add lim_cons_hsm 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_lim3 
    … …  
    1415   !!    lim_cons     :   checks whether energy, mass and salt are conserved  
    1516   !!---------------------------------------------------------------------- 
     17   USE phycst         ! physical constants 
    1618   USE par_ice        ! LIM-3 parameter 
    1719   USE ice            ! LIM-3 variables 
    … …  
    2830   PUBLIC   lim_column_sum_energy 
    2931   PUBLIC   lim_cons_check 
     32   PUBLIC   lim_cons_hsm 
    3033 
    3134   !!---------------------------------------------------------------------- 
    … …  
    7073      !! ** Method  : Arithmetics 
    7174      !!--------------------------------------------------------------------- 
    72       INTEGER                               , INTENT(in   ) ::   ksum   !: number of categories 
    73       INTEGER                               , INTENT(in   ) ::   klay   !: number of vertical layers 
    74       REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in   ) ::   pin   !: input field 
    75       REAL(wp), DIMENSION(jpi,jpj)          , INTENT(  out) ::   pout   !: output field 
     75      INTEGER                                  , INTENT(in   ) ::   ksum   !: number of categories 
     76      INTEGER                                  , INTENT(in   ) ::   klay   !: number of vertical layers 
     77      REAL(wp), DIMENSION(jpi,jpj,nlay_i+1,jpl), INTENT(in   ) ::   pin   !: input field 
     78      REAL(wp), DIMENSION(jpi,jpj)             , INTENT(  out) ::   pout   !: output field 
    7679      ! 
    7780      INTEGER ::   jk, jl   ! dummy loop indices 
    … …  
    151154   END SUBROUTINE lim_cons_check 
    152155 
     156 
     157   SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 
     158      !!------------------------------------------------------------------- 
     159      !!               ***  ROUTINE lim_cons_hsm *** 
     160      !! 
     161      !! ** Purpose : Test the conservation of heat, salt and mass for each routine 
     162      !! 
     163      !! ** Method  : 
     164      !!--------------------------------------------------------------------- 
     165      INTEGER         , INTENT(in)    :: icount      ! determine wether this is the beggining of the routine (0) or the end (1) 
     166      CHARACTER(len=*), INTENT(in)    :: cd_routine  ! name of the routine 
     167      REAL(wp)        , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
     168      REAL(wp)                        :: zvi,   zsmv,   zei,   zfs,   zfw,   zft 
     169      REAL(wp)                        :: zvmin, zamin, zamax  
     170 
     171      IF( icount == 0 ) THEN 
     172 
     173         zvi_b  = glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) 
     174         zsmv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
     175         zei_b  = glob_sum( SUM(   e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) 
     176         zfw_b  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     177            &                   wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     178            &             ) * area(:,:) * tms(:,:) ) 
     179         zfs_b  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     180            &                   sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  & 
     181            &                 ) * area(:,:) * tms(:,:) ) 
     182         zft_b  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     183            &                 - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     184            &                  ) * area(:,:) / unit_fac * tms(:,:) ) 
     185 
     186      ELSEIF( icount == 1 ) THEN 
     187 
     188         zfs  = glob_sum(   ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) +  & 
     189            &                 sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:)                                  &  
     190            &                ) * area(:,:) * tms(:,:) ) - zfs_b 
     191         zfw  = glob_sum( - ( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) +  & 
     192            &                 wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:)    & 
     193            &                ) * area(:,:) * tms(:,:) ) - zfw_b 
     194         zft  = glob_sum(   ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:)  &  
     195            &               - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:)   & 
     196            &                ) * area(:,:) / unit_fac * tms(:,:) ) - zft_b 
     197  
     198         zvi  = ( glob_sum( SUM(   v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * area(:,:) * tms(:,:) ) - zvi_b ) * r1_rdtice - zfw  
     199         zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zsmv_b ) * r1_rdtice + ( zfs / rhoic ) 
     200         zei  =   glob_sum( SUM( e_i(:,:,1:nlay_i,:), dim=3 ) + SUM( e_s(:,:,1:nlay_s,:), dim=3 ) ) * r1_rdtice - zei_b * r1_rdtice + zft 
     201 
     202         zvmin = glob_min(v_i) 
     203         zamax = glob_max(SUM(a_i,dim=3)) 
     204         zamin = glob_min(a_i) 
     205        
     206         IF(lwp) THEN 
     207            IF ( ABS( zvi    ) >  1.e-4 ) WRITE(numout,*) 'violation volume [kg/day]     (',cd_routine,') = ',(zvi * rday) 
     208            IF ( ABS( zsmv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday) 
     209            IF ( ABS( zei    ) >  1.    ) WRITE(numout,*) 'violation enthalpy [1e9 J]    (',cd_routine,') = ',(zei) 
     210            IF ( zvmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [m]          (',cd_routine,') = ',(zvmin) 
     211            IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > amax+1.e-10 ) THEN 
     212                                          WRITE(numout,*) 'violation a_i>amax            (',cd_routine,') = ',zamax 
     213            ENDIF 
     214            IF ( zamin <  0.            ) WRITE(numout,*) 'violation a_i<0               (',cd_routine,') = ',zamin 
     215         ENDIF 
     216 
     217      ENDIF 
     218 
     219   END SUBROUTINE lim_cons_hsm 
     220 
    153221#else 
    154222   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90

    r4909 r4921  
    1818   USE dom_oce         ! ocean domain 
    1919   USE sbc_oce         ! surface boundary condition: ocean fields 
     20   USE sbc_ice         ! Surface boundary condition: sea-ice fields 
    2021   USE daymod          ! model calendar 
    2122   USE phycst          ! physical constant 
    … …  
    3738   REAL(dp) ::   bg_grme            ! global ice growth+melt trends 
    3839   REAL(wp) ::   epsi06 = 1.e-6_wp  ! small number 
    39    REAL(wp) ::   epsi03 = 1.e-3_wp  ! small number 
    40  
    4140 
    4241   !! * Substitutions 
    … …  
    6059      !! 
    6160      REAL(dp)   ::   zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 
    62       REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec  
    63       REAL(dp)   ::   zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res  
     61      REAL(dp)   ::   zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni,   & 
     62      &               zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn  
     63      REAL(dp)   ::   zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 
     64      REAL(dp)   ::   zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub   
     65      REAL(dp)   ::   zbg_hfx_dhc, zbg_hfx_spr 
     66      REAL(dp)   ::   zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in    
     67      REAL(dp)   ::   zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 
    6468      REAL(dp)   ::   z_frc_vol, z_frc_sal, z_bg_grme  
    6569      REAL(dp)   ::   z1_area                     !    -     - 
    … …  
    8690      !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 
    8791 
    88       zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content  [10^9*1.e-11 J] 
    89       zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] 
    90  
    91       zbg_emp     = zinda * glob_sum(         emp(:,:) * area(:,:) * tms(:,:) ) * z1_area         * r1_rau0 * rday 
    92       zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    93       zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    94       zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    95       zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    96       zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    97       zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    98       zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday 
    99  
     92      ! Volume 
     93      zbg_vfx     = zinda * glob_sum(      emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     94      zbg_vfx_bog = zinda * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     95      zbg_vfx_opw = zinda * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     96      zbg_vfx_sni = zinda * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     97      zbg_vfx_dyn = zinda * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     98      zbg_vfx_bom = zinda * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     99      zbg_vfx_sum = zinda * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     100      zbg_vfx_res = zinda * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     101      zbg_vfx_spr = zinda * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     102      zbg_vfx_snw = zinda * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     103      zbg_vfx_sub = zinda * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     104 
     105      ! Salt 
    100106      zbg_sfx     = zinda * glob_sum(     sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    101107      zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    102       zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    103108      zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    104       zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
    105        
     109      zbg_sfx_dyn = zinda * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     110 
     111      zbg_sfx_bog = zinda * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     112      zbg_sfx_opw = zinda * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     113      zbg_sfx_sni = zinda * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     114      zbg_sfx_bom = zinda * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     115      zbg_sfx_sum = zinda * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 
     116 
     117      ! Heat budget 
     118      zbg_ihc      = glob_sum( et_i(:,:) * 1.e-20 ) ! ice heat content  [1.e-20 J] 
     119      zbg_shc      = glob_sum( et_s(:,:) * 1.e-20 ) ! snow heat content [1.e-20 J] 
     120      zbg_hfx_dhc  = glob_sum( diag_heat_dhc(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     121      zbg_hfx_spr  = glob_sum( hfx_spr(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     122 
     123      zbg_hfx_thd  = glob_sum( hfx_thd(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     124      zbg_hfx_dyn  = glob_sum( hfx_dyn(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     125      zbg_hfx_res  = glob_sum( hfx_res(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     126      zbg_hfx_sub  = glob_sum( hfx_sub(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     127      zbg_hfx_snw  = glob_sum( hfx_snw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     128      zbg_hfx_sum  = glob_sum( hfx_sum(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     129      zbg_hfx_bom  = glob_sum( hfx_bom(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     130      zbg_hfx_bog  = glob_sum( hfx_bog(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     131      zbg_hfx_dif  = glob_sum( hfx_dif(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     132      zbg_hfx_opw  = glob_sum( hfx_opw(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     133      zbg_hfx_out  = glob_sum( hfx_out(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     134      zbg_hfx_in   = glob_sum(  hfx_in(:,:) * area(:,:) * tms(:,:) ) ! [in W] 
     135     
    106136      ! --------------------------------------------- ! 
    107137      ! 2 - Trends due to forcing and ice growth/melt ! 
    … …  
    109139      z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes 
    110140      z_frc_sal = r1_rau0 * glob_sum(   sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes 
    111       z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + & 
    112                           &    diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
     141      z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 
     142                          &     wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + wfx_sub(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes 
    113143      ! 
    114144      frc_vol  = frc_vol  + z_frc_vol  * rdt_ice 
    … …  
    134164      CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9        )   ! ice salt content (psu*km3 equivalent liquid)         
    135165 
    136       CALL iom_put( 'ibgemp'    , zbg_emp                                  )   ! volume flux emp (m/day liquid) 
    137       CALL iom_put( 'ibgempbog' , zbg_emp_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
    138       CALL iom_put( 'ibgemplag' , zbg_emp_lag                              )   ! volume flux open water growth - 
    139       CALL iom_put( 'ibgempsig' , zbg_emp_sig                              )   ! volume flux snow ice growth   - 
    140       CALL iom_put( 'ibgempdyg' , zbg_emp_dyg                              )   ! volume flux dynamic growth    - 
    141       CALL iom_put( 'ibgempbom' , zbg_emp_bom                              )   ! volume flux bottom melt       - 
    142       CALL iom_put( 'ibgempsum' , zbg_emp_sum                              )   ! volume flux surface melt      - 
    143       CALL iom_put( 'ibgempres' , zbg_emp_res                              )   ! volume flux resultant         - 
     166      CALL iom_put( 'ibgvfx'    , zbg_vfx                                  )   ! volume flux emp (m/day liquid) 
     167      CALL iom_put( 'ibgvfxbog' , zbg_vfx_bog                              )   ! volume flux bottom growth     -(m/day equivalent liquid) 
     168      CALL iom_put( 'ibgvfxopw' , zbg_vfx_opw                              )   ! volume flux open water growth - 
     169      CALL iom_put( 'ibgvfxsni' , zbg_vfx_sni                              )   ! volume flux snow ice growth   - 
     170      CALL iom_put( 'ibgvfxdyn' , zbg_vfx_dyn                              )   ! volume flux dynamic growth    - 
     171      CALL iom_put( 'ibgvfxbom' , zbg_vfx_bom                              )   ! volume flux bottom melt       - 
     172      CALL iom_put( 'ibgvfxsum' , zbg_vfx_sum                              )   ! volume flux surface melt      - 
     173      CALL iom_put( 'ibgvfxres' , zbg_vfx_res                              )   ! volume flux resultant         - 
     174      CALL iom_put( 'ibgvfxspr' , zbg_vfx_spr                              )   ! volume flux from snow precip         - 
     175      CALL iom_put( 'ibgvfxsnw' , zbg_vfx_snw                              )   ! volume flux from snow melt         - 
     176      CALL iom_put( 'ibgvfxsub' , zbg_vfx_sub                              )   ! volume flux from sublimation         - 
    144177           
    145178      CALL iom_put( 'ibgsfx'    , zbg_sfx                                  )   ! salt flux         -(psu*m/day equivalent liquid)        
    146179      CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri                              )   ! salt flux brines  -       
    147       CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd                              )   ! salt flux thermo  -     
    148       CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec                              )   ! salt flux dynamic -     
     180      CALL iom_put( 'ibgsfxdyn' , zbg_sfx_dyn                              )   ! salt flux dynamic -     
    149181      CALL iom_put( 'ibgsfxres' , zbg_sfx_res                              )   ! salt flux result  -     
     182      CALL iom_put( 'ibgsfxbog' , zbg_sfx_bog                              )   ! salt flux bottom growth    
     183      CALL iom_put( 'ibgsfxopw' , zbg_sfx_opw                              )   ! salt flux open water growth - 
     184      CALL iom_put( 'ibgsfxsni' , zbg_sfx_sni                              )   ! salt flux snow ice growth   - 
     185      CALL iom_put( 'ibgsfxbom' , zbg_sfx_bom                              )   ! salt flux bottom melt       - 
     186      CALL iom_put( 'ibgsfxsum' , zbg_sfx_sum                              )   ! salt flux surface melt      - 
     187 
     188      CALL iom_put( 'ibghfxdhc' , zbg_hfx_dhc                              )   ! Heat content variation in snow and ice [W] 
     189      CALL iom_put( 'ibghfxspr' , zbg_hfx_spr                              )   ! Heat content of snow precip [W] 
     190 
     191      CALL iom_put( 'ibghfxres' , zbg_hfx_res                              )   !  
     192      CALL iom_put( 'ibghfxsub' , zbg_hfx_sub                              )   !  
     193      CALL iom_put( 'ibghfxdyn' , zbg_hfx_dyn                              )   !  
     194      CALL iom_put( 'ibghfxthd' , zbg_hfx_thd                              )   !  
     195      CALL iom_put( 'ibghfxsnw' , zbg_hfx_snw                              )   !  
     196      CALL iom_put( 'ibghfxsum' , zbg_hfx_sum                              )   !  
     197      CALL iom_put( 'ibghfxbom' , zbg_hfx_bom                              )   !  
     198      CALL iom_put( 'ibghfxbog' , zbg_hfx_bog                              )   !  
     199      CALL iom_put( 'ibghfxdif' , zbg_hfx_dif                              )   !  
     200      CALL iom_put( 'ibghfxopw' , zbg_hfx_opw                              )   !  
     201      CALL iom_put( 'ibghfxout' , zbg_hfx_out                              )   !  
     202      CALL iom_put( 'ibghfxin'  , zbg_hfx_in                               )   !  
    150203 
    151204      CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9                          )   ! vol - forcing     (km3 equivalent liquid)  
    152205      CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9                          )   ! sal - forcing     (psu*km3 equivalent liquid)    
    153       CALL iom_put( 'ibggrme'   , bg_grme * rhoic * r1_rau0 * 1.e-9        )   ! vol growth + melt (km3 equivalent liquid)          
     206      CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9                )   ! vol growth + melt (km3 equivalent liquid)          
     207 
    154208      ! 
    155209      IF( lrst_ice )   CALL lim_diahsb_rst( numit, 'WRITE' ) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r4624 r4921  
    3030   USE lib_fortran      ! glob_sum 
    3131   USE timing          ! Timing 
     32   USE limcons        ! conservation tests 
    3233 
    3334   IMPLICIT NONE 
    … …  
    6667      REAL(wp), POINTER, DIMENSION(:)   ::   zmsk           ! i-averaged of tmask 
    6768      REAL(wp), POINTER, DIMENSION(:,:) ::   zu_io, zv_io   ! ice-ocean velocity 
    68       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    69       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     69      ! 
     70      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7071     !!--------------------------------------------------------------------- 
    7172 
    … …  
    7576      CALL wrk_alloc( jpj, zind, zmsk ) 
    7677 
    77       ! ------------------------------- 
    78       !- check conservation (C Rousset) 
    79       IF (ln_limdiahsb) THEN 
    80          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    81          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    82          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    83          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    84       ENDIF 
    85       !- check conservation (C Rousset) 
    86       ! ------------------------------- 
    87  
    8878      IF( kt == nit000 )   CALL lim_dyn_init   ! Initialization (first time-step only) 
    8979 
    9080      IF( ln_limdyn ) THEN 
    9181         ! 
    92          old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 
    93          old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
     82         ! conservation test 
     83         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     84 
     85         u_ice_b(:,:) = u_ice(:,:) * tmu(:,:) 
     86         v_ice_b(:,:) = v_ice(:,:) * tmv(:,:) 
    9487 
    9588         ! Rheology (ice dynamics) 
    … …  
    171164            END DO 
    172165         END DO 
     166         ! 
     167         ! conservation test 
     168         IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    173169         ! 
    174170      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean 
    … …  
    224220      ENDIF 
    225221      ! 
    226       ! ------------------------------- 
    227       !- check conservation (C Rousset) 
    228       IF (ln_limdiahsb) THEN 
    229          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    230          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    231   
    232          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    233          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
    234  
    235          zchk_vmin = glob_min(v_i) 
    236          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    237          zchk_amin = glob_min(a_i) 
    238  
    239          IF(lwp) THEN 
    240             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limdyn) = ',(zchk_v_i * rday) 
    241             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limdyn) = ',(zchk_smv * rday) 
    242             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limdyn) = ',(zchk_vmin * 1.e-3) 
    243             !IF ( zchk_amax >  amax+1.e-10   ) WRITE(numout,*) 'violation a_i>amax            (limdyn) = ',zchk_amax 
    244             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limdyn) = ',zchk_amin 
    245          ENDIF 
    246       ENDIF 
    247       !- check conservation (C Rousset) 
    248       ! ------------------------------- 
    249  
    250222      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io ) 
    251223      CALL wrk_dealloc( jpj, zind, zmsk ) 
    … …  
    269241      !!------------------------------------------------------------------- 
    270242      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    271       NAMELIST/namicedyn/ epsd, alpha,     & 
    272          &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    273          &                c_rhg, etamn, creepl, ecc, ahi0, & 
    274          &                nevp, telast, alphaevp, hminrhg 
     243      NAMELIST/namicedyn/ epsd, om, cw, angvg, pstar,   & 
     244         &                c_rhg, creepl, ecc, ahi0,     & 
     245         &                nevp, relast, alphaevp, hminrhg 
    275246      !!------------------------------------------------------------------- 
    276247 
    … …  
    289260         WRITE(numout,*) '~~~~~~~~~~~~' 
    290261         WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd 
    291          WRITE(numout,*) '   coefficient for semi-implicit coriolis           alpha  = ', alpha 
    292          WRITE(numout,*) '   diffusion constant for dynamics                  dm     = ', dm 
    293          WRITE(numout,*) '   number of sub-time steps for relaxation          nbiter = ', nbiter 
    294          WRITE(numout,*) '   maximum number of iterations for relaxation      nbitdr = ', nbitdr 
    295262         WRITE(numout,*) '   relaxation constant                              om     = ', om 
    296          WRITE(numout,*) '   maximum value for the residual of relaxation     resl   = ', resl 
    297263         WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw 
    298264         WRITE(numout,*) '   turning angle for oceanic stress                 angvg  = ', angvg 
    299265         WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar 
    300266         WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg 
    301          WRITE(numout,*) '   minimun value for viscosity                      etamn  = ', etamn 
    302267         WRITE(numout,*) '   creep limit                                      creepl = ', creepl 
    303268         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc 
    304269         WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    305270         WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp 
    306          WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast 
     271         WRITE(numout,*) '   ratio of elastic timescale over ice time step    relast = ', relast 
    307272         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
    308273         WRITE(numout,*) '   min ice thickness for rheology calculations     hminrhg = ', hminrhg 
    … …  
    322287      pstarh = pstar * 0.5_wp 
    323288 
     289      ! elastic damping 
     290      telast = relast * rdt_ice 
     291 
    324292      !  Diffusion coefficients. 
    325293      ahiu(:,:) = ahi0 * umask(:,:,1) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r4909 r4921  
    2626   USE dom_ice          ! sea-ice domain 
    2727   USE in_out_manager   ! I/O manager 
    28    USE lbclnk           ! lateral boundary condition - MPP exchanges 
    2928   USE lib_mpp          ! MPP library 
    3029   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    3130   USE wrk_nemo         ! work arrays 
     31   USE cpl_oasis3, ONLY : lk_cpl 
    3232 
    3333   IMPLICIT NONE 
    … …  
    3838   !! * Module variables 
    3939   !                          !!** init namelist (namiceini) ** 
    40    REAL(wp) ::   ttest   ! threshold water temperature for initial sea ice 
    41    REAL(wp) ::   hninn   ! initial snow thickness in the north 
    42    REAL(wp) ::   hnins   ! initial snow thickness in the south 
    43    REAL(wp) ::   hginn   ! initial ice thickness in the north 
    44    REAL(wp) ::   hgins   ! initial ice thickness in the south 
    45    REAL(wp) ::   aginn   ! initial leads area in the north 
    46    REAL(wp) ::   agins   ! initial leads area in the south 
    47    REAL(wp) ::   sinn    ! initial salinity  
    48    REAL(wp) ::   sins   
    49  
     40   REAL(wp) ::   thres_sst   ! threshold water temperature for initial sea ice 
     41   REAL(wp) ::   hts_ini_n   ! initial snow thickness in the north 
     42   REAL(wp) ::   hts_ini_s   ! initial snow thickness in the south 
     43   REAL(wp) ::   hti_ini_n   ! initial ice thickness in the north 
     44   REAL(wp) ::   hti_ini_s   ! initial ice thickness in the south 
     45   REAL(wp) ::   ati_ini_n   ! initial leads area in the north 
     46   REAL(wp) ::   ati_ini_s   ! initial leads area in the south 
     47   REAL(wp) ::   smi_ini_n   ! initial salinity  
     48   REAL(wp) ::   smi_ini_s   ! initial salinity 
     49   REAL(wp) ::   tmi_ini_n   ! initial temperature 
     50   REAL(wp) ::   tmi_ini_s   ! initial temperature 
     51 
     52   LOGICAL  ::  ln_limini    ! initialization or not 
    5053   !!---------------------------------------------------------------------- 
    5154   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
    … …  
    9093      INTEGER    :: i_hemis, i_fill, jl0   
    9194      REAL(wp)   :: ztest_1, ztest_2, ztest_3, ztest_4, ztests, zsigma, zarg, zA, zV, zA_cons, zV_cons, zconv 
    92       REAL(wp), POINTER, DIMENSION(:)     :: zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini 
    93       REAL(wp), POINTER, DIMENSION(:,:)   :: zht_i_ini, za_i_ini, zv_i_ini 
    94       REAL(wp), POINTER, DIMENSION(:,:)   :: zidto    ! ice indicator 
     95      REAL(wp), POINTER, DIMENSION(:)     :: zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini 
     96      REAL(wp), POINTER, DIMENSION(:,:)   :: zh_i_ini, za_i_ini, zv_i_ini 
     97      REAL(wp), POINTER, DIMENSION(:,:)   :: zswitch    ! ice indicator 
    9598      INTEGER,  POINTER, DIMENSION(:,:)   :: zhemis   ! hemispheric index 
    9699      !-------------------------------------------------------------------- 
    97100 
    98       CALL wrk_alloc( jpi, jpj, zidto ) 
     101      CALL wrk_alloc( jpi, jpj, zswitch ) 
    99102      CALL wrk_alloc( jpi, jpj, zhemis ) 
    100       CALL wrk_alloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
    101       CALL wrk_alloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
    102  
    103       epsi20   = 1.0e-20 
     103      CALL wrk_alloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     104      CALL wrk_alloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
     105 
     106      epsi20   = 1.e-20_wp 
     107 
    104108      IF(lwp) WRITE(numout,*) 
    105109      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization ' 
    … …  
    112116      CALL lim_istate_init     !  reading the initials parameters of the ice 
    113117 
    114 !!gm  in lim2  the initialisation if only done if required in the namelist : 
    115 !!gm      IF( .NOT. ln_limini ) THEN 
    116 !!gm  this should be added in lim3 namelist... 
     118# if defined key_coupled 
     119      albege(:,:)   = 0.8 * tms(:,:) 
     120# endif 
     121 
     122      ! surface temperature 
     123      DO jl = 1, jpl ! loop over categories 
     124         t_su  (:,:,jl) = rtt * tms(:,:) 
     125         tn_ice(:,:,jl) = rtt * tms(:,:) 
     126      END DO 
     127      ! Basal temperature is set to the freezing point of seawater in Kelvin 
     128      t_bo(:,:) = ( tfreez( tsn(:,:,1,jp_sal) ) + rt0 ) * tms(:,:)  
     129 
     130      IF( ln_limini ) THEN 
    117131 
    118132      !-------------------------------------------------------------------- 
    119133      ! 2) Basal temperature, ice mask and hemispheric index 
    120134      !-------------------------------------------------------------------- 
    121  
    122       ! Basal temperature is set to the freezing point of seawater in Celsius 
    123       t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    124  
    125       DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
     135      ! ice if sst <= t-freez + thres_sst 
     136      DO jj = 1, jpj                                        
    126137         DO ji = 1, jpi 
    127             IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0._wp      ! no ice 
    128             ELSE                                                     ;   zidto(ji,jj) = 1._wp      !    ice 
     138            IF( ( tsn(ji,jj,1,jp_tem)  - ( t_bo(ji,jj) - rt0 ) ) * tms(ji,jj) >= thres_sst ) THEN  
     139               zswitch(ji,jj) = 0._wp * tms(ji,jj)    ! no ice 
     140            ELSE                                                                                    
     141               zswitch(ji,jj) = 1._wp * tms(ji,jj)    !    ice 
    129142            ENDIF 
    130143         END DO 
    131144      END DO 
    132145 
    133       t_bo(:,:) = t_bo(:,:) + rt0                          ! conversion to Kelvin 
    134146 
    135147      ! Hemispheric index 
    … …  
    153165      ! 3.1) Hemisphere-dependent arrays 
    154166      !----------------------------- 
    155       ! assign initial thickness, concentration, snow depth and salinity to 
    156       ! an hemisphere-dependent array 
    157       zhm_i_ini(1) = hginn ; zhm_i_ini(2) = hgins  ! ice thickness 
    158       zat_i_ini(1) = aginn ; zat_i_ini(2) = agins  ! ice concentration 
    159       zvt_i_ini(:) = zhm_i_ini(:) * zat_i_ini(:)   ! ice volume 
    160       zhm_s_ini(1) = hninn ; zhm_s_ini(2) = hnins  ! snow depth 
    161       zsm_i_ini(1) = sinn  ; zsm_i_ini(2) = sins   ! bulk ice salinity 
     167      ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     168      zht_i_ini(1) = hti_ini_n ; zht_i_ini(2) = hti_ini_s  ! ice thickness 
     169      zht_s_ini(1) = hts_ini_n ; zht_s_ini(2) = hts_ini_s  ! snow depth 
     170      zat_i_ini(1) = ati_ini_n ; zat_i_ini(2) = ati_ini_s  ! ice concentration 
     171      zsm_i_ini(1) = smi_ini_n ; zsm_i_ini(2) = smi_ini_s  ! bulk ice salinity 
     172      ztm_i_ini(1) = tmi_ini_n ; ztm_i_ini(2) = tmi_ini_s  ! temperature (ice and snow) 
     173 
     174      zvt_i_ini(:) = zht_i_ini(:) * zat_i_ini(:)   ! ice volume 
    162175 
    163176      !--------------------------------------------------------------------- 
    … …  
    183196            ! *** 1 category to fill 
    184197            IF ( i_fill .EQ. 1 ) THEN 
    185                zht_i_ini(1,i_hemis)       = zhm_i_ini(i_hemis) 
    186                za_i_ini(1,i_hemis)        = zat_i_ini(i_hemis) 
    187                zht_i_ini(2:jpl,i_hemis)   = 0._wp 
    188                za_i_ini(2:jpl,i_hemis)    = 0._wp 
     198               zh_i_ini(1,i_hemis)       = zht_i_ini(i_hemis) 
     199               za_i_ini(1,i_hemis)       = zat_i_ini(i_hemis) 
     200               zh_i_ini(2:jpl,i_hemis)   = 0._wp 
     201               za_i_ini(2:jpl,i_hemis)   = 0._wp 
    189202            ELSE 
    190203 
    191             ! *** >1 categores to fill 
    192             !--- Ice thicknesses in the i_fill - 1 first categories 
     204               ! *** >1 categores to fill 
     205               !--- Ice thicknesses in the i_fill - 1 first categories 
    193206               DO jl = 1, i_fill - 1 
    194                   zht_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
     207                  zh_i_ini(jl,i_hemis)    = 0.5 * ( hi_max(jl) + hi_max(jl-1) ) 
    195208               END DO 
    196  
    197             !--- jl0: most likely index where cc will be maximum 
     209                
     210               !--- jl0: most likely index where cc will be maximum 
    198211               DO jl = 1, jpl 
    199                   IF ( ( zhm_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
    200                        ( zhm_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
     212                  IF ( ( zht_i_ini(i_hemis) .GT. hi_max(jl-1) ) .AND. & 
     213                     ( zht_i_ini(i_hemis) .LE. hi_max(jl)   ) ) THEN 
    201214                     jl0 = jl 
    202215                  ENDIF 
    203216               END DO 
    204217               jl0 = MIN(jl0, i_fill) 
    205  
    206             !--- Concentrations 
     218                
     219               !--- Concentrations 
    207220               za_i_ini(jl0,i_hemis)      = zat_i_ini(i_hemis) / SQRT(REAL(jpl)) 
    208221               DO jl = 1, i_fill - 1 
    209222                  IF ( jl .NE. jl0 ) THEN 
    210                      zsigma               = 0.5 * zhm_i_ini(i_hemis) 
    211                      zarg                 = ( zht_i_ini(jl,i_hemis) - zhm_i_ini(i_hemis) ) / zsigma 
     223                     zsigma               = 0.5 * zht_i_ini(i_hemis) 
     224                     zarg                 = ( zh_i_ini(jl,i_hemis) - zht_i_ini(i_hemis) ) / zsigma 
    212225                     za_i_ini(jl,i_hemis) = za_i_ini(jl0,i_hemis) * EXP(-zarg**2) 
    213226                  ENDIF 
    214                END DO  
    215  
     227               END DO 
     228                
    216229               zA = 0. ! sum of the areas in the jpl categories  
    217230               DO jl = 1, i_fill - 1 
    … …  
    221234               IF ( i_fill .LT. jpl ) za_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    222235          
    223             !--- Ice thickness in the last category 
     236               !--- Ice thickness in the last category 
    224237               zV = 0. ! sum of the volumes of the N-1 categories 
    225238               DO jl = 1, i_fill - 1 
    226                   zV = zV + za_i_ini(jl,i_hemis)*zht_i_ini(jl,i_hemis) 
     239                  zV = zV + za_i_ini(jl,i_hemis)*zh_i_ini(jl,i_hemis) 
    227240               END DO 
    228                zht_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
    229                IF ( i_fill .LT. jpl ) zht_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    230  
    231             !--- volumes 
    232                zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zht_i_ini(:,i_hemis) 
     241               zh_i_ini(i_fill,i_hemis) = ( zvt_i_ini(i_hemis) - zV ) / za_i_ini(i_fill,i_hemis)  
     242               IF ( i_fill .LT. jpl ) zh_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
     243 
     244               !--- volumes 
     245               zv_i_ini(:,i_hemis) = za_i_ini(:,i_hemis) * zh_i_ini(:,i_hemis) 
    233246               IF ( i_fill .LT. jpl ) zv_i_ini(i_fill+1:jpl, i_hemis) = 0._wp 
    234247 
    … …  
    262275 
    263276            ! Test 3: thickness of the last category is in-bounds ? 
    264             IF ( zht_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
     277            IF ( zh_i_ini(i_fill, i_hemis) .GT. hi_max(i_fill-1) ) THEN 
    265278               ztest_3 = 1 
    266279            ELSE 
    267280               ! this write is useful 
    268                IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zht_i_ini(i_fill,i_hemis) = ', & 
    269                zht_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
     281               IF(lwp) WRITE(numout,*) ' * TEST 3 THICKNESS OF THE LAST CATEGORY OUT OF BOUNDS *** zh_i_ini(i_fill,i_hemis) = ', & 
     282               zh_i_ini(i_fill,i_hemis), ' hi_max(jpl-1) = ', hi_max(i_fill-1) 
    270283               ztest_3 = 0 
    271284            ENDIF 
    … …  
    291304         IF ( ztests .NE. 4 ) THEN 
    292305            WRITE(numout,*) 
    293             WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    294             WRITE(numout,*) ' !!!! RED ALERT                  !!! ' 
    295             WRITE(numout,*) ' !!!! BIIIIP BIIIP BIIIIP BIIIIP !!!' 
     306            WRITE(numout,*) ' !!!! ALERT                  !!! ' 
    296307            WRITE(numout,*) ' !!!! Something is wrong in the LIM3 initialization procedure ' 
    297             WRITE(numout,*) ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ' 
    298308            WRITE(numout,*) 
    299309            WRITE(numout,*) ' *** ztests is not equal to 4 ' 
    300310            WRITE(numout,*) ' *** ztest_i (i=1,4) = ', ztest_1, ztest_2, ztest_3, ztest_4 
    301311            WRITE(numout,*) ' zat_i_ini : ', zat_i_ini(i_hemis) 
    302             WRITE(numout,*) ' zhm_i_ini : ', zhm_i_ini(i_hemis) 
     312            WRITE(numout,*) ' zht_i_ini : ', zht_i_ini(i_hemis) 
    303313         ENDIF ! ztests .NE. 4 
    304314      ENDIF 
    … …  
    314324         DO jj = 1, jpj 
    315325            DO ji = 1, jpi 
    316                a_i(ji,jj,jl)   = zidto(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
    317                ht_i(ji,jj,jl)  = zidto(ji,jj) * zht_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
    318                ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zhm_s_ini( zhemis(ji,jj) ) / zhm_i_ini( zhemis(ji,jj) ) )  ! snow depth 
    319                sm_i(ji,jj,jl)  = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min ! salinity 
    320                o_i(ji,jj,jl)   = zidto(ji,jj) * 1._wp + ( 1._wp - zidto(ji,jj) ) ! age 
    321                t_su(ji,jj,jl)  = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * 270.0 ! surf temp 
     326               a_i(ji,jj,jl)   = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj))  ! concentration 
     327               ht_i(ji,jj,jl)  = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj))  ! ice thickness 
     328               ht_s(ji,jj,jl)  = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) )  ! snow depth 
     329               sm_i(ji,jj,jl)  = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min ! salinity 
     330               o_i(ji,jj,jl)   = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age 
     331               t_su(ji,jj,jl)  = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt ! surf temp 
    322332 
    323333               ! This case below should not be used if (ht_s/ht_i) is ok in namelist 
    … …  
    343353            DO jj = 1, jpj 
    344354               DO ji = 1, jpi 
    345                    t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.0 + ( 1._wp - zidto(ji,jj) ) * rtt 
     355                   t_s(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt 
    346356                   ! Snow energy of melting 
    347                    e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
     357                   e_s(ji,jj,jk,jl) = zswitch(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus ) 
    348358                   ! Change dimensions 
    349359                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac 
    350                    ! Multiply by volume, so that heat content in 10^9 Joules 
     360                   ! Multiply by volume, so that heat content in Joules 
    351361                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * v_s(ji,jj,jl) / nlay_s 
    352362               END DO ! ji 
    … …  
    360370            DO jj = 1, jpj 
    361371               DO ji = 1, jpi 
    362                    t_i(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1._wp - zidto(ji,jj) ) * rtt  
    363                    s_i(ji,jj,jk,jl) = zidto(ji,jj) * zsm_i_ini(zhemis(ji,jj)) + ( 1._wp - zidto(ji,jj) ) * s_i_min 
     372                   t_i(ji,jj,jk,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rtt  
     373                   s_i(ji,jj,jk,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * s_i_min 
    364374                   ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K 
    365375 
    366376                   ! heat content per unit volume 
    367                    e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
     377                   e_i(ji,jj,jk,jl) = zswitch(ji,jj) * rhoic * (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) & 
    368378                      +   lfus    * ( 1._wp - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-epsi20) ) & 
    369379                      -   rcp     * ( ztmelts - rtt ) ) 
    … …  
    372382                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac  
    373383 
    374                    ! Mutliply by ice volume, and divide by number of layers  
    375                    ! to get heat content in 10^9 J 
     384                   ! Mutliply by ice volume, and divide by number of layers to get heat content in J 
    376385                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / nlay_i 
    377386               END DO ! ji 
    … …  
    380389      END DO ! jk 
    381390 
     391      tn_ice (:,:,:) = t_su (:,:,:) 
     392 
     393      ELSE  
     394         ! if ln_limini=false 
     395         a_i  (:,:,:) = 0._wp 
     396         v_i  (:,:,:) = 0._wp 
     397         v_s  (:,:,:) = 0._wp 
     398         smv_i(:,:,:) = 0._wp 
     399         oa_i (:,:,:) = 0._wp 
     400         ht_i (:,:,:) = 0._wp 
     401         ht_s (:,:,:) = 0._wp 
     402         sm_i (:,:,:) = 0._wp 
     403         o_i  (:,:,:) = 0._wp 
     404 
     405         e_i(:,:,:,:) = 0._wp 
     406         e_s(:,:,:,:) = 0._wp 
     407 
     408         DO jl = 1, jpl 
     409            DO jk = 1, nlay_i 
     410               t_i(:,:,jk,jl) = rtt * tms(:,:) 
     411            END DO 
     412            DO jk = 1, nlay_s 
     413               t_s(:,:,jk,jl) = rtt * tms(:,:) 
     414            END DO 
     415         END DO 
     416       
     417      ENDIF ! ln_limini 
     418       
     419      at_i (:,:) = 0.0_wp 
     420      DO jl = 1, jpl 
     421         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
     422      END DO 
     423      ! 
    382424      !-------------------------------------------------------------------- 
    383425      ! 4) Global ice variables for output diagnostics                    |  
    384426      !-------------------------------------------------------------------- 
    385       fsbbq (:,:)     = 0._wp 
    386427      u_ice (:,:)     = 0._wp 
    387428      v_ice (:,:)     = 0._wp 
    … …  
    390431      stress12_i(:,:) = 0._wp 
    391432 
    392 # if defined key_coupled 
    393       albege(:,:)   = 0.8 * tms(:,:) 
    394 # endif 
    395  
    396433      !-------------------------------------------------------------------- 
    397434      ! 5) Moments for advection 
    … …  
    428465      sxyage (:,:,:)  = 0._wp 
    429466 
    430       !-------------------------------------------------------------------- 
    431       ! 6) Lateral boundary conditions                                    |  
    432       !-------------------------------------------------------------------- 
    433  
    434       DO jl = 1, jpl 
    435  
    436          CALL lbc_lnk( a_i(:,:,jl)  , 'T', 1. ) 
    437          CALL lbc_lnk( v_i(:,:,jl)  , 'T', 1. ) 
    438          CALL lbc_lnk( v_s(:,:,jl)  , 'T', 1. ) 
    439          CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. ) 
    440          CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. ) 
    441  
    442          CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. ) 
    443          CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. ) 
    444          CALL lbc_lnk( sm_i(:,:,jl) , 'T', 1. ) 
    445          CALL lbc_lnk( o_i(:,:,jl)  , 'T', 1. ) 
    446          CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. ) 
    447          DO jk = 1, nlay_s 
    448             CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. ) 
    449             CALL lbc_lnk(e_s(:,:,jk,jl), 'T', 1. ) 
    450          END DO 
    451          DO jk = 1, nlay_i 
    452             CALL lbc_lnk(t_i(:,:,jk,jl), 'T', 1. ) 
    453             CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. ) 
    454          END DO 
    455          ! 
    456          a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl) 
    457       END DO 
    458        
    459       at_i (:,:) = 0.0_wp 
    460       DO jl = 1, jpl 
    461          at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
    462       END DO 
    463  
    464       CALL lbc_lnk( at_i , 'T', 1. ) 
    465       at_i(:,:) = tms(:,:) * at_i(:,:)                       ! put 0 over land 
    466       ! 
    467       CALL lbc_lnk( fsbbq  , 'T', 1. ) 
    468       ! 
    469       !-------------------------------------------------------------------- 
    470       ! 6) ????                                                           |  
    471       !-------------------------------------------------------------------- 
    472       tn_ice (:,:,:) = t_su (:,:,:) 
    473  
    474       CALL wrk_dealloc( jpi, jpj, zidto ) 
     467 
     468      CALL wrk_dealloc( jpi, jpj, zswitch ) 
    475469      CALL wrk_dealloc( jpi, jpj, zhemis ) 
    476       CALL wrk_dealloc( jpl,   2, zht_i_ini,  za_i_ini,  zv_i_ini ) 
    477       CALL wrk_dealloc(   2,      zhm_i_ini, zat_i_ini, zvt_i_ini, zhm_s_ini, zsm_i_ini ) 
     470      CALL wrk_dealloc( jpl,   2, zh_i_ini,  za_i_ini,  zv_i_ini ) 
     471      CALL wrk_dealloc(   2,      zht_i_ini, zat_i_ini, zvt_i_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    478472 
    479473   END SUBROUTINE lim_istate 
    … …  
    495489      !!  8.5  ! 07-11 (M. Vancoppenolle) rewritten initialization 
    496490      !!----------------------------------------------------------------------------- 
    497       NAMELIST/namiceini/ ttest, hninn, hnins, hginn, hgins, aginn, agins, sinn, sins 
    498       ! 
     491      NAMELIST/namiceini/ ln_limini, thres_sst, hts_ini_n, hts_ini_s, hti_ini_n, hti_ini_s,  & 
     492         &                                      ati_ini_n, ati_ini_s, smi_ini_n, smi_ini_s, tmi_ini_n, tmi_ini_s 
    499493      INTEGER :: ios                 ! Local integer output status for namelist read 
    500494      !!----------------------------------------------------------------------------- 
    … …  
    516510         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation ' 
    517511         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    518          WRITE(numout,*) '   threshold water temp. for initial sea-ice    ttest      = ', ttest 
    519          WRITE(numout,*) '   initial snow thickness in the north          hninn      = ', hninn 
    520          WRITE(numout,*) '   initial snow thickness in the south          hnins      = ', hnins  
    521          WRITE(numout,*) '   initial ice thickness  in the north          hginn      = ', hginn 
    522          WRITE(numout,*) '   initial ice thickness  in the south          hgins      = ', hgins 
    523          WRITE(numout,*) '   initial ice concentr.  in the north          aginn      = ', aginn 
    524          WRITE(numout,*) '   initial ice concentr.  in the north          agins      = ', agins 
    525          WRITE(numout,*) '   initial  ice salinity  in the north          sinn       = ', sinn 
    526          WRITE(numout,*) '   initial  ice salinity  in the south          sins       = ', sins 
     512         WRITE(numout,*) '   initialization with ice (T) or not (F)       ln_limini   = ', ln_limini 
     513         WRITE(numout,*) '   threshold water temp. for initial sea-ice    thres_sst  = ', thres_sst 
     514         WRITE(numout,*) '   initial snow thickness in the north          hts_ini_n  = ', hts_ini_n 
     515         WRITE(numout,*) '   initial snow thickness in the south          hts_ini_s  = ', hts_ini_s  
     516         WRITE(numout,*) '   initial ice thickness  in the north          hti_ini_n  = ', hti_ini_n 
     517         WRITE(numout,*) '   initial ice thickness  in the south          hti_ini_s  = ', hti_ini_s 
     518         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_n  = ', ati_ini_n 
     519         WRITE(numout,*) '   initial ice concentr.  in the north          ati_ini_s  = ', ati_ini_s 
     520         WRITE(numout,*) '   initial  ice salinity  in the north          smi_ini_n  = ', smi_ini_n 
     521         WRITE(numout,*) '   initial  ice salinity  in the south          smi_ini_s  = ', smi_ini_s 
     522         WRITE(numout,*) '   initial  ice/snw temp  in the north          tmi_ini_n  = ', tmi_ini_n 
     523         WRITE(numout,*) '   initial  ice/snw temp  in the south          tmi_ini_s  = ', tmi_ini_s 
    527524      ENDIF 
    528525 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r4624 r4921  
    55   !!====================================================================== 
    66   !! History :  LIM  ! 2006-02  (M. Vancoppenolle) Original code  
    7    !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_mec 
     7   !!            3.2  ! 2009-07  (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in smsw & sfx_dyn 
    88   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation 
    99   !!---------------------------------------------------------------------- 
    … …  
    2222   USE limthd_lac       ! LIM 
    2323   USE limvar           ! LIM 
    24    USE limcons          ! LIM 
    2524   USE in_out_manager   ! I/O manager 
    2625   USE lbclnk           ! lateral boundary condition - MPP exchanges 
    … …  
    3029  ! Check budget (Rousset) 
    3130   USE iom              ! I/O manager 
    32    USE lib_fortran     ! glob_sum 
     31   USE lib_fortran      ! glob_sum 
    3332   USE limdiahsb 
    34    USE timing          ! Timing 
     33   USE timing           ! Timing 
     34   USE limcons          ! conservation tests 
    3535 
    3636   IMPLICIT NONE 
    … …  
    143143      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2) 
    144144      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories 
    145       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    146       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    147       ! mass and salt flux (clem) 
    148       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     145      ! 
     146      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    149147      !!----------------------------------------------------------------------------- 
    150148      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    151149 
    152150      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    153  
    154       CALL wrk_alloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    155  
    156       IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only) 
    157151 
    158152      IF(ln_ctl) THEN 
    … …  
    162156 
    163157      IF( ln_limdyn ) THEN          !   Start ridging and rafting   ! 
    164       ! ------------------------------- 
    165       !- check conservation (C Rousset) 
    166       IF (ln_limdiahsb) THEN 
    167          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    168          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    169          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    170          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    171       ENDIF 
    172       !- check conservation (C Rousset) 
    173       ! ------------------------------- 
    174  
    175       ! mass and salt flux init (clem) 
    176       zviold(:,:,:) = v_i(:,:,:) 
    177       zvsold(:,:,:) = v_s(:,:,:) 
    178       zsmvold(:,:,:) = smv_i(:,:,:) 
     158 
     159      ! conservation test 
     160      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    179161 
    180162      !-----------------------------------------------------------------------------! 
    … …  
    362344            ! 5) Heat, salt and freshwater fluxes 
    363345            !-----------------------------------------------------------------------------! 
    364             fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
    365             fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * r1_rdtice     ! heat sink for ocean 
     346            wfx_snw(ji,jj) = wfx_snw(ji,jj) + msnow_mlt(ji,jj) * r1_rdtice     ! fresh water source for ocean 
     347            hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + esnow_mlt(ji,jj) * unit_fac / area(ji,jj) * r1_rdtice  ! heat sink for ocean (<0, W.m-2) 
    366348 
    367349         END DO 
    … …  
    399381      CALL lim_itd_me_zapsmall 
    400382 
    401       !-------------------------------- 
    402       ! Update mass/salt fluxes (clem) 
    403       !-------------------------------- 
    404       DO jl = 1, jpl 
    405          DO jj = 1, jpj  
    406             DO ji = 1, jpi 
    407                diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    408                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    409                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    410                sfx_mec(ji,jj) = sfx_mec(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic * r1_rdtice  
    411             END DO 
    412          END DO 
    413       END DO 
    414383 
    415384      IF(ln_ctl) THEN     ! Control print 
    … …  
    445414      ENDIF 
    446415 
    447       ! ------------------------------- 
    448       !- check conservation (C Rousset) 
    449       IF (ln_limdiahsb) THEN 
    450          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    451          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    452   
    453          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    454          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    455  
    456          zchk_vmin = glob_min(v_i) 
    457          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    458          zchk_amin = glob_min(a_i) 
    459         
    460          IF(lwp) THEN 
    461             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_me) = ',(zchk_v_i * rday) 
    462             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_me) = ',(zchk_smv * rday) 
    463             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_me) = ',(zchk_vmin * 1.e-3) 
    464             IF ( zchk_amax >  kamax+epsi10  ) WRITE(numout,*) 'violation a_i>amax            (limitd_me) = ',zchk_amax 
    465             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limitd_me) = ',zchk_amin 
    466          ENDIF 
    467       ENDIF 
    468       !- check conservation (C Rousset) 
    469       ! ------------------------------- 
     416      ! conservation test 
     417      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    470418 
    471419      ENDIF  ! ln_limdyn=.true. 
    472420      ! 
    473421      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 
    474       ! 
    475       CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zsmvold )   ! clem 
    476422      ! 
    477423      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
    … …  
    670616      !!---------------------------------------------------------------------! 
    671617      INTEGER ::   ji,jj, jl    ! dummy loop indices 
    672       INTEGER ::   krdg_index   !  
    673618      REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar 
    674619      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here 
    … …  
    746691      !----------------------------------------------------------------- 
    747692 
    748       krdg_index = 1 
    749  
    750       IF( krdg_index == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    751          DO jl = 0, ice_cat_bounds(1,2)       ! only undeformed ice participates 
     693      IF( partfun_swi == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
     694         DO jl = 0, jpl     
    752695            DO jj = 1, jpj  
    753696               DO ji = 1, jpi 
    … …  
    772715            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
    773716         END DO !jl 
    774          DO jl = 0, ice_cat_bounds(1,2) 
     717         DO jl = 0, jpl 
    775718             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
    776719         END DO 
    777720         ! 
    778       ENDIF ! krdg_index 
    779  
    780       IF( raftswi == 1 ) THEN      ! Ridging and rafting ice participation functions 
     721      ENDIF ! partfun_swi 
     722 
     723      IF( raft_swi == 1 ) THEN      ! Ridging and rafting ice participation functions 
    781724         ! 
    782725         DO jl = 1, jpl 
    … …  
    794737         END DO ! jl 
    795738 
    796       ELSE  ! raftswi = 0 
     739      ELSE  ! raft_swi = 0 
    797740         ! 
    798741         DO jl = 1, jpl 
    … …  
    802745      ENDIF 
    803746 
    804       IF ( raftswi == 1 ) THEN 
     747      IF ( raft_swi == 1 ) THEN 
    805748 
    806749         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi10 ) THEN 
    … …  
    908851      INTEGER ::   ij                ! horizontal index, combines i and j loops 
    909852      INTEGER ::   icells            ! number of cells with aicen > puny 
    910       REAL(wp) ::   zindb, zsrdg2   ! local scalar 
     853      REAL(wp) ::   zindb    ! local scalar 
    911854      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration 
     855      REAL(wp) ::   zsstK            ! SST in Kelvin 
    912856 
    913857      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices 
    … …  
    917861 
    918862      REAL(wp), POINTER, DIMENSION(:,:,:) ::   aicen_init, vicen_init   ! ice  area    & volume before ridging 
    919       REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnon_init, esnon_init   ! snow volume  & energy before ridging 
     863      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnwn_init, esnwn_init   ! snow volume  & energy before ridging 
    920864      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging 
    921865 
    … …  
    952896      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    953897      CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    954       CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
    955       CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    956       CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     898      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     899      CALL wrk_alloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
     900      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
    957901 
    958902      ! Conservation check 
    … …  
    1008952         aicen_init(:,:,jl) = a_i(:,:,jl) 
    1009953         vicen_init(:,:,jl) = v_i(:,:,jl) 
    1010          vsnon_init(:,:,jl) = v_s(:,:,jl) 
     954         vsnwn_init(:,:,jl) = v_s(:,:,jl) 
    1011955         ! 
    1012956         smv_i_init(:,:,jl) = smv_i(:,:,jl) 
    … …  
    1014958      END DO !jl 
    1015959 
    1016       esnon_init(:,:,:) = e_s(:,:,1,:) 
     960      esnwn_init(:,:,:) = e_s(:,:,1,:) 
    1017961 
    1018962      DO jl = 1, jpl   
    … …  
    10911035            !     / rafting category n1. 
    10921036            !-------------------------------------------------------------------------- 
    1093             vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
     1037            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 
    10941038            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 
    10951039            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por 
    10961040 
    1097             vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1098             esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj) 
    1099             srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
    1100             srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     1041            vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     1042            esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 
     1043            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 
     1044            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 
    11011045 
    11021046            ! rafting volumes, heat contents ... 
    11031047            virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 
    1104             vsrft(ji,jj) = vsnon_init(ji,jj,jl1) * afrft(ji,jj) 
    1105             esrft(ji,jj) = esnon_init(ji,jj,jl1) * afrft(ji,jj) 
     1048            vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 
     1049            esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 
    11061050            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj)  
    11071051 
    … …  
    11201064            ! Salinity 
    11211065            !------------- 
    1122             smsw(ji,jj)  = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0       ! salt content of seawater frozen in voids 
    1123  
    1124             zsrdg2       = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
    1125  
    1126             srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
     1066            smsw(ji,jj)  = vsw(ji,jj) * sss_m(ji,jj)                      ! salt content of seawater frozen in voids !! MV HC2014 
     1067            srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge 
     1068 
     1069            !srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity 
    11271070             
    1128             !                                                             ! excess of salt is flushed into the ocean 
    1129             !sfx_mec(ji,jj) = sfx_mec(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic * r1_rdtice 
    1130  
    1131             !rdm_ice(ji,jj) = rdm_ice(ji,jj) + vsw(ji,jj) * rhoic    ! gurvan: increase in ice volume du to seawater frozen in voids              
     1071            sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 
     1072            wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice   ! gurvan: increase in ice volume du to seawater frozen in voids              
    11321073 
    11331074            !------------------------------------             
    … …  
    11581099               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft) 
    11591100 
    1160             esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
    1161                &                                + esrft(ji,jj)*(1.0-fsnowrft)           
     1101            ! in 1e-9 Joules (same as e_s) 
     1102            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) - esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included 
     1103               &                                - esrft(ji,jj)*(1.0-fsnowrft)           
    11621104 
    11631105            !----------------------------------------------------------------- 
    … …  
    11841126               jj = indxj(ij) 
    11851127               ! heat content of ridged ice 
    1186                erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )  
     1128               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj)  
    11871129               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 
    11881130               e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) 
    1189                ! sea water heat content 
    1190                ztmelts          = - tmut * sss_m(ji,jj) + rtt 
    1191                ! heat content per unit volume 
    1192                zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 
    1193  
    1194                ! corrected sea water salinity 
    1195                zindb  = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - epsi20 ) ) 
    1196                zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), epsi20 ) 
    1197  
    1198                ztmelts          = - tmut * zdummy + rtt 
    1199                ersw(ji,jj,jk)   = - rcp * ( ztmelts - rtt ) * vsw(ji,jj) 
    1200  
    1201                ! heat flux 
    1202                fheat_mec(ji,jj) = fheat_mec(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) * r1_rdtice 
     1131                
     1132                
     1133               ! enthalpy of the trapped seawater (J/m2, >0) 
     1134               ! clem: if sst>0, then ersw <0 (is that possible?) 
     1135               zsstK  = sst_m(ji,jj) + rt0 
     1136               ersw(ji,jj,jk)   = - rhoic * vsw(ji,jj) * rcp * ( zsstK - rt0 ) / REAL( nlay_i ) 
     1137 
     1138               ! heat flux to the ocean 
     1139               hfx_dyn(ji,jj) = hfx_dyn(ji,jj) + ersw(ji,jj,jk) * r1_rdtice  ! > 0 [W.m-2] ocean->ice flux  
    12031140 
    12041141               ! Correct dimensions to avoid big values 
    1205                ersw(ji,jj,jk)   = ersw(ji,jj,jk) * 1.e-09 
    1206  
    1207                ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J 
    1208                ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / REAL( nlay_i ) 
     1142               ersw(ji,jj,jk)   = ersw(ji,jj,jk) / unit_fac 
     1143 
     1144               ! Mutliply by ice volume, and divide by number of layers to get heat content in 1.e9 J 
     1145               ! it is added to sea ice because the sign convention is the opposite of the sign convention for the ocean  
     1146               !! MV HC 2014 
     1147               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) 
    12091148 
    12101149               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk) 
     1150 
    12111151            END DO ! ij 
    12121152         END DO !jk 
    … …  
    12531193         !------------------------------------------------------------------------------- 
    12541194         !        jl1 looping 1-jpl 
    1255          DO jl2  = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
     1195         DO jl2  = 1, jpl  
    12561196            ! over categories to which ridged ice is transferred 
    12571197!CDIR NODEP 
    … …  
    12981238         END DO                 ! jl2 (new ridges)             
    12991239 
    1300          DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2)  
     1240         DO jl2 = 1, jpl  
    13011241 
    13021242!CDIR NODEP 
    … …  
    13611301      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw ) 
    13621302      CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 
    1363       CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init ) 
    1364       CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw ) 
    1365       CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init ) 
     1303      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 
     1304      CALL wrk_dealloc( jpi, jpj, nlay_i+1,      eirft, erdg1, erdg2, ersw ) 
     1305      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, eicen_init ) 
    13661306      ! 
    13671307   END SUBROUTINE lim_itd_me_ridgeshift 
    … …  
    14041344      !!------------------------------------------------------------------- 
    14051345      INTEGER :: ios                 ! Local integer output status for namelist read 
    1406       NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,&  
    1407          Gstar, astar,                                & 
    1408          Hstar, raftswi, hparmeter, Craft, ridge_por, & 
    1409          sal_max_ridge,  partfun_swi, transfun_swi,   & 
    1410          brinstren_swi 
     1346      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,              &  
     1347        &                   Gstar, astar, Hstar, raft_swi, hparmeter, Craft, ridge_por, & 
     1348        &                   partfun_swi, brinstren_swi 
    14111349      !!------------------------------------------------------------------- 
    14121350      ! 
    … …  
    14321370         WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar 
    14331371         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar 
    1434          WRITE(numout,*)'   Rafting of ice sheets or not                            raftswi         ', raftswi 
     1372         WRITE(numout,*)'   Rafting of ice sheets or not                            raft_swi        ', raft_swi 
    14351373         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter 
    14361374         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft   
    14371375         WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por 
    1438          WRITE(numout,*)'   Maximum salinity of ridging ice                         sal_max_ridge   ', sal_max_ridge 
    14391376         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    partfun_swi     ', partfun_swi 
    1440          WRITE(numout,*)'   Switch for tran. function (0) linear (1) exponential    transfun_swi    ', transfun_swi 
    14411377         WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi 
    14421378      ENDIF 
    … …  
    14621398 
    14631399      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace 
    1464       REAL(wp)                          ::   zmask_glo 
     1400      REAL(wp)                          ::   zmask_glo, zsal, zvi, zvs, zei, zes 
    14651401!!gm      REAL(wp) ::   xtmp      ! temporary variable 
    14661402      !!------------------------------------------------------------------- 
    … …  
    14681404      CALL wrk_alloc( jpi, jpj, zmask ) 
    14691405 
     1406      ! to be sure that at_i is the sum of a_i(jl) 
     1407      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     1408 
    14701409      DO jl = 1, jpl 
    1471  
    14721410         !----------------------------------------------------------------- 
    14731411         ! Count categories to be zapped. 
    1474          ! Abort model in case of negative area. 
    14751412         !----------------------------------------------------------------- 
    14761413         icells = 0 
    … …  
    14781415         DO jj = 1, jpj 
    14791416            DO ji = 1, jpi 
    1480                IF(  ( a_i(ji,jj,jl) >= -epsi10 .AND. a_i(ji,jj,jl) <  0._wp   ) .OR.   & 
    1481                   & ( a_i(ji,jj,jl) >  0._wp   .AND. a_i(ji,jj,jl) <= epsi10  ) .OR.   & 
    1482                   & ( v_i(ji,jj,jl) == 0._wp   .AND. a_i(ji,jj,jl) >  0._wp   ) .OR.   & 
    1483                   & ( v_i(ji,jj,jl) >  0._wp   .AND. v_i(ji,jj,jl) <= epsi10  ) )   zmask(ji,jj) = 1._wp 
     1417               IF( a_i(ji,jj,jl) <= epsi10 .OR. v_i(ji,jj,jl) <= epsi10 .OR. at_i(ji,jj) <= epsi10 ) THEN 
     1418                  zmask(ji,jj) = 1._wp 
     1419               ENDIF 
    14841420            END DO 
    14851421         END DO 
    … …  
    14941430            DO jj = 1 , jpj 
    14951431               DO ji = 1 , jpi 
    1496 !!gm                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) * r1_rdtice 
    1497 !!gm                  xtmp = xtmp * unit_fac 
    1498                   ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
     1432                  zei  = e_i(ji,jj,jk,jl) 
    14991433                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) 
     1434                  t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * ( 1._wp - zmask(ji,jj) ) + rtt * zmask(ji,jj) 
     1435                  ! update exchanges with ocean 
     1436                  hfx_res(ji,jj)   = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15001437               END DO 
    15011438            END DO 
    … …  
    15041441         DO jj = 1 , jpj 
    15051442            DO ji = 1 , jpi 
    1506  
     1443                
     1444               zsal = smv_i(ji,jj,jl) 
     1445               zvi  = v_i(ji,jj,jl) 
     1446               zvs  = v_s(ji,jj,jl) 
     1447               zes  = e_s(ji,jj,1,jl) 
    15071448               !----------------------------------------------------------------- 
    15081449               ! Zap snow energy and use ocean heat to melt snow 
    … …  
    15141455               ! fluxes are positive to the ocean 
    15151456               ! here the flux has to be negative for the ocean 
    1516 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice 
    1517                !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp 
    1518  
    1519 !!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) * r1_rdtice !RB   ??????? 
    1520  
    15211457               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
    15221458 
    … …  
    15241460               ! zap ice and snow volume, add water and salt to ocean 
    15251461               !----------------------------------------------------------------- 
    1526  
    1527                !           xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt 
    1528                !           sfx_res(ji,jj)  = sfx_res(ji,jj) + ( sss_m(ji,jj)                  )   & 
    1529                !                                            * rhosn * v_s(ji,jj,jl) * r1_rdtice 
    1530                !           sfx_res(ji,jj)  = sfx_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) )   &  
    1531                !                                            * rhoic * v_i(ji,jj,jl) * r1_rdtice 
    1532                !           sfx (i,j)      = sfx (i,j)      + xtmp 
    1533  
    1534                ato_i(ji,jj)    = a_i  (ji,jj,jl) *       zmask(ji,jj)   + ato_i(ji,jj) 
     1462               ato_i(ji,jj)    = a_i  (ji,jj,jl) *           zmask(ji,jj)   + ato_i(ji,jj) 
    15351463               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15361464               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    … …  
    15391467               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    15401468               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1._wp - zmask(ji,jj) ) 
    1541                ! 
     1469               e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * ( 1._wp - zmask(ji,jj) ) 
     1470               ! additional condition 
     1471               IF( v_s(ji,jj,jl) <= epsi10 ) THEN 
     1472                  v_s(ji,jj,jl)   = 0._wp 
     1473                  e_s(ji,jj,1,jl) = 0._wp 
     1474               ENDIF 
     1475               ! update exchanges with ocean 
     1476               sfx_res(ji,jj)  = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     1477               wfx_res(ji,jj)  = wfx_res(ji,jj) - ( v_i(ji,jj,jl)   - zvi  ) * rhoic * r1_rdtice 
     1478               wfx_snw(ji,jj)  = wfx_snw(ji,jj) - ( v_s(ji,jj,jl)   - zvs  ) * rhosn * r1_rdtice 
     1479               hfx_res(ji,jj)  = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    15421480            END DO 
    15431481         END DO 
    1544          ! 
    1545       END DO                 ! jl  
     1482      END DO ! jl  
     1483 
     1484      ! to be sure that at_i is the sum of a_i(jl) 
     1485      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    15461486      ! 
    15471487      CALL wrk_dealloc( jpi, jpj, zmask ) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r4333 r4921  
    66   !! History :   -   !          (W. H. Lipscomb and E.C. Hunke) CICE (c) original code 
    77   !!            3.0  ! 2005-12  (M. Vancoppenolle) adaptation to LIM-3 
    8    !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age and types 
     8   !!             -   ! 2006-06  (M. Vancoppenolle) adaptation to include salt, age 
    99   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked 
    1010   !!---------------------------------------------------------------------- 
    … …  
    3535   USE lib_fortran      ! to use key_nosignedzero 
    3636   USE timing          ! Timing 
     37   USE limcons        ! conservation tests 
    3738 
    3839   IMPLICIT NONE 
    … …  
    6566      INTEGER, INTENT(in) ::   kt   ! time step index 
    6667      ! 
    67       INTEGER ::   jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index          
    68       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    69       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     68      INTEGER ::   ji, jj, jk, jl   ! dummy loop index          
     69      ! 
     70      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    7071      !!------------------------------------------------------------------ 
    7172      IF( nn_timing == 1 )  CALL timing_start('limitd_th') 
    7273 
    73       ! ------------------------------- 
    74       !- check conservation (C Rousset) 
    75       IF (ln_limdiahsb) THEN 
    76          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    77          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    78          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    79          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    80        ENDIF 
    81       !- check conservation (C Rousset) 
    82       ! ------------------------------- 
     74      ! conservation test 
     75      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    8376 
    8477      IF( kt == nit000 .AND. lwp ) THEN 
    … …  
    9386      ! Given thermodynamic growth rates, transport ice between 
    9487      ! thickness categories. 
    95       DO jm = 1, jpm 
    96          jbnd1 = ice_cat_bounds(jm,1) 
    97          jbnd2 = ice_cat_bounds(jm,2) 
    98          IF( ice_ncat_types(jm) > 1 )   CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt ) 
    99       END DO 
     88      IF( jpl > 1 )   CALL lim_itd_th_rem( 1, jpl, kt ) 
    10089      ! 
    10190      CALL lim_var_glo2eqv    ! only for info 
    … …  
    10594      !  3) Add frazil ice growing in leads. 
    10695      !------------------------------------------------------------------------------| 
    107  
    10896      CALL lim_thd_lac 
    10997      CALL lim_var_glo2eqv    ! only for info 
    110  
    111      IF(ln_ctl) THEN   ! Control print 
     98      
     99      IF(ln_ctl) THEN   ! Control print 
    112100         CALL prt_ctl_info(' ') 
    113101         CALL prt_ctl_info(' - Cell values : ') 
    … …  
    131119            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ') 
    132120            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ') 
    133             DO ja = 1, nlay_i 
     121            DO jk = 1, nlay_i 
    134122               CALL prt_ctl_info(' ') 
    135                CALL prt_ctl_info(' - Layer : ', ivar1=ja) 
     123               CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
    136124               CALL prt_ctl_info('   ~~~~~~~') 
    137                CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
    138                CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
     125               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : t_i      : ') 
     126               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th  : e_i      : ') 
    139127            END DO 
    140128         END DO 
    141129      ENDIF 
    142130      ! 
    143       ! ------------------------------- 
    144       !- check conservation (C Rousset) 
    145       IF( ln_limdiahsb ) THEN 
    146          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    147          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    148   
    149          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    150          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    151  
    152          zchk_vmin = glob_min(v_i) 
    153          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    154          zchk_amin = glob_min(a_i) 
    155  
    156          IF(lwp) THEN 
    157             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limitd_th) = ',(zchk_v_i * rday) 
    158             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limitd_th) = ',(zchk_smv * rday) 
    159             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limitd_th) = ',(zchk_vmin * 1.e-3) 
    160             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limitd_th) = ',zchk_amax 
    161             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limitd_th) = ',zchk_amin 
    162          ENDIF 
    163        ENDIF 
    164       !- check conservation (C Rousset) 
    165       ! ------------------------------- 
     131      ! conservation test 
     132      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    166133      ! 
    167134     IF( nn_timing == 1 )  CALL timing_stop('limitd_th') 
    … …  
    169136   ! 
    170137 
    171    SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, kt ) 
     138   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, kt ) 
    172139      !!------------------------------------------------------------------ 
    173140      !!                ***  ROUTINE lim_itd_th_rem *** 
    … …  
    182149      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point 
    183150      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied 
    184       INTEGER , INTENT (in) ::   ntyp    ! Number of the type used 
    185151      INTEGER , INTENT (in) ::   kt      ! Ocean time step  
    186152      ! 
    … …  
    200166      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hL          ! left boundary for the ITD for each thickness 
    201167      REAL(wp), POINTER, DIMENSION(:,:,:) ::   hR          ! left boundary for the ITD for each thickness 
    202       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_o     ! old ice thickness 
     168      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zht_i_b     ! old ice thickness 
    203169      REAL(wp), POINTER, DIMENSION(:,:,:) ::   dummy_es 
    204170      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdaice, zdvice          ! local increment of ice area and volume 
    … …  
    218184      CALL wrk_alloc( jpi,jpj, zremap_flag )    ! integer 
    219185      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer 
    220       CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 
     186      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    221187      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    222188      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    … …  
    247213         WRITE(numout,*) ' klbnd :       ', klbnd 
    248214         WRITE(numout,*) ' kubnd :       ', kubnd 
    249          WRITE(numout,*) ' ntyp  :       ', ntyp  
    250215      ENDIF 
    251216 
    … …  
    256221               zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) )     !0 if no ice and 1 if yes 
    257222               ht_i(ji,jj,jl)    = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb 
    258                zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
    259                zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 
    260                IF( a_i(ji,jj,jl) > epsi06 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)  
     223               zindb             = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i_b(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 
     224               zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * zindb 
     225               IF( a_i(ji,jj,jl) > epsi10 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)  
    261226            END DO 
    262227         END DO 
    … …  
    302267            ij = nind_j(ji) 
    303268            ! 
    304             IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. &  
    305                ( zht_i_o(ii,ij,jl+1) .GT. epsi10 ) ) THEN 
     269            zhbnew(ii,ij,jl) = hi_max(jl) 
     270            IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 
    306271               !interpolate between adjacent category growth rates 
    307                zslope = ( zdhice(ii,ij,jl+1)     - zdhice(ii,ij,jl) ) / & 
    308                   ( zht_i_o   (ii,ij,jl+1) - zht_i_o   (ii,ij,jl) ) 
    309                zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + & 
    310                   zslope * ( hi_max(jl) - zht_i_o(ii,ij,jl) ) 
    311             ELSEIF (zht_i_o(ii,ij,jl).gt.epsi10) THEN 
     272               zslope           = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 
     273               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 
     274            ELSEIF ( a_i_b(ii,ij,jl) > epsi10) THEN 
    312275               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 
    313             ELSEIF (zht_i_o(ii,ij,jl+1).gt.epsi10) THEN 
     276            ELSEIF ( a_i_b(ii,ij,jl+1) > epsi10) THEN 
    314277               zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 
    315             ELSE 
    316                zhbnew(ii,ij,jl) = hi_max(jl) 
    317278            ENDIF 
    318279         END DO 
    … …  
    320281         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    321282         DO ji = 1, nbrem 
    322             ! jl, ji 
    323283            ii = nind_i(ji) 
    324284            ij = nind_j(ji) 
    325             ! jl, ji 
    326             IF ( ( a_i(ii,ij,jl) .GT.epsi10) .AND. &  
    327                ( ht_i(ii,ij,jl).GE. zhbnew(ii,ij,jl) ) & 
    328                ) THEN 
     285            IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 
    329286               zremap_flag(ii,ij) = 0 
    330             ELSEIF ( ( a_i(ii,ij,jl+1) .GT. epsi10 ) .AND. & 
    331                ( ht_i(ii,ij,jl+1).LE. zhbnew(ii,ij,jl) ) & 
    332                ) THEN 
     287            ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) <= zhbnew(ii,ij,jl) ) THEN 
    333288               zremap_flag(ii,ij) = 0 
    334289            ENDIF 
    335290 
    336291            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max   
    337             ! jl, ji 
    338             IF (zhbnew(ii,ij,jl).gt.hi_max(jl+1)) THEN 
    339                zremap_flag(ii,ij) = 0 
    340             ENDIF 
    341             ! jl, ji 
    342             IF (zhbnew(ii,ij,jl).lt.hi_max(jl-1)) THEN 
    343                zremap_flag(ii,ij) = 0 
    344             ENDIF 
    345             ! jl, ji 
    346          END DO !ji 
    347          ! ji 
     292            IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 
     293            IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 
     294         END DO 
     295 
    348296      END DO !jl 
    349297 
    … …  
    354302      DO jj = 1, jpj 
    355303         DO ji = 1, jpi 
    356             IF ( zremap_flag(ji,jj) == 1 ) THEN 
     304            IF( zremap_flag(ji,jj) == 1 ) THEN 
    357305               nbrem         = nbrem + 1 
    358306               nind_i(nbrem) = ji 
    359307               nind_j(nbrem) = jj 
    360308            ENDIF 
    361          END DO !ji 
    362       END DO !jj 
     309         END DO  
     310      END DO  
    363311 
    364312      !----------------------------------------------------------------------------------------------- 
    … …  
    367315      DO jj = 1, jpj 
    368316         DO ji = 1, jpi 
    369             zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme 
    370             zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er 
     317            zhb0(ji,jj) = hi_max(0) ! 0eme 
     318            zhb1(ji,jj) = hi_max(1) ! 1er 
    371319 
    372320            zhbnew(ji,jj,klbnd-1) = 0._wp 
    … …  
    380328            ENDIF 
    381329 
    382             IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) )   zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
     330            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) ) zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) 
    383331 
    384332         END DO !jj 
    … …  
    389337      !----------------------------------------------------------------------------------------------- 
    390338      !- 7.1 g(h) for category 1 at start of time step 
    391       CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_o(:,:,klbnd),         & 
     339      CALL lim_itd_fitline( klbnd, zhb0, zhb1, zht_i_b(:,:,klbnd),         & 
    392340         &                  g0(:,:,klbnd), g1(:,:,klbnd), hL(:,:,klbnd),   & 
    393341         &                  hR(:,:,klbnd), zremap_flag ) 
    … …  
    414362                  ! Constrain new thickness <= ht_i 
    415363                  zdamax = a_i(ii,ij,klbnd) * &  
    416                      (1.0 - ht_i(ii,ij,klbnd)/zht_i_o(ii,ij,klbnd)) ! zdamax > 0 
     364                     (1.0 - ht_i(ii,ij,klbnd)/zht_i_b(ii,ij,klbnd)) ! zdamax > 0 
    417365                  !ice area lost due to melting of thin ice 
    418366                  zda0   = MIN(zda0, zdamax) 
    … …  
    428376            ELSE ! if ice accretion 
    429377               ! ji, a_i > epsi10; zdh0 > 0 
    430                IF ( ntyp .EQ. 1 ) zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
     378               zhbnew(ii,ij,klbnd-1) = MIN(zdh0,hi_max(klbnd))  
    431379               ! zhbnew was 0, and is shifted to the right to account for thin ice 
    432380               ! growth in openwater (F0 = f1) 
    433                IF ( ntyp .NE. 1 ) zhbnew(ii,ij,0) = 0  
    434                ! in other types there is 
    435                ! no open water growth (F0 = 0) 
    436381            ENDIF ! zdh0  
    437382 
    … …  
    444389      DO jl = klbnd, kubnd 
    445390         CALL lim_itd_fitline(jl, zhbnew(:,:,jl-1), zhbnew(:,:,jl), ht_i(:,:,jl), & 
    446             g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl),     & 
    447             zremap_flag) 
     391            g0(:,:,jl), g1(:,:,jl), hL(:,:,jl), hR(:,:,jl), zremap_flag) 
    448392      END DO 
    449393 
    … …  
    493437            nd   = zdonor(ii,ij,jl) 
    494438            zdaice(ii,ij,jl) = g1(ii,ij,nd)*zx2 + g0(ii,ij,nd)*zx1 
    495             zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + & 
    496                zdaice(ii,ij,jl)*hL(ii,ij,nd) 
     439            zdvice(ii,ij,jl) = g1(ii,ij,nd)*zx3 + g0(ii,ij,nd)*zx2 + zdaice(ii,ij,jl)*hL(ii,ij,nd) 
    497440 
    498441         END DO ! ji 
    … …  
    511454         ii = nind_i(ji) 
    512455         ij = nind_j(ji) 
    513          IF ( ( a_i(ii,ij,1) > epsi10 ) .AND. ( ht_i(ii,ij,1) < hiclim ) ) THEN 
     456         IF ( a_i(ii,ij,1) > epsi10 .AND. ht_i(ii,ij,1) < hiclim ) THEN 
    514457            a_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim  
    515458            ht_i(ii,ij,1) = hiclim 
    516             v_i(ii,ij,1)  = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless 
    517459         ENDIF 
    518460      END DO !ji 
    … …  
    542484      CALL wrk_dealloc( jpi,jpj, zremap_flag )    ! integer 
    543485      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer 
    544       CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es ) 
     486      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 
    545487      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )    
    546488      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )    
    … …  
    799741            !-------------- 
    800742 
    801             zdvsnow          = v_s(ii,ij,jl1) * zworka(ii,ij) 
     743            zdvsnow        = v_s(ii,ij,jl1) * zworka(ii,ij) 
    802744            v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow 
    803745            v_s(ii,ij,jl2) = v_s(ii,ij,jl2) + zdvsnow  
    … …  
    807749            !-------------------- 
    808750 
    809             zdesnow              = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
     751            zdesnow            = e_s(ii,ij,1,jl1) * zworka(ii,ij) 
    810752            e_s(ii,ij,1,jl1)   = e_s(ii,ij,1,jl1) - zdesnow 
    811753            e_s(ii,ij,1,jl2)   = e_s(ii,ij,1,jl2) + zdesnow 
    … …  
    815757            !-------------- 
    816758 
    817             zdo_aice             = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
     759            zdo_aice           = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 
    818760            oa_i(ii,ij,jl1)    = oa_i(ii,ij,jl1) - zdo_aice 
    819761            oa_i(ii,ij,jl2)    = oa_i(ii,ij,jl2) + zdo_aice 
    … …  
    823765            !-------------- 
    824766 
    825             zdsm_vice            = smv_i(ii,ij,jl1) * zworka(ii,ij) 
     767            zdsm_vice          = smv_i(ii,ij,jl1) * zworka(ii,ij) 
    826768            smv_i(ii,ij,jl1)   = smv_i(ii,ij,jl1) - zdsm_vice 
    827769            smv_i(ii,ij,jl2)   = smv_i(ii,ij,jl2) + zdsm_vice 
    … …  
    831773            !--------------------- 
    832774 
    833             zdaTsf               = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
     775            zdaTsf             = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 
    834776            zaTsfn(ii,ij,jl1)  = zaTsfn(ii,ij,jl1) - zdaTsf 
    835777            zaTsfn(ii,ij,jl2)  = zaTsfn(ii,ij,jl2) + zdaTsf  
    … …  
    888830    
    889831 
    890    SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp ) 
     832   SUBROUTINE lim_itd_th_reb( klbnd, kubnd ) 
    891833      !!------------------------------------------------------------------ 
    892834      !!                ***  ROUTINE lim_itd_th_reb *** 
    … …  
    898840      INTEGER , INTENT (in) ::   klbnd   ! Start thickness category index point 
    899841      INTEGER , INTENT (in) ::   kubnd   ! End point on which the  the computation is applied 
    900       INTEGER , INTENT (in) ::   ntyp    ! number of the ice type involved in the rebinning process 
    901842      ! 
    902843      INTEGER ::   ji,jj, jl   ! dummy loop indices 
    … …  
    910851      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   ! snow volume summed over categories 
    911852      !!------------------------------------------------------------------ 
     853      !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate 
    912854       
    913855      CALL wrk_alloc( jpi,jpj,jpl, zdonor )   ! interger 
    … …  
    937879 
    938880      !------------------------------------------------------------------------------ 
    939       ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd) 
     881      ! 2) Make sure thickness of cat klbnd is at least hi_max(klbnd) 
    940882      !------------------------------------------------------------------------------ 
    941883      DO jj = 1, jpj  
    942884         DO ji = 1, jpi  
    943885            IF( a_i(ji,jj,klbnd) > epsi10 ) THEN 
    944                IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN 
    945                   a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp)  
    946                   ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp) 
     886               IF( ht_i(ji,jj,klbnd) <= hi_max(0) .AND. hi_max(0) > 0._wp ) THEN 
     887                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max(0)  
     888                  ht_i(ji,jj,klbnd) = hi_max(0) 
    947889               ENDIF 
    948890            ENDIF 
    … …  
    1015957 
    1016958!clem-change 
     959         DO jj = 1, jpj 
     960            DO ji = 1, jpi 
     961               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     962                  ! 
     963                  zshiftflag = 1 
     964                  zdonor(ji,jj,jl) = jl + 1 
     965                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
     966                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
     967               ENDIF 
     968            END DO                 ! ji 
     969         END DO                 ! jj 
     970 
     971         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
     972          
     973         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
     974            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
     975            ! Reset shift parameters 
     976            zdonor(:,:,jl) = 0 
     977            zdaice(:,:,jl) = 0._wp 
     978            zdvice(:,:,jl) = 0._wp 
     979         ENDIF 
     980!clem-change 
     981 
     982!         ! clem-change begin: why not doing that? 
    1017983!         DO jj = 1, jpj 
    1018984!            DO ji = 1, jpi 
    1019 !               IF( a_i(ji,jj,jl+1) >  epsi10 .AND.   & 
    1020 !                  ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    1021 !                  ! 
    1022 !                  zshiftflag = 1 
    1023 !                  zdonor(ji,jj,jl) = jl + 1 
    1024 !                  zdaice(ji,jj,jl) = a_i(ji,jj,jl+1)  
    1025 !                  zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 
     985!               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     986!                  ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
     987!                  a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    1026988!               ENDIF 
    1027989!            END DO                 ! ji 
    1028990!         END DO                 ! jj 
    1029 ! 
    1030 !         IF(lk_mpp)   CALL mpp_max( zshiftflag ) 
    1031 !          
    1032 !         IF( zshiftflag == 1 ) THEN            ! Shift ice between categories 
    1033 !            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    1034 !            ! Reset shift parameters 
    1035 !            zdonor(:,:,jl) = 0 
    1036 !            zdaice(:,:,jl) = 0._wp 
    1037 !            zdvice(:,:,jl) = 0._wp 
    1038 !         ENDIF 
    1039 !clem-change 
    1040  
    1041          ! clem-change begin: why not doing that? 
    1042          DO jj = 1, jpj 
    1043             DO ji = 1, jpi 
    1044                IF( a_i(ji,jj,jl+1) >  epsi10 .AND.   & 
    1045                   ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    1046                   ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 
    1047                   a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)  
    1048                ENDIF 
    1049             END DO                 ! ji 
    1050          END DO                 ! jj 
    1051991         ! clem-change end 
    1052992 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r4346 r4921  
    5151 
    5252   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   rzero   = 0._wp   ! constant values 
    54    REAL(wp) ::   rone    = 1._wp   ! constant values 
    5553       
    5654   !! * Substitutions 
    … …  
    514512!CDIR NOVERRCHK 
    515513               DO ji = fs_2, fs_jpim1 
    516                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     514                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    517515                  zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg 
    518516                  z0           = zmass1(ji,jj)/dtevp 
    … …  
    547545               DO ji = fs_2, fs_jpim1 
    548546 
    549                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     547                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    550548                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    551549                  z0           = zmass2(ji,jj)/dtevp 
    … …  
    579577!CDIR NOVERRCHK 
    580578               DO ji = fs_2, fs_jpim1 
    581                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj) 
     579                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass2(ji,jj))))*tmv(ji,jj) 
    582580                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    583581                  z0           = zmass2(ji,jj)/dtevp 
    … …  
    611609!CDIR NOVERRCHK 
    612610               DO ji = fs_2, fs_jpim1 
    613                   zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj) 
     611                  zmask        = (1.0-MAX(0._wp,SIGN(1._wp,-zmass1(ji,jj))))*tmu(ji,jj) 
    614612                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg 
    615613                  z0           = zmass1(ji,jj)/dtevp 
    … …  
    661659      ! 4) Prevent ice velocities when the ice is thin 
    662660      !------------------------------------------------------------------------------! 
    663       !clem : add hminrhg in the namelist 
    664       ! 
    665661      ! If the ice thickness is below hminrhg (5cm) then ice velocity should equal the 
    666662      ! ocean velocity,  

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4205 r4921  
    142142         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    143143      END DO 
    144  
     144       
    145145      DO jl = 1, jpl  
    146146         WRITE(zchar,'(I1)') jl 
    … …  
    162162      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      ) 
    163163      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      ) 
    164       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'        , fsbbq      ) 
    165164      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  ) 
    166165      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
    … …  
    393392      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    394393      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    395       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    396394      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    397395      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    … …  
    522520      END DO 
    523521      ! 
     522      ! clem: I do not understand why the following IF is needed 
     523      !       I suspect something inconsistent in the main code with option num_sal=1 
     524      IF( num_sal == 1 ) THEN 
     525         DO jl = 1, jpl  
     526            sm_i(:,:,jl) = bulk_sal 
     527            DO jk = 1, nlay_i  
     528               s_i(:,:,jk,jl) = bulk_sal 
     529            END DO 
     530         END DO 
     531      ENDIF 
     532      ! 
    524533      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 
    525534      ! 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4614 r4921  
    2727   USE par_ice          ! ice parameters 
    2828   USE dom_oce          ! ocean domain 
    29    USE domvvl           ! ocean vertical scale factors 
    30    USE dom_ice,    ONLY : tms 
     29   USE dom_ice,    ONLY : tms, area 
    3130   USE ice              ! LIM sea-ice variables 
    3231   USE sbc_ice          ! Surface boundary condition: sea-ice fields 
    … …  
    4342   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4443   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
     44   USE iom 
     45   USE domvvl           ! Variable volume 
    4546 
    4647   IMPLICIT NONE 
    … …  
    5152   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim 
    5253 
    53    REAL(wp)  ::   rzero  = 0._wp     
    54    REAL(wp)  ::   rone   = 1._wp 
     54   REAL(wp)  ::   epsi10 = 1.e-10   ! 
     55   REAL(wp)  ::   epsi20 = 1.e-20   ! 
    5556 
    5657   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress     [N/m2] 
    … …  
    104105      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    105106      ! 
    106       INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    107       INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    108       INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
    109       REAL(wp) ::   zinda, zemp, zemp_snow, zfmm      ! local scalars 
    110       REAL(wp) ::   zemp_snw                          !   -      - 
    111       REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
     107      INTEGER  ::   ji, jj, jl, jk           ! dummy loop indices 
     108      REAL(wp) ::   zinda, zemp      ! local scalars 
     109      REAL(wp) ::   zf_mass         ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
     110      REAL(wp) ::   zfcm1           ! New solar flux received by the ocean 
    112111      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
    113       REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
    114112      !!--------------------------------------------------------------------- 
    115113       
    116114      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 
    117115 
    118       !------------------------------------------! 
    119       !      heat flux at the ocean surface      ! 
    120       !------------------------------------------! 
     116      ! make calls for heat fluxes before it is modified 
     117      CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) )   !     solar flux at ocean surface 
     118      CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) )   ! non-solar flux at ocean surface 
     119      CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )  !     solar flux at ice surface 
     120      CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )  ! non-solar flux at ice surface 
     121      CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )  !     solar flux transmitted thru ice 
     122      CALL iom_put( "qt_oce"  , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )   
     123      CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 
     124 
    121125      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 
    122       ! changed to old_frld and old ht_i 
    123  
    124126      DO jj = 1, jpj 
    125127         DO ji = 1, jpi 
    126             zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    127             ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
    128             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    129             idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    130             iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
    131             ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr 
    132             iadv    = ( 1  - i1mfr ) * zinda 
    133             ifral   = ( 1  - i1mfr * ( 1 - ial ) )    
    134             ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    135  
    136             ! switch --- 1.0 ---------------- 0.0 -------------------- 
    137             ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    138             ! zinda   | if pfrld = 1       | if pfrld < 1            | 
    139             !  -> ifvt| if pfrld old_ht_i 
    140             ! i1mfr   | if frld = 1        | if frld  < 1            | 
    141             ! idfr    | if frld <= pfrld    | if frld > pfrld        | 
    142             ! iflt    |  
    143             ! ial     | 
    144             ! iadv    | 
    145             ! ifral 
    146             ! ifrdv 
    147  
    148             !   computation the solar flux at ocean surface 
    149             IF (lk_cpl) THEN ! be carfeful: not been tested yet 
     128 
     129            !------------------------------------------! 
     130            !      heat flux at the ocean surface      ! 
     131            !------------------------------------------! 
     132            zinda   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 
     133 
     134            ! Solar heat flux reaching the ocean = zfcm1 (W.m-2)  
     135            !--------------------------------------------------- 
     136            IF( lk_cpl ) THEN ! be carfeful: not been tested yet 
    150137               ! original line 
    151                !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 
    152                ! new line to include solar penetration (not tested) 
    153                zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     138               zfcm1 = qsr_tot(ji,jj) 
     139               !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
    154140               DO jl = 1, jpl 
    155                   zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     141                  zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 
    156142               END DO 
    157143            ELSE 
    158                zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
    159                     &    ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     144               !!!zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
     145               !!!     &    ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 
     146               zfcm1   = pfrld(ji,jj) * qsr(ji,jj) 
     147               DO jl = 1, jpl 
     148                  zfcm1   = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 
     149               END DO 
    160150            ENDIF 
    161             ! fstric     Solar flux transmitted trough the ice 
    162             ! qsr        Net short wave heat flux on free ocean 
    163             ! new line 
    164             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
    165  
    166             ! solar flux and fscmbq with light penetration (clem) 
    167             zzfcm1  = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
    168             zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
    169  
    170             !  computation the non solar heat flux at ocean surface 
    171             zfcm2 = - zzfcm1                                                                    & ! 
    172                &    + iflt    * zfscmbq                                                         & ! total ablation: heat given to the ocean 
    173                &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    174                &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
    175                &    + fhmec(ji,jj)                                                              & ! snow melt when ridging 
    176                &    + fheat_mec(ji,jj)                                                          & ! ridge formation 
    177                &    + fheat_res(ji,jj)                                                            ! residual heat flux 
    178             ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok) 
    179             ! qldif   heat balance of the lead (or of the open ocean) 
    180             ! qfvbq   latent heat uptake/release after accretion/ablation 
    181             ! qdtcn   Energy from the turbulent oceanic heat flux heat flux coming in the lead 
    182  
    183             IF( num_sal == 2 )   zfcm2 = zfcm2 + fhbri(ji,jj)    ! add contribution due to brine drainage  
    184  
    185             ! bottom radiative component is sent to the computation of the oceanic heat flux 
    186             fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj)      
    187  
    188             ! used to compute the oceanic heat flux at the next time step 
    189             qsr(ji,jj) = zfcm1                                       ! solar heat flux  
    190             qns(ji,jj) = zfcm2 - fdtcn(ji,jj)                        ! non solar heat flux 
    191             !                           ! fdtcn : turbulent oceanic heat flux 
    192          END DO 
    193       END DO 
    194  
    195       !------------------------------------------! 
    196       !      mass flux at the ocean surface      ! 
    197       !------------------------------------------! 
    198  
    199 !!gm   optimisation: this loop have to be merged with the previous one 
    200       DO jj = 1, jpj 
    201          DO ji = 1, jpi 
     151 
     152            ! Total heat flux reaching the ocean = hfx_out (W.m-2)  
     153            !--------------------------------------------------- 
     154            zf_mass        = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 
     155            hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 
     156 
     157            ! New qsr and qns used to compute the oceanic heat flux at the next time step 
     158            !--------------------------------------------------- 
     159            qsr(ji,jj) = zfcm1                                       
     160            qns(ji,jj) = hfx_out(ji,jj) - zfcm1               
     161 
     162            !------------------------------------------! 
     163            !      mass flux at the ocean surface      ! 
     164            !------------------------------------------! 
    202165            !  case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 
    203166            !  -------------------------------------------------------------------------------------  
    … …  
    208171            !                     Even if i see Ice melting as a FW and SALT flux 
    209172            !         
    210  
    211173            !  computing freshwater exchanges at the ice/ocean interface 
    212             IF (lk_cpl) THEN  
     174            IF( lk_cpl ) THEN  
    213175               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
    214                   &   - rdm_snw(ji,jj) / rdt_ice 
     176                  &   + wfx_snw(ji,jj) 
    215177            ELSE 
    216                zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    217                   &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    218                   &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    219                   &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     178               zemp =   emp(ji,jj)     *           pfrld(ji,jj)            &   ! evaporation over oceanic fraction 
     179                  &   - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) )          &   ! all precipitation reach the ocean 
     180                  &   + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas )       ! except solid precip intercepted by sea-ice 
    220181            ENDIF 
    221182 
    222             ! mass flux at the ocean/ice interface (sea ice fraction) 
    223             zemp_snw = rdm_snw(ji,jj) * r1_rdtice                         ! snow melting = pure water that enters the ocean 
    224             zfmm     = rdm_ice(ji,jj) * r1_rdtice                         ! Freezing minus melting   
    225  
    226             fmmflx(ji,jj) = zfmm                                     ! F/M mass flux save at least for biogeochemical model 
    227  
    228             emp(ji,jj) = zemp + zemp_snw + zfmm  ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
     183            ! mass flux from ice/ocean 
     184            wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj)   & 
     185                           + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 
     186 
     187            ! mass flux at the ocean/ice interface 
     188            fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice                   ! F/M mass flux save at least for biogeochemical model 
     189            emp(ji,jj)    = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)       ! mass flux + F/M mass flux (always ice/ocean mass exchange) 
    229190             
    230             !  correcting brine salt fluxes   (zinda = 1  if pfrld=1 , =0 otherwise) 
    231             zinda        = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    232             sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 
    233191         END DO 
    234192      END DO 
    … …  
    237195      !      salt flux at the ocean surface      ! 
    238196      !------------------------------------------! 
    239  
    240       IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux 
    241          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 
    242       ELSE                         ! constant ice salinity: 
    243          sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 
    244       ENDIF 
    245       !-----------------------------------------------! 
    246       !   mass of snow and ice per unit area          ! 
    247       !-----------------------------------------------! 
    248       IF( nn_ice_embd /= 0 ) THEN                               ! embedded sea-ice (mass required) 
    249          snwice_mass_b(:,:) = snwice_mass(:,:)                  ! save mass from the previous ice time step 
    250          !                                                      ! new mass per unit area 
     197      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
     198         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 
     199 
     200      !-------------------------------------------------------------! 
     201      !   mass of snow and ice per unit area for embedded sea-ice   ! 
     202      !-------------------------------------------------------------! 
     203      IF( nn_ice_embd /= 0 ) THEN 
     204         ! save mass from the previous ice time step 
     205         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     206         ! new mass per unit area 
    251207         snwice_mass  (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
    252          !                                                      ! time evolution of snow+ice mass 
     208         ! time evolution of snow+ice mass 
    253209         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    254210      ENDIF 
    … …  
    265221      IF( lk_cpl ) THEN          ! coupled case 
    266222         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo 
    267          ! 
    268223         alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys) 
    269224      ENDIF 
     225 
    270226 
    271227      IF(ln_ctl) THEN 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r4624 r4921  
    88   !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations 
    99   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif 
    10    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw 
     10   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw 
    1111   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas) 
    1212   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
    … …  
    4343   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4444   USE timing         ! Timing 
     45   USE cpl_oasis3, ONLY : lk_cpl 
     46   USE limcons        ! conservation tests 
    4547 
    4648   IMPLICIT NONE 
    … …  
    5153 
    5254   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    53    REAL(wp) ::   zzero  = 0._wp      ! 
    54    REAL(wp) ::   zone   = 1._wp      ! 
    5555 
    5656   !! * Substitutions 
    … …  
    8484      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    8585      !! 
    86       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    87       INTEGER  ::   nbpb             ! nb of icy pts for thermo. cal. 
    88       REAL(wp) ::   zfric_umin = 5e-03_wp    ! lower bound for the friction velocity 
    89       REAL(wp) ::   zfric_umax = 2e-02_wp    ! upper bound for the friction velocity 
    90       REAL(wp) ::   zinda, zindb, zthsnice, zfric_u     ! local scalar 
    91       REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         - 
    92       REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif 
    93       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    94       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
     86      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
     87      INTEGER  :: nbpb             ! nb of icy pts for thermo. cal. 
     88      INTEGER  :: ii, ij           ! temporary dummy loop index 
     89      REAL(wp) :: zfric_umin = 0._wp        ! lower bound for the friction velocity (cice value=5.e-04) 
     90      REAL(wp) :: zch        = 0.0057_wp    ! heat transfer coefficient 
     91      REAL(wp) :: zinda, zindb, zareamin  
     92      REAL(wp) :: zfric_u, zqld, zqfr 
     93      ! 
     94      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9595      !!------------------------------------------------------------------- 
    9696      IF( nn_timing == 1 )  CALL timing_start('limthd') 
    9797 
    98       CALL wrk_alloc( jpi, jpj, zqlbsbq ) 
    99     
    100       ! ------------------------------- 
    101       !- check conservation (C Rousset) 
    102       IF (ln_limdiahsb) THEN 
    103          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    104          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    105          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    106          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    107       ENDIF 
    108       !- check conservation (C Rousset) 
    109       ! ------------------------------- 
     98      ! conservation test 
     99      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    110100 
    111101      !------------------------------------------------------------------------------! 
    … …  
    121111            DO jj = 1, jpj 
    122112               DO ji = 1, jpi 
    123                   !Energy of melting q(S,T) [J.m-3] 
    124                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
    125113                  !0 if no ice and 1 if yes 
    126114                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 )  ) 
    127                   !convert units ! very important that this line is here 
    128                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb  
     115                  !Energy of melting q(S,T) [J.m-3] 
     116                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i ) 
     117                  !convert units ! very important that this line is here         
     118                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac  
    129119               END DO 
    130120            END DO 
    … …  
    133123            DO jj = 1, jpj 
    134124               DO ji = 1, jpi 
    135                   !Energy of melting q(S,T) [J.m-3] 
    136                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    137125                  !0 if no ice and 1 if yes 
    138126                  zindb = 1.0 - MAX(  0.0 , SIGN( 1.0 , - v_s(ji,jj,jl) + epsi10 )  ) 
     127                  !Energy of melting q(S,T) [J.m-3] 
     128                  e_s(ji,jj,jk,jl) = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL( nlay_s ) 
    139129                  !convert units ! very important that this line is here 
    140                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb  
     130                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac  
    141131               END DO 
    142132            END DO 
    143133         END DO 
    144134      END DO 
    145  
    146       !----------------------------------- 
    147       ! 1.4) Compute global heat content 
    148       !----------------------------------- 
    149       qt_i_in  (:,:) = 0.e0 
    150       qt_s_in  (:,:) = 0.e0 
    151       qt_i_fin (:,:) = 0.e0 
    152       qt_s_fin (:,:) = 0.e0 
    153       sum_fluxq(:,:) = 0.e0 
    154       fatm     (:,:) = 0.e0 
    155135 
    156136      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      ! 
    … …  
    161141!CDIR NOVERRCHK 
    162142         DO ji = 1, jpi 
    163             zinda          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - at_i(ji,jj) + epsi10 ) ) ) 
     143            zinda          = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 
    164144            ! 
    165145            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget 
    … …  
    168148            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean  
    169149            !           !  temperature and turbulent mixing (McPhee, 1992) 
    170             ! friction velocity 
    171             zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  
    172  
    173             ! here the drag will depend on ice thickness and type (0.006) 
    174             fdtcn(ji,jj)  = zinda * rau0 * rcp * 0.006  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) )  
    175             ! also category dependent 
    176             !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead  
    177             qdtcn(ji,jj)  = zinda * fdtcn(ji,jj) * ( 1.0 - at_i(ji,jj) ) * rdt_ice 
    178             !                        
    179             !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh)  
    180             !           !   caution: exponent betas used as more snow can fallinto leads 
    181             qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             & 
    182                &   pfrld(ji,jj)        * (  qsr(ji,jj) * oatte(ji,jj)             &   ! solar heat + clem modif 
    183                &                            + qns(ji,jj)                          &   ! non solar heat 
    184                &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat 
    185                &                            + fsbbq(ji,jj) * ( 1.0 - zinda )  )   &   ! residual heat from previous step 
    186                & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting 
    187150            ! 
    188             ! Positive heat budget is used for bottom ablation 
    189             zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) ) 
    190             != 1 if positive heat budget 
    191             zpareff        = 1.0 - zinda * zfntlat 
    192             != 0 if ice and positive heat budget and 1 if one of those two is false 
    193             zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / ( rdt_ice * MAX( at_i(ji,jj), epsi10 ) ) 
     151            ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 
     152            zqld =  tms(ji,jj) * rdt_ice *                                       & 
     153               &  ( pfrld(ji,jj)         * ( qsr(ji,jj) * oatte(ji,jj)           &   ! solar heat + clem modif 
     154               &                           + qns(ji,jj) )                        &   ! non solar heat 
     155               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     156               &    + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)         & 
     157               &    * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )    & 
     158               &    + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) )  & 
     159               &    * rcp * ( tatm_ice(ji,jj) - rtt ) ) 
     160 
     161            !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     162            zqfr = tms(ji,jj) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
     163 
     164            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
     165            qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     166 
     167            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     168            IF( at_i(ji,jj) > epsi10 .AND. zqld > 0._wp ) THEN 
     169               fhld (ji,jj) = zqld * r1_rdtice / at_i(ji,jj) ! divided by at_i since this is (re)multiplied by a_i in limthd_dh.F90 
     170               qlead(ji,jj) = 0._wp 
     171            ENDIF 
    194172            ! 
    195             ! Heat budget of the lead, energy transferred from ice to ocean 
    196             qldif  (ji,jj) = zpareff * qldif(ji,jj) 
    197             qdtcn  (ji,jj) = zpareff * qdtcn(ji,jj) 
    198             ! 
    199             ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx) 
    200             qcmif  (ji,jj) =  rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    201             ! 
    202             ! oceanic heat flux (limthd_dh) 
    203             fbif   (ji,jj) = zinda * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) + fdtcn(ji,jj) ) 
    204             ! 
     173            !-- Energy from the turbulent oceanic heat flux --- ! 
     174            !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 
     175            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     176            fhtur(ji,jj) = MAX( 0._wp, zinda * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2  
     177            ! upper bound for fhtur: we do not want SST to drop below Tfreeze.  
     178            ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)    
     179            ! This is not a clean budget, so that should be corrected at some point 
     180            fhtur(ji,jj) = zinda * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     181 
     182            ! ----------------------------------------- 
     183            ! Net heat flux on top of ice-ocean [W.m-2] 
     184            ! ----------------------------------------- 
     185            !     First  step here      : heat flux at the ocean surface + precip 
     186            !     Second step below     : heat flux at the ice   surface (after limthd_dif)  
     187            hfx_in(ji,jj) = hfx_in(ji,jj)                                                                                         &  
     188               ! heat flux above the ocean 
     189               &    +             pfrld(ji,jj)   * ( qns(ji,jj) + qsr(ji,jj) )                                                    & 
     190               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     191               &    +   ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )  & 
     192               &    +   ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) 
     193 
     194            ! ----------------------------------------------------------------------------- 
     195            ! Net heat flux that is retroceded to the ocean or taken from the ocean [W.m-2] 
     196            ! ----------------------------------------------------------------------------- 
     197            !     First  step here              :  non solar + precip - qlead - qturb 
     198            !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
     199            !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     200            hfx_out(ji,jj) = hfx_out(ji,jj)                                                                                   &  
     201               ! Non solar heat flux received by the ocean 
     202               &    +        pfrld(ji,jj) * qns(ji,jj)                                                                        & 
     203               ! latent heat of precip (note that precip is included in qns but not in qns_ice) 
     204               &    +      ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj)                                            & 
     205               &    * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus )                                            & 
     206               &    +      ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt )   & 
     207               ! heat flux taken from the ocean where there is open water ice formation 
     208               &    -      qlead(ji,jj) * r1_rdtice                                                                           & 
     209               ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 
     210               &    -      at_i(ji,jj) * fhtur(ji,jj)                                                                         & 
     211               &    -      at_i(ji,jj) *  fhld(ji,jj) 
     212 
    205213         END DO 
    206214      END DO 
    … …  
    234242               DO jj = mj0(jjindx), mj1(jjindx) 
    235243                  jiindex_1d = (jj - 1) * jpi + ji 
     244                  WRITE(numout,*) ' lim_thd : Category no : ', jl  
    236245               END DO 
    237246            END DO 
    … …  
    250259            !------------------------- 
    251260 
    252             CALL tab_2d_1d( nbpb, at_i_b     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
    253             CALL tab_2d_1d( nbpb, a_i_b      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
    254             CALL tab_2d_1d( nbpb, ht_i_b     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    255             CALL tab_2d_1d( nbpb, ht_s_b     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    256  
    257             CALL tab_2d_1d( nbpb, t_su_b     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    258             CALL tab_2d_1d( nbpb, sm_i_b     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     261            CALL tab_2d_1d( nbpb, at_i_1d     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) ) 
     262            CALL tab_2d_1d( nbpb, a_i_1d      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) ) 
     263            CALL tab_2d_1d( nbpb, ht_i_1d     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     264            CALL tab_2d_1d( nbpb, ht_s_1d     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     265 
     266            CALL tab_2d_1d( nbpb, t_su_1d     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
     267            CALL tab_2d_1d( nbpb, sm_i_1d     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) ) 
    259268            DO jk = 1, nlay_s 
    260                CALL tab_2d_1d( nbpb, t_s_b(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    261                CALL tab_2d_1d( nbpb, q_s_b(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     269               CALL tab_2d_1d( nbpb, t_s_1d(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     270               CALL tab_2d_1d( nbpb, q_s_1d(1:nbpb,jk), e_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    262271            END DO 
    263272            DO jk = 1, nlay_i 
    264                CALL tab_2d_1d( nbpb, t_i_b(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    265                CALL tab_2d_1d( nbpb, q_i_b(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    266                CALL tab_2d_1d( nbpb, s_i_b(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     273               CALL tab_2d_1d( nbpb, t_i_1d(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     274               CALL tab_2d_1d( nbpb, q_i_1d(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
     275               CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) ) 
    267276            END DO 
    268277 
    … …  
    271280            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) ) 
    272281            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) ) 
    273             CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    274 #if ! defined key_coupled 
    275             CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
    276             CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    277 #endif 
     282            CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     283            CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     284            IF( .NOT. lk_cpl ) THEN 
     285               CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 
     286               CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
     287            ENDIF 
    278288            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 
    279             CALL tab_2d_1d( nbpb, t_bo_b     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
     289            CALL tab_2d_1d( nbpb, t_bo_1d     (1:nbpb), t_bo            , jpi, jpj, npb(1:nbpb) ) 
    280290            CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb), sprecip         , jpi, jpj, npb(1:nbpb) )  
    281             CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb), fbif            , jpi, jpj, npb(1:nbpb) ) 
    282             CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif           , jpi, jpj, npb(1:nbpb) ) 
    283             CALL tab_2d_1d( nbpb, rdm_ice_1d (1:nbpb), rdm_ice         , jpi, jpj, npb(1:nbpb) ) 
    284             CALL tab_2d_1d( nbpb, rdm_snw_1d (1:nbpb), rdm_snw         , jpi, jpj, npb(1:nbpb) ) 
    285             CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi           , jpi, jpj, npb(1:nbpb) ) 
    286             CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq         , jpi, jpj, npb(1:nbpb) ) 
    287  
    288             CALL tab_2d_1d( nbpb, sfx_thd_1d (1:nbpb), sfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     291            CALL tab_2d_1d( nbpb, fhtur_1d   (1:nbpb), fhtur           , jpi, jpj, npb(1:nbpb) ) 
     292            CALL tab_2d_1d( nbpb, qlead_1d   (1:nbpb), qlead           , jpi, jpj, npb(1:nbpb) ) 
     293            CALL tab_2d_1d( nbpb, fhld_1d    (1:nbpb), fhld            , jpi, jpj, npb(1:nbpb) ) 
     294 
     295            CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     296            CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     297 
     298            CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     299            CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     300            CALL tab_2d_1d( nbpb, wfx_sum_1d (1:nbpb), wfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     301            CALL tab_2d_1d( nbpb, wfx_sni_1d (1:nbpb), wfx_sni         , jpi, jpj, npb(1:nbpb) ) 
     302            CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res         , jpi, jpj, npb(1:nbpb) ) 
     303            CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     304 
     305            CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     306            CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     307            CALL tab_2d_1d( nbpb, sfx_sum_1d (1:nbpb), sfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     308            CALL tab_2d_1d( nbpb, sfx_sni_1d (1:nbpb), sfx_sni         , jpi, jpj, npb(1:nbpb) ) 
    289309            CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri         , jpi, jpj, npb(1:nbpb) ) 
    290             CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri           , jpi, jpj, npb(1:nbpb) ) 
    291             CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric          , jpi, jpj, npb(1:nbpb) ) 
    292             CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq           , jpi, jpj, npb(1:nbpb) ) 
    293  
    294             CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
    295             CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) ) ! clem modif 
     310            CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res         , jpi, jpj, npb(1:nbpb) ) 
     311 
     312            CALL tab_2d_1d( nbpb, iatte_1d   (1:nbpb), iatte           , jpi, jpj, npb(1:nbpb) )  
     313            CALL tab_2d_1d( nbpb, oatte_1d   (1:nbpb), oatte           , jpi, jpj, npb(1:nbpb) )  
     314 
     315            CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd         , jpi, jpj, npb(1:nbpb) ) 
     316            CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr         , jpi, jpj, npb(1:nbpb) ) 
     317            CALL tab_2d_1d( nbpb, hfx_sum_1d (1:nbpb), hfx_sum         , jpi, jpj, npb(1:nbpb) ) 
     318            CALL tab_2d_1d( nbpb, hfx_bom_1d (1:nbpb), hfx_bom         , jpi, jpj, npb(1:nbpb) ) 
     319            CALL tab_2d_1d( nbpb, hfx_bog_1d (1:nbpb), hfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     320            CALL tab_2d_1d( nbpb, hfx_dif_1d (1:nbpb), hfx_dif         , jpi, jpj, npb(1:nbpb) ) 
     321            CALL tab_2d_1d( nbpb, hfx_opw_1d (1:nbpb), hfx_opw         , jpi, jpj, npb(1:nbpb) ) 
     322            CALL tab_2d_1d( nbpb, hfx_snw_1d (1:nbpb), hfx_snw         , jpi, jpj, npb(1:nbpb) ) 
     323            CALL tab_2d_1d( nbpb, hfx_sub_1d (1:nbpb), hfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     324            CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err         , jpi, jpj, npb(1:nbpb) ) 
     325            CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res         , jpi, jpj, npb(1:nbpb) ) 
     326            CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
     327 
    296328            !-------------------------------- 
    297329            ! 4.3) Thermodynamic processes 
    298330            !-------------------------------- 
    299331 
    300             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_enmelt( 1, nbpb )   ! computes sea ice energy of melting 
    301             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl ) 
    302  
    303             !                                 !---------------------------------! 
    304             CALL lim_thd_dif( 1, nbpb, jl )   ! Ice/Snow Temperature profile    ! 
    305             !                                 !---------------------------------! 
    306  
    307             CALL lim_thd_enmelt( 1, nbpb )    ! computes sea ice energy of melting compulsory for limthd_dh 
    308  
    309             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    310             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_con_dif( 1 , nbpb , jl ) 
    311  
    312             !                                 !---------------------------------! 
    313             CALL lim_thd_dh( 1, nbpb, jl )    ! Ice/Snow thickness              !  
    314             !                                 !---------------------------------! 
    315  
    316             !                                 !---------------------------------! 
    317             CALL lim_thd_ent( 1, nbpb, jl )   ! Ice/Snow enthalpy remapping     ! 
    318             !                                 !---------------------------------! 
    319  
    320             !                                 !---------------------------------! 
    321             CALL lim_thd_sal( 1, nbpb )       ! Ice salinity computation        ! 
    322             !                                 !---------------------------------! 
    323  
    324             !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting 
    325             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl )  
    326             IF( con_i .AND. jiindex_1d > 0 )   CALL lim_thd_con_dh ( 1 , nbpb , jl ) 
     332            !---------------------------------! 
     333            ! Ice/Snow Temperature profile    ! 
     334            !---------------------------------! 
     335            CALL lim_thd_dif( 1, nbpb ) 
     336 
     337            !---------------------------------! 
     338            ! Ice/Snow thicnkess              ! 
     339            !---------------------------------! 
     340            CALL lim_thd_dh( 1, nbpb )     
     341 
     342            ! --- Ice enthalpy remapping --- ! 
     343            CALL lim_thd_ent( 1, nbpb, q_i_1d(1:nbpb,:) )  
     344                                             
     345            !---------------------------------! 
     346            ! --- Ice salinity --- ! 
     347            !---------------------------------! 
     348            CALL lim_thd_sal( 1, nbpb )     
     349 
     350            !---------------------------------! 
     351            ! --- temperature update --- ! 
     352            !---------------------------------! 
     353            CALL lim_thd_temp( 1, nbpb ) 
    327354 
    328355            !-------------------------------- 
    … …  
    330357            !-------------------------------- 
    331358 
    332                CALL tab_1d_2d( nbpb, at_i          , npb, at_i_b    (1:nbpb)   , jpi, jpj ) 
    333                CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_b    (1:nbpb)   , jpi, jpj ) 
    334                CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_b    (1:nbpb)   , jpi, jpj ) 
    335                CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_b     (1:nbpb)   , jpi, jpj ) 
    336                CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_b    (1:nbpb)   , jpi, jpj ) 
    337                CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_b    (1:nbpb)   , jpi, jpj ) 
     359               CALL tab_1d_2d( nbpb, at_i          , npb, at_i_1d    (1:nbpb)   , jpi, jpj ) 
     360               CALL tab_1d_2d( nbpb, ht_i(:,:,jl)  , npb, ht_i_1d    (1:nbpb)   , jpi, jpj ) 
     361               CALL tab_1d_2d( nbpb, ht_s(:,:,jl)  , npb, ht_s_1d    (1:nbpb)   , jpi, jpj ) 
     362               CALL tab_1d_2d( nbpb, a_i (:,:,jl)  , npb, a_i_1d     (1:nbpb)   , jpi, jpj ) 
     363               CALL tab_1d_2d( nbpb, t_su(:,:,jl)  , npb, t_su_1d    (1:nbpb)   , jpi, jpj ) 
     364               CALL tab_1d_2d( nbpb, sm_i(:,:,jl)  , npb, sm_i_1d    (1:nbpb)   , jpi, jpj ) 
    338365            DO jk = 1, nlay_s 
    339                CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b     (1:nbpb,jk), jpi, jpj) 
    340                CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b     (1:nbpb,jk), jpi, jpj) 
     366               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_1d     (1:nbpb,jk), jpi, jpj) 
     367               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_1d     (1:nbpb,jk), jpi, jpj) 
    341368            END DO 
    342369            DO jk = 1, nlay_i 
    343                CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b     (1:nbpb,jk), jpi, jpj) 
    344                CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b     (1:nbpb,jk), jpi, jpj) 
    345                CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b     (1:nbpb,jk), jpi, jpj) 
    346             END DO 
    347                CALL tab_1d_2d( nbpb, fstric        , npb, fstbif_1d (1:nbpb)   , jpi, jpj ) 
    348                CALL tab_1d_2d( nbpb, qldif         , npb, qldif_1d  (1:nbpb)   , jpi, jpj ) 
    349                CALL tab_1d_2d( nbpb, qfvbq         , npb, qfvbq_1d  (1:nbpb)   , jpi, jpj ) 
    350                CALL tab_1d_2d( nbpb, rdm_ice       , npb, rdm_ice_1d(1:nbpb)   , jpi, jpj ) 
    351                CALL tab_1d_2d( nbpb, rdm_snw       , npb, rdm_snw_1d(1:nbpb)   , jpi, jpj ) 
    352                CALL tab_1d_2d( nbpb, dmgwi         , npb, dmgwi_1d  (1:nbpb)   , jpi, jpj ) 
    353                CALL tab_1d_2d( nbpb, rdvosif       , npb, dvsbq_1d  (1:nbpb)   , jpi, jpj ) 
    354                CALL tab_1d_2d( nbpb, rdvobif       , npb, dvbbq_1d  (1:nbpb)   , jpi, jpj ) 
    355                CALL tab_1d_2d( nbpb, fdvolif       , npb, dvlbq_1d  (1:nbpb)   , jpi, jpj ) 
    356                CALL tab_1d_2d( nbpb, rdvonif       , npb, dvnbq_1d  (1:nbpb)   , jpi, jpj )  
    357                CALL tab_1d_2d( nbpb, sfx_thd       , npb, sfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     370               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_1d     (1:nbpb,jk), jpi, jpj) 
     371               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_1d     (1:nbpb,jk), jpi, jpj) 
     372               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_1d     (1:nbpb,jk), jpi, jpj) 
     373            END DO 
     374               CALL tab_1d_2d( nbpb, qlead         , npb, qlead_1d  (1:nbpb)   , jpi, jpj ) 
     375 
     376               CALL tab_1d_2d( nbpb, wfx_snw       , npb, wfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     377               CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     378 
     379               CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     380               CALL tab_1d_2d( nbpb, wfx_bom       , npb, wfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     381               CALL tab_1d_2d( nbpb, wfx_sum       , npb, wfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     382               CALL tab_1d_2d( nbpb, wfx_sni       , npb, wfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     383               CALL tab_1d_2d( nbpb, wfx_res       , npb, wfx_res_1d(1:nbpb)   , jpi, jpj ) 
     384               CALL tab_1d_2d( nbpb, wfx_spr       , npb, wfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     385 
     386               CALL tab_1d_2d( nbpb, sfx_bog       , npb, sfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     387               CALL tab_1d_2d( nbpb, sfx_bom       , npb, sfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     388               CALL tab_1d_2d( nbpb, sfx_sum       , npb, sfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     389               CALL tab_1d_2d( nbpb, sfx_sni       , npb, sfx_sni_1d(1:nbpb)   , jpi, jpj ) 
     390               CALL tab_1d_2d( nbpb, sfx_res       , npb, sfx_res_1d(1:nbpb)   , jpi, jpj ) 
    358391            ! 
    359392            IF( num_sal == 2 ) THEN 
    360393               CALL tab_1d_2d( nbpb, sfx_bri       , npb, sfx_bri_1d(1:nbpb)   , jpi, jpj ) 
    361                CALL tab_1d_2d( nbpb, fhbri         , npb, fhbri_1d  (1:nbpb)   , jpi, jpj ) 
    362394            ENDIF 
     395 
     396              CALL tab_1d_2d( nbpb, hfx_thd       , npb, hfx_thd_1d(1:nbpb)   , jpi, jpj ) 
     397              CALL tab_1d_2d( nbpb, hfx_spr       , npb, hfx_spr_1d(1:nbpb)   , jpi, jpj ) 
     398              CALL tab_1d_2d( nbpb, hfx_sum       , npb, hfx_sum_1d(1:nbpb)   , jpi, jpj ) 
     399              CALL tab_1d_2d( nbpb, hfx_bom       , npb, hfx_bom_1d(1:nbpb)   , jpi, jpj ) 
     400              CALL tab_1d_2d( nbpb, hfx_bog       , npb, hfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     401              CALL tab_1d_2d( nbpb, hfx_dif       , npb, hfx_dif_1d(1:nbpb)   , jpi, jpj ) 
     402              CALL tab_1d_2d( nbpb, hfx_opw       , npb, hfx_opw_1d(1:nbpb)   , jpi, jpj ) 
     403              CALL tab_1d_2d( nbpb, hfx_snw       , npb, hfx_snw_1d(1:nbpb)   , jpi, jpj ) 
     404              CALL tab_1d_2d( nbpb, hfx_sub       , npb, hfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     405              CALL tab_1d_2d( nbpb, hfx_err       , npb, hfx_err_1d(1:nbpb)   , jpi, jpj ) 
     406              CALL tab_1d_2d( nbpb, hfx_res       , npb, hfx_res_1d(1:nbpb)   , jpi, jpj ) 
     407              CALL tab_1d_2d( nbpb, hfx_err_rem   , npb, hfx_err_rem_1d(1:nbpb)   , jpi, jpj ) 
    363408            ! 
    364409            !+++++       temporary stuff for a dummy version 
    365             CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
    366             CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
    367             CALL tab_1d_2d( nbpb, fsup2D     , npb, fsup     (1:nbpb)      , jpi, jpj ) 
    368             CALL tab_1d_2d( nbpb, focea2D    , npb, focea    (1:nbpb)      , jpi, jpj ) 
    369             CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
    370             CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    371             CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 
     410              CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj ) 
     411              CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj ) 
     412              CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj ) 
     413              CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj ) 
    372414            !+++++ 
     415              CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
     416              CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    373417            ! 
    374418            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? 
    … …  
    384428      ! 5.1) Ice heat content               
    385429      !------------------------ 
    386       ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    387       zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) ) 
     430      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    388431      DO jl = 1, jpl 
    389432         DO jk = 1, nlay_i 
    390             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef 
     433            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) / ( unit_fac * REAL( nlay_i ) ) 
    391434         END DO 
    392435      END DO 
    … …  
    395438      ! 5.2) Snow heat content               
    396439      !------------------------ 
    397       ! Enthalpies are global variables we have to readjust the units (heat content in 10^9 Joules) 
    398       zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) ) 
     440      ! Enthalpies are global variables we have to readjust the units (heat content in Joules) 
    399441      DO jl = 1, jpl 
    400442         DO jk = 1, nlay_s 
    401             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef 
     443            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) / ( unit_fac * REAL( nlay_s ) ) 
    402444         END DO 
    403445      END DO 
    … …  
    411453      ! 5.4) Diagnostic thermodynamic growth rates 
    412454      !-------------------------------------------- 
    413 !clem@useless      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes  
    414 !clem@mv-to-itd    dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    415  
    416       IF( con_i .AND. jiindex_1d > 0 )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:) 
    417  
    418455      IF(ln_ctl) THEN            ! Control print 
    419456         CALL prt_ctl_info(' ') 
    … …  
    448485      ENDIF 
    449486      ! 
    450       ! ------------------------------- 
    451       !- check conservation (C Rousset) 
    452       IF (ln_limdiahsb) THEN 
    453          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    454          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    455   
    456          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    457          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    458  
    459          zchk_vmin = glob_min(v_i) 
    460          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    461          zchk_amin = glob_min(a_i) 
    462         
    463          IF(lwp) THEN 
    464             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limthd) = ',(zchk_v_i * rday) 
    465             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limthd) = ',(zchk_smv * rday) 
    466             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limthd) = ',(zchk_vmin * 1.e-3) 
    467             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limthd) = ',zchk_amax 
    468             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limthd) = ',zchk_amin 
    469          ENDIF 
    470       ENDIF 
    471       !- check conservation (C Rousset) 
    472       ! ------------------------------- 
    473       ! 
    474       CALL wrk_dealloc( jpi, jpj, zqlbsbq ) 
     487      ! conservation test 
     488      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    475489      ! 
    476490      IF( nn_timing == 1 )  CALL timing_stop('limthd') 
    477    END SUBROUTINE lim_thd 
    478  
    479  
    480    SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl ) 
     491   END SUBROUTINE lim_thd  
     492 
     493   SUBROUTINE lim_thd_temp( kideb, kiut ) 
    481494      !!----------------------------------------------------------------------- 
    482       !!                   ***  ROUTINE lim_thd_glohec ***  
     495      !!                   ***  ROUTINE lim_thd_temp ***  
    483496      !!                  
    484       !! ** Purpose :  Compute total heat content for each category 
    485       !!               Works with 1d vectors only 
    486       !!----------------------------------------------------------------------- 
    487       INTEGER , INTENT(in   )                         ::   kideb, kiut   ! bounds for the spatial loop 
    488       INTEGER , INTENT(in   )                         ::   jl            ! category number 
    489       REAL(wp), INTENT(  out), DIMENSION (jpij,jpl  ) ::   eti, ets      ! vertically-summed heat content for ice & snow 
    490       REAL(wp), INTENT(  out), DIMENSION (jpij,jkmax) ::   etilayer      ! heat content for ice layers 
    491       !! 
    492       INTEGER  ::   ji,jk   ! loop indices 
    493       !!----------------------------------------------------------------------- 
    494       eti(:,:) = 0._wp 
    495       ets(:,:) = 0._wp 
    496       ! 
    497       DO jk = 1, nlay_i                ! total q over all layers, ice [J.m-2] 
    498          DO ji = kideb, kiut 
    499             etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    500             eti     (ji,jl) = eti(ji,jl) + etilayer(ji,jk)  
    501          END DO 
    502       END DO 
    503       DO ji = kideb, kiut              ! total q over all layers, snow [J.m-2] 
    504          ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / REAL( nlay_s ) 
    505       END DO 
    506       ! 
    507       WRITE(numout,*) ' lim_thd_glohec ' 
    508       WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) * r1_rdtice 
    509       WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) * r1_rdtice 
    510       WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) * r1_rdtice 
    511       ! 
    512    END SUBROUTINE lim_thd_glohec 
    513  
    514  
    515    SUBROUTINE lim_thd_con_dif( kideb, kiut, jl ) 
    516       !!----------------------------------------------------------------------- 
    517       !!                   ***  ROUTINE lim_thd_con_dif ***  
    518       !!                  
    519       !! ** Purpose :   Test energy conservation after heat diffusion 
    520       !!------------------------------------------------------------------- 
    521       INTEGER , INTENT(in   ) ::   kideb, kiut   ! bounds for the spatial loop 
    522       INTEGER , INTENT(in   ) ::   jl            ! category number 
    523  
    524       INTEGER  ::   ji, jk         ! loop indices 
    525       INTEGER  ::   ii, ij 
    526       INTEGER  ::   numce          ! number of points for which conservation is violated 
    527       REAL(wp) ::   meance         ! mean conservation error 
    528       REAL(wp) ::   max_cons_err, max_surf_err 
    529       !!--------------------------------------------------------------------- 
    530  
    531       max_cons_err =  1.0_wp          ! maximum tolerated conservation error 
    532       max_surf_err =  0.001_wp        ! maximum tolerated surface error 
    533  
    534       !-------------------------- 
    535       ! Increment of energy 
    536       !-------------------------- 
    537       ! global 
    538       DO ji = kideb, kiut 
    539          dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl) 
    540       END DO 
    541       ! layer by layer 
    542       dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:) 
    543  
    544       !---------------------------------------- 
    545       ! Atmospheric heat flux, ice heat budget 
    546       !---------------------------------------- 
    547       DO ji = kideb, kiut 
    548          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    549          ij =    ( npb(ji) - 1 ) / jpi + 1 
    550          fatm     (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) 
    551          sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(ii,ij,jl) 
    552       END DO 
    553  
    554       !-------------------- 
    555       ! Conservation error 
    556       !-------------------- 
    557       DO ji = kideb, kiut 
    558          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    559       END DO 
    560  
    561       numce  = 0 
    562       meance = 0._wp 
    563       DO ji = kideb, kiut 
    564          IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    565             numce = numce + 1 
    566             meance = meance + cons_error(ji,jl) 
    567          ENDIF 
    568       END DO 
    569       IF( numce > 0 )   meance = meance / numce 
    570  
    571       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 
    572       WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    573       WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 
    574       WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit 
    575  
    576       !------------------------------------------------------- 
    577       ! Surface error due to imbalance between Fatm and Fcsu 
    578       !------------------------------------------------------- 
    579       numce  = 0 
    580       meance = 0._wp 
    581  
    582       DO ji = kideb, kiut 
    583          surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) ) 
    584          IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN 
    585             numce = numce + 1  
    586             meance = meance + surf_error(ji,jl) 
    587          ENDIF 
    588       ENDDO 
    589       IF( numce > 0 )   meance = meance / numce 
    590  
    591       WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err 
    592       WRITE(numout,*) ' After lim_thd_dif, category : ', jl 
    593       WRITE(numout,*) ' Mean surface error on big error points ', meance, numit 
    594       WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit 
    595  
    596       WRITE(numout,*) ' fc_su      : ', fc_su(jiindex_1d) 
    597       WRITE(numout,*) ' fatm       : ', fatm(jiindex_1d,jl) 
    598       WRITE(numout,*) ' t_su       : ', t_su_b(jiindex_1d) 
    599  
    600       !--------------------------------------- 
    601       ! Write ice state in case of big errors 
    602       !--------------------------------------- 
    603       DO ji = kideb, kiut 
    604          IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. & 
    605             ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN 
    606             ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    607             ij                 = ( npb(ji) - 1 ) / jpi + 1 
    608             ! 
    609             WRITE(numout,*) ' alerte 1     ' 
    610             WRITE(numout,*) ' Untolerated conservation / surface error after ' 
    611             WRITE(numout,*) ' heat diffusion in the ice ' 
    612             WRITE(numout,*) ' Category   : ', jl 
    613             WRITE(numout,*) ' ii , ij  : ', ii, ij 
    614             WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    615             WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    616             WRITE(numout,*) ' surf_error : ', surf_error(ji,jl) 
    617             WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) * r1_rdtice 
    618             WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl) 
    619             WRITE(numout,*) 
    620             !        WRITE(numout,*) ' qt_i_in   : ', qt_i_in(ji,jl) 
    621             !        WRITE(numout,*) ' qt_s_in   : ', qt_s_in(ji,jl) 
    622             !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl) 
    623             !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl) 
    624             !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl) 
    625             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    626             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    627             WRITE(numout,*) ' t_su       : ', t_su_b(ji) 
    628             WRITE(numout,*) ' t_s        : ', t_s_b(ji,1) 
    629             WRITE(numout,*) ' t_i        : ', t_i_b(ji,1:nlay_i) 
    630             WRITE(numout,*) ' t_bo       : ', t_bo_b(ji) 
    631             WRITE(numout,*) ' q_i        : ', q_i_b(ji,1:nlay_i) 
    632             WRITE(numout,*) ' s_i        : ', s_i_b(ji,1:nlay_i) 
    633             WRITE(numout,*) ' tmelts     : ', rtt - tmut*s_i_b(ji,1:nlay_i) 
    634             WRITE(numout,*) 
    635             WRITE(numout,*) ' Fluxes ' 
    636             WRITE(numout,*) ' ~~~~~~ ' 
    637             WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    638             WRITE(numout,*) ' fc_su      : ', fc_su    (ji) 
    639             WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji) 
    640             WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji) 
    641             WRITE(numout,*) ' foc        : ', fbif_1d(ji) 
    642             WRITE(numout,*) ' fstroc     : ', fstroc   (ii,ij,jl) 
    643             WRITE(numout,*) ' i0         : ', i0(ji) 
    644             WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji) 
    645             WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji) 
    646             WRITE(numout,*) ' Conduction fluxes : ' 
    647             WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s) 
    648             WRITE(numout,*) ' fc_i      : ', fc_i(ji,0:nlay_i) 
    649             WRITE(numout,*) 
    650             WRITE(numout,*) ' Layer by layer ... ' 
    651             WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    652             WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) - fc_s(ji,0) 
    653             DO jk = 1, nlay_i 
    654                WRITE(numout,*) ' layer  : ', jk 
    655                WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) * r1_rdtice   
    656                WRITE(numout,*) ' radab  : ', radab(ji,jk) 
    657                WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) - fc_i(ji,jk-1) 
    658                WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk) 
    659             END DO 
    660  
    661          ENDIF 
    662          ! 
    663       END DO 
    664       ! 
    665    END SUBROUTINE lim_thd_con_dif 
    666  
    667  
    668    SUBROUTINE lim_thd_con_dh( kideb, kiut, jl ) 
    669       !!----------------------------------------------------------------------- 
    670       !!                   ***  ROUTINE lim_thd_con_dh  ***  
    671       !!                  
    672       !! ** Purpose :   Test energy conservation after enthalpy redistr. 
    673       !!----------------------------------------------------------------------- 
    674       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
    675       INTEGER, INTENT(in) ::   jl            ! category number 
    676       ! 
    677       INTEGER  ::   ji                ! loop indices 
    678       INTEGER  ::   ii, ij, numce         ! local integers 
    679       REAL(wp) ::   meance, max_cons_err    !local scalar 
    680       !!--------------------------------------------------------------------- 
    681  
    682       max_cons_err = 1._wp 
    683  
    684       !-------------------------- 
    685       ! Increment of energy 
    686       !-------------------------- 
    687       DO ji = kideb, kiut 
    688          dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl)   ! global 
    689       END DO 
    690       dq_i_layer(:,:)    = q_i_layer_fin(:,:) - q_i_layer_in(:,:)                            ! layer by layer 
    691  
    692       !---------------------------------------- 
    693       ! Atmospheric heat flux, ice heat budget 
    694       !---------------------------------------- 
    695       DO ji = kideb, kiut 
    696          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    697          ij =    ( npb(ji) - 1 ) / jpi + 1 
    698  
    699          fatm      (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji)                       ! total heat flux 
    700          sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(ii,ij,jl)  
    701          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    702       END DO 
    703  
    704       !-------------------- 
    705       ! Conservation error 
    706       !-------------------- 
    707       DO ji = kideb, kiut 
    708          cons_error(ji,jl) = ABS( dq_i(ji,jl) * r1_rdtice + sum_fluxq(ji,jl) ) 
    709       END DO 
    710  
    711       numce = 0 
    712       meance = 0._wp 
    713       DO ji = kideb, kiut 
    714          IF( cons_error(ji,jl) .GT. max_cons_err ) THEN 
    715             numce = numce + 1 
    716             meance = meance + cons_error(ji,jl) 
    717          ENDIF 
    718       ENDDO 
    719       IF(numce > 0 ) meance = meance / numce 
    720  
    721       WRITE(numout,*) ' Error report - Category : ', jl 
    722       WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
    723       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err 
    724       WRITE(numout,*) ' After lim_thd_ent, category : ', jl 
    725       WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit 
    726       WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit 
    727  
    728       !--------------------------------------- 
    729       ! Write ice state in case of big errors 
    730       !--------------------------------------- 
    731       DO ji = kideb, kiut 
    732          IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN 
    733             ii = MOD( npb(ji) - 1, jpi ) + 1 
    734             ij =    ( npb(ji) - 1 ) / jpi + 1 
    735             ! 
    736             WRITE(numout,*) ' alerte 1 - category : ', jl 
    737             WRITE(numout,*) ' Untolerated conservation error after limthd_ent ' 
    738             WRITE(numout,*) ' ii , ij  : ', ii, ij 
    739             WRITE(numout,*) ' lat, lon   : ', gphit(ii,ij), glamt(ii,ij) 
    740             WRITE(numout,*) ' * ' 
    741             WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl) 
    742             WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) * r1_rdtice 
    743             WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) * r1_rdtice 
    744             WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) * r1_rdtice 
    745             WRITE(numout,*) ' cons_error : ', cons_error(ji,jl) 
    746             WRITE(numout,*) ' * ' 
    747             WRITE(numout,*) ' Fluxes        --- : ' 
    748             WRITE(numout,*) ' fatm       : ', fatm(ji,jl) 
    749             WRITE(numout,*) ' foce       : ', fbif_1d(ji) 
    750             WRITE(numout,*) ' fres       : ', ftotal_fin(ji) 
    751             WRITE(numout,*) ' fhbri      : ', fhbricat(ii,ij,jl) 
    752             WRITE(numout,*) ' * ' 
    753             WRITE(numout,*) ' Heat contents --- : ' 
    754             WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) * r1_rdtice 
    755             WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) * r1_rdtice 
    756             WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) * r1_rdtice 
    757             WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) * r1_rdtice 
    758             WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) * r1_rdtice 
    759             WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) * r1_rdtice 
    760             WRITE(numout,*) ' * ' 
    761             WRITE(numout,*) ' Ice variables --- : ' 
    762             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji) 
    763             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji) 
    764             WRITE(numout,*) ' dh_s_tot  : ', dh_s_tot(ji) 
    765             WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji) 
    766             WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji) 
    767             WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    768          ENDIF 
    769          ! 
    770       END DO 
    771       ! 
    772    END SUBROUTINE lim_thd_con_dh 
    773  
    774  
    775    SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
    776       !!----------------------------------------------------------------------- 
    777       !!                   ***  ROUTINE lim_thd_enmelt ***  
    778       !!                  
    779       !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) 
     497      !! ** Purpose :   Computes sea ice temperature (Kelvin) from enthalpy 
    780498      !! 
    781499      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
    … …  
    784502      !! 
    785503      INTEGER  ::   ji, jk   ! dummy loop indices 
    786       REAL(wp) ::   ztmelts  ! local scalar  
     504      REAL(wp) ::   ztmelts, zswitch, zaaa, zbbb, zccc, zdiscrim  ! local scalar  
    787505      !!------------------------------------------------------------------- 
    788       ! 
    789       DO jk = 1, nlay_i             ! Sea ice energy of melting 
     506      ! Recover ice temperature 
     507      DO jk = 1, nlay_i 
    790508         DO ji = kideb, kiut 
    791             ztmelts      =  - tmut  * s_i_b(ji,jk) + rtt  
    792             q_i_b(ji,jk) =    rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) )                                 & 
    793                &                      + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) )   & 
    794                &                      - rcp  * ( ztmelts-rtt  )  )  
    795          END DO 
    796       END DO 
    797       DO jk = 1, nlay_s             ! Snow energy of melting 
    798          DO ji = kideb, kiut 
    799             q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    800          END DO 
    801       END DO 
    802       ! 
    803    END SUBROUTINE lim_thd_enmelt 
    804  
     509            ztmelts       =  -tmut * s_i_1d(ji,jk) + rtt 
     510            ! Conversion q(S,T) -> T (second order equation) 
     511            zaaa          =  cpic 
     512            zbbb          =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_1d(ji,jk) / rhoic - lfus 
     513            zccc          =  lfus * ( ztmelts - rtt ) 
     514            zdiscrim      =  SQRT( MAX( zbbb * zbbb - 4._wp * zaaa * zccc, 0._wp ) ) 
     515            t_i_1d(ji,jk)  =  rtt - ( zbbb + zdiscrim ) / ( 2._wp * zaaa ) 
     516             
     517            ! mask temperature 
     518            zswitch      =  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
     519            t_i_1d(ji,jk) =  zswitch * t_i_1d(ji,jk) + ( 1._wp - zswitch ) * rtt 
     520         END DO  
     521      END DO  
     522 
     523   END SUBROUTINE lim_thd_temp 
    805524 
    806525   SUBROUTINE lim_thd_init 
    … …  
    818537      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    819538      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   & 
    820          &                hicmin, hiclim,                                        & 
    821          &                sbeta  , parlat, hakspl, hibspl, exld,                 & 
    822          &                hakdif, hnzst  , thth  , parsub, alphs, betas,         &  
     539         &                hiclim, hnzst, parsub, betas,                          &  
    823540         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi 
    824541      !!------------------------------------------------------------------- 
    … …  
    843560         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation ' 
    844561         WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt 
    845          WRITE(numout,*)'      ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit 
     562         WRITE(numout,*)'      ice thick. for lateral accretion                        hiccrit      = ', hiccrit 
    846563         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi 
    847564         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb 
    848565         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb 
    849566         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb 
    850          WRITE(numout,*)'      ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin   
    851567         WRITE(numout,*)'      minimum ice thickness                                   hiclim       = ', hiclim  
    852568         WRITE(numout,*)'      numerical carac. of the scheme for diffusion in ice ' 
    853          WRITE(numout,*)'      Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta 
    854          WRITE(numout,*)'      percentage of energy used for lateral ablation          parlat       = ', parlat 
    855          WRITE(numout,*)'      slope of distr. for Hakkinen-Mellor lateral melting     hakspl       = ', hakspl   
    856          WRITE(numout,*)'      slope of distribution for Hibler lateral melting        hibspl       = ', hibspl 
    857          WRITE(numout,*)'      exponent for leads-closure rate                         exld         = ', exld 
    858          WRITE(numout,*)'      coefficient for diffusions of ice and snow              hakdif       = ', hakdif 
    859          WRITE(numout,*)'      threshold thick. for comp. of eq. thermal conductivity  zhth         = ', thth  
    860569         WRITE(numout,*)'      thickness of the surf. layer in temp. computation       hnzst        = ', hnzst 
    861570         WRITE(numout,*)'      switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub   
    862          WRITE(numout,*)'      coefficient for snow density when snow ice formation    alphs        = ', alphs 
    863571         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas 
    864572         WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i 
    … …  
    866574         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd 
    867575         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi 
     576         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    868577      ENDIF 
    869       ! 
    870       rcdsn = hakdif * rcdsn  
    871       rcdic = hakdif * rcdic 
    872578      ! 
    873579   END SUBROUTINE lim_thd_init 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r4333 r4921  
    66   !! History :  LIM  ! 2003-05 (M. Vancoppenolle) Original code in 1D 
    77   !!                 ! 2005-06 (M. Vancoppenolle) 3D version  
    8    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdm_snw & rdm_ice 
     8   !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw & wfx_ice 
    99   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
    1010   !!            3.5  ! 2012-10 (G. Madec & co) salt flux + bug fixes  
    … …  
    2626   USE wrk_nemo       ! work arrays 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    28  
     28   USE cpl_oasis3, ONLY : lk_cpl 
     29    
    2930   IMPLICIT NONE 
    3031   PRIVATE 
    … …  
    3435   REAL(wp) ::   epsi20 = 1.e-20   ! constant values 
    3536   REAL(wp) ::   epsi10 = 1.e-10   ! 
    36    REAL(wp) ::   epsi13 = 1.e-13   ! 
    37    REAL(wp) ::   zzero  = 0._wp    ! 
    38    REAL(wp) ::   zone   = 1._wp    ! 
    3937 
    4038   !!---------------------------------------------------------------------- 
    … …  
    4543CONTAINS 
    4644 
    47    SUBROUTINE lim_thd_dh( kideb, kiut, jl ) 
     45   SUBROUTINE lim_thd_dh( kideb, kiut ) 
    4846      !!------------------------------------------------------------------ 
    4947      !!                ***  ROUTINE lim_thd_dh  *** 
    … …  
    7068      !!------------------------------------------------------------------ 
    7169      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    72       INTEGER , INTENT(in) ::   jl            ! Thickness cateogry number 
    7370      !!  
    7471      INTEGER  ::   ji , jk        ! dummy loop indices 
    7572      INTEGER  ::   ii, ij         ! 2D corresponding indices to ji 
    76       INTEGER  ::   isnow          ! switch for presence (1) or absence (0) of snow 
    77       INTEGER  ::   isnowic        ! snow ice formation not 
    78       INTEGER  ::   i_ice_switch   ! ice thickness above a certain treshold or not 
    7973      INTEGER  ::   iter 
    8074 
    81       REAL(wp) ::   zzfmass_i, zihgnew                     ! local scalar 
    82       REAL(wp) ::   zzfmass_s, zhsnew, ztmelts             ! local scalar 
    83       REAL(wp) ::   zhn, zdhcf, zdhbf, zhni, zhnfi, zihg   ! 
    84       REAL(wp) ::   zdhnm, zhnnew, zhisn, zihic, zzc       ! 
     75      REAL(wp) ::   ztmelts             ! local scalar 
     76      REAL(wp) ::   zdh, zfdum  ! 
    8577      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment 
    8678      REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads 
    87       REAL(wp) ::   zsm_snowice  ! snow-ice salinity 
     79      REAL(wp) ::   zs_snic  ! snow-ice salinity 
    8880      REAL(wp) ::   zswi1        ! switch for computation of bottom salinity 
    8981      REAL(wp) ::   zswi12       ! switch for computation of bottom salinity 
    9082      REAL(wp) ::   zswi2        ! switch for computation of bottom salinity 
    9183      REAL(wp) ::   zgrr         ! bottom growth rate 
    92       REAL(wp) ::   ztform       ! bottom formation temperature 
    93       ! 
    94       REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
     84      REAL(wp) ::   zt_i_new     ! bottom formation temperature 
     85 
     86      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2), >0 towards the ocean 
     87      REAL(wp) ::   zEi          ! specific enthalpy of sea ice (J/kg) 
     88      REAL(wp) ::   zEw          ! specific enthalpy of exchanged water (J/kg) 
     89      REAL(wp) ::   zdE          ! specific enthalpy difference (J/kg) 
     90      REAL(wp) ::   zfmdt        ! exchange mass flux x time step (J/m2), >0 towards the ocean 
     91      REAL(wp) ::   zsstK        ! SST in Kelvin 
     92 
    9593      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
    96       REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! melting point 
    97       REAL(wp), POINTER, DIMENSION(:) ::   zhsold      ! old snow thickness 
    98       REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow 
    99       REAL(wp), POINTER, DIMENSION(:) ::   zqfont_su   ! incoming, remaining surface energy 
    100       REAL(wp), POINTER, DIMENSION(:) ::   zqfont_bo   ! incoming, bottom energy 
    101       REAL(wp), POINTER, DIMENSION(:) ::   z_f_surf    ! surface heat for ablation 
    102       REAL(wp), POINTER, DIMENSION(:) ::   zhgnew      ! new ice thickness 
    103       REAL(wp), POINTER, DIMENSION(:) ::   zfmass_i    !  
     94      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow                       (J.m-3) 
     95      REAL(wp), POINTER, DIMENSION(:) ::   zq_su       ! heat for surface ablation                   (J.m-2) 
     96      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2) 
     97      REAL(wp), POINTER, DIMENSION(:) ::   zq_1cat     ! corrected heat in case 1-cat and hmelt>15cm (J.m-2) 
     98      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
     99      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt     ! Heat budget to determine melting or freezing(W.m-2) 
     100      INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting  
    104101 
    105102      REAL(wp), POINTER, DIMENSION(:) ::   zdh_s_mel   ! snow melt  
    … …  
    108105 
    109106      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah 
    110  
    111       ! Pathological cases 
    112       REAL(wp), POINTER, DIMENSION(:) ::   zfdt_init   ! total incoming heat for ice melt 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zfdt_final  ! total remaing heat for ice melt 
    114       REAL(wp), POINTER, DIMENSION(:) ::   zqt_i       ! total ice heat content 
    115       REAL(wp), POINTER, DIMENSION(:) ::   zqt_s       ! total snow heat content 
    116       REAL(wp), POINTER, DIMENSION(:) ::   zqt_dummy   ! dummy heat content 
    117  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   zqt_i_lay   ! total ice heat content 
     107      REAL(wp), POINTER, DIMENSION(:,:) ::   zh_i      ! ice layer thickness 
     108 
     109      REAL(wp), POINTER, DIMENSION(:) ::   zqh_i       ! total ice heat content  (J.m-2) 
     110      REAL(wp), POINTER, DIMENSION(:) ::   zqh_s       ! total snow heat content (J.m-2) 
     111      REAL(wp), POINTER, DIMENSION(:) ::   zq_s        ! total snow enthalpy     (J.m-3) 
    119112 
    120113      ! mass and salt flux (clem) 
    121       REAL(wp) :: zdvres, zdvsur, zdvbot 
    122       REAL(wp), POINTER, DIMENSION(:) ::   zviold, zvsold   ! old ice volume... 
     114      REAL(wp) :: zdvres, zswitch_sal, zswitch 
    123115 
    124116      ! Heat conservation  
    125       INTEGER  ::   num_iter_max, numce_dh 
    126       REAL(wp) ::   meance_dh 
    127       REAL(wp) ::   zinda  
    128       REAL(wp), POINTER, DIMENSION(:) ::   zinnermelt 
    129       REAL(wp), POINTER, DIMENSION(:) ::   zfbase, zdq_i 
     117      INTEGER  ::   num_iter_max 
     118      REAL(wp) ::   zinda, zindq, zindh  
     119      REAL(wp), POINTER, DIMENSION(:) ::   zintermelt   ! debug 
     120 
    130121      !!------------------------------------------------------------------ 
    131122 
    132       CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    133       CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    134       CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i ) 
    135       CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    136  
    137       CALL wrk_alloc( jpij, zviold, zvsold ) ! clem 
     123      ! Discriminate between varying salinity (num_sal=2) and prescribed cases (other values) 
     124      SELECT CASE( num_sal )                       ! varying salinity or not 
     125         CASE( 1, 3, 4 ) ;   zswitch_sal = 0       ! prescribed salinity profile 
     126         CASE( 2 )       ;   zswitch_sal = 1       ! varying salinity profile 
     127      END SELECT 
     128 
     129      CALL wrk_alloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 
     130      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     131      CALL wrk_alloc( jpij, zintermelt ) 
     132      CALL wrk_alloc( jpij, nlay_i+1, zdeltah, zh_i ) 
     133      CALL wrk_alloc( jpij, icount ) 
    138134       
    139       ftotal_fin(:) = 0._wp 
    140       zfdt_init (:) = 0._wp 
    141       zfdt_final(:) = 0._wp 
    142  
    143       dh_i_surf (:) = 0._wp 
    144       dh_i_bott (:) = 0._wp 
    145       dh_snowice(:) = 0._wp 
    146  
    147       DO ji = kideb, kiut 
    148          old_ht_i_b(ji) = ht_i_b(ji) 
    149          old_ht_s_b(ji) = ht_s_b(ji) 
    150          zviold(ji) = a_i_b(ji) * ht_i_b(ji) ! clem 
    151          zvsold(ji) = a_i_b(ji) * ht_s_b(ji) ! clem 
    152       END DO 
     135      dh_i_surf  (:) = 0._wp ; dh_i_bott  (:) = 0._wp ; dh_snowice(:) = 0._wp 
     136      dsm_i_se_1d(:) = 0._wp ; dsm_i_si_1d(:) = 0._wp    
     137  
     138      zqprec (:) = 0._wp ; zq_su  (:) = 0._wp ; zq_bo  (:) = 0._wp ; zf_tt  (:) = 0._wp 
     139      zq_1cat(:) = 0._wp ; zq_rema(:) = 0._wp 
     140 
     141      zh_s     (:) = 0._wp        
     142      zdh_s_pre(:) = 0._wp 
     143      zdh_s_mel(:) = 0._wp 
     144      zdh_s_sub(:) = 0._wp 
     145      zqh_s    (:) = 0._wp       
     146      zqh_i    (:) = 0._wp    
     147 
     148      zh_i      (:,:) = 0._wp        
     149      zdeltah   (:,:) = 0._wp        
     150      zintermelt(:)   = 0._wp 
     151      icount    (:)   = 0 
     152 
     153      ! initialize layer thicknesses and enthalpies 
     154      h_i_old (:,0:nlay_i+1) = 0._wp 
     155      qh_i_old(:,0:nlay_i+1) = 0._wp 
     156      DO jk = 1, nlay_i 
     157         DO ji = kideb, kiut 
     158            h_i_old (ji,jk) = ht_i_1d(ji) / REAL( nlay_i ) 
     159            qh_i_old(ji,jk) = q_i_1d(ji,jk) * h_i_old(ji,jk) 
     160         ENDDO 
     161      ENDDO 
    153162      ! 
    154163      !------------------------------------------------------------------------------! 
    155       !  1) Calculate available heat for surface ablation                            ! 
     164      !  1) Calculate available heat for surface and bottom ablation                 ! 
    156165      !------------------------------------------------------------------------------! 
    157166      ! 
    158167      DO ji = kideb, kiut 
    159          isnow         = INT(  1.0 - MAX(  0.0 , SIGN( 1.0 , - ht_s_b(ji) )  )  ) 
    160          ztfs     (ji) = isnow * rtt + ( 1.0 - isnow ) * rtt 
    161          z_f_surf (ji) = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 
    162          z_f_surf (ji) = MAX(  zzero , z_f_surf(ji)  ) * MAX(  zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) )  ) 
    163          zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice 
    164       END DO ! ji 
    165  
    166       zqfont_su  (:) = 0._wp 
    167       zqfont_bo  (:) = 0._wp 
    168       dsm_i_se_1d(:) = 0._wp      
    169       dsm_i_si_1d(:) = 0._wp    
     168         zinda         = 1._wp - MAX(  0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) ) 
     169         ztmelts       = zinda * rtt + ( 1._wp - zinda ) * rtt 
     170 
     171         zfdum     = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)  
     172         zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)  
     173 
     174         zq_su (ji) = MAX( 0._wp, zfdum     * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts ) ) 
     175         zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 
     176      END DO 
     177 
    170178      ! 
    171179      !------------------------------------------------------------------------------! 
    172       !  2) Computing layer thicknesses and  snow and sea-ice enthalpies.            ! 
     180      ! If snow temperature is above freezing point, then snow melts  
     181      ! (should not happen but sometimes it does) 
    173182      !------------------------------------------------------------------------------! 
    174       ! 
    175       DO ji = kideb, kiut     ! Layer thickness 
    176          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    177          zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
    178       END DO 
    179       ! 
    180       zqt_s(:) = 0._wp        ! Total enthalpy of the snow 
     183      DO ji = kideb, kiut 
     184         IF( t_s_1d(ji,1) > rtt ) THEN !!! Internal melting 
     185            ! Contribution to heat flux to the ocean [W.m-2], < 0   
     186            hfx_res_1d(ji) = hfx_res_1d(ji) + q_s_1d(ji,1) * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 
     187            ! Contribution to mass flux 
     188            wfx_snw_1d(ji) = wfx_snw_1d(ji) + rhosn * ht_s_1d(ji) * a_i_1d(ji) * r1_rdtice 
     189            ! updates 
     190            ht_s_1d(ji)   = 0._wp 
     191            q_s_1d (ji,1) = 0._wp 
     192            t_s_1d (ji,1) = rtt 
     193         END IF 
     194      END DO 
     195 
     196      !------------------------------------------------------------! 
     197      !  2) Computing layer thicknesses and enthalpies.            ! 
     198      !------------------------------------------------------------! 
     199      ! 
     200      DO ji = kideb, kiut      
     201         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 
     202      END DO 
     203      ! 
    181204      DO jk = 1, nlay_s 
    182205         DO ji = kideb, kiut 
    183             zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s ) 
     206            zqh_s(ji) =  zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji) 
    184207         END DO 
    185208      END DO 
    186209      ! 
    187       zqt_i(:) = 0._wp        ! Total enthalpy of the ice 
    188210      DO jk = 1, nlay_i 
    189211         DO ji = kideb, kiut 
    190             zzc = q_i_b(ji,jk) * ht_i_b(ji) / REAL( nlay_i ) 
    191             zqt_i(ji)        =  zqt_i(ji) + zzc 
    192             zqt_i_lay(ji,jk) =              zzc 
     212            zh_i(ji,jk) = ht_i_1d(ji) / REAL( nlay_i ) 
     213            zqh_i(ji)   = zqh_i(ji) + q_i_1d(ji,jk) * zh_i(ji,jk) 
    193214         END DO 
    194215      END DO 
    … …  
    212233      ! Martin Vancoppenolle, December 2006 
    213234 
    214       ! Snow fall 
    215       DO ji = kideb, kiut 
    216          zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji)  
     235      DO ji = kideb, kiut 
     236         !----------- 
     237         ! Snow fall 
     238         !----------- 
     239         ! thickness change 
     240         zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**betas ) / at_i_1d(ji)  
    217241         zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn 
    218       END DO 
    219       zdh_s_mel(:) =  0._wp 
    220  
    221       ! Melt of fallen snow 
    222       DO ji = kideb, kiut 
    223          ! tatm_ice is now in K 
    224          zqprec   (ji)   =  rhosn * ( cpic * ( rtt - tatm_ice_1d(ji) ) + lfus )   
    225          zqfont_su(ji)   =  z_f_surf(ji) * rdt_ice 
    226          zdeltah  (ji,1) =  MIN( 0.e0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) ) 
    227          zqfont_su(ji)   =  MAX( 0.e0 , - zdh_s_pre(ji) - zdeltah(ji,1)              ) * zqprec(ji) 
    228          zdeltah  (ji,1) =  MAX( - zdh_s_pre(ji) , zdeltah(ji,1) ) 
    229          zdh_s_mel(ji)   =  zdh_s_mel(ji) + zdeltah(ji,1) 
    230          ! heat conservation 
    231          qt_s_in(ji,jl)  =  qt_s_in(ji,jl) + zqprec(ji) * zdh_s_pre(ji) 
    232          zqt_s  (ji)     =  zqt_s  (ji)    + zqprec(ji) * zdh_s_pre(ji) 
    233          zqt_s  (ji)     =  MAX( zqt_s(ji) - zqfont_su(ji) , 0.e0 )  
    234       END DO 
    235  
    236  
    237       ! Snow melt due to surface heat imbalance 
     242         ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 
     243         zqprec   (ji) = rhosn * ( cpic * ( rtt - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus )    
     244         IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 
     245         ! heat flux from snow precip (>0, W.m-2) 
     246         hfx_spr_1d(ji) = hfx_spr_1d(ji) + zdh_s_pre(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
     247         ! mass flux, <0 
     248         wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice 
     249         ! update thickness 
     250         ht_s_1d    (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 
     251 
     252         !--------------------- 
     253         ! Melt of falling snow 
     254         !--------------------- 
     255         ! thickness change 
     256         IF( zdh_s_pre(ji) > 0._wp ) THEN 
     257         zindq          = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zqprec(ji) + epsi20 ) ) 
     258         zdh_s_mel (ji) = - zindq * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 
     259         zdh_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting  
     260         ! heat used to melt snow (W.m-2, >0) 
     261         hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdh_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 
     262         ! snow melting only = water into the ocean (then without snow precip), >0 
     263         wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice 
     264          
     265         ! updates available heat + thickness 
     266         zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) )       
     267         ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) ) 
     268         zh_s  (ji) = ht_s_1d(ji) / REAL( nlay_s ) 
     269 
     270         ENDIF 
     271      END DO 
     272 
     273      ! If heat still available, then melt more snow 
     274      zdeltah(:,:) = 0._wp ! important 
    238275      DO jk = 1, nlay_s 
    239276         DO ji = kideb, kiut 
    240             zdeltah  (ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk) 
    241             zqfont_su(ji)    =  MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * q_s_b(ji,jk)  
    242             zdeltah  (ji,jk) =  MAX( zdeltah(ji,jk) , - zh_s(ji) ) 
    243             zdh_s_mel(ji)    =  zdh_s_mel(ji) + zdeltah(ji,jk)        ! resulting melt of snow     
     277            ! thickness change 
     278            zindh            = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )  
     279            zindq            = 1._wp - MAX( 0._wp, SIGN( 1._wp, - q_s_1d(ji,jk) + epsi20 ) )  
     280            zdeltah  (ji,jk) = - zindh * zindq * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 ) 
     281            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting 
     282            zdh_s_mel(ji)    = zdh_s_mel(ji) + zdeltah(ji,jk)     
     283            ! heat used to melt snow(W.m-2, >0) 
     284            hfx_snw_1d(ji)   = hfx_snw_1d(ji) - zdeltah(ji,jk) * a_i_1d(ji) * q_s_1d(ji,jk) * r1_rdtice  
     285            ! snow melting only = water into the ocean (then without snow precip) 
     286            wfx_snw_1d(ji)   = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     287 
     288            ! updates available heat + thickness 
     289            zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 
     290            ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 
     291 
    244292         END DO 
    245293      END DO 
    246294 
    247       ! Apply snow melt to snow depth 
    248       DO ji = kideb, kiut 
    249          dh_s_tot(ji)   =  zdh_s_mel(ji) + zdh_s_pre(ji) 
    250          ! Old and new snow depths 
    251          zhsold(ji)     =  ht_s_b(ji) 
    252          zhsnew         =  ht_s_b(ji) + dh_s_tot(ji) 
    253          ! If snow is still present zhn = 1, else zhn = 0 
    254          zhn            =  1.0 - MAX(  zzero , SIGN( zone , - zhsnew )  ) 
    255          ht_s_b(ji)     =  MAX( zzero , zhsnew ) 
    256          ! we recompute dh_s_tot (clem)  
    257          dh_s_tot (ji)  =  ht_s_b(ji) - zhsold(ji) 
    258          ! Volume and mass variations of snow 
    259          dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_pre(ji) ) 
    260          dvsbq_1d  (ji) =  MIN( zzero, dvsbq_1d(ji) ) 
    261          !clem rdm_snw_1d(ji) =  rdm_snw_1d(ji) + rhosn * dvsbq_1d(ji) 
     295      !---------------------- 
     296      ! 3.2 Snow sublimation  
     297      !---------------------- 
     298      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
     299      ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean) 
     300      ! clem comment: ice should also sublimate 
     301      IF( lk_cpl ) THEN 
     302         ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
     303         zdh_s_sub(:)      =  0._wp  
     304      ELSE 
     305         ! forced  mode: snow thickness change due to sublimation 
     306         DO ji = kideb, kiut 
     307            zdh_s_sub(ji)  =  MAX( - ht_s_1d(ji) , - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 
     308            ! Heat flux by sublimation [W.m-2], < 0 
     309            !      sublimate first snow that had fallen, then pre-existing snow 
     310            zcoeff         =      ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) )   * zqprec(ji) +   & 
     311               &  ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) )  & 
     312               &  * a_i_1d(ji) * r1_rdtice 
     313            hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 
     314            ! Mass flux by sublimation 
     315            wfx_sub_1d(ji) =  wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 
     316            ! new snow thickness 
     317            ht_s_1d(ji)     =  MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 
     318         END DO 
     319      ENDIF 
     320 
     321      ! --- Update snow diags --- ! 
     322      DO ji = kideb, kiut 
     323         dh_s_tot(ji)   = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 
     324         zh_s(ji)       = ht_s_1d(ji) / REAL( nlay_s ) 
    262325      END DO ! ji 
    263326 
     327      !------------------------------------------- 
     328      ! 3.3 Update temperature, energy 
     329      !------------------------------------------- 
     330      ! new temp and enthalpy of the snow (remaining snow precip + remaining pre-existing snow) 
     331      zq_s(:) = 0._wp  
     332      DO jk = 1, nlay_s 
     333         DO ji = kideb,kiut 
     334            zindh  =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) + epsi20 )  ) 
     335            q_s_1d(ji,jk) = ( 1._wp - zindh ) / MAX( ht_s_1d(ji), epsi20 ) *             & 
     336              &            ( (   MAX( 0._wp, dh_s_tot(ji) )              ) * zqprec(ji) +  & 
     337              &              ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) ) 
     338            zq_s(ji)     =  zq_s(ji) + q_s_1d(ji,jk) 
     339         END DO 
     340      END DO 
     341 
    264342      !-------------------------- 
    265       ! 3.2 Surface ice ablation  
     343      ! 3.4 Surface ice ablation  
    266344      !-------------------------- 
    267       DO ji = kideb, kiut  
    268          z_f_surf (ji) =  zqfont_su(ji) * r1_rdtice   ! heat conservation test 
    269          zdq_i    (ji) =  0._wp 
    270       END DO ! ji 
    271  
     345      zdeltah(:,:) = 0._wp ! important 
    272346      DO jk = 1, nlay_i 
    273347         DO ji = kideb, kiut  
    274             !                                                    ! melt of layer jk 
    275             zdeltah  (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk) 
    276             !                                                    ! recompute heat available 
    277             zqfont_su(ji   ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk)  
    278             !                                                    ! melt of layer jk cannot be higher than its thickness 
    279             zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) ) 
    280             !                                                    ! update surface melt 
    281             dh_i_surf(ji   ) = dh_i_surf(ji) + zdeltah(ji,jk)  
    282             !                                                    ! for energy conservation 
    283             zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
    284             ! 
    285             ! clem 
    286             sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
    287                &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic / rdt_ice 
     348            zEi            = - q_i_1d(ji,jk) / rhoic                ! Specific enthalpy of layer k [J/kg, <0] 
     349 
     350            ztmelts        = - tmut * s_i_1d(ji,jk) + rtt           ! Melting point of layer k [K] 
     351 
     352            zEw            =    rcp * ( ztmelts - rt0 )            ! Specific enthalpy of resulting meltwater [J/kg, <0] 
     353 
     354            zdE            =    zEi - zEw                          ! Specific enthalpy difference < 0 
     355 
     356            zfmdt          = - zq_su(ji) / zdE                     ! Mass flux to the ocean [kg/m2, >0] 
     357 
     358            zdeltah(ji,jk) = - zfmdt / rhoic                       ! Melt of layer jk [m, <0] 
     359 
     360            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] 
     361 
     362            zq_su(ji)      = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 
     363 
     364            dh_i_surf(ji)  = dh_i_surf(ji) + zdeltah(ji,jk)        ! Cumulate surface melt 
     365 
     366            zfmdt          = - rhoic * zdeltah(ji,jk)              ! Recompute mass flux [kg/m2, >0] 
     367 
     368            zQm            = zfmdt * zEw                           ! Energy of the melt water sent to the ocean [J/m2, <0] 
     369 
     370            ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     371            sfx_sum_1d(ji)   = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     372 
     373            ! Contribution to heat flux [W.m-2], < 0 
     374            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     375 
     376            ! Total heat flux used in this process [W.m-2], > 0   
     377            hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     378 
     379            ! Contribution to mass flux 
     380            wfx_sum_1d(ji) =  wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     381            
     382            ! record which layers have disappeared (for bottom melting)  
     383            !    => icount=0 : no layer has vanished 
     384            !    => icount=5 : 5 layers have vanished 
     385            zindh       = NINT( MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) )  
     386            icount(ji)  = icount(ji) + zindh 
     387            zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 
     388 
     389            ! update heat content (J.m-2) and layer thickness 
     390            qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     391            h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    288392         END DO 
    289393      END DO 
    290  
    291       !                                          !------------------- 
    292       IF( con_i .AND. jiindex_1d > 0 ) THEN      ! Conservation test 
    293          !                                       !------------------- 
    294          numce_dh  = 0 
    295          meance_dh = 0._wp 
    296          DO ji = kideb, kiut 
    297             IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN 
    298                numce_dh  = numce_dh + 1 
    299                meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji) 
    300             ENDIF 
    301             IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN! 
    302                WRITE(numout,*) ' ALERTE heat loss for surface melt ' 
    303                WRITE(numout,*) ' ii, ij, jl :', ii, ij, jl 
    304                WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji) 
    305                WRITE(numout,*) ' z_f_surf     : ', z_f_surf(ji) 
    306                WRITE(numout,*) ' zdq_i        : ', zdq_i(ji) 
    307                WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji) 
    308                WRITE(numout,*) ' fc_bo_i      : ', fc_bo_i(ji) 
    309                WRITE(numout,*) ' fbif_1d      : ', fbif_1d(ji) 
    310                WRITE(numout,*) ' qlbbq_1d     : ', qlbbq_1d(ji) 
    311                WRITE(numout,*) ' s_i_new      : ', s_i_new(ji) 
    312                WRITE(numout,*) ' sss_m        : ', sss_m(ii,ij) 
    313             ENDIF 
    314          END DO 
    315          ! 
    316          IF( numce_dh > 0 )   meance_dh = meance_dh / numce_dh 
    317          WRITE(numout,*) ' Error report - Category : ', jl 
    318          WRITE(numout,*) ' ~~~~~~~~~~~~ ' 
    319          WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh 
    320          WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh 
    321          ! 
    322       ENDIF 
    323  
    324       !---------------------- 
    325       ! 3.3 Snow sublimation 
    326       !---------------------- 
    327  
    328       DO ji = kideb, kiut 
    329          ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 
    330 #if defined key_coupled 
    331          zdh_s_sub(ji)    =  0._wp      ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 
    332 #else 
    333          !                              ! forced  mode: snow thickness change due to sublimation 
    334          zdh_s_sub(ji)    =  - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice 
    335 #endif 
    336          dh_s_tot (ji)    =  dh_s_tot(ji) + zdh_s_sub(ji) 
    337          zdhcf            =  ht_s_b(ji) + zdh_s_sub(ji)  
    338          ht_s_b   (ji)    =  MAX( zzero , zdhcf ) 
    339          ! we recompute dh_s_tot  
    340          dh_s_tot (ji)    =  ht_s_b(ji) - zhsold(ji) 
    341          qt_s_in  (ji,jl) =  qt_s_in(ji,jl) + zdh_s_sub(ji)*q_s_b(ji,1) 
    342       END DO 
    343  
    344       zqt_dummy(:) = 0.e0 
    345       DO jk = 1, nlay_s 
    346          DO ji = kideb,kiut 
    347             q_s_b    (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus ) 
    348             zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / REAL( nlay_s )            ! heat conservation 
    349          END DO 
    350       END DO 
    351  
    352       DO jk = 1, nlay_s 
    353          DO ji = kideb, kiut 
    354             ! In case of disparition of the snow, we have to update the snow temperatures 
    355             zhisn  =  MAX(  zzero , SIGN( zone, - ht_s_b(ji) )  ) 
    356             t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt 
    357             q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk) 
    358          END DO 
     394      ! update ice thickness 
     395      DO ji = kideb, kiut 
     396         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_surf(ji) ) 
    359397      END DO 
    360398 
    … …  
    364402      !------------------------------------------------------------------------------! 
    365403      ! 
    366       ! Ice basal growth / melt is given by the ratio of heat budget over basal 
    367       ! ice heat content.  Basal heat budget is given by the difference between 
    368       ! the inner conductive flux  (fc_bo_i), from the open water heat flux  
    369       ! (qlbbqb) and the turbulent ocean flux (fbif).  
    370       ! fc_bo_i is positive downwards. fbif and qlbbq are positive to the ice  
    371  
    372       !----------------------------------------------------- 
    373       ! 4.1 Basal growth - (a) salinity not varying in time  
    374       !----------------------------------------------------- 
    375       IF(  num_sal /= 2  ) THEN   ! ice salinity constant in time 
     404      !------------------ 
     405      ! 4.1 Basal growth  
     406      !------------------ 
     407      ! Basal growth is driven by heat imbalance at the ice-ocean interface, 
     408      ! between the inner conductive flux  (fc_bo_i), from the open water heat flux  
     409      ! (fhld) and the turbulent ocean flux (fhtur).  
     410      ! fc_bo_i is positive downwards. fhtur and fhld are positive to the ice  
     411 
     412      ! If salinity varies in time, an iterative procedure is required, because 
     413      ! the involved quantities are inter-dependent. 
     414      ! Basal growth (dh_i_bott) depends upon new ice specific enthalpy (zEi), 
     415      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bott) 
     416      ! -> need for an iterative procedure, which converges quickly 
     417 
     418      IF ( num_sal == 2 ) THEN 
     419         num_iter_max = 5 
     420      ELSE 
     421         num_iter_max = 1 
     422      ENDIF 
     423 
     424      !clem debug. Just to be sure that enthalpy at nlay_i+1 is null 
     425      DO ji = kideb, kiut 
     426         q_i_1d(ji,nlay_i+1) = 0._wp 
     427      END DO 
     428 
     429      ! Iterative procedure 
     430      DO iter = 1, num_iter_max 
    376431         DO ji = kideb, kiut 
    377             IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0._wp  ) THEN 
    378                s_i_new(ji)         =  sm_i_b(ji) 
    379                ! Melting point in K 
    380                ztmelts             =  - tmut * s_i_new(ji) + rtt  
    381                ! New ice heat content (Bitz and Lipscomb, 1999) 
    382                ztform              =  t_i_b(ji,nlay_i)  ! t_bo_b crashes in the 
    383                ! Baltic 
    384                q_i_b(ji,nlay_i+1)  = rhoic * (  cpic * ( ztmelts - ztform )                                & 
    385                   &                           + lfus * (  1.0 - ( ztmelts - rtt ) / ( ztform - rtt )  )    & 
    386                   &                           - rcp  * ( ztmelts - rtt )                                 ) 
    387                ! Basal growth rate = - F*dt / q 
    388                dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)  
    389                sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 
    390             ENDIF 
    391          END DO 
    392       ENDIF 
    393  
    394       !------------------------------------------------- 
    395       ! 4.1 Basal growth - (b) salinity varying in time  
    396       !------------------------------------------------- 
    397       IF(  num_sal == 2  ) THEN 
    398          ! the growth rate (dh_i_bott) is function of the new ice heat content (q_i_b(nlay_i+1)).  
    399          ! q_i_b depends on the new ice salinity (snewice).  
    400          ! snewice depends on dh_i_bott ; it converges quickly, so, no problem 
    401          ! See Vancoppenolle et al., OM08 for more info on this 
    402  
    403          ! Initial value (tested 1D, can be anything between 1 and 20) 
    404          num_iter_max = 4 
    405          s_i_new(:)   = 4.0 
    406  
    407          ! Iterative procedure 
    408          DO iter = 1, num_iter_max 
    409             DO ji = kideb, kiut 
    410                IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0  ) THEN 
    411                   ii = MOD( npb(ji) - 1, jpi ) + 1 
    412                   ij = ( npb(ji) - 1 ) / jpi + 1 
    413                   ! Melting point in K 
    414                   ztmelts             =   - tmut * s_i_new(ji) + rtt  
    415                   ! New ice heat content (Bitz and Lipscomb, 1999) 
    416                   q_i_b(ji,nlay_i+1)  =  rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             & 
    417                      &                            + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
    418                      &                            - rcp * ( ztmelts-rtt )                                     ) 
    419                   ! Bottom growth rate = - F*dt / q 
    420                   dh_i_bott(ji) =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
    421                   ! New ice salinity ( Cox and Weeks, JGR, 1988 ) 
    422                   ! zswi2  (1) if dh_i_bott/rdt .GT. 3.6e-7 
    423                   ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8 
    424                   ! zswi1  (1) if dh_i_bott/rdt .LT. 2.0e-8 
    425                   zgrr   = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi13 ) ) 
    426                   zswi2  = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) )  
    427                   zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
    428                   zswi1  = 1. - zswi2 * zswi12  
    429                   zfracs = zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
    430                      &                   + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  
    431                   zfracs = MIN( 0.5 , zfracs ) 
    432                   s_i_new(ji) = zfracs * sss_m(ii,ij) 
    433                ENDIF ! fc_bo_i 
    434             END DO ! ji 
    435          END DO ! iter 
    436  
    437          ! Final values 
    438          DO ji = kideb, kiut 
    439             IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0  ) THEN 
    440                ! New ice salinity must not exceed 20 psu 
    441                s_i_new(ji) = MIN( s_i_new(ji), s_i_max ) 
    442                ! Metling point in K 
    443                ztmelts     =   - tmut * s_i_new(ji) + rtt  
    444                ! New ice heat content (Bitz and Lipscomb, 1999) 
    445                q_i_b(ji,nlay_i+1)  =  rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                              & 
    446                   &                            + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )    & 
    447                   &                            - rcp * ( ztmelts - rtt )                                    ) 
    448                ! Basal growth rate = - F*dt / q 
    449                dh_i_bott(ji)       =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
    450                ! Salinity update 
    451                ! entrapment during bottom growth 
    452                sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * dh_i_bott(ji) * rhoic * r1_rdtice 
    453             ENDIF ! heat budget 
    454          END DO 
    455       ENDIF 
     432            IF(  zf_tt(ji) < 0._wp  ) THEN 
     433 
     434               ! New bottom ice salinity (Cox & Weeks, JGR88 ) 
     435               !--- zswi1  if dh/dt < 2.0e-8 
     436               !--- zswi12 if 2.0e-8 < dh/dt < 3.6e-7  
     437               !--- zswi2  if dh/dt > 3.6e-7 
     438               zgrr               = MIN( 1.0e-3, MAX ( dh_i_bott(ji) * r1_rdtice , epsi10 ) ) 
     439               zswi2              = MAX( 0._wp , SIGN( 1._wp , zgrr - 3.6e-7 ) ) 
     440               zswi12             = MAX( 0._wp , SIGN( 1._wp , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 ) 
     441               zswi1              = 1. - zswi2 * zswi12 
     442               zfracs             = MIN ( zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   & 
     443                  &               + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) )  , 0.5 ) 
     444 
     445               ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     446 
     447               s_i_new(ji)        = zswitch_sal * zfracs * sss_m(ii,ij)  &  ! New ice salinity 
     448                                  + ( 1. - zswitch_sal ) * sm_i_1d(ji)  
     449               ! New ice growth 
     450               ztmelts            = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K) 
     451 
     452               zt_i_new           = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
     453                
     454               zEi                = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
     455                  &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   & 
     456                  &               + rcp  * ( ztmelts-rtt )           
     457 
     458               zEw                = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
     459 
     460               zdE                = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0) 
     461 
     462               dh_i_bott(ji)      = rdt_ice * MAX( 0._wp , zf_tt(ji) / ( zdE * rhoic ) ) 
     463 
     464               q_i_1d(ji,nlay_i+1) = -zEi * rhoic                        ! New ice energy of melting (J/m3, >0) 
     465                
     466            ENDIF ! fc_bo_i 
     467         END DO ! ji 
     468      END DO ! iter 
     469 
     470      ! Contribution to Energy and Salt Fluxes 
     471      DO ji = kideb, kiut 
     472         IF(  zf_tt(ji) < 0._wp  ) THEN 
     473            ! New ice growth 
     474                                     
     475            zfmdt          = - rhoic * dh_i_bott(ji)             ! Mass flux x time step (kg/m2, < 0) 
     476 
     477            ztmelts        = - tmut * s_i_new(ji) + rtt          ! New ice melting point (K) 
     478             
     479            zt_i_new       = zswitch_sal * t_bo_1d(ji) + ( 1. - zswitch_sal) * t_i_1d(ji, nlay_i) 
     480             
     481            zEi            = cpic * ( zt_i_new - ztmelts ) &     ! Specific enthalpy of forming ice (J/kg, <0)       
     482               &               - lfus * ( 1.0 - ( ztmelts - rtt ) / ( zt_i_new - rtt ) )   & 
     483               &               + rcp  * ( ztmelts-rtt )           
     484             
     485            zEw            = rcp  * ( t_bo_1d(ji) - rt0 )         ! Specific enthalpy of seawater (J/kg, < 0) 
     486             
     487            zdE            = zEi - zEw                           ! Specific enthalpy difference (J/kg, <0) 
     488             
     489            ! Contribution to heat flux to the ocean [W.m-2], >0   
     490            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     491 
     492            ! Total heat flux used in this process [W.m-2], <0   
     493            hfx_bog_1d(ji) = hfx_bog_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     494             
     495            ! Contribution to salt flux, <0 
     496            sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt * r1_rdtice 
     497 
     498            ! Contribution to mass flux, <0 
     499            wfx_bog_1d(ji) =  wfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * r1_rdtice 
     500 
     501            ! update heat content (J.m-2) and layer thickness 
     502            qh_i_old(ji,nlay_i+1) = qh_i_old(ji,nlay_i+1) + dh_i_bott(ji) * q_i_1d(ji,nlay_i+1) 
     503            h_i_old (ji,nlay_i+1) = h_i_old (ji,nlay_i+1) + dh_i_bott(ji) 
     504         ENDIF 
     505      END DO 
    456506 
    457507      !---------------- 
    458508      ! 4.2 Basal melt 
    459509      !---------------- 
    460       meance_dh = 0._wp 
    461       numce_dh  = 0 
    462       zinnermelt(:) = 0._wp 
    463  
    464       DO ji = kideb, kiut 
    465          ! heat convergence at the surface > 0 
    466          IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp  ) THEN 
    467             s_i_new(ji)   =  s_i_b(ji,nlay_i) 
    468             zqfont_bo(ji) =  rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) 
    469             zfbase(ji)    =  zqfont_bo(ji) * r1_rdtice     ! heat conservation test 
    470             zdq_i(ji)     =  0._wp 
    471             dh_i_bott(ji) =  0._wp 
    472          ENDIF 
    473       END DO 
    474  
     510      zdeltah(:,:) = 0._wp ! important 
    475511      DO jk = nlay_i, 1, -1 
    476512         DO ji = kideb, kiut 
    477             IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji)  >=  0._wp  ) THEN 
    478                ztmelts = - tmut * s_i_b(ji,jk) + rtt  
    479                IF( t_i_b(ji,jk) >= ztmelts ) THEN   !!gm : a comment is needed 
    480                   zdeltah   (ji,jk) = - zh_i(ji) 
    481                   dh_i_bott (ji   ) = dh_i_bott(ji) + zdeltah(ji,jk) 
    482                   zinnermelt(ji   ) = 1._wp 
    483                ELSE                                  ! normal ablation 
    484                   zdeltah  (ji,jk) = - zqfont_bo(ji) / q_i_b(ji,jk) 
    485                   zqfont_bo(ji   ) = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 
    486                   zdeltah  (ji,jk) = MAX(zdeltah(ji,jk), - zh_i(ji) ) 
    487                   dh_i_bott(ji   ) = dh_i_bott(ji) + zdeltah(ji,jk) 
    488                   zdq_i    (ji   ) = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) * r1_rdtice 
     513            IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting  
     514 
     515               ztmelts = - tmut * s_i_1d(ji,jk) + rtt  ! Melting point of layer jk (K) 
     516 
     517               IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 
     518                  zintermelt(ji)    = 1._wp 
     519 
     520                  zEi               = - q_i_1d(ji,jk) / rhoic        ! Specific enthalpy of melting ice (J/kg, <0) 
     521 
     522                  !!zEw               = rcp * ( t_i_1d(ji,jk) - rtt )  ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0) 
     523 
     524                  zdE               = 0._wp                         ! Specific enthalpy difference   (J/kg, <0) 
     525                                                                    ! set up at 0 since no energy is needed to melt water...(it is already melted) 
     526 
     527                  zdeltah   (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing      
     528                                                                   ! this should normally not happen, but sometimes, heat diffusion leads to this 
     529 
     530                  dh_i_bott (ji)    = dh_i_bott(ji) + zdeltah(ji,jk) 
     531 
     532                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     533 
     534                  ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean)  
     535                  hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice 
     536 
     537                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     538                  sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     539                                     
     540                  ! Contribution to mass flux 
     541                  wfx_res_1d(ji) =  wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     542 
     543                  ! update heat content (J.m-2) and layer thickness 
     544                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     545                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
     546 
     547               ELSE                               !!! Basal melting 
     548 
     549                  zEi               = - q_i_1d(ji,jk) / rhoic ! Specific enthalpy of melting ice (J/kg, <0) 
     550 
     551                  zEw               = rcp * ( ztmelts - rtt )! Specific enthalpy of meltwater (J/kg, <0) 
     552 
     553                  zdE               = zEi - zEw              ! Specific enthalpy difference   (J/kg, <0) 
     554 
     555                  zfmdt             = - zq_bo(ji) / zdE  ! Mass flux x time step (kg/m2, >0) 
     556 
     557                  zdeltah(ji,jk)    = - zfmdt / rhoic        ! Gross thickness change 
     558 
     559                  zdeltah(ji,jk)    = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 
     560                   
     561                  zq_bo(ji)         = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 
     562 
     563                  dh_i_bott(ji)     = dh_i_bott(ji) + zdeltah(ji,jk)    ! Update basal melt 
     564 
     565                  zfmdt             = - zdeltah(ji,jk) * rhoic          ! Mass flux x time step > 0 
     566 
     567                  zQm               = zfmdt * zEw         ! Heat exchanged with ocean 
     568 
     569                  ! Contribution to heat flux to the ocean [W.m-2], <0   
     570                  hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 
     571 
     572                  ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 
     573                  sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 
     574                   
     575                  ! Total heat flux used in this process [W.m-2], >0   
     576                  hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 
     577                   
     578                  ! Contribution to mass flux 
     579                  wfx_bom_1d(ji) =  wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 
     580 
     581                  ! update heat content (J.m-2) and layer thickness 
     582                  qh_i_old(ji,jk) = qh_i_old(ji,jk) + zdeltah(ji,jk) * q_i_1d(ji,jk) 
     583                  h_i_old (ji,jk) = h_i_old (ji,jk) + zdeltah(ji,jk) 
    489584               ENDIF 
    490                ! clem: contribution to salt flux 
    491                sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji)    & 
    492                     &                              * MIN( zdeltah(ji,jk) , 0._wp ) * rhoic * r1_rdtice 
     585            
    493586            ENDIF 
    494587         END DO ! ji 
    495588      END DO ! jk 
    496589 
    497       !                                          !------------------- 
    498       IF( con_i .AND. jiindex_1d > 0 ) THEN      ! Conservation test 
    499       !                                          !------------------- 
    500          DO ji = kideb, kiut 
    501             IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0  ) THEN 
    502                IF( ( zfbase(ji) + zdq_i(ji) ) >= 1.e-3 ) THEN 
    503                   numce_dh  = numce_dh + 1 
    504                   meance_dh = meance_dh + zfbase(ji) + zdq_i(ji) 
    505                ENDIF 
    506                IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN 
    507                   WRITE(numout,*) ' ALERTE heat loss for basal melt : ii, ij, jl :', ii, ij, jl 
    508                   WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji) 
    509                   WRITE(numout,*) ' zfbase    : ', zfbase(ji) 
    510                   WRITE(numout,*) ' zdq_i     : ', zdq_i(ji) 
    511                   WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji) 
    512                   WRITE(numout,*) ' fc_bo_i   : ', fc_bo_i(ji) 
    513                   WRITE(numout,*) ' fbif_1d   : ', fbif_1d(ji) 
    514                   WRITE(numout,*) ' qlbbq_1d  : ', qlbbq_1d(ji) 
    515                   WRITE(numout,*) ' s_i_new   : ', s_i_new(ji) 
    516                   WRITE(numout,*) ' sss_m     : ', sss_m(ii,ij) 
    517                   WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 
    518                   WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) ) 
    519                ENDIF 
    520             ENDIF 
    521          END DO 
    522          IF( numce_dh > 0 )   meance_dh = meance_dh / numce_dh 
    523          WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh 
    524          WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh 
    525          WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d) 
    526          ! 
    527       ENDIF 
    528  
    529       ! 
    530590      !------------------------------------------------------------------------------! 
    531       !  5) Pathological cases                                                       ! 
     591      ! Excessive ablation in a 1-category model 
     592      !     in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 
    532593      !------------------------------------------------------------------------------! 
    533       ! 
    534       !---------------------------------------------- 
    535       ! 5.1 Excessive ablation in a 1-category model 
    536       !---------------------------------------------- 
    537  
    538       DO ji = kideb, kiut 
    539          !                     ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15) 
    540          IF( jpl == 1 ) THEN   ;   zdhbf = MAX( hmelt , dh_i_bott(ji) ) 
    541          ELSE                  ;   zdhbf =              dh_i_bott(ji)  
    542          ENDIF 
    543          zdvres        = zdhbf - dh_i_bott(ji) 
    544          dh_i_bott(ji) = zdhbf 
    545          sfx_thd_1d(ji)  = sfx_thd_1d(ji) - sm_i_b(ji) * a_i_b(ji) * zdvres * rhoic * r1_rdtice 
    546          !                     ! excessive energy is sent to lateral ablation 
    547          zinda = MAX( 0._wp, SIGN( 1._wp , 1.0 - at_i_b(ji) - epsi10 ) ) 
    548          fsup(ji) =  zinda * rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi10 ) * zdvres * r1_rdtice 
    549       END DO 
    550  
    551       !----------------------------------- 
    552       ! 5.2 More than available ice melts 
    553       !----------------------------------- 
    554       ! then heat applied minus heat content at previous time step should equal heat remaining  
    555       ! 
    556       DO ji = kideb, kiut 
    557          ! Adapt the remaining energy if too much ice melts 
    558          !-------------------------------------------------- 
    559          zdvres     = MAX( 0._wp, - ht_i_b(ji) - dh_i_surf(ji) - dh_i_bott(ji) ) 
    560          zdvsur     = MIN( 0._wp, dh_i_surf(ji) + zdvres ) - dh_i_surf(ji) ! fill the surface first 
    561          zdvbot     = MAX( 0._wp, zdvres - zdvsur ) ! then the bottom 
    562          dh_i_surf (ji) = dh_i_surf(ji) + zdvsur ! clem 
    563          dh_i_bott (ji) = dh_i_bott(ji) + zdvbot ! clem 
    564  
    565          ! new ice thickness (clem) 
    566          zhgnew(ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji) 
    567          zihgnew    = 1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice 
    568          zhgnew(ji) = zihgnew * zhgnew(ji)      ! ice thickness is put to 0 
    569   
    570          !                     !since ice volume is only used for outputs, we keep it global for all categories 
    571          dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji) 
    572  
    573         ! remaining heat 
    574          zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) +  zqfont_bo(ji) )  
    575  
    576          ! If snow remains, energy is used to melt snow 
    577          zhni =  ht_s_b(ji)      ! snow depth at previous time step 
    578          zihg =  MAX(  zzero , SIGN ( zone , - ht_s_b(ji) )  )   ! =0 if snow  
    579  
    580          ! energy of melting of remaining snow 
    581          zinda = MAX( 0._wp, SIGN( 1._wp , zhni - epsi10 ) ) 
    582          zqt_s(ji) =    ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi10 ) * zinda 
    583          zdhnm     =  - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 ) 
    584          zhnfi     =  zhni + zdhnm 
    585          zfdt_final(ji) =  MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 ) 
    586          ht_s_b(ji)     =  MAX( zzero , zhnfi ) 
    587          zqt_s(ji)      =  zqt_s(ji) * ht_s_b(ji) 
    588          ! we recompute dh_s_tot (clem) 
    589          dh_s_tot (ji)  =  ht_s_b(ji) - zhsold(ji) 
    590  
    591          ! Mass variations of ice and snow 
    592          !--------------------------------- 
    593          !                                              ! mass variation of the jl category 
    594          zzfmass_s = - a_i_b(ji) * ( zhni       - ht_s_b(ji) ) * rhosn   ! snow 
    595          zzfmass_i =   a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic   ! ice   
    596          ! 
    597          zfmass_i(ji) = zzfmass_i                       ! ice variation saved to compute salt flux (see below) 
    598          ! 
    599          !                                              ! mass variation cumulated over category 
    600          !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + zzfmass_s                     ! snow  
    601          !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + zzfmass_i                     ! ice  
    602  
    603          ! Remaining heat to the ocean  
    604          !--------------------------------- 
    605          focea(ji)  = - zfdt_final(ji) * r1_rdtice         ! focea is in W.m-2 * dt 
    606  
    607          ! residual salt flux (clem) 
    608          !-------------------------- 
    609          ! surface 
    610          sfx_thd_1d(ji)    = sfx_thd_1d(ji) - sm_i_b(ji)  * a_i_b(ji) * zdvsur * rhoic * r1_rdtice 
    611          ! bottom 
    612          IF ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) >= 0._wp ) THEN ! melting 
    613             sfx_thd_1d(ji) = sfx_thd_1d(ji) - sm_i_b(ji)  * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 
    614          ELSE                                                          ! growth 
    615             sfx_thd_1d(ji) = sfx_thd_1d(ji) - s_i_new(ji) * a_i_b(ji) * zdvbot * rhoic * r1_rdtice 
    616          ENDIF 
    617          ! 
    618          ! diagnostic  
    619          ii = MOD( npb(ji) - 1, jpi ) + 1 
    620          ij = ( npb(ji) - 1 ) / jpi + 1 
    621          diag_bot_gr(ii,ij) = diag_bot_gr(ii,ij) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    622          diag_sur_me(ii,ij) = diag_sur_me(ii,ij) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) * r1_rdtice 
    623          diag_bot_me(ii,ij) = diag_bot_me(ii,ij) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) * r1_rdtice 
    624       END DO 
    625  
    626       ftotal_fin (:) = zfdt_final(:)  * r1_rdtice 
    627  
    628       !--------------------------- 
    629       ! heat fluxes                     
    630       !--------------------------- 
    631       DO ji = kideb, kiut 
    632          zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   ! =1 if ice 
    633          ! 
    634          ! Heat flux 
    635          ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 
    636          ! excessive total  ablation energy (focea) sent to the ocean 
    637          qfvbq_1d(ji)  = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice 
    638  
    639          zihic   = 1.0 - MAX(  zzero , SIGN( zone , -ht_i_b(ji) )  )      ! equals 0 if ht_i = 0, 1 if ht_i gt 0 
    640          fscbq_1d(ji) =  a_i_b(ji) * fstbif_1d(ji) 
    641          qldif_1d(ji)  = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea   (ji) * a_i_b(ji) * rdt_ice   & 
    642             &                                    + ( 1.0 - zihic   ) * fscbq_1d(ji)             * rdt_ice 
    643       END DO  ! ji 
    644  
    645       !------------------------------------------- 
    646       ! Correct temperature, energy and thickness 
    647       !------------------------------------------- 
    648       DO ji = kideb, kiut 
    649          zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )  
    650          t_su_b(ji) =  zihgnew * t_su_b(ji) + ( 1.0 - zihgnew ) * rtt 
    651       END DO  ! ji 
    652  
    653       DO jk = 1, nlay_i 
    654          DO ji = kideb, kiut 
    655             zihgnew      =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )  
    656             t_i_b(ji,jk) =  zihgnew * t_i_b(ji,jk) + ( 1.0 - zihgnew ) * rtt 
    657             q_i_b(ji,jk) =  zihgnew * q_i_b(ji,jk) 
    658          END DO 
    659       END DO  ! ji 
    660  
    661       DO ji = kideb, kiut 
    662          ht_i_b(ji) = zhgnew(ji) 
    663       END DO  ! ji 
     594      ! ??? keep ??? 
     595      ! clem bug: I think this should be included above, so we would not have to  
     596      !           track heat/salt/mass fluxes backwards 
     597!      IF( jpl == 1 ) THEN 
     598!         DO ji = kideb, kiut 
     599!            IF(  zf_tt(ji)  >=  0._wp  ) THEN 
     600!               zdh            = MAX( hmelt , dh_i_bott(ji) ) 
     601!               zdvres         = zdh - dh_i_bott(ji) ! >=0 
     602!               dh_i_bott(ji)  = zdh 
     603! 
     604!               ! excessive energy is sent to lateral ablation 
     605!               zinda = MAX( 0._wp, SIGN( 1._wp , 1._wp - at_i_1d(ji) - epsi20 ) ) 
     606!               zq_1cat(ji) =  zinda * rhoic * lfus * at_i_1d(ji) / MAX( 1._wp - at_i_1d(ji) , epsi20 ) * zdvres ! J.m-2 >=0 
     607! 
     608!               ! correct salt and mass fluxes 
     609!               sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdvres * rhoic * r1_rdtice ! this is only a raw approximation 
     610!               wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdvres * r1_rdtice 
     611!            ENDIF 
     612!         END DO 
     613!      ENDIF 
     614 
     615      !------------------------------------------- 
     616      ! Update temperature, energy 
     617      !------------------------------------------- 
     618      DO ji = kideb, kiut 
     619         ht_i_1d(ji) =  MAX( 0._wp , ht_i_1d(ji) + dh_i_bott(ji) ) 
     620      END DO   
     621 
     622      !------------------------------------------- 
     623      ! 5. What to do with remaining energy 
     624      !------------------------------------------- 
     625      ! If heat still available for melting and snow remains, then melt more snow 
     626      !------------------------------------------- 
     627      zdeltah(:,:) = 0._wp ! important 
     628      DO ji = kideb, kiut 
     629         zq_rema(ji)     = zq_su(ji) + zq_bo(ji)  
     630!         zindh           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - ht_s_1d(ji) ) )   ! =1 if snow 
     631!         zindq           = 1._wp - MAX( 0._wp, SIGN( 1._wp, - zq_s(ji) + epsi20 ) ) 
     632!         zdeltah  (ji,1) = - zindh * zindq * zq_rema(ji) / MAX( zq_s(ji), epsi20 ) 
     633!         zdeltah  (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting 
     634!         zdh_s_mel(ji)   = zdh_s_mel(ji) + zdeltah(ji,1)     
     635!         dh_s_tot (ji)   = dh_s_tot(ji) + zdeltah(ji,1) 
     636!         ht_s_1d   (ji)   = ht_s_1d(ji)   + zdeltah(ji,1) 
     637!         
     638!         zq_rema(ji)     = zq_rema(ji) + zdeltah(ji,1) * zq_s(ji)                ! update available heat (J.m-2) 
     639!         ! heat used to melt snow 
     640!         hfx_snw_1d(ji)  = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zq_s(ji) * r1_rdtice ! W.m-2 (>0) 
     641!         ! Contribution to mass flux 
     642!         wfx_snw_1d(ji)  =  wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 
     643!     
     644         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     645         ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 
     646         hfx_out(ii,ij)  = hfx_out(ii,ij) + ( zq_1cat(ji) + zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 
     647 
     648         IF( ln_nicep .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) 
     649      END DO 
     650       
    664651      ! 
    665652      !------------------------------------------------------------------------------| 
    … …  
    670657      DO ji = kideb, kiut 
    671658         ! 
    672          dh_snowice(ji) = MAX(  zzero , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic )  ) 
    673          zhgnew(ji)     = MAX(  zhgnew(ji) , zhgnew(ji) + dh_snowice(ji)  ) 
    674          zhnnew         = MIN(  ht_s_b(ji) , ht_s_b(ji) - dh_snowice(ji)  ) 
    675  
    676          !  Changes in ice volume and ice mass. 
    677          dvnbq_1d  (ji) =                a_i_b(ji) * ( zhgnew(ji)-ht_i_b(ji) ) 
    678          dmgwi_1d  (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn 
    679  
    680          !clem rdm_ice_1d(ji) = rdm_ice_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic  
    681          !clem rdm_snw_1d(ji) = rdm_snw_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn  
    682  
    683          !        Equivalent salt flux (1) Snow-ice formation component 
    684          !        ----------------------------------------------------- 
    685          ii = MOD( npb(ji) - 1, jpi ) + 1 
    686          ij =    ( npb(ji) - 1 ) / jpi + 1 
    687  
    688          IF( num_sal == 2 ) THEN   ;   zsm_snowice = sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic 
    689          ELSE                      ;   zsm_snowice = sm_i_b(ji)    
    690          ENDIF 
     659         dh_snowice(ji) = MAX(  0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic )  ) 
     660 
     661         ht_i_1d(ji)     = ht_i_1d(ji) + dh_snowice(ji) 
     662         ht_s_1d(ji)     = ht_s_1d(ji) - dh_snowice(ji) 
     663 
     664         ! Salinity of snow ice 
     665         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     666         zs_snic = zswitch_sal * sss_m(ii,ij) * ( rhoic - rhosn ) / rhoic + ( 1. - zswitch_sal ) * sm_i_1d(ji) 
     667 
    691668         ! entrapment during snow ice formation 
    692          ! clem: new salinity difference stored (to be used in limthd_ent.F90) 
     669         ! new salinity difference stored (to be used in limthd_ent.F90) 
    693670         IF (  num_sal == 2  ) THEN 
    694             i_ice_switch = MAX( 0._wp , SIGN( 1._wp , zhgnew(ji) - epsi10 ) ) 
     671            zswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi10 ) ) 
    695672            ! salinity dif due to snow-ice formation 
    696             dsm_i_si_1d(ji) = ( zsm_snowice - sm_i_b(ji) ) * dh_snowice(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch      
     673            dsm_i_si_1d(ji) = ( zs_snic - sm_i_1d(ji) ) * dh_snowice(ji) / MAX( ht_i_1d(ji), epsi10 ) * zswitch      
    697674            ! salinity dif due to bottom growth  
    698             IF (  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji)  < 0._wp ) THEN 
    699                dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_b(ji) ) * dh_i_bott(ji) / MAX( zhgnew(ji), epsi10 ) * i_ice_switch 
     675            IF (  zf_tt(ji)  < 0._wp ) THEN 
     676               dsm_i_se_1d(ji) = ( s_i_new(ji) - sm_i_1d(ji) ) * dh_i_bott(ji) / MAX( ht_i_1d(ji), epsi10 ) * zswitch 
    700677            ENDIF 
    701678         ENDIF 
    702679 
    703          !  Actualize new snow and ice thickness. 
    704          ht_s_b(ji)  = zhnnew 
    705          ht_i_b(ji)  = zhgnew(ji) 
    706  
    707          ! Total ablation ! new lines added to debug 
    708          IF( ht_i_b(ji) <= 0._wp )   a_i_b(ji) = 0._wp 
    709  
    710          ! diagnostic ( snow ice growth ) 
    711          ii = MOD( npb(ji) - 1, jpi ) + 1 
    712          ij =    ( npb(ji) - 1 ) / jpi + 1 
    713          diag_sni_gr(ii,ij)  = diag_sni_gr(ii,ij) + dh_snowice(ji)*a_i_b(ji) * r1_rdtice 
    714          ! 
    715          ! salt flux 
    716          sfx_thd_1d(ji) = sfx_thd_1d(ji) - zsm_snowice * a_i_b(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
    717          !-------------------------------- 
    718          ! Update mass fluxes (clem) 
    719          !-------------------------------- 
    720          rdm_ice_1d(ji) = rdm_ice_1d(ji) + ( a_i_b(ji) * ht_i_b(ji) - zviold(ji) ) * rhoic  
    721          rdm_snw_1d(ji) = rdm_snw_1d(ji) + ( a_i_b(ji) * ht_s_b(ji) - zvsold(ji) ) * rhosn  
     680         ! Contribution to energy flux to the ocean [J/m2], >0 (if sst<0) 
     681         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     682         zfmdt          = ( rhosn - rhoic ) * MAX( dh_snowice(ji), 0._wp )    ! <0 
     683         zsstK          = sst_m(ii,ij) + rt0                                 
     684         zEw            = rcp * ( zsstK - rt0 ) 
     685         zQm            = zfmdt * zEw  
     686          
     687         ! Contribution to heat flux 
     688         hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice  
     689 
     690         ! Contribution to salt flux 
     691         sfx_sni_1d(ji) = sfx_sni_1d(ji) + sss_m(ii,ij) * a_i_1d(ji) * zfmdt * r1_rdtice  
     692           
     693         ! Contribution to mass flux 
     694         ! All snow is thrown in the ocean, and seawater is taken to replace the volume 
     695         wfx_sni_1d(ji) = wfx_sni_1d(ji) - a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice 
     696         wfx_snw_1d(ji) = wfx_snw_1d(ji) + a_i_1d(ji) * dh_snowice(ji) * rhosn * r1_rdtice 
     697 
     698         ! update heat content (J.m-2) and layer thickness 
     699         qh_i_old(ji,0) = qh_i_old(ji,0) + dh_snowice(ji) * q_s_1d(ji,1) + zfmdt * zEw 
     700         h_i_old (ji,0) = h_i_old (ji,0) + dh_snowice(ji) 
     701          
     702         ! Total ablation (to debug) 
     703         IF( ht_i_1d(ji) <= 0._wp )   a_i_1d(ji) = 0._wp 
    722704 
    723705      END DO !ji 
    724       ! 
    725       CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i ) 
    726       CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy ) 
    727       CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i ) 
    728       CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay ) 
    729       ! 
    730       CALL wrk_dealloc( jpij, zviold, zvsold ) ! clem 
     706 
     707      ! 
     708      !------------------------------------------- 
     709      ! Update temperature, energy 
     710      !------------------------------------------- 
     711      !clem bug: we should take snow into account here 
     712      DO ji = kideb, kiut 
     713         zindh    =  1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )  
     714         t_su_1d(ji) =  zindh * t_su_1d(ji) + ( 1.0 - zindh ) * rtt 
     715      END DO  ! ji 
     716 
     717      DO jk = 1, nlay_s 
     718         DO ji = kideb,kiut 
     719            ! mask enthalpy 
     720            zinda        =  MAX(  0._wp , SIGN( 1._wp, - ht_s_1d(ji) )  ) 
     721            q_s_1d(ji,jk) = ( 1.0 - zinda ) * q_s_1d(ji,jk) 
     722            ! recalculate t_s_1d from q_s_1d 
     723            t_s_1d(ji,jk) = rtt + ( 1._wp - zinda ) * ( - q_s_1d(ji,jk) / ( rhosn * cpic ) + lfus / cpic ) 
     724         END DO 
     725      END DO 
     726 
     727      CALL wrk_dealloc( jpij, zh_s, zqprec, zq_su, zq_bo, zf_tt, zq_1cat, zq_rema ) 
     728      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 
     729      CALL wrk_dealloc( jpij, zintermelt ) 
     730      CALL wrk_dealloc( jpij, nlay_i+1, zdeltah, zh_i ) 
     731      CALL wrk_dealloc( jpij, icount ) 
     732      ! 
    731733      ! 
    732734   END SUBROUTINE lim_thd_dh 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r4333 r4921  
    2525   USE wrk_nemo       ! work arrays 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE cpl_oasis3, ONLY : lk_cpl 
    2728 
    2829   IMPLICIT NONE 
    … …  
    3132   PUBLIC   lim_thd_dif   ! called by lim_thd 
    3233 
    33    REAL(wp) ::   epsi10      = 1.e-10_wp    ! 
     34   REAL(wp) ::   epsi10 = 1.e-10_wp    ! 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    … …  
    3940CONTAINS 
    4041 
    41    SUBROUTINE lim_thd_dif( kideb , kiut , jl ) 
     42   SUBROUTINE lim_thd_dif( kideb , kiut ) 
    4243      !!------------------------------------------------------------------ 
    4344      !!                ***  ROUTINE lim_thd_dif  *** 
    … …  
    7475      !! 
    7576      !! ** Inputs / Ouputs : (global commons) 
    76       !!           surface temperature : t_su_b 
    77       !!           ice/snow temperatures   : t_i_b, t_s_b 
    78       !!           ice salinities          : s_i_b 
     77      !!           surface temperature : t_su_1d 
     78      !!           ice/snow temperatures   : t_i_1d, t_s_1d 
     79      !!           ice salinities          : s_i_1d 
    7980      !!           number of layers in the ice/snow: nlay_i, nlay_s 
    8081      !!           profile of the ice/snow layers : z_i, z_s 
    81       !!           total ice/snow thickness : ht_i_b, ht_s_b 
     82      !!           total ice/snow thickness : ht_i_1d, ht_s_1d 
    8283      !! 
    8384      !! ** External :  
    … …  
    9192      !!           (04-2007) Energy conservation tested by M. Vancoppenolle 
    9293      !!------------------------------------------------------------------ 
    93       INTEGER , INTENT (in) ::   kideb   ! Start point on which the  the computation is applied 
    94       INTEGER , INTENT (in) ::   kiut    ! End point on which the  the computation is applied 
    95       INTEGER , INTENT (in) ::   jl      ! Category number 
     94      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    9695 
    9796      !! * Local variables 
    … …  
    9998      INTEGER ::   ii, ij      ! temporary dummy loop index 
    10099      INTEGER ::   numeq       ! current reference number of equation 
    101       INTEGER ::   layer       ! vertical dummy loop index  
     100      INTEGER ::   jk       ! vertical dummy loop index  
    102101      INTEGER ::   nconv       ! number of iterations in iterative procedure 
    103102      INTEGER ::   minnumeqmin, maxnumeqmax 
    104       INTEGER, DIMENSION(kiut) ::   numeqmin   ! reference number of top equation 
    105       INTEGER, DIMENSION(kiut) ::   numeqmax   ! reference number of bottom equation 
    106       INTEGER, DIMENSION(kiut) ::   isnow      ! switch for presence (1) or absence (0) of snow 
     103      INTEGER, POINTER, DIMENSION(:) ::   numeqmin   ! reference number of top equation 
     104      INTEGER, POINTER, DIMENSION(:) ::   numeqmax   ! reference number of bottom equation 
     105      INTEGER, POINTER, DIMENSION(:) ::   isnow      ! switch for presence (1) or absence (0) of snow 
    107106      REAL(wp) ::   zg1s      =  2._wp        ! for the tridiagonal system 
    108107      REAL(wp) ::   zg1       =  2._wp        ! 
    … …  
    111110      REAL(wp) ::   zraext_s  =  1.e+8_wp     ! extinction coefficient of radiation in the snow 
    112111      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity 
     112      REAL(wp) ::   ztsu_err  =  1.e-5_wp     ! range around which t_su is considered as 0°C  
    113113      REAL(wp) ::   ztmelt_i    ! ice melting temperature 
    114114      REAL(wp) ::   zerritmax   ! current maximal error on temperature  
    115       REAL(wp), DIMENSION(kiut) ::   ztfs        ! ice melting point 
    116       REAL(wp), DIMENSION(kiut) ::   ztsuold     ! old surface temperature (before the iterative procedure ) 
    117       REAL(wp), DIMENSION(kiut) ::   ztsuoldit   ! surface temperature at previous iteration 
    118       REAL(wp), DIMENSION(kiut) ::   zh_i        ! ice layer thickness 
    119       REAL(wp), DIMENSION(kiut) ::   zh_s        ! snow layer thickness 
    120       REAL(wp), DIMENSION(kiut) ::   zfsw        ! solar radiation absorbed at the surface 
    121       REAL(wp), DIMENSION(kiut) ::   zf          ! surface flux function 
    122       REAL(wp), DIMENSION(kiut) ::   dzf         ! derivative of the surface flux function 
    123       REAL(wp), DIMENSION(kiut) ::   zerrit      ! current error on temperature 
    124       REAL(wp), DIMENSION(kiut) ::   zdifcase    ! case of the equation resolution (1->4) 
    125       REAL(wp), DIMENSION(kiut) ::   zftrice     ! solar radiation transmitted through the ice 
    126       REAL(wp), DIMENSION(kiut) ::   zihic, zhsu 
    127       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity 
    128       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice 
    129       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice 
    130       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice 
    131       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztiold      ! Old temperature in the ice 
    132       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zeta_i      ! Eta factor in the ice 
    133       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
    134       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zspeche_i   ! Ice specific heat 
    135       REAL(wp), DIMENSION(kiut,0:nlay_i) ::   z_i         ! Vertical cotes of the layers in the ice 
    136       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow 
    137       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow 
    138       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow 
    139       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zeta_s       ! Eta factor in the snow 
    140       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztstemp      ! Temporary temperature in the snow to check the convergence 
    141       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztsold       ! Temporary temperature in the snow 
    142       REAL(wp), DIMENSION(kiut,0:nlay_s) ::   z_s          ! Vertical cotes of the layers in the snow 
    143       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindterm   ! Independent term 
    144       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindtbis   ! temporary independent term 
    145       REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis 
    146       REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms 
     115      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! ice melting point 
     116      REAL(wp), POINTER, DIMENSION(:) ::   ztsub       ! old surface temperature (before the iterative procedure ) 
     117      REAL(wp), POINTER, DIMENSION(:) ::   ztsubit     ! surface temperature at previous iteration 
     118      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness 
     119      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness 
     120      REAL(wp), POINTER, DIMENSION(:) ::   zfsw        ! solar radiation absorbed at the surface 
     121      REAL(wp), POINTER, DIMENSION(:) ::   zf          ! surface flux function 
     122      REAL(wp), POINTER, DIMENSION(:) ::   dzf         ! derivative of the surface flux function 
     123      REAL(wp), POINTER, DIMENSION(:) ::   zerrit      ! current error on temperature 
     124      REAL(wp), POINTER, DIMENSION(:) ::   zdifcase    ! case of the equation resolution (1->4) 
     125      REAL(wp), POINTER, DIMENSION(:) ::   zftrice     ! solar radiation transmitted through the ice 
     126      REAL(wp), POINTER, DIMENSION(:) ::   zihic, zhsu 
     127      REAL(wp), POINTER, DIMENSION(:,:) ::   ztcond_i    ! Ice thermal conductivity 
     128      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_i    ! Radiation transmitted through the ice 
     129      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_i    ! Radiation absorbed in the ice 
     130      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_i    ! Kappa factor in the ice 
     131      REAL(wp), POINTER, DIMENSION(:,:) ::   ztib        ! Old temperature in the ice 
     132      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_i      ! Eta factor in the ice 
     133      REAL(wp), POINTER, DIMENSION(:,:) ::   ztitemp     ! Temporary temperature in the ice to check the convergence 
     134      REAL(wp), POINTER, DIMENSION(:,:) ::   zspeche_i   ! Ice specific heat 
     135      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i         ! Vertical cotes of the layers in the ice 
     136      REAL(wp), POINTER, DIMENSION(:,:) ::   zradtr_s    ! Radiation transmited through the snow 
     137      REAL(wp), POINTER, DIMENSION(:,:) ::   zradab_s    ! Radiation absorbed in the snow 
     138      REAL(wp), POINTER, DIMENSION(:,:) ::   zkappa_s    ! Kappa factor in the snow 
     139      REAL(wp), POINTER, DIMENSION(:,:) ::   zeta_s      ! Eta factor in the snow 
     140      REAL(wp), POINTER, DIMENSION(:,:) ::   ztstemp     ! Temporary temperature in the snow to check the convergence 
     141      REAL(wp), POINTER, DIMENSION(:,:) ::   ztsb        ! Temporary temperature in the snow 
     142      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s         ! Vertical cotes of the layers in the snow 
     143      REAL(wp), POINTER, DIMENSION(:,:) ::   zindterm    ! Independent term 
     144      REAL(wp), POINTER, DIMENSION(:,:) ::   zindtbis    ! temporary independent term 
     145      REAL(wp), POINTER, DIMENSION(:,:) ::   zdiagbis 
     146      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrid     ! tridiagonal system terms 
     147      ! diag errors on heat 
     148      REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 
     149      REAL(wp)                        :: zhfx_err 
    147150      !!------------------------------------------------------------------      
    148151      !  
     152      CALL wrk_alloc( jpij, numeqmin, numeqmax, isnow ) 
     153      CALL wrk_alloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
     154      CALL wrk_alloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     155      CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0) 
     156      CALL wrk_alloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0) 
     157      CALL wrk_alloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis  ) 
     158      CALL wrk_alloc( jpij, nlay_i+3, 3, ztrid ) 
     159 
     160      CALL wrk_alloc( jpij, zdq, zq_ini ) 
     161 
     162      ! --- diag error on heat diffusion - PART 1 --- ! 
     163      zdq(:) = 0._wp ; zq_ini(:) = 0._wp       
     164      DO ji = kideb, kiut 
     165         zq_ini(ji) = ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
     166            &           SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) )  
     167      END DO 
     168 
    149169      !------------------------------------------------------------------------------! 
    150170      ! 1) Initialization                                                            ! 
    151171      !------------------------------------------------------------------------------! 
    152       ! 
     172      ! clem clean: replace just ztfs by rtt 
    153173      DO ji = kideb , kiut 
    154174         ! is there snow or not 
    155          isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  ) 
     175         isnow(ji)= NINT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_1d(ji) ) )  ) 
    156176         ! surface temperature of fusion 
    157 !!gm ???  ztfs(ji) = rtt !!!???? 
    158177         ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 
    159178         ! layer thickness 
    160          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
    161          zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 
     179         zh_i(ji) = ht_i_1d(ji) / REAL( nlay_i ) 
     180         zh_s(ji) = ht_s_1d(ji) / REAL( nlay_s ) 
    162181      END DO 
    163182 
    … …  
    169188      z_i(:,0) = 0._wp   ! vert. coord. of the up. lim. of the 1st ice layer 
    170189 
    171       DO layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
    172          DO ji = kideb , kiut 
    173             z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s ) 
    174          END DO 
    175       END DO 
    176  
    177       DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
    178          DO ji = kideb , kiut 
    179             z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i ) 
     190      DO jk = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer 
     191         DO ji = kideb , kiut 
     192            z_s(ji,jk) = z_s(ji,jk-1) + ht_s_1d(ji) / REAL( nlay_s ) 
     193         END DO 
     194      END DO 
     195 
     196      DO jk = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer 
     197         DO ji = kideb , kiut 
     198            z_i(ji,jk) = z_i(ji,jk-1) + ht_i_1d(ji) / REAL( nlay_i ) 
    180199         END DO 
    181200      END DO 
    … …  
    194213      ! zfsw    = (1-i0).qsr_ice   is absorbed at the surface  
    195214      ! zftrice = io.qsr_ice       is below the surface  
    196       ! fstbif = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
     215      ! ftr_ice = io.qsr_ice.exp(-k(h_i)) transmitted below the ice  
    197216 
    198217      DO ji = kideb , kiut 
    199218         ! switches 
    200          isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  )  
     219         isnow(ji) = NINT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )  )  
    201220         ! hs > 0, isnow = 1 
    202221         zhsu (ji) = hnzst  ! threshold for the computation of i0 
    203          zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )      
     222         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_1d(ji) / zhsu(ji) ) )      
    204223 
    205224         i0(ji)    = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 
    … …  
    208227         !            a function of the cloud cover 
    209228         ! 
    210          !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0) 
     229         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_1d(ji)+10.0) 
    211230         !formula used in Cice 
    212231      END DO 
    … …  
    230249      END DO 
    231250 
    232       DO layer = 1, nlay_s          ! Radiation through snow 
     251      DO jk = 1, nlay_s          ! Radiation through snow 
    233252         DO ji = kideb, kiut 
    234253            !                             ! radiation transmitted below the layer-th snow layer 
    235             zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) ) 
     254            zradtr_s(ji,jk) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,jk) ) ) ) 
    236255            !                             ! radiation absorbed by the layer-th snow layer 
    237             zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer) 
     256            zradab_s(ji,jk) = zradtr_s(ji,jk-1) - zradtr_s(ji,jk) 
    238257         END DO 
    239258      END DO 
    … …  
    243262      END DO 
    244263 
    245       DO layer = 1, nlay_i          ! Radiation through ice 
     264      DO jk = 1, nlay_i          ! Radiation through ice 
    246265         DO ji = kideb, kiut 
    247266            !                             ! radiation transmitted below the layer-th ice layer 
    248             zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) ) 
     267            zradtr_i(ji,jk) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,jk) ) ) ) 
    249268            !                             ! radiation absorbed by the layer-th ice layer 
    250             zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer) 
     269            zradab_i(ji,jk) = zradtr_i(ji,jk-1) - zradtr_i(ji,jk) 
    251270         END DO 
    252271      END DO 
    253272 
    254273      DO ji = kideb, kiut           ! Radiation transmitted below the ice 
    255          fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 
    256       END DO 
    257  
    258       ! +++++ 
    259       ! just to check energy conservation 
    260       DO ji = kideb, kiut 
    261          ii = MOD( npb(ji) - 1 , jpi ) + 1 
    262          ij =    ( npb(ji) - 1 ) / jpi + 1 
    263          fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 
    264       END DO 
    265       ! +++++ 
    266  
    267       DO layer = 1, nlay_i 
    268          DO ji = kideb, kiut 
    269             radab(ji,layer) = zradab_i(ji,layer) 
    270          END DO 
     274         !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_1d(ji) / at_i_1d(ji) ! clem modif 
     275         ftr_ice_1d(ji) = zradtr_i(ji,nlay_i)  
    271276      END DO 
    272277 
    … …  
    277282      ! 
    278283      DO ji = kideb, kiut        ! Old surface temperature 
    279          ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr. 
    280          ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter 
    281          t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji)-0.00001 )     ! necessary 
     284         ztsub  (ji) =  t_su_1d(ji)                              ! temperature at the beg of iter pr. 
     285         ztsubit(ji) =  t_su_1d(ji)                              ! temperature at the previous iter 
     286         t_su_1d   (ji) =  MIN( t_su_1d(ji), ztfs(ji) - ztsu_err )  ! necessary 
    282287         zerrit   (ji) =  1000._wp                                ! initial value of error 
    283288      END DO 
    284289 
    285       DO layer = 1, nlay_s       ! Old snow temperature 
    286          DO ji = kideb , kiut 
    287             ztsold(ji,layer) =  t_s_b(ji,layer) 
    288          END DO 
    289       END DO 
    290  
    291       DO layer = 1, nlay_i       ! Old ice temperature 
    292          DO ji = kideb , kiut 
    293             ztiold(ji,layer) =  t_i_b(ji,layer) 
     290      DO jk = 1, nlay_s       ! Old snow temperature 
     291         DO ji = kideb , kiut 
     292            ztsb(ji,jk) =  t_s_1d(ji,jk) 
     293         END DO 
     294      END DO 
     295 
     296      DO jk = 1, nlay_i       ! Old ice temperature 
     297         DO ji = kideb , kiut 
     298            ztib(ji,jk) =  t_i_1d(ji,jk) 
    294299         END DO 
    295300      END DO 
    … …  
    308313         IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula 
    309314            DO ji = kideb , kiut 
    310                ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / MIN(-epsi10,t_i_b(ji,1)-rtt) 
     315               ztcond_i(ji,0)        = rcdic + zbeta*s_i_1d(ji,1) / MIN(-epsi10,t_i_1d(ji,1)-rtt) 
    311316               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin) 
    312317            END DO 
    313             DO layer = 1, nlay_i-1 
     318            DO jk = 1, nlay_i-1 
    314319               DO ji = kideb , kiut 
    315                   ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) /  & 
    316                      MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt) 
    317                   ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),zkimin) 
     320                  ztcond_i(ji,jk) = rcdic + zbeta*( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) ) /  & 
     321                     MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt) 
     322                  ztcond_i(ji,jk) = MAX(ztcond_i(ji,jk),zkimin) 
    318323               END DO 
    319324            END DO 
    … …  
    322327         IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T 
    323328            DO ji = kideb , kiut 
    324                ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_b(ji,1) / MIN( -epsi10, t_i_b(ji,1)-rtt )   & 
    325                   &                   - 0.011_wp * ( t_i_b(ji,1) - rtt )   
     329               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_1d(ji,1) / MIN( -epsi10, t_i_1d(ji,1)-rtt )   & 
     330                  &                   - 0.011_wp * ( t_i_1d(ji,1) - rtt )   
    326331               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin ) 
    327332            END DO 
    328             DO layer = 1, nlay_i-1 
     333            DO jk = 1, nlay_i-1 
    329334               DO ji = kideb , kiut 
    330                   ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   & 
    331                      &                                  / MIN(-2.0_wp * epsi10, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)   & 
    332                      &                       - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )   
    333                   ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin ) 
     335                  ztcond_i(ji,jk) = rcdic +                                                                     &  
     336                     &                 0.090_wp * ( s_i_1d(ji,jk) + s_i_1d(ji,jk+1) )                          & 
     337                     &                 / MIN(-2.0_wp * epsi10, t_i_1d(ji,jk)+t_i_1d(ji,jk+1) - 2.0_wp * rtt)   & 
     338                     &               - 0.0055_wp* ( t_i_1d(ji,jk) + t_i_1d(ji,jk+1) - 2.0*rtt )   
     339                  ztcond_i(ji,jk) = MAX( ztcond_i(ji,jk), zkimin ) 
    334340               END DO 
    335341            END DO 
    336342            DO ji = kideb , kiut 
    337                ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-epsi10,t_bo_b(ji)-rtt)   & 
    338                   &                        - 0.011_wp * ( t_bo_b(ji) - rtt )   
     343               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_1d(ji,nlay_i) / MIN(-epsi10,t_bo_1d(ji)-rtt)   & 
     344                  &                        - 0.011_wp * ( t_bo_1d(ji) - rtt )   
    339345               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin ) 
    340346            END DO 
    … …  
    352358         END DO 
    353359 
    354          DO layer = 1, nlay_s-1 
    355             DO ji = kideb , kiut 
    356                zkappa_s(ji,layer)  = 2.0 * rcdsn / & 
     360         DO jk = 1, nlay_s-1 
     361            DO ji = kideb , kiut 
     362               zkappa_s(ji,jk)  = 2.0 * rcdsn / & 
    357363                  MAX(epsi10,2.0*zh_s(ji)) 
    358364            END DO 
    359365         END DO 
    360366 
    361          DO layer = 1, nlay_i-1 
     367         DO jk = 1, nlay_i-1 
    362368            DO ji = kideb , kiut 
    363369               !-- Ice kappa factors 
    364                zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ & 
     370               zkappa_i(ji,jk)  = 2.0*ztcond_i(ji,jk)/ & 
    365371                  MAX(epsi10,2.0*zh_i(ji))  
    366372            END DO 
    … …  
    381387         !------------------------------------------------------------------------------| 
    382388         ! 
    383          DO layer = 1, nlay_i 
    384             DO ji = kideb , kiut 
    385                ztitemp(ji,layer)   = t_i_b(ji,layer) 
    386                zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ & 
    387                   MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),epsi10) 
    388                zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), & 
     389         DO jk = 1, nlay_i 
     390            DO ji = kideb , kiut 
     391               ztitemp(ji,jk)   = t_i_1d(ji,jk) 
     392               zspeche_i(ji,jk) = cpic + zgamma*s_i_1d(ji,jk)/ & 
     393                  MAX((t_i_1d(ji,jk)-rtt)*(ztib(ji,jk)-rtt),epsi10) 
     394               zeta_i(ji,jk)    = rdt_ice / MAX(rhoic*zspeche_i(ji,jk)*zh_i(ji), & 
    389395                  epsi10) 
    390396            END DO 
    391397         END DO 
    392398 
    393          DO layer = 1, nlay_s 
    394             DO ji = kideb , kiut 
    395                ztstemp(ji,layer) = t_s_b(ji,layer) 
    396                zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 
     399         DO jk = 1, nlay_s 
     400            DO ji = kideb , kiut 
     401               ztstemp(ji,jk) = t_s_1d(ji,jk) 
     402               zeta_s(ji,jk)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),epsi10) 
    397403            END DO 
    398404         END DO 
    … …  
    403409         ! 
    404410         DO ji = kideb , kiut 
    405  
    406411            ! update of the non solar flux according to the update in T_su 
    407             qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * &  
    408                ( t_su_b(ji) - ztsuoldit(ji) ) 
     412            qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_1d(ji) - ztsubit(ji) ) 
    409413 
    410414            ! update incoming flux 
    411415            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation 
    412                + qnsr_ice_1d(ji)           ! non solar total flux  
     416               + qns_ice_1d(ji)                  ! non solar total flux  
    413417            ! (LWup, LWdw, SH, LH) 
    414  
    415418         END DO 
    416419 
    … …  
    427430         !!ice interior terms (top equation has the same form as the others) 
    428431 
    429          DO numeq=1,jkmax+2 
     432         DO numeq=1,nlay_i+3 
    430433            DO ji = kideb , kiut 
    431434               ztrid(ji,numeq,1) = 0. 
    … …  
    440443         DO numeq = nlay_s + 2, nlay_s + nlay_i  
    441444            DO ji = kideb , kiut 
    442                layer              = numeq - nlay_s - 1 
    443                ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1) 
    444                ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + & 
    445                   zkappa_i(ji,layer)) 
    446                ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer) 
    447                zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* & 
    448                   zradab_i(ji,layer) 
     445               jk              = numeq - nlay_s - 1 
     446               ztrid(ji,numeq,1)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk-1) 
     447               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,jk)*(zkappa_i(ji,jk-1) + & 
     448                  zkappa_i(ji,jk)) 
     449               ztrid(ji,numeq,3)  =  - zeta_i(ji,jk)*zkappa_i(ji,jk) 
     450               zindterm(ji,numeq) =  ztib(ji,jk) + zeta_i(ji,jk)* & 
     451                  zradab_i(ji,jk) 
    449452            END DO 
    450453         ENDDO 
    … …  
    457460               +  zkappa_i(ji,nlay_i-1) ) 
    458461            ztrid(ji,numeq,3)  =  0.0 
    459             zindterm(ji,numeq) =  ztiold(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
     462            zindterm(ji,numeq) =  ztib(ji,nlay_i) + zeta_i(ji,nlay_i)* & 
    460463               ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 & 
    461                *  t_bo_b(ji) )  
     464               *  t_bo_1d(ji) )  
    462465         ENDDO 
    463466 
    464467 
    465468         DO ji = kideb , kiut 
    466             IF ( ht_s_b(ji).gt.0.0 ) THEN 
     469            IF ( ht_s_1d(ji).gt.0.0 ) THEN 
    467470               ! 
    468471               !------------------------------------------------------------------------------| 
    … …  
    472475               !!snow interior terms (bottom equation has the same form as the others) 
    473476               DO numeq = 3, nlay_s + 1 
    474                   layer =  numeq - 1 
    475                   ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1) 
    476                   ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + & 
    477                      zkappa_s(ji,layer) ) 
    478                   ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer) 
    479                   zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* & 
    480                      zradab_s(ji,layer) 
     477                  jk =  numeq - 1 
     478                  ztrid(ji,numeq,1)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk-1) 
     479                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,jk)*( zkappa_s(ji,jk-1) + & 
     480                     zkappa_s(ji,jk) ) 
     481                  ztrid(ji,numeq,3)   =  - zeta_s(ji,jk)*zkappa_s(ji,jk) 
     482                  zindterm(ji,numeq)  =  ztsb(ji,jk) + zeta_s(ji,jk)* & 
     483                     zradab_s(ji,jk) 
    481484               END DO 
    482485 
    … …  
    485488                  ztrid(ji,nlay_s+2,3)    =  0.0 
    486489                  zindterm(ji,nlay_s+2)   =  zindterm(ji,nlay_s+2) + zkappa_i(ji,1)* & 
    487                      t_bo_b(ji)  
     490                     t_bo_1d(ji)  
    488491               ENDIF 
    489492 
    490                IF ( t_su_b(ji) .LT. rtt ) THEN 
     493               IF ( t_su_1d(ji) .LT. rtt ) THEN 
    491494 
    492495                  !------------------------------------------------------------------------------| 
    … …  
    501504                  ztrid(ji,1,2) = dzf(ji) - zg1s*zkappa_s(ji,0) 
    502505                  ztrid(ji,1,3) = zg1s*zkappa_s(ji,0) 
    503                   zindterm(ji,1) = dzf(ji)*t_su_b(ji)   - zf(ji) 
     506                  zindterm(ji,1) = dzf(ji)*t_su_1d(ji)   - zf(ji) 
    504507 
    505508                  !!first layer of snow equation 
    … …  
    507510                  ztrid(ji,2,2)  =  1.0 + zeta_s(ji,1)*(zkappa_s(ji,1) + zkappa_s(ji,0)*zg1s) 
    508511                  ztrid(ji,2,3)  =  - zeta_s(ji,1)* zkappa_s(ji,1) 
    509                   zindterm(ji,2) =  ztsold(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
     512                  zindterm(ji,2) =  ztsb(ji,1) + zeta_s(ji,1)*zradab_s(ji,1) 
    510513 
    511514               ELSE  
    … …  
    524527                     zkappa_s(ji,0) * zg1s ) 
    525528                  ztrid(ji,2,3)  =  - zeta_s(ji,1)*zkappa_s(ji,1)  
    526                   zindterm(ji,2) = ztsold(ji,1) + zeta_s(ji,1) *            & 
     529                  zindterm(ji,2) = ztsb(ji,1) + zeta_s(ji,1) *            & 
    527530                     ( zradab_s(ji,1) +                         & 
    528                      zkappa_s(ji,0) * zg1s * t_su_b(ji) )  
     531                     zkappa_s(ji,0) * zg1s * t_su_1d(ji) )  
    529532               ENDIF 
    530533            ELSE 
    … …  
    534537               !------------------------------------------------------------------------------| 
    535538               ! 
    536                IF (t_su_b(ji) .LT. rtt) THEN 
     539               IF (t_su_1d(ji) .LT. rtt) THEN 
    537540                  ! 
    538541                  !------------------------------------------------------------------------------| 
    … …  
    548551                  ztrid(ji,numeqmin(ji),2)   =  dzf(ji) - zkappa_i(ji,0)*zg1     
    549552                  ztrid(ji,numeqmin(ji),3)   =  zkappa_i(ji,0)*zg1 
    550                   zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_b(ji) - zf(ji) 
     553                  zindterm(ji,numeqmin(ji))  =  dzf(ji)*t_su_1d(ji) - zf(ji) 
    551554 
    552555                  !!first layer of ice equation 
    … …  
    555558                     + zkappa_i(ji,0) * zg1 ) 
    556559                  ztrid(ji,numeqmin(ji)+1,3) =  - zeta_i(ji,1)*zkappa_i(ji,1)   
    557                   zindterm(ji,numeqmin(ji)+1)=  ztiold(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
     560                  zindterm(ji,numeqmin(ji)+1)=  ztib(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)   
    558561 
    559562                  !!case of only one layer in the ice (surface & ice equations are altered) 
    … …  
    568571                     ztrid(ji,numeqmin(ji)+1,3)  =  0.0 
    569572 
    570                      zindterm(ji,numeqmin(ji)+1) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    571                         ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji) ) 
     573                     zindterm(ji,numeqmin(ji)+1) =  ztib(ji,1) + zeta_i(ji,1)* & 
     574                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji) ) 
    572575                  ENDIF 
    573576 
    … …  
    588591                     zg1)   
    589592                  ztrid(ji,numeqmin(ji),3)      =  - zeta_i(ji,1) * zkappa_i(ji,1) 
    590                   zindterm(ji,numeqmin(ji))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
    591                      zkappa_i(ji,0) * zg1 * t_su_b(ji) )  
     593                  zindterm(ji,numeqmin(ji))     =  ztib(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + & 
     594                     zkappa_i(ji,0) * zg1 * t_su_1d(ji) )  
    592595 
    593596                  !!case of only one layer in the ice (surface & ice equations are altered) 
    … …  
    597600                        zkappa_i(ji,1)) 
    598601                     ztrid(ji,numeqmin(ji),3)  =  0.0 
    599                      zindterm(ji,numeqmin(ji)) =  ztiold(ji,1) + zeta_i(ji,1)* & 
    600                         (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) & 
    601                         + t_su_b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
     602                     zindterm(ji,numeqmin(ji)) =  ztib(ji,1) + zeta_i(ji,1)* & 
     603                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_1d(ji)) & 
     604                        + t_su_1d(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0 
    602605                  ENDIF 
    603606 
    … …  
    618621 
    619622         maxnumeqmax = 0 
    620          minnumeqmin = jkmax+4 
     623         minnumeqmin = nlay_i+5 
    621624 
    622625         DO ji = kideb , kiut 
    … …  
    627630         END DO 
    628631 
    629          DO layer = minnumeqmin+1, maxnumeqmax 
    630             DO ji = kideb , kiut 
    631                numeq               =  min(max(numeqmin(ji)+1,layer),numeqmax(ji)) 
     632         DO jk = minnumeqmin+1, maxnumeqmax 
     633            DO ji = kideb , kiut 
     634               numeq               =  min(max(numeqmin(ji)+1,jk),numeqmax(ji)) 
    632635               zdiagbis(ji,numeq)  =  ztrid(ji,numeq,2) - ztrid(ji,numeq,1)* & 
    633636                  ztrid(ji,numeq-1,3)/zdiagbis(ji,numeq-1) 
    … …  
    639642         DO ji = kideb , kiut 
    640643            ! ice temperatures 
    641             t_i_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
     644            t_i_1d(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji)) 
    642645         END DO 
    643646 
    644647         DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1 
    645648            DO ji = kideb , kiut 
    646                layer    =  numeq - nlay_s - 1 
    647                t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 
    648                   t_i_b(ji,layer+1))/zdiagbis(ji,numeq) 
     649               jk    =  numeq - nlay_s - 1 
     650               t_i_1d(ji,jk)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* & 
     651                  t_i_1d(ji,jk+1))/zdiagbis(ji,numeq) 
    649652            END DO 
    650653         END DO 
    … …  
    652655         DO ji = kideb , kiut 
    653656            ! snow temperatures       
    654             IF (ht_s_b(ji).GT.0._wp) & 
    655                t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
    656                *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 
    657                *        MAX(0.0,SIGN(1.0,ht_s_b(ji)))  
     657            IF (ht_s_1d(ji).GT.0._wp) & 
     658               t_s_1d(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 
     659               *  t_i_1d(ji,1))/zdiagbis(ji,nlay_s+1) & 
     660               *        MAX(0.0,SIGN(1.0,ht_s_1d(ji)))  
    658661 
    659662            ! surface temperature 
    660             isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) )  )  ) 
    661             ztsuoldit(ji) = t_su_b(ji) 
    662             IF( t_su_b(ji) < ztfs(ji) ) & 
    663                t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1)   & 
    664                &          + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
     663            isnow(ji)     = NINT(  1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_1d(ji) )  )  ) 
     664            ztsubit(ji) = t_su_1d(ji) 
     665            IF( t_su_1d(ji) < ztfs(ji) ) & 
     666               t_su_1d(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_1d(ji,1)   & 
     667               &          + REAL( 1 - isnow(ji) )*t_i_1d(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))   
    665668         END DO 
    666669         ! 
    … …  
    672675         ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd 
    673676         DO ji = kideb , kiut 
    674             t_su_b(ji) =  MAX(  MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp  ) 
    675             zerrit(ji) =  ABS( t_su_b(ji) - ztsuoldit(ji) )      
    676          END DO 
    677  
    678          DO layer  =  1, nlay_s 
    679             DO ji = kideb , kiut 
    680                ii = MOD( npb(ji) - 1, jpi ) + 1 
    681                ij = ( npb(ji) - 1 ) / jpi + 1 
    682                t_s_b(ji,layer) = MAX(  MIN( t_s_b(ji,layer), rtt ), 190._wp  ) 
    683                zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer))) 
    684             END DO 
    685          END DO 
    686  
    687          DO layer  =  1, nlay_i 
    688             DO ji = kideb , kiut 
    689                ztmelt_i        = -tmut * s_i_b(ji,layer) + rtt  
    690                t_i_b(ji,layer) =  MAX(MIN(t_i_b(ji,layer),ztmelt_i), 190._wp) 
    691                zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer))) 
     677            t_su_1d(ji) =  MAX(  MIN( t_su_1d(ji) , ztfs(ji) ) , 190._wp  ) 
     678            zerrit(ji) =  ABS( t_su_1d(ji) - ztsubit(ji) )      
     679         END DO 
     680 
     681         DO jk  =  1, nlay_s 
     682            DO ji = kideb , kiut 
     683               t_s_1d(ji,jk) = MAX(  MIN( t_s_1d(ji,jk), rtt ), 190._wp  ) 
     684               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_1d(ji,jk) - ztstemp(ji,jk))) 
     685            END DO 
     686         END DO 
     687 
     688         DO jk  =  1, nlay_i 
     689            DO ji = kideb , kiut 
     690               ztmelt_i        = -tmut * s_i_1d(ji,jk) + rtt  
     691               t_i_1d(ji,jk) =  MAX(MIN(t_i_1d(ji,jk),ztmelt_i), 190._wp) 
     692               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_1d(ji,jk) - ztitemp(ji,jk))) 
    692693            END DO 
    693694         END DO 
    … …  
    713714      !-------------------------------------------------------------------------! 
    714715      DO ji = kideb, kiut 
    715 #if ! defined key_coupled 
    716716         ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)  
    717          qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) ) ) 
    718 #endif 
     717         IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) ) 
    719718         !                                ! surface ice conduction flux 
    720          isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  ) 
    721          fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   & 
    722             &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji)) 
     719         isnow(ji)       = NINT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) )  ) 
     720         fc_su(ji)       =  -     REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_1d(ji,1) - t_su_1d(ji))   & 
     721            &               - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_1d(ji,1) - t_su_1d(ji)) 
    723722         !                                ! bottom ice conduction flux 
    724          fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    725       END DO 
    726  
    727       !-------------------------! 
    728       ! Heat conservation       ! 
    729       !-------------------------! 
    730       IF( con_i .AND. jiindex_1d > 0 ) THEN 
     723         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_1d(ji) - t_i_1d(ji,nlay_i)) ) 
     724      END DO 
     725 
     726      !----------------------------------------- 
     727      ! Heat flux used to warm/cool ice in W.m-2 
     728      !----------------------------------------- 
     729      DO ji = kideb, kiut 
     730         IF( t_su_1d(ji) < rtt ) THEN  ! case T_su < 0degC 
     731            hfx_dif_1d(ji) = hfx_dif_1d(ji)  +   & 
     732               &            ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
     733         ELSE                         ! case T_su = 0degC 
     734            hfx_dif_1d(ji) = hfx_dif_1d(ji) +    & 
     735               &             ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 
     736         ENDIF 
     737      END DO 
     738 
     739      ! --- computes sea ice energy of melting compulsory for limthd_dh --- ! 
     740      CALL lim_thd_enmelt( kideb, kiut ) 
     741 
     742      ! --- diag error on heat diffusion - PART 2 --- ! 
     743      DO ji = kideb, kiut 
     744         zdq(ji)        = - zq_ini(ji) + ( SUM( q_i_1d(ji,1:nlay_i) ) * ht_i_1d(ji) / REAL( nlay_i ) +  & 
     745            &                              SUM( q_s_1d(ji,1:nlay_s) ) * ht_s_1d(ji) / REAL( nlay_s ) ) 
     746         zhfx_err    = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice )  
     747         hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_1d(ji) 
     748         ! --- correction of qns_ice and surface conduction flux --- ! 
     749         qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err  
     750         fc_su     (ji) = fc_su     (ji) - zhfx_err  
     751         ! --- Heat flux at the ice surface in W.m-2 --- ! 
     752         ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 
     753         hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 
     754      END DO 
     755    
     756      ! 
     757      CALL wrk_dealloc( jpij, numeqmin, numeqmax, isnow ) 
     758      CALL wrk_dealloc( jpij, ztfs, ztsub, ztsubit, zh_i, zh_s, zfsw ) 
     759      CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zhsu ) 
     760      CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i,   & 
     761         &              ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 
     762      CALL wrk_dealloc( jpij, nlay_s+1,           zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 
     763      CALL wrk_dealloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 
     764      CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 
     765      CALL wrk_dealloc( jpij, zdq, zq_ini ) 
     766 
     767   END SUBROUTINE lim_thd_dif 
     768 
     769   SUBROUTINE lim_thd_enmelt( kideb, kiut ) 
     770      !!----------------------------------------------------------------------- 
     771      !!                   ***  ROUTINE lim_thd_enmelt ***  
     772      !!                  
     773      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3) from temperature 
     774      !! 
     775      !! ** Method  :   Formula (Bitz and Lipscomb, 1999) 
     776      !!------------------------------------------------------------------- 
     777      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop 
     778      ! 
     779      INTEGER  ::   ji, jk   ! dummy loop indices 
     780      REAL(wp) ::   ztmelts, zindb  ! local scalar  
     781      !!------------------------------------------------------------------- 
     782      ! 
     783      DO jk = 1, nlay_i             ! Sea ice energy of melting 
    731784         DO ji = kideb, kiut 
    732             ! Upper snow value 
    733             fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )  
    734             ! Bott. snow value 
    735             fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )  
    736          END DO 
    737          DO ji = kideb, kiut         ! Upper ice layer 
    738             fc_i(ji,0) = - REAL( isnow(ji) ) * &  ! interface flux if there is snow 
    739                ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 
    740                - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * &  
    741                zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 
    742          END DO 
    743          DO layer = 1, nlay_i - 1         ! Internal ice layers 
    744             DO ji = kideb, kiut 
    745                fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) ) 
    746                ii = MOD( npb(ji) - 1, jpi ) + 1 
    747                ij = ( npb(ji) - 1 ) / jpi + 1 
    748             END DO 
    749          END DO 
    750          DO ji = kideb, kiut         ! Bottom ice layers 
    751             fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) 
    752          END DO 
    753       ENDIF 
     785            ztmelts      = - tmut  * s_i_1d(ji,jk) + rtt  
     786            zindb        = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rtt) - epsi10 ) ) 
     787            q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) )                                             & 
     788               &                   + lfus * ( 1.0 - zindb * ( ztmelts-rtt ) / MIN( t_i_1d(ji,jk)-rtt, -epsi10 ) )   & 
     789               &                   - rcp  *                 ( ztmelts-rtt )  )  
     790         END DO 
     791      END DO 
     792      DO jk = 1, nlay_s             ! Snow energy of melting 
     793         DO ji = kideb, kiut 
     794            q_s_1d(ji,jk) = rhosn * ( cpic * ( rtt - t_s_1d(ji,jk) ) + lfus ) 
     795         END DO 
     796      END DO 
    754797      ! 
    755    END SUBROUTINE lim_thd_dif 
     798   END SUBROUTINE lim_thd_enmelt 
    756799 
    757800#else 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90

    r4333 r4921  
    1010   !!                 ! 2006-11 (X. Fettweis) Vectorized  
    1111   !!            3.0  ! 2008-03 (M. Vancoppenolle) Energy conservation and clean code 
    12    !!            4.0  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     13   !!             -   ! 2014-05 (C. Rousset) complete rewriting 
    1314   !!---------------------------------------------------------------------- 
    1415#if defined key_lim3 
    … …  
    2223   USE domain         ! 
    2324   USE phycst         ! physical constants 
     25   USE sbc_oce        ! Surface boundary condition: ocean fields 
    2426   USE ice            ! LIM variables 
    2527   USE par_ice        ! LIM parameters 
    … …  
    3436   PRIVATE 
    3537 
    36    PUBLIC   lim_thd_ent         ! called by lim_thd 
     38   PUBLIC   lim_thd_ent         ! called by limthd and limthd_lac 
    3739 
    38    REAL(wp) ::   epsi20 = 1.e-20_wp   ! constant values 
    39    REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    40    REAL(wp) ::   zzero  = 0._wp      ! 
    41    REAL(wp) ::   zone   = 1._wp      ! 
     40   REAL(wp) :: epsi20 = 1.e-20   ! constant values 
     41   REAL(wp) :: epsi10 = 1.e-10   ! constant values 
    4242 
    4343   !!---------------------------------------------------------------------- 
    … …  
    4848CONTAINS 
    4949  
    50    SUBROUTINE lim_thd_ent( kideb, kiut, jl ) 
     50   SUBROUTINE lim_thd_ent( kideb, kiut, qnew ) 
    5151      !!------------------------------------------------------------------- 
    5252      !!               ***   ROUTINE lim_thd_ent  *** 
    5353      !! 
    5454      !! ** Purpose : 
    55       !!           This routine computes new vertical grids  
    56       !!           in the ice and in the snow, and consistently redistributes  
    57       !!           temperatures in the snow / ice.  
     55      !!           This routine computes new vertical grids in the ice,  
     56      !!           and consistently redistributes temperatures.  
    5857      !!           Redistribution is made so as to ensure to energy conservation 
    5958      !! 
    … …  
    6160      !! ** Method  : linear conservative remapping 
    6261      !!            
    63       !! ** Steps : 1) Grid 
    64       !!            2) Switches 
    65       !!            3) Snow redistribution 
    66       !!            4) Ice enthalpy redistribution 
    67       !!            5) Ice salinity, recover temperature 
     62      !! ** Steps : 1) cumulative integrals of old enthalpies/thicknesses 
     63      !!            2) linear remapping on the new layers 
     64      !! 
     65      !! ------------ cum0(0)                        ------------- cum1(0) 
     66      !!                                    NEW      ------------- 
     67      !! ------------ cum0(1)               ==>      ------------- 
     68      !!     ...                                     ------------- 
     69      !! ------------                                ------------- 
     70      !! ------------ cum0(nlay_i+2)                 ------------- cum1(nlay_i) 
     71      !! 
    6872      !! 
    6973      !! References : Bitz & Lipscomb, JGR 99; Vancoppenolle et al., GRL, 2005 
    7074      !!------------------------------------------------------------------- 
    7175      INTEGER , INTENT(in) ::   kideb, kiut   ! Start/End point on which the  the computation is applied 
    72       INTEGER , INTENT(in) ::   jl            ! Thickness cateogry number 
    7376 
    74       INTEGER ::   ji,jk   !  dummy loop indices 
    75       INTEGER ::   ii, ij       ,   &  !  dummy indices 
    76          ntop0          ,   &  !  old layer top index 
    77          nbot1          ,   &  !  new layer bottom index 
    78          ntop1          ,   &  !  new layer top index 
    79          limsum         ,   &  !  temporary loop index 
    80          nlayi0,nlays0  ,   &  !  old number of layers 
    81          maxnbot0       ,   &  !  old layer bottom index 
    82          layer0, layer1        !  old/new layer indexes 
     77      REAL(wp), INTENT(inout), DIMENSION(:,:) :: qnew          ! new enthlapies (J.m-3, remapped) 
    8378 
    84  
    85       REAL(wp) :: & 
    86          ztmelts        ,   &  ! ice melting point 
    87          zqsnic         ,   &  ! enthalpy of snow ice layer 
    88          zhsnow         ,   &  ! temporary snow thickness variable 
    89          zswitch        ,   &  ! dummy switch argument 
    90          zfac1          ,   &  ! dummy factor 
    91          zfac2          ,   &  ! dummy factor 
    92          ztform         ,   &  !: bottom formation temperature 
    93          zaaa           ,   &  !: dummy factor 
    94          zbbb           ,   &  !: dummy factor 
    95          zccc           ,   &  !: dummy factor 
    96          zdiscrim              !: dummy factor 
    97  
    98       INTEGER, POINTER, DIMENSION(:) ::   snswi     !  snow switch 
    99       INTEGER, POINTER, DIMENSION(:) ::   nbot0     !  old layer bottom index 
    100       INTEGER, POINTER, DIMENSION(:) ::   icsuind   !  ice surface index 
    101       INTEGER, POINTER, DIMENSION(:) ::   icsuswi   !  ice surface switch 
    102       INTEGER, POINTER, DIMENSION(:) ::   icboind   !  ice bottom index 
    103       INTEGER, POINTER, DIMENSION(:) ::   icboswi   !  ice bottom switch 
    104       INTEGER, POINTER, DIMENSION(:) ::   snicind   !  snow ice index 
    105       INTEGER, POINTER, DIMENSION(:) ::   snicswi   !  snow ice switch 
    106       INTEGER, POINTER, DIMENSION(:) ::   snind     !  snow index 
     79      INTEGER  :: ji         !  dummy loop indices 
     80      INTEGER  :: jk0, jk1   !  old/new layer indices 
     81      REAL(wp) :: zswitch 
    10782      ! 
    108       REAL(wp), POINTER, DIMENSION(:) ::   zh_i   ! thickness of an ice layer 
    109       REAL(wp), POINTER, DIMENSION(:) ::   zh_s          ! thickness of a snow layer 
    110       REAL(wp), POINTER, DIMENSION(:) ::   zqsnow        ! enthalpy of the snow put in snow ice     
    111       REAL(wp), POINTER, DIMENSION(:) ::   zdeltah       ! temporary variable 
    112       REAL(wp), POINTER, DIMENSION(:) ::   zqti_in, zqts_in 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zqti_fin, zqts_fin 
    114  
    115       REAL(wp), POINTER, DIMENSION(:,:) ::   zm0       !  old layer-system vertical cotes  
    116       REAL(wp), POINTER, DIMENSION(:,:) ::   qm0       !  old layer-system heat content  
    117       REAL(wp), POINTER, DIMENSION(:,:) ::   z_s       !  new snow system vertical cotes  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   z_i       !  new ice system vertical cotes  
    119       REAL(wp), POINTER, DIMENSION(:,:) ::   zthick0   !  old ice thickness  
    120       REAL(wp), POINTER, DIMENSION(:,:) ::   zhl0      ! old and new layer thicknesses  
    121       REAL(wp), POINTER, DIMENSION(:,:) ::   zrl01 
    122  
    123       REAL(wp) ::   zinda  
     83      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces 
     84      REAL(wp), POINTER, DIMENSION(:,:) :: zqh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces 
     85      REAL(wp), POINTER, DIMENSION(:)   :: zhnew               ! new layers thicknesses 
    12486      !!------------------------------------------------------------------- 
    12587 
    126       CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind )   ! integer 
    127       CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin )           ! real 
    128       CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 
    129       CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 
     88      CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 
     89      CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 
     90      CALL wrk_alloc( jpij, zhnew ) 
    13091 
    131       zthick0(:,:) = 0._wp 
    132       zm0    (:,:) = 0._wp 
    133       qm0    (:,:) = 0._wp 
    134       zrl01  (:,:) = 0._wp 
    135       zhl0   (:,:) = 0._wp 
    136       z_i    (:,:) = 0._wp 
    137       z_s    (:,:) = 0._wp 
    138  
    139       ! 
    140       !------------------------------------------------------------------------------| 
    141       !  1) Grid                                                                     | 
    142       !------------------------------------------------------------------------------| 
    143       nlays0 = nlay_s 
    144       nlayi0 = nlay_i 
    145  
    146       DO ji = kideb, kiut 
    147          zh_i(ji) = old_ht_i_b(ji) / REAL( nlay_i )  
    148          zh_s(ji) = old_ht_s_b(ji) / REAL( nlay_s ) 
    149       END DO 
    150  
    151       ! 
    152       !------------------------------------------------------------------------------| 
    153       !  2) Switches                                                                 | 
    154       !------------------------------------------------------------------------------| 
    155       ! 2.1 snind(ji), snswi(ji) 
    156       ! snow surface behaviour : computation of snind(ji)-snswi(ji) 
    157       ! snind(ji) : index which equals  
    158       !   0 if snow is accumulating 
    159       !   1 if 1st layer is melting 
    160       !   2 if 2nd layer is melting ... 
    161       DO ji = kideb, kiut 
    162          snind  (ji) = 0 
    163          zdeltah(ji) = 0._wp 
    164       ENDDO !ji 
    165  
    166       DO jk = 1, nlays0 
     92      !-------------------------------------------------------------------------- 
     93      !  1) Cumulative integral of old enthalpy * thicnkess and layers interfaces 
     94      !-------------------------------------------------------------------------- 
     95      zqh_cum0(:,0:nlay_i+2) = 0._wp  
     96      zh_cum0 (:,0:nlay_i+2) = 0._wp 
     97      DO jk0 = 1, nlay_i+2 
    16798         DO ji = kideb, kiut 
    168             snind(ji)  = jk        *      NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)))) & 
    169                + snind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji))))) 
    170             zdeltah(ji)= zdeltah(ji) + zh_s(ji) 
    171          END DO ! ji 
    172       END DO ! jk 
    173  
    174       ! snswi(ji) : switch which value equals 1 if snow melts 
    175       !              0 if not 
    176       DO ji = kideb, kiut 
    177          snswi(ji)     = MAX(0,NINT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji))))) 
    178       END DO ! ji 
    179  
    180       ! 2.2 icsuind(ji), icsuswi(ji) 
    181       ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji) 
    182       ! icsuind(ji) : index which equals 
    183       !     0 if nothing happens at the surface 
    184       !     1 if first layer is melting 
    185       !     2 if 2nd layer is reached by melt ... 
    186       DO ji = kideb, kiut 
    187          icsuind(ji) = 0 
    188          zdeltah(ji) = 0._wp 
    189       END DO !ji 
    190       DO jk = 1, nlayi0 
    191          DO ji = kideb, kiut 
    192             icsuind(ji) = jk          *      NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)))) & 
    193                + icsuind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji))))) 
    194             zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    195          END DO ! ji 
    196       ENDDO !jk 
    197  
    198       ! icsuswi(ji) : switch which equals  
    199       !     1 if ice melts at the surface 
    200       !     0 if not 
    201       DO ji = kideb, kiut 
    202          icsuswi(ji)  = MAX(0,NINT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) ) 
     99            zqh_cum0(ji,jk0) = zqh_cum0(ji,jk0-1) + qh_i_old(ji,jk0-1) 
     100            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + h_i_old (ji,jk0-1) 
     101         ENDDO 
    203102      ENDDO 
    204103 
    205       ! 2.3 icboind(ji), icboswi(ji) 
    206       ! ice bottom behaviour : computation of icboind(ji)-icboswi(ji) 
    207       ! icboind(ji) : index which equals 
    208       !     0 if accretion is on the way 
    209       !     1 if last layer has started to melt 
    210       !     2 if penultiem layer is melting ... and so on 
    211       !            N+1 if all layers melt and that snow transforms into ice 
    212       DO ji = kideb, kiut  
    213          icboind(ji) = 0 
    214          zdeltah(ji) = 0._wp 
    215       END DO 
    216       DO jk = nlayi0, 1, -1 
    217          DO ji = kideb, kiut 
    218             icboind(ji) = (nlayi0+1-jk) *      NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))) & 
    219                &          + icboind(ji) * (1 - NINT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)))))  
    220             zdeltah(ji) = zdeltah(ji) + zh_i(ji) 
    221          END DO 
    222       END DO 
    223  
     104      !------------------------------------ 
     105      !  2) Interpolation on the new layers 
     106      !------------------------------------ 
     107      ! new layer thickesses 
    224108      DO ji = kideb, kiut 
    225          ! case of total ablation with remaining snow 
    226          IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. & 
    227             ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1 
    228       END DO 
    229  
    230       ! icboswi(ji) : switch which equals  
    231       !     1 if ice accretion is on the way 
    232       !     0 if ablation is on the way 
    233       DO ji = kideb, kiut  
    234          icboswi(ji) = MAX(0,NINT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji))))) 
    235       END DO 
    236  
    237       ! 2.4 snicind(ji), snicswi(ji) 
    238       ! snow ice formation : calcul de snicind(ji)-snicswi(ji) 
    239       ! snicind(ji) : index which equals  
    240       !     0 if no snow-ice forms 
    241       !     1 if last layer of snow has started to melt 
    242       !     2 if penultiem layer ... 
    243       DO ji = kideb, kiut 
    244          snicind(ji) = 0 
    245          zdeltah(ji) = 0._wp 
    246       END DO 
    247       DO jk = nlays0, 1, -1 
    248          DO ji = kideb, kiut 
    249             snicind(ji) = (nlays0+1-jk) & 
    250                *      NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)))) + snicind(ji)   & 
    251                * (1 - NINT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji))))) 
    252             zdeltah(ji) = zdeltah(ji) + zh_s(ji) 
    253          END DO 
    254       END DO 
    255  
    256       ! snicswi(ji) : switch which equals  
    257       !     1 if snow-ice forms 
    258       !     0 if not 
    259       DO ji = kideb, kiut 
    260          snicswi(ji)   = MAX(0,NINT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji))))) 
     109         zhnew(ji) = SUM( h_i_old(ji,0:nlay_i+1) ) / REAL( nlay_i )   
    261110      ENDDO 
    262111 
    263       ! 
    264       !------------------------------------------------------------------------------| 
    265       !  3) Snow redistribution                                                      | 
    266       !------------------------------------------------------------------------------| 
    267       ! 
    268       !------------- 
    269       ! Old profile 
    270       !------------- 
    271  
    272       ! by 'old', it is meant that layers coming from accretion are included,  
    273       ! and that interfacial layers which were partly melted are reduced  
    274  
    275       ! indexes of the vectors 
    276       !------------------------ 
    277       ntop0    =  1 
    278       maxnbot0 =  0 
    279  
    280       DO ji = kideb, kiut 
    281          nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1 - snicind(ji) ) * snicswi(ji) 
    282          ! cotes of the top of the layers 
    283          zm0(ji,0) =  0._wp 
    284          maxnbot0 =  MAX ( maxnbot0 , nbot0(ji) ) 
    285       END DO 
    286       IF( lk_mpp )   CALL mpp_max( maxnbot0, kcom=ncomm_ice ) 
    287  
    288       DO jk = 1, maxnbot0 
     112      ! new layers interfaces 
     113      zh_cum1(:,0:nlay_i) = 0._wp 
     114      DO jk1 = 1, nlay_i 
    289115         DO ji = kideb, kiut 
    290             !change 
    291             limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 
    292             limsum = MIN( limsum , nlay_s ) 
    293             zm0(ji,jk) =  dh_s_tot(ji) + zh_s(ji) * REAL( limsum ) 
    294          END DO 
    295       END DO 
    296  
    297       DO ji = kideb, kiut 
    298          zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - REAL( snicswi(ji) ) * dh_snowice(ji) + zh_s(ji) * REAL( nlays0 ) 
    299          zm0(ji,1)         =  dh_s_tot(ji) * REAL( 1 - snswi(ji) ) + REAL( snswi(ji) ) * zm0(ji,1) 
    300       END DO 
    301  
    302       DO jk = ntop0, maxnbot0 
    303          DO ji = kideb, kiut 
    304             zthick0(ji,jk)  =  zm0(ji,jk) - zm0(ji,jk-1)            ! layer thickness 
    305          END DO 
    306       END DO 
    307  
    308       zqts_in(:) = 0._wp 
    309  
    310       DO ji = kideb, kiut         ! layer heat content 
    311          qm0    (ji,1) =  rhosn * (  cpic * ( rtt - REAL( 1 - snswi(ji) ) * tatm_ice_1d(ji)        & 
    312             &                                         - REAL( snswi(ji) ) * t_s_b      (ji,1)  )   & 
    313             &                      + lfus  ) * zthick0(ji,1) 
    314          zqts_in(ji)   =  zqts_in(ji) + qm0(ji,1)  
    315       END DO 
    316  
    317       DO jk = 2, maxnbot0 
    318          DO ji = kideb, kiut 
    319             limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 ) 
    320             limsum      = MIN( limsum , nlay_s ) 
    321             qm0(ji,jk)  = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk) 
    322             zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, - ht_s_b(ji) ) ) 
    323             zqts_in(ji) = zqts_in(ji) + REAL( 1 - snswi(ji) ) * qm0(ji,jk) * zswitch 
    324          END DO ! jk 
    325       END DO ! ji 
    326  
    327       !------------------------------------------------ 
    328       ! Energy given by the snow in snow-ice formation 
    329       !------------------------------------------------ 
    330       ! zqsnow, enthalpy of the flooded snow 
    331       DO ji = kideb, kiut 
    332          zqsnow (ji) =  rhosn * lfus 
    333          zdeltah(ji) =  0._wp 
    334       END DO 
    335  
    336       DO jk =  nlays0, 1, -1 
    337          DO ji = kideb, kiut 
    338             zhsnow =  MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) ) 
    339             zqsnow (ji) =  zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk)) 
    340             zdeltah(ji) =  zdeltah(ji) + zh_s(ji) 
    341          END DO 
    342       END DO 
    343  
    344       DO ji = kideb, kiut 
    345          zqsnow(ji) = zqsnow(ji) * dh_snowice(ji) 
    346       END DO 
    347  
    348       !------------------ 
    349       ! new snow profile 
    350       !------------------ 
    351  
    352       !-------------- 
    353       ! Vector index    
    354       !-------------- 
    355       ntop1 =  1 
    356       nbot1 =  nlay_s 
    357  
    358       !------------------- 
    359       ! Layer coordinates  
    360       !------------------- 
    361       DO ji = kideb, kiut 
    362          zh_s(ji)  = ht_s_b(ji) / REAL( nlay_s ) 
    363          z_s(ji,0) =  0._wp 
     116            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji) 
     117         ENDDO 
    364118      ENDDO 
    365119 
    366       DO jk = 1, nlay_s 
     120      zqh_cum1(:,0:nlay_i) = 0._wp  
     121      ! new cumulative q*h => linear interpolation 
     122      DO jk0 = 1, nlay_i+1 
     123         DO jk1 = 1, nlay_i-1 
     124            DO ji = kideb, kiut 
     125               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN 
     126                  zqh_cum1(ji,jk1) = ( zqh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  & 
     127                     &                 zqh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  & 
     128                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) ) 
     129               ENDIF 
     130            ENDDO 
     131         ENDDO 
     132      ENDDO 
     133      ! to ensure that total heat content is strictly conserved, set: 
     134      zqh_cum1(:,nlay_i) = zqh_cum0(:,nlay_i+2)  
     135 
     136      ! new enthalpies 
     137      DO jk1 = 1, nlay_i 
    367138         DO ji = kideb, kiut 
    368             z_s(ji,jk) =  zh_s(ji) * REAL( jk ) 
    369          END DO 
    370       END DO 
    371  
    372       !----------------- 
    373       ! Layer thickness 
    374       !----------------- 
    375       DO layer0 = ntop0, maxnbot0 
    376          DO ji = kideb, kiut 
    377             zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1) 
    378          END DO 
    379       END DO 
    380  
    381       DO layer1 = ntop1, nbot1 
    382          DO ji = kideb, kiut 
    383             q_s_b(ji,layer1) = 0._wp 
    384          END DO 
    385       END DO 
    386  
    387       !---------------- 
    388       ! Weight factors 
    389       !---------------- 
    390       DO layer0 = ntop0, maxnbot0 
    391          DO layer1 = ntop1, nbot1 
    392             DO ji = kideb, kiut 
    393                zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 
    394                zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1))   & 
    395                   &                 - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10))  
    396                q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0)   & 
    397                   &                                * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    398             END DO 
    399          END DO 
    400       END DO 
    401  
    402       ! Heat conservation 
    403       zqts_fin(:) = 0._wp 
    404       DO jk = 1, nlay_s 
    405          DO ji = kideb, kiut 
    406             zqts_fin(ji) = zqts_fin(ji) + q_s_b(ji,jk) 
    407          END DO 
    408       END DO 
    409  
    410       IF ( con_i .AND. jiindex_1d > 0 ) THEN 
    411          DO ji = kideb, kiut 
    412             IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
    413                ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    414                ij                 = ( npb(ji) - 1 ) / jpi + 1 
    415                WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqts_in(ji) - zqts_fin(ji) ) * r1_rdtice 
    416                WRITE(numout,*) ' ji, jj   : ', ii, ij 
    417                WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji) 
    418                WRITE(numout,*) ' zqts_in  : ', zqts_in (ji) * r1_rdtice 
    419                WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) * r1_rdtice 
    420                WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji) 
    421                WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji) 
    422                WRITE(numout,*) ' snswi    : ', snswi(ji) 
    423             ENDIF 
    424          END DO 
    425       ENDIF 
    426  
    427       !--------------------- 
    428       ! Recover heat content 
    429       !--------------------- 
    430       DO jk = 1, nlay_s 
    431          DO ji = kideb, kiut 
    432             zinda = MAX( 0._wp, SIGN( 1._wp , zh_s(ji) - epsi10 ) )         
    433             q_s_b(ji,jk) = zinda * q_s_b(ji,jk) / MAX( zh_s(ji) , epsi10 ) 
    434          END DO !ji 
    435       END DO !jk   
    436  
    437       !--------------------- 
    438       ! Recover temperature 
    439       !--------------------- 
    440       zfac1 = 1. / ( rhosn * cpic ) 
    441       zfac2 = lfus / cpic   
    442       DO jk = 1, nlay_s 
    443          DO ji = kideb, kiut 
    444             zswitch = MAX ( 0.0 , SIGN ( 1.0, - ht_s_b(ji) ) ) 
    445             t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 ) 
    446          END DO 
    447       END DO 
    448       ! 
    449       !------------------------------------------------------------------------------| 
    450       !  4) Ice redistribution                                                       | 
    451       !------------------------------------------------------------------------------| 
    452       ! 
    453       !------------- 
    454       ! OLD PROFILE  
    455       !------------- 
    456  
    457       !---------------- 
    458       ! Vector indexes 
    459       !---------------- 
    460       ntop0    =  1 
    461       maxnbot0 =  0 
    462  
    463       DO ji = kideb, kiut 
    464          ! reference number of the bottommost layer 
    465          nbot0(ji) =  MAX( 1 ,  MIN( nlayi0 + ( 1 - icboind(ji) ) +        & 
    466             &                           ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) ) 
    467          ! maximum reference number of the bottommost layer over all domain 
    468          maxnbot0 =  MAX( maxnbot0 , nbot0(ji) ) 
    469       END DO 
    470  
    471       !------------------------- 
    472       ! Cotes of old ice layers 
    473       !------------------------- 
    474       zm0(:,0) =  0._wp 
    475  
    476       DO jk = 1, maxnbot0 
    477          DO ji = kideb, kiut 
    478             ! jk goes from 1 to nbot0 
    479             ! the ice layer number goes from 1 to nlay_i 
    480             ! limsum is the real ice layer number corresponding to present jk 
    481             limsum    =  ( (icsuswi(ji)*(icsuind(ji)+jk-1) + &  
    482                (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji) 
    483             zm0(ji,jk)=  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) & 
    484                +  REAL(limsum) * zh_i(ji) 
    485          END DO 
    486       END DO 
    487  
    488       DO ji = kideb, kiut 
    489          zm0(ji,nbot0(ji)) =  REAL(icsuswi(ji))*dh_i_surf(ji) + REAL(snicswi(ji))*dh_snowice(ji) + dh_i_bott(ji) & 
    490             +  zh_i(ji) * REAL(nlayi0) 
    491          zm0(ji,1)         =  REAL(snicswi(ji))*dh_snowice(ji) + REAL(1-snicswi(ji))*zm0(ji,1) 
    492       END DO 
    493  
    494       !----------------------------- 
    495       ! Thickness of old ice layers 
    496       !----------------------------- 
    497       DO jk = ntop0, maxnbot0 
    498          DO ji = kideb, kiut 
    499             zthick0(ji,jk) =  zm0(ji,jk) - zm0(ji,jk-1) 
    500          END DO 
    501       END DO 
    502  
    503       !--------------------------- 
    504       ! Inner layers heat content 
    505       !--------------------------- 
    506       qm0(:,:) =  0.0 
    507       zqti_in(:) = 0.0 
    508  
    509       DO jk = ntop0, maxnbot0 
    510          DO ji = kideb, kiut 
    511             limsum =  MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + & 
    512                (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i)) 
    513             ztmelts = -tmut * s_i_b(ji,limsum) + rtt 
    514             qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ & 
    515                MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) & 
    516                * zthick0(ji,jk) 
    517          END DO 
    518       END DO 
    519  
    520       !---------------------------- 
    521       ! Bottom layers heat content 
    522       !---------------------------- 
    523       DO ji = kideb, kiut         
    524          ztmelts    = REAL( 1 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice 
    525             &       +     REAL( icboswi(ji) ) * (-tmut * s_i_new(ji)        )   &   ! case of forming ice 
    526             &       + rtt                                                         ! in Kelvin 
    527  
    528          ! bottom formation temperature 
    529          ztform = t_i_b(ji,nlay_i) 
    530          IF(  num_sal == 2  )   ztform = t_bo_b(ji) 
    531          qm0(ji,nbot0(ji)) = REAL( 1 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice 
    532             &              + REAL( icboswi(ji) ) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice 
    533             + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) )      &  
    534             - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji)  ) 
    535       END DO 
    536  
    537       !----------------------------- 
    538       ! Snow ice layer heat content 
    539       !----------------------------- 
    540       DO ji = kideb, kiut 
    541          ! energy of the flooding seawater 
    542          zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * & 
    543             (rhoic - rhosn) / rhoic * REAL(snicswi(ji)) ! generally positive 
    544          ! Heat conservation diagnostic 
    545          qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic  
    546  
    547          qldif_1d(ji)   = qldif_1d(ji) + zqsnic * a_i_b(ji) 
    548  
    549          ! enthalpy of the newly formed snow-ice layer 
    550          ! = enthalpy of snow + enthalpy of frozen water 
    551          zqsnic         =  zqsnow(ji) + zqsnic 
    552          qm0(ji,1)      =  REAL(snicswi(ji)) * zqsnic + REAL( 1 - snicswi(ji) ) * qm0(ji,1) 
    553  
    554       END DO ! ji 
    555  
    556       DO jk = ntop0, maxnbot0 
    557          DO ji = kideb, kiut 
    558             ! Heat conservation 
    559             zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi10) ) & 
    560                &                                   * MAX( 0.0 , SIGN( 1. , REAL(nbot0(ji) - jk) ) ) 
    561          END DO 
    562       END DO 
    563  
    564       !------------- 
    565       ! NEW PROFILE 
    566       !------------- 
    567  
    568       !--------------- 
    569       ! Vectors index 
    570       !--------------- 
    571       ntop1 =  1  
    572       nbot1 =  nlay_i 
    573  
    574       !------------------ 
    575       ! Layers thickness  
    576       !------------------ 
    577       DO ji = kideb, kiut 
    578          zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 
     139            zswitch      = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zhnew(ji) + epsi10 ) )  
     140            qnew(ji,jk1) = zswitch * ( zqh_cum1(ji,jk1) - zqh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi10 ) 
     141         ENDDO 
    579142      ENDDO 
    580143 
    581       !------------- 
    582       ! Layer cotes       
    583       !------------- 
    584       z_i(:,0) =  0._wp 
    585       DO jk = 1, nlay_i 
    586          DO ji = kideb, kiut 
    587             z_i(ji,jk) =  zh_i(ji) * jk 
    588          END DO 
     144      ! --- diag error on heat remapping --- ! 
     145      ! comment: if input h_i_old and qh_i_old are already multiplied by a_i (as in limthd_lac),  
     146      ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 
     147      DO ji = kideb, kiut 
     148         hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_rdtice *  & 
     149            &               ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( qh_i_old(ji,0:nlay_i+1) ) )  
    589150      END DO 
    590  
    591       !--thicknesses of the layers 
    592       DO layer0 = ntop0, maxnbot0 
    593          DO ji = kideb, kiut 
    594             zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1)   ! thicknesses of the layers 
    595          END DO 
    596       END DO 
    597  
    598       !------------------------ 
    599       ! Weights for relayering 
    600       !------------------------ 
    601       q_i_b(:,:) = 0._wp 
    602       DO layer0 = ntop0, maxnbot0 
    603          DO layer1 = ntop1, nbot1 
    604             DO ji = kideb, kiut 
    605                zinda = MAX( 0._wp, SIGN( 1._wp , zhl0(ji,layer0) - epsi10 ) ) 
    606                zrl01(layer1,layer0) = zinda * MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) & 
    607                   - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10)) 
    608                q_i_b(ji,layer1) = q_i_b(ji,layer1) &  
    609                   + zrl01(layer1,layer0)*qm0(ji,layer0) & 
    610                   * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi10)) & 
    611                   * MAX(0.0,SIGN(1.0,REAL(nbot0(ji)-layer0))) 
    612             END DO 
    613          END DO 
    614       END DO 
    615  
    616       !------------------------- 
    617       ! Heat conservation check 
    618       !------------------------- 
    619       zqti_fin(:) = 0._wp 
    620       DO jk = 1, nlay_i 
    621          DO ji = kideb, kiut 
    622             zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) 
    623          END DO 
    624       END DO 
     151       
    625152      ! 
    626       IF ( con_i .AND. jiindex_1d > 0 ) THEN 
    627          DO ji = kideb, kiut 
    628             IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice  >  1.0e-6 ) THEN 
    629                ii                 = MOD( npb(ji) - 1, jpi ) + 1 
    630                ij                 = ( npb(ji) - 1 ) / jpi + 1 
    631                WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) * r1_rdtice 
    632                WRITE(numout,*) ' ji, jj   : ', ii, ij 
    633                WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji) 
    634                WRITE(numout,*) ' zqti_in  : ', zqti_in (ji) * r1_rdtice 
    635                WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) * r1_rdtice 
    636                WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji) 
    637                WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji) 
    638                WRITE(numout,*) ' dh_snowice:', dh_snowice(ji) 
    639                WRITE(numout,*) ' icsuswi  : ', icsuswi(ji) 
    640                WRITE(numout,*) ' icboswi  : ', icboswi(ji) 
    641                WRITE(numout,*) ' snicswi  : ', snicswi(ji) 
    642             ENDIF 
    643          END DO 
    644       ENDIF 
    645  
    646       !---------------------- 
    647       ! Recover heat content  
    648       !---------------------- 
    649       DO jk = 1, nlay_i 
    650          DO ji = kideb, kiut 
    651             zinda = MAX( 0._wp, SIGN( 1._wp , zh_i(ji) - epsi10 ) ) 
    652             q_i_b(ji,jk) = zinda * q_i_b(ji,jk) / MAX( zh_i(ji) , epsi10 ) 
    653          END DO !ji 
    654       END DO !jk   
    655  
    656       ! Heat conservation 
    657       zqti_fin(:) = 0.0 
    658       DO jk = 1, nlay_i 
    659          DO ji = kideb, kiut 
    660             zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) * zh_i(ji) 
    661          END DO 
    662       END DO 
    663  
    664       ! 
    665       !------------------------------------------------------------------------------| 
    666       !  5) Update salinity and recover temperature                                  | 
    667       !------------------------------------------------------------------------------| 
    668       ! 
    669       ! Update salinity (basal entrapment, snow ice formation) 
    670       DO ji = kideb, kiut 
    671          sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
    672       END DO !ji 
    673  
    674       ! Recover temperature 
    675       DO jk = 1, nlay_i 
    676          DO ji = kideb, kiut 
    677             ztmelts    =  -tmut*s_i_b(ji,jk) + rtt 
    678             !Conversion q(S,T) -> T (second order equation) 
    679             zaaa         =  cpic 
    680             zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 
    681             zccc         =  lfus * ( ztmelts - rtt ) 
    682             zdiscrim     =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) ) 
    683             t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 
    684          END DO !ji 
    685  
    686       END DO !jk 
    687       ! 
    688       CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind )   ! integer 
    689       CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin )           ! real 
    690       CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 ) 
    691       CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 ) 
     153      CALL wrk_dealloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 
     154      CALL wrk_dealloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 
     155      CALL wrk_dealloc( jpij, zhnew ) 
    692156      ! 
    693157   END SUBROUTINE lim_thd_ent 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r4333 r4921  
    2929   USE lib_mpp        ! MPP library 
    3030   USE wrk_nemo       ! work arrays 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3132   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     33   USE limthd_ent 
    3234 
    3335   IMPLICIT NONE 
    … …  
    3739 
    3840   REAL(wp) ::   epsi10 = 1.e-10_wp   ! 
    39    REAL(wp) ::   zzero  = 0._wp      ! 
    40    REAL(wp) ::   zone   = 1._wp      ! 
     41   REAL(wp) ::   epsi20 = 1.e-20_wp   ! 
    4142 
    4243   !!---------------------------------------------------------------------- 
    … …  
    7172      !!             - Computation of variation of ice volume and mass 
    7273      !!             - Computation of frldb after lateral accretion and  
    73       !!               update ht_s_b, ht_i_b and tbif_1d(:,:)       
     74      !!               update ht_s_1d, ht_i_1d and tbif_1d(:,:)       
    7475      !!------------------------------------------------------------------------ 
    75       INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices 
    76       INTEGER ::   layer, nbpac     ! local integers  
    77       INTEGER ::   ii, ij, iter   !   -       - 
    78       REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zinda, zde  ! local scalars 
     76      INTEGER ::   ji,jj,jk,jl      ! dummy loop indices 
     77      INTEGER ::   nbpac            ! local integers  
     78      INTEGER ::   ii, ij, iter     !   -       - 
     79      REAL(wp)  ::   ztmelts, zdv, zfrazb, zweight, zindb, zinda, zde  ! local scalars 
    7980      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      - 
    8081      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    8182      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness 
    8283      CHARACTER (len = 15) :: fieldid 
    83       ! 
    84       INTEGER , POINTER, DIMENSION(:) ::   zcatac      ! indexes of categories where new ice grows 
     84 
     85      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
     86      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg) 
     87      REAL(wp) ::   zEw          ! seawater specific enthalpy (J/kg) 
     88      REAL(wp) ::   zfmdt        ! mass flux x time step (kg/m2, >0 towards ocean) 
     89      
     90      REAL(wp) ::   zv_newfra 
     91   
     92      INTEGER , POINTER, DIMENSION(:) ::   jcat        ! indexes of categories where new ice grows 
    8593      REAL(wp), POINTER, DIMENSION(:) ::   zswinew     ! switch for new ice or not 
    8694 
    … …  
    93101      REAL(wp), POINTER, DIMENSION(:) ::   zdv_res     ! residual volume in case of excessive heat budget 
    94102      REAL(wp), POINTER, DIMENSION(:) ::   zda_res     ! residual area in case of excessive heat budget 
    95       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_ac    ! total ice fraction     
    96       REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)    
    97       REAL(wp), POINTER, DIMENSION(:) ::   zdh_frazb   ! accretion of frazil ice at the ice bottom 
    98       REAL(wp), POINTER, DIMENSION(:) ::   zvrel_ac    ! relative ice / frazil velocity (1D vector) 
    99  
    100       REAL(wp), POINTER, DIMENSION(:,:) ::   zhice_old   ! previous ice thickness 
    101       REAL(wp), POINTER, DIMENSION(:,:) ::   zdummy      ! dummy thickness of new ice  
    102       REAL(wp), POINTER, DIMENSION(:,:) ::   zdhicbot    ! thickness of new ice which is accreted vertically 
    103       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl 
    104       REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl 
    105       REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_ac     ! 1-D version of a_i 
    106       REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_ac     ! 1-D version of v_i 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_ac    ! 1-D version of oa_i 
    108       REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_ac   ! 1-D version of smv_i 
    109  
    110       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_ac   !: 1-D version of e_i 
    111  
    112       REAL(wp), POINTER, DIMENSION(:) ::   zqbgow    ! heat budget of the open water (negative) 
    113       REAL(wp), POINTER, DIMENSION(:) ::   zdhex     ! excessively thick accreted sea ice (hlead-hice) 
    114  
    115       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqm0      ! old layer-system heat content 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zthick0   ! old ice thickness 
    117  
    118       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final   ! ice volume summed over categories 
    119       REAL(wp), POINTER, DIMENSION(:,:) ::   vt_s_init, vt_s_final   !  snow volume summed over categories 
    120       REAL(wp), POINTER, DIMENSION(:,:) ::   et_i_init, et_i_final   !  ice energy summed over categories 
    121       REAL(wp), POINTER, DIMENSION(:,:) ::   et_s_init               !  snow energy summed over categories 
     103      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_1d    ! total ice fraction     
     104      REAL(wp), POINTER, DIMENSION(:) ::   zv_frazb    ! accretion of frazil ice at the ice bottom 
     105      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector) 
     106 
     107      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_b      ! old volume of ice in category jl 
     108      REAL(wp), POINTER, DIMENSION(:,:) ::   za_b      ! old area of ice in category jl 
     109      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_1d   ! 1-D version of a_i 
     110      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_1d   ! 1-D version of v_i 
     111      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_1d  ! 1-D version of oa_i 
     112      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_1d ! 1-D version of smv_i 
     113 
     114      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_1d !: 1-D version of e_i 
     115 
    122116      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity 
    123117      !!-----------------------------------------------------------------------! 
    124118 
    125       CALL wrk_alloc( jpij, zcatac )   ! integer 
     119      CALL wrk_alloc( jpij, jcat )   ! integer 
    126120      CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    127       CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    128       CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    129       CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac ) 
    130       CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
    131       CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 
    132  
    133       et_i_init(:,:) = 0._wp 
    134       et_s_init(:,:) = 0._wp 
    135       vt_i_init(:,:) = 0._wp 
    136       vt_s_init(:,:) = 0._wp 
    137  
    138       !------------------------------------------------------------------------------! 
    139       ! 1) Conservation check and changes in each ice category 
    140       !------------------------------------------------------------------------------! 
    141       IF( con_i ) THEN 
    142          CALL lim_column_sum        ( jpl, v_i          , vt_i_init) 
    143          CALL lim_column_sum        ( jpl, v_s          , vt_s_init) 
    144          CALL lim_column_sum_energy ( jpl, nlay_i , e_i , et_i_init) 
    145          CALL lim_column_sum        ( jpl, e_s(:,:,1,:) , et_s_init) 
    146       ENDIF 
     121      CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
     122      CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
     123      CALL wrk_alloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     124      CALL wrk_alloc( jpi,jpj, zvrel ) 
    147125 
    148126      !------------------------------------------------------------------------------| 
    … …  
    154132               DO ji = 1, jpi 
    155133                  !Energy of melting q(S,T) [J.m-3] 
    156                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * REAL( nlay_i ) 
    157134                  zindb = 1._wp - MAX(  0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 )  )   !0 if no ice and 1 if yes 
    158                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
     135                  e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) ,  epsi10 ) ) * REAL( nlay_i, wp ) 
     136                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 
    159137               END DO 
    160138            END DO 
    … …  
    179157 
    180158      ! Default new ice thickness  
    181       hicol(:,:) = hiccrit(1) 
    182  
    183       IF( fraz_swi == 1._wp ) THEN 
     159      hicol(:,:) = hiccrit 
     160 
     161      IF( fraz_swi == 1 ) THEN 
    184162 
    185163         !-------------------- 
    … …  
    193171         zgamafr = 0.03 
    194172 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197  
    198                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN 
     173         DO jj = 2, jpj 
     174            DO ji = 2, jpi 
     175               IF ( qlead(ji,jj) < 0._wp ) THEN 
    199176                  !------------- 
    200177                  ! Wind stress 
    … …  
    206183                     &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) * 0.5_wp 
    207184                  ! Square root of wind stress 
    208                   ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     185                  ztenagm       =  SQRT( SQRT( ztaux**2 + ztauy**2 ) ) 
    209186 
    210187                  !--------------------- 
    211188                  ! Frazil ice velocity 
    212189                  !--------------------- 
    213                   zvfrx         = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10) 
    214                   zvfry         = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10) 
     190                  zindb = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
     191                  zvfrx = zindb * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
     192                  zvfry = zindb * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
    215193 
    216194                  !------------------- 
    … …  
    264242            END DO ! loop on ji ends 
    265243         END DO ! loop on jj ends 
     244      !  
     245      CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 
     246      CALL lbc_lnk( hicol(:,:), 'T', 1. ) 
    266247 
    267248      ENDIF ! End of computation of frazil ice collection thickness 
    … …  
    276257      ! This occurs if open water energy budget is negative 
    277258      nbpac = 0 
     259      npac(:) = 0 
     260      ! 
    278261      DO jj = 1, jpj 
    279262         DO ji = 1, jpi 
    280             IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     263            IF ( qlead(ji,jj)  <  0._wp ) THEN 
    281264               nbpac = nbpac + 1 
    282265               npac( nbpac ) = (jj - 1) * jpi + ji 
    … …  
    290273         DO ji = mi0(jiindx), mi1(jiindx) 
    291274            DO jj = mj0(jjindx), mj1(jjindx) 
    292                IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) )  >  0._wp ) THEN 
     275               IF ( qlead(ji,jj)  <  0._wp ) THEN 
    293276                  jiindex_1d = (jj - 1) * jpi + ji 
    294277               ENDIF 
    … …  
    307290      IF ( nbpac > 0 ) THEN 
    308291 
    309          CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
     292         CALL tab_2d_1d( nbpac, zat_i_1d  (1:nbpac)     , at_i         , jpi, jpj, npac(1:nbpac) ) 
    310293         DO jl = 1, jpl 
    311             CALL tab_2d_1d( nbpac, za_i_ac  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    312             CALL tab_2d_1d( nbpac, zv_i_ac  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    313             CALL tab_2d_1d( nbpac, zoa_i_ac (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    314             CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     294            CALL tab_2d_1d( nbpac, za_i_1d  (1:nbpac,jl), a_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     295            CALL tab_2d_1d( nbpac, zv_i_1d  (1:nbpac,jl), v_i  (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     296            CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 
     297            CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 
    315298            DO jk = 1, nlay_i 
    316                CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
     299               CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 
    317300            END DO ! jk 
    318301         END DO ! jl 
    319302 
    320          CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif  , jpi, jpj, npac(1:nbpac) ) 
    321          CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif  , jpi, jpj, npac(1:nbpac) ) 
    322          CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
    323          CALL tab_2d_1d( nbpac, sfx_thd_1d(1:nbpac)     , sfx_thd, jpi, jpj, npac(1:nbpac) ) 
    324          CALL tab_2d_1d( nbpac, rdm_ice_1d(1:nbpac)     , rdm_ice, jpi, jpj, npac(1:nbpac) ) 
    325          CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
    326          CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     303         CALL tab_2d_1d( nbpac, qlead_1d  (1:nbpac)     , qlead  , jpi, jpj, npac(1:nbpac) ) 
     304         CALL tab_2d_1d( nbpac, t_bo_1d   (1:nbpac)     , t_bo   , jpi, jpj, npac(1:nbpac) ) 
     305         CALL tab_2d_1d( nbpac, sfx_opw_1d(1:nbpac)     , sfx_opw, jpi, jpj, npac(1:nbpac) ) 
     306         CALL tab_2d_1d( nbpac, wfx_opw_1d(1:nbpac)     , wfx_opw, jpi, jpj, npac(1:nbpac) ) 
     307         CALL tab_2d_1d( nbpac, hicol_1d  (1:nbpac)     , hicol  , jpi, jpj, npac(1:nbpac) ) 
     308         CALL tab_2d_1d( nbpac, zvrel_1d  (1:nbpac)     , zvrel  , jpi, jpj, npac(1:nbpac) ) 
     309 
     310         CALL tab_2d_1d( nbpac, hfx_thd_1d(1:nbpac)     , hfx_thd, jpi, jpj, npac(1:nbpac) ) 
     311         CALL tab_2d_1d( nbpac, hfx_opw_1d(1:nbpac)     , hfx_opw, jpi, jpj, npac(1:nbpac) ) 
    327312 
    328313         !------------------------------------------------------------------------------! 
    … …  
    330315         !------------------------------------------------------------------------------! 
    331316 
     317         !----------------------------------------- 
     318         ! Keep old ice areas and volume in memory 
     319         !----------------------------------------- 
     320         zv_b(1:nbpac,:) = zv_i_1d(1:nbpac,:)  
     321         za_b(1:nbpac,:) = za_i_1d(1:nbpac,:) 
    332322         !---------------------- 
    333323         ! Thickness of new ice 
    334324         !---------------------- 
    335325         DO ji = 1, nbpac 
    336             zh_newice(ji) = hiccrit(1) 
    337          END DO 
    338          IF( fraz_swi == 1.0 )   zh_newice(:) = hicol_b(:) 
     326            zh_newice(ji) = hiccrit 
     327         END DO 
     328         IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_1d(1:nbpac) 
    339329 
    340330         !---------------------- 
    341331         ! Salinity of new ice  
    342332         !---------------------- 
    343  
    344333         SELECT CASE ( num_sal ) 
    345334         CASE ( 1 )                    ! Sice = constant  
    346             zs_newice(:) = bulk_sal 
     335            zs_newice(1:nbpac) = bulk_sal 
    347336         CASE ( 2 )                    ! Sice = F(z,t) [Vancoppenolle et al (2005)] 
    348337            DO ji = 1, nbpac 
    … …  
    352341            END DO 
    353342         CASE ( 3 )                    ! Sice = F(z) [multiyear ice] 
    354             zs_newice(:) =   2.3 
     343            zs_newice(1:nbpac) =   2.3 
    355344         END SELECT 
    356  
    357345 
    358346         !------------------------- 
    … …  
    362350         DO ji = 1, nbpac 
    363351            ztmelts       = - tmut * zs_newice(ji) + rtt                  ! Melting point (K) 
    364             ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             & 
    365                &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   & 
     352            ze_newice(ji) =   rhoic * (  cpic * ( ztmelts - t_bo_1d(ji) )                             & 
     353               &                       + lfus * ( 1.0 - ( ztmelts - rtt ) / MIN( t_bo_1d(ji) - rtt, -epsi10 ) )   & 
    366354               &                       - rcp  *         ( ztmelts - rtt )  ) 
    367             ze_newice(ji) =   MAX( ze_newice(ji) , 0._wp )    & 
    368                &          +   MAX(  0.0 , SIGN( 1.0 , - ze_newice(ji) )  ) * rhoic * lfus 
    369355         END DO ! ji 
     356 
    370357         !---------------- 
    371358         ! Age of new ice 
    … …  
    375362         END DO ! ji 
    376363 
    377          !-------------------------- 
    378          ! Open water energy budget  
    379          !-------------------------- 
    380          DO ji = 1, nbpac 
    381             zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)     !<0 
    382          END DO ! ji 
    383  
    384364         !------------------- 
    385365         ! Volume of new ice 
    386366         !------------------- 
    387367         DO ji = 1, nbpac 
    388             zv_newice(ji) = - zqbgow(ji) / ze_newice(ji) 
     368 
     369            zEi           = - ze_newice(ji) / rhoic                ! specific enthalpy of forming ice [J/kg] 
     370 
     371            zEw           = rcp * ( t_bo_1d(ji) - rt0 )             ! specific enthalpy of seawater at t_bo_1d [J/kg] 
     372                                                                   ! clem: we suppose we are already at the freezing point (condition qlead<0 is satisfyied)  
     373                                                                    
     374            zdE           = zEi - zEw                              ! specific enthalpy difference [J/kg] 
     375                                               
     376            zfmdt         = - qlead_1d(ji) / zdE                   ! Fm.dt [kg/m2] (<0)  
     377                                                                   ! clem: we use qlead instead of zqld (limthd) because we suppose we are at the freezing point    
     378            zv_newice(ji) = - zfmdt / rhoic 
     379 
     380            zQm           = zfmdt * zEw                            ! heat to the ocean >0 associated with mass flux   
     381 
     382            ! Contribution to heat flux to the ocean [W.m-2], >0   
     383            hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * zEw * r1_rdtice 
     384            ! Total heat flux used in this process [W.m-2]   
     385            hfx_opw_1d(ji) = hfx_opw_1d(ji) - zfmdt * zdE * r1_rdtice 
     386            ! mass flux 
     387            wfx_opw_1d(ji) = wfx_opw_1d(ji) - zv_newice(ji) * rhoic * r1_rdtice 
     388            ! salt flux 
     389            sfx_opw_1d(ji) = sfx_opw_1d(ji) - zv_newice(ji) * rhoic * zs_newice(ji) * r1_rdtice 
    389390 
    390391            ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    391             zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
    392             zdh_frazb(ji) =         zfrazb   * zv_newice(ji) 
     392            zinda         = 1._wp - MAX( 0._wp, SIGN( 1._wp , - zat_i_1d(ji) ) ) 
     393            zfrazb        = zinda * ( TANH ( Cfrazb * ( zvrel_1d(ji) - vfrazb ) ) + 1.0 ) * 0.5 * maxfrazb 
     394            zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
    393395            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    394396         END DO 
    395  
    396          !------------------------------------ 
    397          ! Diags for energy conservation test 
    398          !------------------------------------ 
    399          DO ji = 1, nbpac 
    400             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    401             ij =    ( npac(ji) - 1 ) / jpi + 1 
    402             ! 
    403             zde = ze_newice(ji) / unit_fac * area(ii,ij) * zv_newice(ji) 
    404             ! 
    405             vt_i_init(ii,ij) = vt_i_init(ii,ij) + zv_newice(ji)             ! volume 
    406             et_i_init(ii,ij) = et_i_init(ii,ij) + zde                       ! Energy 
    407  
    408          END DO 
    409  
    410          ! keep new ice volume in memory 
    411          CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , jpi, jpj ) 
    412397 
    413398         !----------------- 
    … …  
    415400         !----------------- 
    416401         DO ji = 1, nbpac 
    417             ii = MOD( npac(ji) - 1 , jpi ) + 1 
    418             ij =    ( npac(ji) - 1 ) / jpi + 1 
    419402            za_newice(ji) = zv_newice(ji) / zh_newice(ji) 
    420             diag_lat_gr(ii,ij) = diag_lat_gr(ii,ij) + zv_newice(ji) * r1_rdtice ! clem 
    421          END DO !ji 
     403         END DO 
    422404 
    423405         !------------------------------------------------------------------------------! 
    … …  
    425407         !------------------------------------------------------------------------------! 
    426408 
    427          !----------------------------------------- 
    428          ! Keep old ice areas and volume in memory 
    429          !----------------------------------------- 
    430          zv_old(:,:) = zv_i_ac(:,:)  
    431          za_old(:,:) = za_i_ac(:,:) 
    432  
    433          !------------------------------------------- 
    434          ! Compute excessive new ice area and volume 
    435          !------------------------------------------- 
     409         !------------------------ 
     410         ! 6.1) lateral ice growth 
     411         !------------------------ 
    436412         ! If lateral ice growth gives an ice concentration gt 1, then 
    437413         ! we keep the excessive volume in memory and attribute it later to bottom accretion 
    438414         DO ji = 1, nbpac 
    439             IF ( za_newice(ji) >  ( amax - zat_i_ac(ji) ) ) THEN 
    440                zda_res(ji)   = za_newice(ji) - ( amax - zat_i_ac(ji) ) 
     415            IF ( za_newice(ji) >  ( amax - zat_i_1d(ji) ) ) THEN 
     416               zda_res(ji)   = za_newice(ji) - ( amax - zat_i_1d(ji) ) 
    441417               zdv_res(ji)   = zda_res  (ji) * zh_newice(ji)  
    442418               za_newice(ji) = za_newice(ji) - zda_res  (ji) 
    … …  
    446422               zdv_res(ji) = 0._wp 
    447423            ENDIF 
    448          END DO ! ji 
    449  
    450          !------------------------------------------------ 
    451          ! Laterally redistribute new ice volume and area 
    452          !------------------------------------------------ 
    453          zat_i_ac(:) = 0._wp 
     424         END DO 
     425 
     426         ! find which category to fill 
     427         zat_i_1d(:) = 0._wp 
    454428         DO jl = 1, jpl 
    455429            DO ji = 1, nbpac 
    456                IF(  hi_max   (jl-1)  <   zh_newice(ji)   .AND.   & 
    457                   & zh_newice(ji)    <=  hi_max   (jl)         ) THEN 
    458                   za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji) 
    459                   zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji) 
    460                   zat_i_ac(ji)    = zat_i_ac(ji)    + za_i_ac  (ji,jl) 
    461                   zcatac  (ji)    = jl 
     430               IF( zh_newice(ji) > hi_max(jl-1) .AND. zh_newice(ji) <= hi_max(jl) ) THEN 
     431                  za_i_1d (ji,jl) = za_i_1d (ji,jl) + za_newice(ji) 
     432                  zv_i_1d (ji,jl) = zv_i_1d (ji,jl) + zv_newice(ji) 
     433                  jcat    (ji)    = jl 
    462434               ENDIF 
    463             END DO 
    464          END DO 
    465  
    466          !---------------------------------- 
    467          ! Heat content - lateral accretion 
    468          !---------------------------------- 
    469          DO ji = 1, nbpac 
    470             jl = zcatac(ji)                                                           ! categroy in which new ice is put 
    471             zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) + epsi10 ) )             ! zindb=1 if ice =0 otherwise 
    472             zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness 
    473             zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness 
    474             zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi10 ) )   ! ice totally new in jl category 
     435               zat_i_1d(ji) = zat_i_1d(ji) + za_i_1d  (ji,jl) 
     436            END DO 
     437         END DO 
     438 
     439         ! Heat content 
     440         DO ji = 1, nbpac 
     441            jl = jcat(ji)                                                    ! categroy in which new ice is put 
     442            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_b(ji,jl) ) )   ! 0 if old ice 
    475443         END DO 
    476444 
    477445         DO jk = 1, nlay_i 
    478446            DO ji = 1, nbpac 
    479                jl = zcatac(ji) 
    480                zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ] 
    481                zalphai = MIN( zhice_old(ji,jl) * REAL( jk )     / REAL( nlay_i ), zh_newice(ji) )   & 
    482                   &    - MIN( zhice_old(ji,jl) * REAL( jk - 1 ) / REAL( nlay_i ), zh_newice(ji) ) 
    483                ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     & 
    484                   + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / REAL( nlay_i )  & 
    485                   + za_newice(ji)  * ze_newice(ji) * zalphai                                       & 
    486                   + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / REAL( nlay_i ) ) / ( ( zv_i_ac(ji,jl) ) / REAL( nlay_i ) ) 
    487             END DO 
    488          END DO 
    489  
    490          !----------------------------------------------- 
    491          ! Add excessive volume of new ice at the bottom 
    492          !----------------------------------------------- 
    493          ! If the ice concentration exceeds 1, the remaining volume of new ice 
    494          ! is equally redistributed among all ice categories in which there is 
    495          ! ice 
    496  
    497          ! Fraction of level ice 
    498          jm = 1 
    499          zat_i_lev(:) = 0._wp 
    500  
    501          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    502             DO ji = 1, nbpac 
    503                zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl)  
    504             END DO 
    505          END DO 
    506  
    507          IF( ln_nicep .AND. jiindex_1d > 0 ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    508          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    509             DO ji = 1, nbpac 
    510                zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) ) 
    511                zinda = MAX( 0._wp, SIGN( 1._wp , zat_i_lev(ji) - epsi10 ) )  ! clem 
    512                zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zinda * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi10 ) 
    513             END DO 
    514          END DO 
    515          IF( ln_nicep .AND. jiindex_1d > 0 )   WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindex_1d, 1:jpl) 
    516  
    517          !--------------------------------- 
    518          ! Heat content - bottom accretion 
    519          !--------------------------------- 
    520          jm = 1 
    521          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    522             DO ji = 1, nbpac 
    523                zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) + epsi10 ) )       ! zindb=1 if ice =0 otherwise 
    524                zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb 
    525                zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    & 
    526                   &             +  zindb * zdh_frazb(ji)                               ! frazil ice may coalesce 
    527                zdummy(ji,jl)    = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb      ! thickness of residual ice 
    528             END DO 
    529          END DO 
    530  
    531          ! old layers thicknesses and enthalpies 
    532          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     447               jl = jcat(ji) 
     448               zinda = MAX( 0._wp, SIGN( 1._wp , zv_i_1d(ji,jl) - epsi20 ) ) 
     449               ze_i_1d(ji,jk,jl) = zswinew(ji)   *   ze_newice(ji) +                                                      & 
     450                  &        ( 1.0 - zswinew(ji) ) * ( ze_newice(ji) * zv_newice(ji) + ze_i_1d(ji,jk,jl) * zv_b(ji,jl) )  & 
     451                  &        * zinda / MAX( zv_i_1d(ji,jl), epsi20 ) 
     452            END DO 
     453         END DO 
     454 
     455         !------------------------------------------------ 
     456         ! 6.2) bottom ice growth + ice enthalpy remapping 
     457         !------------------------------------------------ 
     458         DO jl = 1, jpl 
     459 
     460            ! for remapping 
     461            h_i_old (1:nbpac,0:nlay_i+1) = 0._wp 
     462            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 
    533463            DO jk = 1, nlay_i 
    534464               DO ji = 1, nbpac 
    535                   zthick0(ji,jk,jl) =  zhice_old(ji,jl) / REAL( nlay_i ) 
    536                   zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl) 
     465                  h_i_old (ji,jk) = zv_i_1d(ji,jl) / REAL( nlay_i ) 
     466                  qh_i_old(ji,jk) = ze_i_1d(ji,jk,jl) * h_i_old(ji,jk) 
    537467               END DO 
    538468            END DO 
    539          END DO 
    540 !!gm ???  why the previous do loop  if ocerwriten by the following one ? 
    541          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
     469 
     470            ! new volumes including lateral/bottom accretion + residual 
    542471            DO ji = 1, nbpac 
    543                zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl) 
    544                zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji) * zdhicbot(ji,jl) 
    545             END DO ! ji 
    546          END DO ! jl 
    547  
    548          ! Redistributing energy on the new grid 
    549          ze_i_ac(:,:,:) = 0._wp 
    550          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    551             DO jk = 1, nlay_i 
    552                DO layer = 1, nlay_i + 1 
    553                   DO ji = 1, nbpac 
    554                      zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  
    555                      ! Redistributing energy on the new grid 
    556                      zweight = MAX (  MIN( zhice_old(ji,jl) * REAL( layer ), zdummy(ji,jl) * REAL( jk ) )   & 
    557                         &    - MAX( zhice_old(ji,jl) * REAL( layer - 1 ) , zdummy(ji,jl) * REAL( jk - 1 ) ) , 0._wp )   & 
    558                         &    /( MAX(REAL(nlay_i) * zthick0(ji,layer,jl),epsi10) ) * zindb 
    559                      ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)   
    560                   END DO ! ji 
    561                END DO ! layer 
    562             END DO ! jk 
    563          END DO ! jl 
    564  
    565          DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 
    566             DO jk = 1, nlay_i 
    567                DO ji = 1, nbpac 
    568                   zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  
    569                   ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   & 
    570                      &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * REAL( nlay_i ) * zindb 
    571                END DO 
    572             END DO 
    573          END DO 
     472               zinda          = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 
     473               zv_newfra      = zinda * ( zdv_res(ji) + zv_frazb(ji) ) * za_i_1d(ji,jl) / MAX( zat_i_1d(ji) , epsi20 ) 
     474               za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl)                
     475               zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 
     476               ! for remapping 
     477               h_i_old (ji,nlay_i+1) = zv_newfra 
     478               qh_i_old(ji,nlay_i+1) = ze_newice(ji) * zv_newfra 
     479            ENDDO 
     480 
     481            ! --- Ice enthalpy remapping --- ! 
     482            CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) )  
     483         ENDDO 
    574484 
    575485         !------------ 
    … …  
    578488         DO jl = 1, jpl 
    579489            DO ji = 1, nbpac 
    580                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    581                zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    
     490               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_1d(ji,jl) + epsi20 ) )  ! 0 if no ice and 1 if yes 
     491               zoa_i_1d(ji,jl)  = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * zindb    
    582492            END DO  
    583493         END DO    
    … …  
    586496         ! Update salinity 
    587497         !----------------- 
    588          !clem IF(  num_sal == 2  ) THEN 
    589             DO jl = 1, jpl 
    590                DO ji = 1, nbpac 
    591                   zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    592                   zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    593                   zsmv_i_ac(ji,jl) = zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) * zindb ! clem modif 
    594                END DO 
    595             END DO    
    596          !clem ENDIF 
    597  
    598          !-------------------------------- 
    599          ! Update mass/salt fluxes (clem) 
    600          !-------------------------------- 
    601498         DO jl = 1, jpl 
    602499            DO ji = 1, nbpac 
    603                zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) + epsi10 ) )  ! 0 if no ice and 1 if yes 
    604                zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl) 
    605                rdm_ice_1d(ji) = rdm_ice_1d(ji) + zdv * rhoic * zindb 
    606                sfx_thd_1d(ji)   =   sfx_thd_1d(ji) - zdv * rhoic * zs_newice(ji) * r1_rdtice * zindb 
    607            END DO 
     500               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl) 
     501               zsmv_i_1d(ji,jl) = zsmv_i_1d(ji,jl) + zdv * zs_newice(ji) 
     502            END DO 
    608503         END DO 
    609504 
    610505         !------------------------------------------------------------------------------! 
    611          ! 8) Change 2D vectors to 1D vectors  
     506         ! 7) Change 2D vectors to 1D vectors  
    612507         !------------------------------------------------------------------------------! 
    613508         DO jl = 1, jpl 
    614             CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj ) 
    615             CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj ) 
    616             CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj ) 
    617             !clem IF (  num_sal == 2  )   & 
    618                CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj ) 
     509            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 
     510            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 
     511            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj ) 
     512            CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 
    619513            DO jk = 1, nlay_i 
    620                CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj ) 
    621             END DO 
    622          END DO 
    623          CALL tab_1d_2d( nbpac, sfx_thd, npac(1:nbpac), sfx_thd_1d(1:nbpac), jpi, jpj ) 
    624          CALL tab_1d_2d( nbpac, rdm_ice, npac(1:nbpac), rdm_ice_1d(1:nbpac), jpi, jpj ) 
     514               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_1d(1:nbpac,jk,jl), jpi, jpj ) 
     515            END DO 
     516         END DO 
     517         CALL tab_1d_2d( nbpac, sfx_opw, npac(1:nbpac), sfx_opw_1d(1:nbpac), jpi, jpj ) 
     518         CALL tab_1d_2d( nbpac, wfx_opw, npac(1:nbpac), wfx_opw_1d(1:nbpac), jpi, jpj ) 
     519 
     520         CALL tab_1d_2d( nbpac, hfx_thd, npac(1:nbpac), hfx_thd_1d(1:nbpac), jpi, jpj ) 
     521         CALL tab_1d_2d( nbpac, hfx_opw, npac(1:nbpac), hfx_opw_1d(1:nbpac), jpi, jpj ) 
    625522         ! 
    626523      ENDIF ! nbpac > 0 
    627524 
    628525      !------------------------------------------------------------------------------! 
    629       ! 9) Change units for e_i 
     526      ! 8) Change units for e_i 
    630527      !------------------------------------------------------------------------------!     
    631528      DO jl = 1, jpl 
    632          DO jk = 1, nlay_i          ! heat content in 10^9 Joules 
    633             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / REAL( nlay_i )  / unit_fac  
     529         DO jk = 1, nlay_i 
     530            DO jj = 1, jpj 
     531               DO ji = 1, jpi 
     532                  ! heat content in Joules 
     533                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac )  
     534               END DO 
     535            END DO 
    634536         END DO 
    635537      END DO 
    636538 
    637       !------------------------------------------------------------------------------| 
    638       ! 10) Conservation check and changes in each ice category 
    639       !------------------------------------------------------------------------------| 
    640       IF( con_i ) THEN  
    641          CALL lim_column_sum (jpl,   v_i, vt_i_final) 
    642          fieldid = 'v_i, limthd_lac' 
    643          CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid)  
    644          ! 
    645          CALL lim_column_sum_energy(jpl, nlay_i, e_i, et_i_final) 
    646          fieldid = 'e_i, limthd_lac' 
    647          CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid)  
    648          ! 
    649          CALL lim_column_sum (jpl,   v_s, vt_s_final) 
    650          fieldid = 'v_s, limthd_lac' 
    651          CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    652          ! 
    653          !     CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init) 
    654          !     fieldid = 'e_s, limthd_lac' 
    655          !     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid)  
    656          IF( ln_nicep ) THEN 
    657             DO ji = mi0(jiindx), mi1(jiindx) 
    658                DO jj = mj0(jjindx), mj1(jjindx) 
    659                   WRITE(numout,*) ' vt_i_init : ', vt_i_init (ji,jj) 
    660                   WRITE(numout,*) ' vt_i_final: ', vt_i_final(ji,jj) 
    661                   WRITE(numout,*) ' et_i_init : ', et_i_init (ji,jj) 
    662                   WRITE(numout,*) ' et_i_final: ', et_i_final(ji,jj) 
    663                END DO 
    664             END DO 
    665          ENDIF 
    666          ! 
    667       ENDIF 
    668539      ! 
    669       CALL wrk_dealloc( jpij, zcatac )   ! integer 
     540      CALL wrk_dealloc( jpij, jcat )   ! integer 
    670541      CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 
    671       CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex ) 
    672       CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac ) 
    673       CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac ) 
    674       CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 ) 
    675       CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel ) 
     542      CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 
     543      CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zoa_i_1d, zsmv_i_1d ) 
     544      CALL wrk_dealloc( jpij,nlay_i+1,jpl, ze_i_1d ) 
     545      CALL wrk_dealloc( jpi,jpj, zvrel ) 
    676546      ! 
    677547   END SUBROUTINE lim_thd_lac 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90

    r4624 r4921  
    5353      ! 
    5454      INTEGER  ::   ji, jk     ! dummy loop indices  
    55       REAL(wp) ::   zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,  ztmelts   ! local scalars 
    56       REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars 
    57       REAL(wp), POINTER, DIMENSION(:) ::   ze_init, zhiold, zsiold 
     55      REAL(wp) ::   iflush, igravdr   ! local scalars 
    5856      !!--------------------------------------------------------------------- 
    5957 
    60       CALL wrk_alloc( jpij, ze_init, zhiold, zsiold ) 
    61  
     58      !--------------------------------------------------------- 
     59      !  0) Update ice salinity from snow-ice and bottom growth 
     60      !--------------------------------------------------------- 
     61      DO ji = kideb, kiut 
     62         sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji) 
     63      END DO 
     64  
    6265      !------------------------------------------------------------------------------| 
    6366      ! 1) Constant salinity, constant in time                                       | 
    6467      !------------------------------------------------------------------------------| 
    65 !!gm comment: if num_sal = 1 s_i_new, s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 
     68!!gm comment: if num_sal = 1 s_i_new, s_i_1d and sm_i_1d can be set to bulk_sal one for all in the initialisation phase !! 
    6669!!gm           ===>>>   simplification of almost all test on num_sal value 
    6770      IF(  num_sal == 1  ) THEN 
    68             s_i_b (kideb:kiut,1:nlay_i) =  bulk_sal 
    69             sm_i_b (kideb:kiut)          =  bulk_sal  
     71            s_i_1d (kideb:kiut,1:nlay_i) =  bulk_sal 
     72            sm_i_1d(kideb:kiut)          =  bulk_sal  
    7073            s_i_new(kideb:kiut)          =  bulk_sal 
    7174      ENDIF 
    … …  
    7477      !  Module 2 : Constant salinity varying in time                                | 
    7578      !------------------------------------------------------------------------------| 
    76  
    7779      IF(  num_sal == 2  ) THEN 
    78  
    79          !--------------------------------- 
    80          ! Thickness at previous time step 
    81          !--------------------------------- 
    82          DO ji = kideb, kiut 
    83             zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 
    84             zsiold(ji) = sm_i_b(ji) 
    85          END DO 
    86  
    87          !--------------------- 
    88          ! Global heat content 
    89          !--------------------- 
    90          ze_init(:)  =  0._wp 
    91          DO jk = 1, nlay_i 
    92             DO ji = kideb, kiut 
    93                ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / REAL (nlay_i ) 
    94             END DO 
    95          END DO 
    9680 
    9781         DO ji = kideb, kiut 
    … …  
    9983            ! Switches  
    10084            !---------- 
    101             iflush       =         MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt )        )    ! =1 if summer  
    102             igravdr      =         MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo 
    103             iaccrbo      =         MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) )           )    ! =1 if bottom accretion 
    104             i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 
    105             isnowic      = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch   ! =1 if snow ice formation 
     85            iflush  = MAX( 0._wp , SIGN( 1._wp , t_su_1d(ji) - rtt )        )     ! =1 if summer  
     86            igravdr = MAX( 0._wp , SIGN( 1._wp , t_bo_1d(ji) - t_su_1d(ji) ) )    ! =1 if t_su < t_bo 
    10687 
    10788            !--------------------- 
    10889            ! Salinity tendencies 
    10990            !--------------------- 
    110             !                                   ! drainage by gravity drainage 
    111             dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
    112             !                                   ! drainage by flushing   
    113             dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
     91            ! drainage by gravity drainage 
     92            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_1d(ji) - sal_G , 0._wp ) / time_G * rdt_ice  
     93            ! drainage by flushing   
     94            dsm_i_fl_1d(ji) = - iflush  * MAX( sm_i_1d(ji) - sal_F , 0._wp ) / time_F * rdt_ice 
    11495 
    11596            !----------------- 
    … …  
    11899            ! only drainage terms ( gravity drainage and flushing ) 
    119100            ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 
    120             sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    121  
    122             ! if no ice, salinity = 0.1 
    123             i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 
    124             sm_i_b(ji)   = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 
    125  
    126             !---------------------------- 
    127             ! Heat flux - brine drainage 
    128             !---------------------------- 
    129             fhbri_1d(ji) = 0._wp 
     101            sm_i_1d(ji) = sm_i_1d(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 
    130102 
    131103            !---------------------------- 
    132104            ! Salt flux - brine drainage 
    133105            !---------------------------- 
    134             sfx_bri_1d(ji) = sfx_bri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) * ( sm_i_b(ji) - zsiold(ji) ) * r1_rdtice 
     106            sfx_bri_1d(ji) = sfx_bri_1d(ji) - rhoic * a_i_1d(ji) * ht_i_1d(ji) * ( dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) ) * r1_rdtice 
    135107 
    136108         END DO 
    … …  
    138110         ! Salinity profile 
    139111         CALL lim_var_salprof1d( kideb, kiut ) 
    140  
    141  
    142          ! Only necessary for conservation check since salinity is modified 
    143          !-------------------- 
    144          ! Temperature update 
    145          !-------------------- 
    146          DO jk = 1, nlay_i 
    147             DO ji = kideb, kiut 
    148                ztmelts    =  -tmut*s_i_b(ji,jk) + rtt 
    149                !Conversion q(S,T) -> T (second order equation) 
    150                zaaa         =  cpic 
    151                zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 
    152                zccc         =  lfus * ( ztmelts - rtt ) 
    153                zdiscrim     =  SQRT(  MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp )  ) 
    154                t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 
    155             END DO 
    156          END DO 
    157112         ! 
    158113      ENDIF  
    … …  
    161116      !  Module 3 : Profile of salinity, constant in time                            | 
    162117      !------------------------------------------------------------------------------| 
    163  
    164118      IF(  num_sal == 3  )   CALL lim_var_salprof1d( kideb, kiut ) 
    165119 
    166       ! 
    167       CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold ) 
    168120      ! 
    169121   END SUBROUTINE lim_thd_sal 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r4333 r4921  
    3030   USE limvar          ! clem for ice thickness correction 
    3131   USE timing          ! Timing 
     32   USE limcons        ! conservation tests 
    3233 
    3334   IMPLICIT NONE 
    … …  
    3738 
    3839   REAL(wp)  ::   epsi10 = 1.e-10_wp   
    39    REAL(wp)  ::   rzero  = 0._wp    
    40    REAL(wp)  ::   rone   = 1._wp 
     40   REAL(wp)  ::   epsi20 = 1.e-20_wp   
    4141 
    4242   !! * Substitution 
    … …  
    6363      INTEGER, INTENT(in) ::   kt   ! number of iteration 
    6464      ! 
    65       INTEGER  ::   ji, jj, jk, jl, layer   ! dummy loop indices 
     65      INTEGER  ::   ji, jj, jk, jl, jn      ! dummy loop indices 
    6666      INTEGER  ::   initad                  ! number of sub-timestep for the advection 
    6767      INTEGER  ::   ierr                    ! error status 
    6868      REAL(wp) ::   zindb  , zindsn , zindic, zindh, zinda      ! local scalar 
    69       REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      - 
    7069      REAL(wp) ::   zcfl , zusnit                 !   -      - 
    71       REAL(wp) ::   ze   , zsal   , zage          !   -      - 
     70      REAL(wp) ::   zsal   , zage          !   -      - 
    7271      ! 
    7372      REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow 
    7473      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi 
    7574      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e 
    76       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    77       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 
    7875      ! mass and salt flux (clem) 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold   ! old ice volume... 
    80       ! correct ice thickness (clem) 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold   ! old ice volume... 
    8177      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zaiold, zhimax   ! old ice concentration and thickness 
    82       REAL(wp) :: zdv, zda, zvi, zvs, zsmv 
     78      REAL(wp), POINTER, DIMENSION(:,:)   ::   zeiold, zesold   ! old enthalpies 
     79      REAL(wp) :: zdv, zda, zvi, zvs, zsmv, zes, zei 
     80      ! 
     81      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    8382      !!--------------------------------------------------------------------- 
    8483      IF( nn_timing == 1 )  CALL timing_start('limtrp') 
    8584 
    86       CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
     85      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    8786      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    88       CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e ) 
    89  
    90       CALL wrk_alloc( jpi,jpj,jpl,zviold )   ! clem 
    91       CALL wrk_alloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
    92  
    93       ! ------------------------------- 
    94       !- check conservation (C Rousset) 
    95       IF( ln_limdiahsb ) THEN 
    96          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    97          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    98          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    99          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    100       ENDIF 
    101       !- check conservation (C Rousset) 
    102       ! ------------------------------- 
     87      CALL wrk_alloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 
     88 
     89      CALL wrk_alloc( jpi, jpj, jpl, zaiold, zhimax, zviold, zvsold )   ! clem 
    10390 
    10491      IF( numit == nstart .AND. lwp ) THEN 
    … …  
    115102      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   ! 
    116103         !                          !-------------------------------------! 
     104 
     105         ! conservation test 
     106         IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     107 
    117108         ! mass and salt flux init (clem) 
    118109         zviold(:,:,:)  = v_i(:,:,:) 
     110         zeiold(:,:)  = SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 )  
     111         zesold(:,:)  = SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )  
    119112 
    120113         !--- Thickness correction init. (clem) ------------------------------- 
    … …  
    167160!         ENDIF 
    168161!!gm end 
    169          initad = 1 + NINT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) ) 
     162         initad = 1 + NINT( MAX( 0._wp, SIGN( 1._wp, zcfl-0.5 ) ) ) 
    170163         zusnit = 1.0 / REAL( initad )  
    171164         IF( zcfl > 0.5 .AND. lwp )   & 
    … …  
    174167 
    175168         IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN       !==  odd ice time step:  adv_x then adv_y  ==! 
    176             DO jk = 1,initad 
    177                CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     169            DO jn = 1,initad 
     170               CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    178171                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    179                CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
     172               CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    180173                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    181174               DO jl = 1, jpl 
    182                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     175                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    183176                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    184                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     177                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    185178                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    186                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     179                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    187180                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    188                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     181                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    189182                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    190                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     183                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    191184                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    192                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     185                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    193186                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    194                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
     187                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---      
    195188                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    196                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     189                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    197190                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    198                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     191                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    199192                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    200                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
     193                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &  
    201194                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    202                   CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     195                  CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    203196                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    204                   CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     197                  CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    205198                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    206                   DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    207                      CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    208                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    209                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    210                      CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    211                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    212                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     199                  DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
     200                     CALL lim_adv_x( zusnit, u_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     201                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     202                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     203                     CALL lim_adv_y( zusnit, v_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     204                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     205                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    213206                  END DO 
    214207               END DO 
    215208            END DO 
    216209         ELSE 
    217             DO jk = 1, initad 
    218                CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
     210            DO jn = 1, initad 
     211               CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area 
    219212                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    220                CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   & 
     213               CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ow (:,:), sxopw(:,:),   & 
    221214                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  ) 
    222215               DO jl = 1, jpl 
    223                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
     216                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  --- 
    224217                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    225                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
     218                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   & 
    226219                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  ) 
    227                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
     220                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  --- 
    228221                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    229                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
     222                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   & 
    230223                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  ) 
    231                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
     224                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity --- 
    232225                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    233                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
     226                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   & 
    234227                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  ) 
    235228 
    236                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
     229                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      --- 
    237230                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    238                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
     231                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   & 
    239232                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  ) 
    240                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
     233                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations --- 
    241234                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    242                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
     235                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
    243236                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  ) 
    244                   CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
     237                  CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents --- 
    245238                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    246                   CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
     239                  CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   & 
    247240                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  ) 
    248                   DO layer = 1, nlay_i                                                           !--- ice heat contents --- 
    249                      CALL lim_adv_y( zusnit, v_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    250                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    251                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
    252                      CALL lim_adv_x( zusnit, u_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   &  
    253                         &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   & 
    254                         &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) ) 
     241                  DO jk = 1, nlay_i                                                           !--- ice heat contents --- 
     242                     CALL lim_adv_y( zusnit, v_ice, 1._wp , zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     243                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     244                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
     245                     CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, zs0e(:,:,jk,jl), sxe (:,:,jk,jl),   &  
     246                        &                                       sxxe(:,:,jk,jl), sye (:,:,jk,jl),   & 
     247                        &                                       syye(:,:,jk,jl), sxye(:,:,jk,jl) ) 
    255248                  END DO 
    256249               END DO 
    … …  
    268261            zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:) 
    269262            zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:) 
    270             zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:) 
    271             DO jk = 1, nlay_i 
    272                zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:) 
    273             END DO 
     263            ! 
    274264         END DO 
    275265 
    … …  
    289279         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    290280            DO ji = 1 , fs_jpim1   ! vector opt. 
    291                pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji  ,jj) ) ) )   & 
    292                   &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
    293                pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj  ) ) ) )   & 
    294                   &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
     281               pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji  ,jj) ) ) )   & 
     282                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj) 
     283               pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0at(ji,jj  ) ) ) )   & 
     284                  &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj) 
    295285            END DO 
    296286         END DO 
    … …  
    305295            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    306296               DO ji = 1 , fs_jpim1   ! vector opt. 
    307                   pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj,jl) ) ) )   & 
    308                      &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
    309                   pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ,jl) ) ) )   & 
    310                      &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
     297                  pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji  ,jj,jl) ) ) )   & 
     298                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 
     299                  pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -zs0a(ji,jj  ,jl) ) ) )   & 
     300                     &        * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 
    311301               END DO 
    312302            END DO 
    … …  
    334324            DO jj = 1, jpj 
    335325               DO ji = 1, jpi 
    336                   zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl) ) 
    337                   zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl) ) 
    338                   zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl) ) 
    339                   zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl) ) 
    340                   zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl) ) 
    341                   zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl) ) 
     326                  zs0sn (ji,jj,jl) = MAX( 0._wp, zs0sn (ji,jj,jl) ) 
     327                  zs0ice(ji,jj,jl) = MAX( 0._wp, zs0ice(ji,jj,jl) ) 
     328                  zs0sm (ji,jj,jl) = MAX( 0._wp, zs0sm (ji,jj,jl) ) 
     329                  zs0oi (ji,jj,jl) = MAX( 0._wp, zs0oi (ji,jj,jl) ) 
     330                  zs0a  (ji,jj,jl) = MAX( 0._wp, zs0a  (ji,jj,jl) ) 
     331                  zs0c0 (ji,jj,jl) = MAX( 0._wp, zs0c0 (ji,jj,jl) ) 
    342332                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl) 
    343333               END DO 
    … …  
    346336 
    347337         !--------------------------------------------------------- 
    348          ! 5.2) Snow thickness, Ice thickness, Ice concentrations 
     338         ! 5.2) Update and mask variables 
    349339         !--------------------------------------------------------- 
    350          DO jj = 1, jpj 
    351             DO ji = 1, jpi 
    352                zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - epsi10) ) 
    353                zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp ) 
    354                ato_i(ji,jj) = zs0ow(ji,jj) 
    355             END DO 
    356          END DO 
    357  
    358          DO jl = 1, jpl         ! Remove very small areas  
     340         DO jl = 1, jpl           
    359341            DO jj = 1, jpj 
    360342               DO ji = 1, jpi 
    361                   zvi = zs0ice(ji,jj,jl) 
    362                   zvs = zs0sn(ji,jj,jl) 
     343                  zindb= MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
     344 
     345                  zvi  = zs0ice(ji,jj,jl) 
     346                  zvs  = zs0sn (ji,jj,jl) 
     347                  zes  = zs0c0 (ji,jj,jl)       
     348                  zsmv = zs0sm (ji,jj,jl) 
    363349                  ! 
    364                   zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - epsi10) ) 
    365                   ! 
    366                   v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl)  
    367                   v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl) 
    368                   ! 
    369                   zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    370                   zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    371                   zindb          = MAX( zindsn, zindic ) 
    372                   ! 
    373                   zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration 
    374                   a_i (ji,jj,jl) = zs0a(ji,jj,jl) 
    375                   v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl) 
    376                   v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl) 
    377                   ! 
    378                   ! Update mass fluxes (clem) 
    379                   rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic  
    380                   rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn  
     350                  ! Remove very small areas 
     351                  v_s(ji,jj,jl)   = zindb * zs0sn (ji,jj,jl)  
     352                  v_i(ji,jj,jl)   = zindb * zs0ice(ji,jj,jl) 
     353                  a_i(ji,jj,jl)   = zindb * zs0a  (ji,jj,jl) 
     354                  e_s(ji,jj,1,jl) = zindb * zs0c0 (ji,jj,jl)       
     355                  ! Ice salinity and age 
     356                  IF(  num_sal == 2  ) THEN 
     357                     smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
     358                  ENDIF 
     359                  oa_i(ji,jj,jl) = MAX( zindb * zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ), 0._wp ) * a_i(ji,jj,jl) 
     360 
     361                 ! Update fluxes 
     362                  wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice  
     363                  wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
     364                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
     365                  hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    381366              END DO 
    382367            END DO 
    383368         END DO 
     369 
     370         DO jl = 1, jpl 
     371            DO jk = 1, nlay_i 
     372               DO jj = 1, jpj 
     373                  DO ji = 1, jpi 
     374                     zindb            = MAX( 0._wp , SIGN( 1._wp, zs0a(ji,jj,jl) - epsi10 ) ) 
     375                     zei              = zs0e(ji,jj,jk,jl)       
     376                     e_i(ji,jj,jk,jl) = zindb * MAX( 0._wp, zs0e(ji,jj,jk,jl) ) 
     377                     ! Update fluxes 
     378                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     379                  END DO !ji 
     380               END DO ! jj 
     381            END DO ! jk 
     382         END DO ! jl 
    384383 
    385384         !--- Thickness correction in case too high (clem) -------------------------------------------------------- 
    … …  
    390389 
    391390                  IF ( v_i(ji,jj,jl) > 0._wp ) THEN 
    392                      zvi = v_i(ji,jj,jl) 
    393                      zvs = v_s(ji,jj,jl) 
    394                      zdv = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
     391                     zvi  = v_i  (ji,jj,jl) 
     392                     zvs  = v_s  (ji,jj,jl) 
     393                     zsmv = smv_i(ji,jj,jl) 
     394                     zes  = e_s  (ji,jj,1,jl) 
     395                     zei  = SUM( e_i(ji,jj,:,jl) ) 
     396                     zdv  = v_i(ji,jj,jl) - zviold(ji,jj,jl)    
    395397                     !zda = a_i(ji,jj,jl) - zaiold(ji,jj,jl)    
    396398                      
    … …  
    399401                        & ( zdv < 0.0 .AND. ht_i(ji,jj,jl) > zhimax(ji,jj,jl) ) ) THEN                                           
    400402                        ht_i(ji,jj,jl) = MIN( zhimax(ji,jj,jl), hi_max(jl) ) 
    401                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    402                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     403                        zindh   =  MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
     404                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
    403405                     ELSE 
    404406                        ht_i(ji,jj,jl) = MAX( MIN( ht_i(ji,jj,jl), hi_max(jl) ), hi_max(jl-1) ) 
    405                         zindh   =  MAX( rzero, SIGN( rone, ht_i(ji,jj,jl) - epsi10 ) ) 
    406                         a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi10 ) 
     407                        zindh   =  MAX( 0._wp, SIGN( 1._wp, ht_i(ji,jj,jl) - epsi20 ) ) 
     408                        a_i(ji,jj,jl)  = zindh * v_i(ji,jj,jl) / MAX( ht_i(ji,jj,jl), epsi20 ) 
    407409                     ENDIF 
    408410 
    409411                     ! small correction due to *zindh for a_i 
    410                      v_i(ji,jj,jl) = zindh * v_i(ji,jj,jl) 
    411                      v_s(ji,jj,jl) = zindh * v_s(ji,jj,jl) 
     412                     v_i  (ji,jj,jl) = zindh * v_i  (ji,jj,jl) 
     413                     v_s  (ji,jj,jl) = zindh * v_s  (ji,jj,jl) 
     414                     smv_i(ji,jj,jl) = zindh * smv_i(ji,jj,jl) 
     415                     e_s(ji,jj,1,jl) = zindh * e_s(ji,jj,1,jl) 
     416                     e_i(ji,jj,:,jl) = zindh * e_i(ji,jj,:,jl) 
    412417 
    413418                     ! Update mass fluxes 
    414                      rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zvi ) * rhoic 
    415                      rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvs ) * rhosn 
     419                     wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice 
     420                     wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice 
     421                     sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
     422                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
     423                     hfx_res(ji,jj) = hfx_res(ji,jj) + ( SUM( e_i(ji,jj,:,jl) ) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0 
    416424 
    417425                  ENDIF 
    418426 
    419427                  diag_trp_vi(ji,jj) = diag_trp_vi(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * r1_rdtice 
    420  
    421                END DO 
    422             END DO 
    423          END DO 
    424  
    425          ! --- 
     428                  diag_trp_vs(ji,jj) = diag_trp_vs(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * r1_rdtice 
     429 
     430               END DO 
     431            END DO 
     432         END DO 
     433         ! ------------------------------------------------- 
     434 
     435         ! --- diags --- 
    426436         DO jj = 1, jpj 
    427437            DO ji = 1, jpi 
    428                zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) ) ! clem@useless?? 
    429             END DO 
    430          END DO 
    431  
    432          !---------------------- 
    433          ! 5.3) Ice properties 
    434          !---------------------- 
    435  
    436          zbigval = 1.e+13 
    437  
     438               diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
     439               diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) / area(ji,jj) * unit_fac * r1_rdtice 
     440            END DO 
     441         END DO 
     442 
     443         ! --- agglomerate variables (clem) ----------------- 
     444         vt_i (:,:) = 0._wp 
     445         vt_s (:,:) = 0._wp 
     446         at_i (:,:) = 0._wp 
     447         ! 
    438448         DO jl = 1, jpl 
    439449            DO jj = 1, jpj 
    440450               DO ji = 1, jpi 
    441                   zsmv = zs0sm(ji,jj,jl) 
    442  
    443                   ! Switches and dummy variables 
    444                   zusvosn         = 1.0/MAX( v_s(ji,jj,jl) , epsi10 ) 
    445                   zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi10 ) 
    446                   zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
    447                   zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    448                   zindb           = MAX( zindsn, zindic ) 
    449  
    450                   ! Ice salinity and age 
    451                   !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 
    452                   IF(  num_sal == 2  ) THEN 
    453                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 
    454                   ENDIF 
    455  
    456                   zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) ), 0._wp  ) * a_i(ji,jj,jl) 
    457                   oa_i (ji,jj,jl)  = zindic * zage  
    458  
    459                   ! Snow heat content 
    460                   ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval ) 
    461                   e_s(ji,jj,1,jl) = zindsn * ze       
    462  
    463                   ! Update salt fluxes (clem) 
    464                   sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmv ) * rhoic * r1_rdtice  
    465                END DO !ji 
    466             END DO !jj 
    467          END DO ! jl 
    468  
    469          DO jl = 1, jpl 
    470             DO jk = 1, nlay_i 
    471                DO jj = 1, jpj 
    472                   DO ji = 1, jpi 
    473                      ! Ice heat content 
    474                      zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
    475                      ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval ) 
    476                      e_i(ji,jj,jk,jl) = zindic * ze 
    477                   END DO !ji 
    478                END DO ! jj 
    479             END DO ! jk 
    480          END DO ! jl 
    481  
    482  
    483       ! --- agglomerate variables (clem) ----------------- 
    484       vt_i (:,:) = 0._wp 
    485       vt_s (:,:) = 0._wp 
    486       at_i (:,:) = 0._wp 
    487       ! 
    488       DO jl = 1, jpl 
     451                  ! 
     452                  vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
     453                  vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
     454                  at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
     455               END DO 
     456            END DO 
     457         END DO 
     458         ! ------------------------------------------------- 
     459 
     460         ! open water 
    489461         DO jj = 1, jpj 
    490462            DO ji = 1, jpi 
    491                ! 
    492                vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume 
    493                vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume 
    494                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    495                ! 
    496                zinda = MAX( rzero , SIGN( rone , at_i(ji,jj) - epsi10 ) ) 
    497                icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
    498             END DO 
    499          END DO 
    500       END DO 
    501       ! ------------------------------------------------- 
    502  
    503  
     463               ! open water = 1 if at_i=0 
     464               zindb        = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
     465               ato_i(ji,jj) = zindb + (1._wp - zindb ) * zs0ow(ji,jj) 
     466            END DO 
     467         END DO       
     468 
     469         ! conservation test 
     470         IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limtrp', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    504471 
    505472      ENDIF 
    … …  
    536503         END DO 
    537504      ENDIF 
    538       ! ------------------------------- 
    539       !- check conservation (C Rousset) 
    540       IF( ln_limdiahsb ) THEN 
    541          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    542          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    543   
    544          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) / rdt_ice 
    545          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) / rdt_ice + ( zchk_fs / rhoic ) 
    546  
    547          zchk_vmin = glob_min(v_i) 
    548          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    549          zchk_amin = glob_min(a_i) 
    550          zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2)) 
    551  
    552          IF(lwp) THEN 
    553             IF ( ABS( zchk_v_i   ) >  1.e-5 ) THEN 
    554                WRITE(numout,*) 'violation volume [m3/day]     (limtrp) = ',(zchk_v_i * rday) 
    555                WRITE(numout,*) 'u_ice max [m/s]               (limtrp) = ',zchk_umax 
    556                WRITE(numout,*) 'number of time steps          (limtrp) =',kt 
    557             ENDIF 
    558             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 
    559             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limtrp) = ',(zchk_vmin * 1.e-3) 
    560             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limtrp) = ',zchk_amin 
    561          ENDIF 
    562       ENDIF 
    563       !- check conservation (C Rousset) 
    564       ! ------------------------------- 
    565505      ! 
    566       CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow ) 
     506      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow, zeiold, zesold ) 
    567507      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi ) 
    568       CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e ) 
    569  
    570       CALL wrk_dealloc( jpi,jpj,jpl,zaiold, zhimax )   ! clem 
     508      CALL wrk_dealloc( jpi, jpj, nlay_i+1, jpl, zs0e ) 
     509 
     510      CALL wrk_dealloc( jpi, jpj, jpl, zviold, zvsold, zaiold, zhimax )   ! clem 
    571511      ! 
    572512      IF( nn_timing == 1 )  CALL timing_stop('limtrp') 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r4333 r4921  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
     7   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
    … …  
    3233   USE par_ice 
    3334   USE limitd_th 
     35   USE limitd_me 
    3436   USE limvar 
    3537   USE prtctl           ! Print control 
    … …  
    3739   USE wrk_nemo         ! work arrays 
    3840   USE lib_fortran     ! glob_sum 
    39    ! Check budget (Rousset) 
    4041   USE in_out_manager   ! I/O manager 
    4142   USE iom              ! I/O manager 
    4243   USE lib_mpp          ! MPP library 
    4344   USE timing          ! Timing 
     45   USE limcons        ! conservation tests 
    4446 
    4547   IMPLICIT NONE 
    … …  
    4951 
    5052      REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    51       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    52       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    5353          
    5454   !! * Substitutions 
    … …  
    6666      !!                
    6767      !! ** Purpose :  Computes update of sea-ice global variables at  
    68       !!               the end of the time step. 
    69       !!               Address pathological cases 
    70       !!               This place is very important 
     68      !!               the end of the dynamics. 
    7169      !!                 
    72       !! ** Method  :   
    73       !!    Ice speed from ice dynamics 
    74       !!    Ice thickness, Snow thickness, Temperatures, Lead fraction 
    75       !!      from advection and ice thermodynamics  
    76       !! 
    77       !! ** Action  : -  
    7870      !!--------------------------------------------------------------------- 
    79       INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    80       INTEGER ::   jbnd1, jbnd2 
    81       INTEGER ::   i_ice_switch 
    82       INTEGER ::   ind_im, layer      ! indices for internal melt 
    83       REAL(wp) ::   zweight, zesum, z_da_i, zhimax 
    84       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    85       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    86       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    87       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    88  
    89       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    90       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    91       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    92       ! mass and salt flux (clem) 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     71      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     72      INTEGER  ::   i_ice_switch 
     73      REAL(wp) ::   zsal 
     74      ! 
     75      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9476      !!------------------------------------------------------------------- 
    9577      IF( nn_timing == 1 )  CALL timing_start('limupdate1') 
    9678 
    97       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    98  
    99       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    100  
    101       !------------------------------------------------------------------------------ 
    102       ! 1. Update of Global variables                                               | 
    103       !------------------------------------------------------------------------------ 
    104  
    105       !----------------- 
    106       !  Trend terms 
    107       !----------------- 
    108       d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:) 
    109       d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:) 
    110       d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:) 
    111       d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)   
    112       d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)    
    113       d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)   
    114       d_e_i_trp  (:,:,:,:) = e_i  (:,:,:,:) - old_e_i  (:,:,:,:) 
    115       d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:) 
    116       d_smv_i_trp(:,:,:)   = 0._wp 
    117       IF(  num_sal == 2  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:) 
    118  
    119       ! mass and salt flux init (clem) 
    120       zviold(:,:,:) = v_i(:,:,:) 
    121       zvsold(:,:,:) = v_s(:,:,:) 
    122       zsmvold(:,:,:) = smv_i(:,:,:) 
    123  
    124       ! ------------------------------- 
    125       !- check conservation (C Rousset) 
    126       IF (ln_limdiahsb) THEN 
    127          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    128          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    129          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    130          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    131       ENDIF 
    132       !- check conservation (C Rousset) 
    133       ! ------------------------------- 
     79      IF( ln_limdyn ) THEN  
     80 
     81      ! conservation test 
     82      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     83 
     84      !----------------- 
     85      ! zap small values 
     86      !----------------- 
     87      CALL lim_itd_me_zapsmall 
    13488 
    13589      CALL lim_var_glo2eqv 
    136  
    137       !-------------------------------------- 
    138       ! 2. Review of all pathological cases 
    139       !-------------------------------------- 
    140  
    141 ! clem: useless now 
    142       !------------------------------------------- 
    143       ! 2.1) Advection of ice in an ice-free cell 
    144       !------------------------------------------- 
    145       ! should be removed since it is treated after dynamics now 
    146 !      zhimax = 5._wp 
    147 !      ! first category 
    148 !      DO jj = 1, jpj 
    149 !         DO ji = 1, jpi 
    150 !            !--- the thickness of such an ice is often out of bounds 
    151 !            !--- thus we recompute a new area while conserving ice volume 
    152 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    153 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_trp(ji,jj,1) ) - epsi10 ) )  
    154 !            IF( ( ABS( d_v_i_trp(ji,jj,1) ) / MAX( ABS( d_a_i_trp(ji,jj,1) ), epsi10 ) * zindb .GT. zhimax ) & 
    155 !              &   .AND.( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    156 !              &   .AND.( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    157 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    158 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    159 !            ENDIF 
    160 !         END DO 
    161 !      END DO 
    162 ! 
    163 !      zhimax = 20._wp 
    164 !      ! other categories 
    165 !      DO jl = 2, jpl 
    166 !         jm = ice_types(jl) 
    167 !         DO jj = 1, jpj 
    168 !            DO ji = 1, jpi 
    169 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_trp(ji,jj,jl) ) - epsi10 ) )  
    170 !               ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    171 !               ! it makes problems when the advected volume and concentration do not seem to be  
    172 !               ! related with each other 
    173 !               ! the new thickness is sometimes very big! 
    174 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    175 !               ! which of course is plausible 
    176 !               ! but fuck! it fucks everything up :) 
    177 !               IF ( ( ABS( d_v_i_trp(ji,jj,jl) ) / MAX( ABS( d_a_i_trp(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    178 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    179 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    180 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    181 !               ENDIF 
    182 !            END DO ! ji 
    183 !         END DO !jj 
    184 !      END DO !jl 
    18590      
     91      !---------------------------------------------------- 
     92      ! Rebin categories with thickness out of bounds 
     93      !---------------------------------------------------- 
     94      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
     95 
    18696      at_i(:,:) = 0._wp 
    18797      DO jl = 1, jpl 
    … …  
    190100 
    191101      !---------------------------------------------------- 
    192       ! 2.2) Rebin categories with thickness out of bounds 
    193       !---------------------------------------------------- 
    194       DO jm = 1, jpm 
    195          jbnd1 = ice_cat_bounds(jm,1) 
    196          jbnd2 = ice_cat_bounds(jm,2) 
    197          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
     102      ! ice concentration should not exceed amax  
     103      !----------------------------------------------------- 
     104      DO jl  = 1, jpl 
     105         DO jj = 1, jpj 
     106            DO ji = 1, jpi 
     107               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     108                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
     109                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     110               ENDIF 
     111            END DO 
     112         END DO 
    198113      END DO 
    199114 
    … …  
    202117         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    203118      END DO 
    204  
    205       zbigvalue      = 1.0e+20 
    206  
    207       DO jl = 1, jpl 
    208          DO jj = 1, jpj  
    209             DO ji = 1, jpi 
    210  
    211                !switches 
    212                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    213                !switch = 1 if a_i > 1e-06 and 0 if not 
    214                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    215                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    216                ! bug fix 25 avril 2007 
    217                zindb         = zindb*zindic 
    218  
    219                !--- 2.3 Correction to ice age  
    220                !------------------------------ 
    221                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    222                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    223                !                ENDIF 
    224                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    225                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
    226                ENDIF 
    227                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    228  
    229                !--- 2.4 Correction to snow thickness 
    230                !------------------------------------- 
    231                !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0 
    232                !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0)  
    233                ! snow thickness cannot be smaller than 1e-6 
    234                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    235                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    236  
    237                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    238   
    239                !--- 2.5 Correction to ice thickness 
    240                !------------------------------------- 
    241                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    242                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    243  
    244                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    245                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    246  
    247                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    248                !---------------------------------------------------------------------------- 
    249                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    250                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    251                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    252  
    253                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    254                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    255  
    256                !--- 2.7 Correction to ice concentrations  
    257                !-------------------------------------------- 
    258                ! if greater than 0, ice concentration cannot be smaller than 1e-10 
    259                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    260  
    261                !------------------------- 
    262                ! 2.8) Snow heat content 
    263                !------------------------- 
    264                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0._wp, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    265  
    266             END DO ! ji 
    267          END DO ! jj 
    268       END DO ! jl 
    269  
    270       !------------------------ 
    271       ! 2.9) Ice heat content  
    272       !------------------------ 
    273  
    274       DO jl = 1, jpl 
    275          DO jk = 1, nlay_i 
     119     
     120      ! -------------------------------------- 
     121      ! Final thickness distribution rebinning 
     122      ! -------------------------------------- 
     123      IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 
     124 
     125      !----------------- 
     126      ! zap small values 
     127      !----------------- 
     128      CALL lim_itd_me_zapsmall 
     129 
     130      !--------------------- 
     131      ! Ice salinity bounds 
     132      !--------------------- 
     133      IF (  num_sal == 2  ) THEN  
     134         DO jl = 1, jpl 
    276135            DO jj = 1, jpj  
    277136               DO ji = 1, jpi 
    278                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    279                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    280                END DO ! ji 
    281             END DO ! jj 
    282          END DO !jk 
    283       END DO !jl 
    284   
    285       at_i(:,:) = 0._wp 
    286       DO jl = 1, jpl 
    287          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    288       END DO 
    289  
    290       !--- 2.13 ice concentration should not exceed amax  
    291       !         (it should not be the case)  
    292       !----------------------------------------------------- 
    293       DO jj = 1, jpj 
    294          DO ji = 1, jpi 
    295             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    296             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    297             DO jl  = 1, jpl 
    298                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    299                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    300                ! 
    301                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    302                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    303                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
     137                  zsal            = smv_i(ji,jj,jl) 
     138                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
     139                  ! salinity stays in bounds 
     140                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     141                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
     142                  ! associated salt flux 
     143                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     144               END DO 
    304145            END DO 
    305146         END DO 
    306       END DO 
    307       at_i(:,:) = a_i(:,:,1) 
    308       DO jl = 2, jpl 
    309          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    310       END DO 
    311  
    312  
    313       ! Final thickness distribution rebinning 
    314       ! -------------------------------------- 
    315       DO jm = 1, jpm 
    316          jbnd1 = ice_cat_bounds(jm,1) 
    317          jbnd2 = ice_cat_bounds(jm,2) 
    318          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    319          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    320          ENDIF 
    321       END DO 
    322  
    323  
    324       !--------------------- 
    325       ! 2.11) Ice salinity 
    326       !--------------------- 
    327       ! clem correct bug on smv_i 
    328       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    329  
    330       IF (  num_sal == 2  ) THEN ! general case 
    331          DO jl = 1, jpl 
    332             !DO jk = 1, nlay_i 
    333                DO jj = 1, jpj  
    334                   DO ji = 1, jpi 
    335                      ! salinity stays in bounds 
    336                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    337                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    338                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    339                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    340                   END DO ! ji 
    341                END DO ! jj 
    342             !END DO !jk 
    343          END DO !jl 
    344147      ENDIF 
    345148 
    346       at_i(:,:) = a_i(:,:,1) 
    347       DO jl = 2, jpl 
    348          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    349       END DO 
    350  
    351  
    352       !-------------------------------- 
    353       ! Update mass/salt fluxes (clem) 
    354       !-------------------------------- 
    355       DO jl = 1, jpl 
    356          DO jj = 1, jpj  
    357             DO ji = 1, jpi 
    358                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    359                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    360                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    361                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    362             END DO 
    363          END DO 
    364       END DO 
    365    
    366       ! ------------------------------- 
    367       !- check conservation (C Rousset) 
    368       IF (ln_limdiahsb) THEN 
    369  
    370          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    371          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    372   
    373          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    374          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    375  
    376          zchk_vmin = glob_min(v_i) 
    377          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    378          zchk_amin = glob_min(a_i) 
    379         
    380          IF(lwp) THEN 
    381             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate1) = ',(zchk_v_i * rday) 
    382             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate1) = ',(zchk_smv * rday) 
    383             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate1) = ',(zchk_vmin * 1.e-3) 
    384             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate1) = ',zchk_amax 
    385             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate1) = ',zchk_amin 
    386          ENDIF 
    387       ENDIF 
    388       !- check conservation (C Rousset) 
    389       ! ------------------------------- 
     149      ! ------------------------------------------------- 
     150      ! Diagnostics 
     151      ! ------------------------------------------------- 
     152      d_u_ice_dyn(:,:)     = u_ice(:,:)     - u_ice_b(:,:) 
     153      d_v_ice_dyn(:,:)     = v_ice(:,:)     - v_ice_b(:,:) 
     154      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - a_i_b  (:,:,:) 
     155      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - v_s_b  (:,:,:)   
     156      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - v_i_b  (:,:,:)    
     157      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - e_s_b  (:,:,:,:)   
     158      d_e_i_trp  (:,:,1:nlay_i,:) = e_i  (:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
     159      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - oa_i_b (:,:,:) 
     160      d_smv_i_trp(:,:,:)   = 0._wp 
     161      IF(  num_sal == 2  ) d_smv_i_trp(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
     162 
     163      ! conservation test 
     164      IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    390165 
    391166      IF(ln_ctl) THEN   ! Control print 
    … …  
    400175         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update1  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    401176         CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update1  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :') 
    402          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update1  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     177         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update1  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    403178 
    404179         DO jl = 1, jpl 
    … …  
    413188            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update1  : o_i         : ') 
    414189            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update1  : a_i         : ') 
    415             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_a_i     : ') 
     190            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : a_i_b       : ') 
    416191            CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_a_i_trp   : ') 
    417192            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update1  : v_i         : ') 
    418             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_i     : ') 
     193            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_i_b       : ') 
    419194            CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_i_trp   : ') 
    420195            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update1  : v_s         : ') 
    421             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update1  : old_v_s     : ') 
     196            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update1  : v_s_b       : ') 
    422197            CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update1  : d_v_s_trp   : ') 
    423198            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1        : ') 
    424             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i1    : ') 
     199            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : e_i1_b      : ') 
    425200            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : de_i1_trp   : ') 
    426201            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2        : ') 
    427             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : old_e_i2    : ') 
     202            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : e_i2_b      : ') 
    428203            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update1  : de_i2_trp   : ') 
    429204            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow      : ') 
    430             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update1  : old_e_snow  : ') 
     205            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update1  : e_snow_b    : ') 
    431206            CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update1  : d_e_s_trp   : ') 
    432207            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update1  : smv_i       : ') 
    433             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update1  : old_smv_i   : ') 
     208            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update1  : smv_i_b     : ') 
    434209            CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update1  : d_smv_i_trp : ') 
    435210            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update1  : oa_i        : ') 
    436             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update1  : old_oa_i    : ') 
     211            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update1  : oa_i_b      : ') 
    437212            CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update1  : d_oa_i_trp  : ') 
    438213 
    … …  
    446221         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    447222         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    448          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update1 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    449223         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update1 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    450          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update1 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    451224 
    452225         CALL prt_ctl_info(' ') 
    … …  
    458231      ENDIF 
    459232    
    460  
    461       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    462  
    463       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
     233      ENDIF ! ln_limdyn 
    464234 
    465235      IF( nn_timing == 1 )  CALL timing_stop('limupdate1') 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r4333 r4921  
    55   !!====================================================================== 
    66   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code 
     7   !!            3.6  !  2014-06  (C. Rousset)       Complete rewriting/cleaning 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_lim3 
    … …  
    3940   USE lib_fortran     ! glob_sum 
    4041   USE timing          ! Timing 
     42   USE limcons        ! conservation tests 
    4143 
    4244   IMPLICIT NONE 
    … …  
    4547   PUBLIC   lim_update2   ! routine called by ice_step 
    4648 
    47       REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
    48       REAL(wp)  ::   rzero  = 0._wp       !    -       - 
    49       REAL(wp)  ::   rone   = 1._wp       !    -       - 
    50           
     49   REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       - 
     50   REAL(wp)  ::   epsi20 = 1.e-20_wp    
     51       
    5152   !! * Substitutions 
    5253#  include "vectopt_loop_substitute.h90" 
    … …  
    6465      !! ** Purpose :  Computes update of sea-ice global variables at  
    6566      !!               the end of the time step. 
    66       !!               Address pathological cases 
    67       !!               This place is very important 
    68       !!                 
    69       !! ** Method  :   
    70       !!    Ice speed from ice dynamics 
    71       !!    Ice thickness, Snow thickness, Temperatures, Lead fraction 
    72       !!      from advection and ice thermodynamics  
    7367      !! 
    74       !! ** Action  : -  
    7568      !!--------------------------------------------------------------------- 
    76       INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices 
    77       INTEGER ::   jbnd1, jbnd2 
    78       INTEGER ::   i_ice_switch 
    79       INTEGER ::   ind_im, layer      ! indices for internal melt 
    80       REAL(wp) ::   zweight, zesum, zhimax, z_da_i 
    81       REAL(wp) ::   zinda, zindb, zindsn, zindic 
    82       REAL(wp) ::   zindg, zh, zdvres, zviold2 
    83       REAL(wp) ::   zbigvalue, zvsold2, z_da_ex 
    84       REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s 
    85  
    86       INTEGER , POINTER, DIMENSION(:,:,:) ::  internal_melt 
    87       REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for 
    88       REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 
    89       REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset) 
    90       ! mass and salt flux (clem) 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zviold, zvsold, zsmvold   ! old ice volume... 
     69      INTEGER  ::   ji, jj, jk, jl    ! dummy loop indices 
     70      INTEGER  ::   i_ice_switch 
     71      REAL(wp) ::   zh, zsal 
     72      ! 
     73      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    9274      !!------------------------------------------------------------------- 
    9375      IF( nn_timing == 1 )  CALL timing_start('limupdate2') 
    9476 
    95       CALL wrk_alloc( jpi,jpj,jpl, internal_melt )   ! integer 
    96       CALL wrk_alloc( jkmax, zthick0, zqm0 ) 
    97  
    98       CALL wrk_alloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    99  
    100       !---------------------------------------------------------------------------------------- 
    101       ! 1. Computation of trend terms       
    102       !---------------------------------------------------------------------------------------- 
    103       !- Trend terms 
    104       d_a_i_thd(:,:,:)   = a_i(:,:,:)   - old_a_i(:,:,:)  
    105       d_v_s_thd(:,:,:)   = v_s(:,:,:)   - old_v_s(:,:,:) 
    106       d_v_i_thd(:,:,:)   = v_i(:,:,:)   - old_v_i(:,:,:)   
    107       d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:)  
    108       d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 
    109       !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - old_oa_i (:,:,:) 
    110       d_smv_i_thd(:,:,:) = 0._wp 
    111       IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 
    112       ! diag only (clem) 
    113       dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
    114  
    115       ! mass and salt flux init (clem) 
    116       zviold(:,:,:) = v_i(:,:,:) 
    117       zvsold(:,:,:) = v_s(:,:,:) 
    118       zsmvold(:,:,:) = smv_i(:,:,:) 
    119  
    120       ! ------------------------------- 
    121       !- check conservation (C Rousset) 
    122       IF (ln_limdiahsb) THEN 
    123          zchk_v_i_b = glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    124          zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 
    125          zchk_fw_b  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) 
    126          zchk_fs_b  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) 
    127       ENDIF 
    128       !- check conservation (C Rousset) 
    129       ! ------------------------------- 
     77      ! conservation test 
     78      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
     79 
     80      !----------------- 
     81      ! zap small values 
     82      !----------------- 
     83      CALL lim_itd_me_zapsmall 
    13084 
    13185      CALL lim_var_glo2eqv 
    13286 
    133       !-------------------------------------- 
    134       ! 2. Review of all pathological cases 
    135       !-------------------------------------- 
    136  
    137 ! clem: useless now 
    138       !------------------------------------------- 
    139       ! 2.1) Advection of ice in an ice-free cell 
    140       !------------------------------------------- 
    141       ! should be removed since it is treated after dynamics now 
    142 !      zhimax = 5._wp 
    143 !      ! first category 
    144 !      DO jj = 1, jpj 
    145 !         DO ji = 1, jpi 
    146 !            !--- the thickness of such an ice is often out of bounds 
    147 !            !--- thus we recompute a new area while conserving ice volume 
    148 !            zat_i_old = SUM( old_a_i(ji,jj,:) ) 
    149 !            zindb     = MAX( 0._wp, SIGN( 1._wp, ABS( d_a_i_thd(ji,jj,1) ) - epsi10 ) )  
    150 !            IF ( ( ABS( d_v_i_thd(ji,jj,1) ) / MAX( ABS( d_a_i_thd(ji,jj,1) ),epsi10 ) * zindb .GT. zhimax ) & 
    151 !               &  .AND. ( ( v_i(ji,jj,1) / MAX( a_i(ji,jj,1), epsi10 ) * zindb ) .GT. zhimax ) & 
    152 !               &  .AND. ( zat_i_old .LT. 1.e-6 ) )  THEN ! new line 
    153 !               ht_i(ji,jj,1) = hi_max(1) * 0.5_wp 
    154 !               a_i (ji,jj,1) = v_i(ji,jj,1) / ht_i(ji,jj,1) 
    155 !            ENDIF 
    156 !         END DO 
    157 !      END DO 
    158  
    159 !      zhimax = 20._wp 
    160 !      ! other categories 
    161 !      DO jl = 2, jpl 
    162 !         jm = ice_types(jl) 
    163 !         DO jj = 1, jpj 
    164 !            DO ji = 1, jpi 
    165 !               zindb =  MAX( rzero, SIGN( rone, ABS( d_a_i_thd(ji,jj,jl)) - epsi10 ) )  
    166 !              ! this correction is very tricky... sometimes, advection gets wrong i don't know why 
    167 !               ! it makes problems when the advected volume and concentration do not seem to be  
    168 !               ! related with each other 
    169 !               ! the new thickness is sometimes very big! 
    170 !               ! and sometimes d_a_i_trp and d_v_i_trp have different sign 
    171 !               ! which of course is plausible 
    172 !               ! but fuck! it fucks everything up :) 
    173 !               IF ( ( ABS( d_v_i_thd(ji,jj,jl) ) / MAX( ABS( d_a_i_thd(ji,jj,jl) ), epsi10 ) * zindb .GT. zhimax ) & 
    174 !                  &  .AND. ( v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb ) .GT. zhimax ) THEN 
    175 !                  ht_i(ji,jj,jl) = ( hi_max_typ(jl-ice_cat_bounds(jm,1),jm) + hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) * 0.5_wp 
    176 !                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / ht_i(ji,jj,jl) 
    177 !               ENDIF 
    178 !            END DO ! ji 
    179 !         END DO !jj 
    180 !      END DO !jl 
    181       
     87      !---------------------------------------------------- 
     88      ! Rebin categories with thickness out of bounds 
     89      !---------------------------------------------------- 
     90      IF ( jpl > 1 )   CALL lim_itd_th_reb(1, jpl) 
     91 
     92      !---------------------------------------------------------------------- 
     93      ! Constrain the thickness of the smallest category above hiclim 
     94      !---------------------------------------------------------------------- 
     95      DO jj = 1, jpj  
     96         DO ji = 1, jpi 
     97            IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < hiclim ) THEN 
     98               zh             = hiclim / ht_i(ji,jj,1) 
     99               ht_s(ji,jj,1) = ht_s(ji,jj,1) * zh 
     100               ht_i(ji,jj,1) = ht_i(ji,jj,1) * zh 
     101               a_i (ji,jj,1) = a_i(ji,jj,1)  / zh 
     102            ENDIF 
     103         END DO 
     104      END DO 
     105       
     106      !----------------------------------------------------- 
     107      ! ice concentration should not exceed amax  
     108      !----------------------------------------------------- 
    182109      at_i(:,:) = 0._wp 
    183110      DO jl = 1, jpl 
    … …  
    185112      END DO 
    186113 
    187       !---------------------------------------------------- 
    188       ! 2.2) Rebin categories with thickness out of bounds 
    189       !---------------------------------------------------- 
    190       DO jm = 1, jpm 
    191          jbnd1 = ice_cat_bounds(jm,1) 
    192          jbnd2 = ice_cat_bounds(jm,2) 
    193          IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    194       END DO 
    195  
    196       !--------------------------------- 
    197       ! 2.3) Melt of an internal layer 
    198       !--------------------------------- 
    199       internal_melt(:,:,:) = 0 
    200  
    201       DO jl = 1, jpl 
    202          DO jk = 1, nlay_i 
    203             DO jj = 1, jpj  
    204                DO ji = 1, jpi 
    205                   ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    206                   IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) & 
    207                     & .AND. ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN 
    208                      internal_melt(ji,jj,jl) = 1 
    209                   ENDIF 
    210                END DO ! ji 
    211             END DO ! jj 
    212          END DO !jk 
    213       END DO !jl 
    214  
    215       DO jl = 1, jpl 
    216          DO jj = 1, jpj  
     114      DO jl  = 1, jpl 
     115         DO jj = 1, jpj 
    217116            DO ji = 1, jpi 
    218                IF( internal_melt(ji,jj,jl) == 1 ) THEN 
    219                   ! initial ice thickness 
    220                   !----------------------- 
     117               IF( at_i(ji,jj) > amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 
     118                  a_i(ji,jj,jl)  = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - amax / at_i(ji,jj) ) ) 
    221119                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
    222  
    223                   ! reduce ice thickness 
    224                   !----------------------- 
    225                   ind_im = 0 
    226                   zesum = 0.0 
    227                   DO jk = 1, nlay_i 
    228                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    229                      IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) ind_im = ind_im + 1 
    230                      zesum = zesum + e_i(ji,jj,jk,jl) 
    231                   END DO 
    232                   ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) 
    233                   v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    234  
    235                   !CLEM 
    236                   zdvres = REAL(ind_im)*ht_i(ji,jj,jl) / REAL(nlay_i) * a_i(ji,jj,jl) 
    237                   !rdm_ice(ji,jj) = rdm_ice(ji,jj) - zdvres * rhoic 
    238                   !sfx_res(ji,jj)  = sfx_res(ji,jj) + sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    239  
    240                   ! redistribute heat 
    241                   !----------------------- 
    242                   ! old thicknesses and enthalpies 
    243                   ind_im = 0 
    244                   DO jk = 1, nlay_i 
    245                      ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt 
    246                      IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  &  
    247                         ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN 
    248                         ind_im = ind_im + 1 
    249                         zthick0(ind_im) = ht_i(ji,jj,jl) * REAL(ind_im / nlay_i) 
    250                         zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 ) 
    251                      ENDIF 
    252                   END DO 
    253  
    254                   ! Redistributing energy on the new grid 
    255                   IF ( ind_im .GT. 0 ) THEN 
    256  
    257                      DO jk = 1, nlay_i 
    258                         e_i(ji,jj,jk,jl) = 0.0 
    259                         DO layer = 1, ind_im 
    260                            zweight         = MAX (  & 
    261                               MIN( ht_i(ji,jj,jl) * REAL(layer/ind_im) , ht_i(ji,jj,jl) * REAL(jk / nlay_i) ) -       & 
    262                               MAX( ht_i(ji,jj,jl) * REAL((layer-1)/ind_im) , ht_i(ji,jj,jl) * REAL((jk-1) / nlay_i) ) , 0.0 ) & 
    263                               /  ( ht_i(ji,jj,jl) / REAL(ind_im) ) 
    264  
    265                            e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer) 
    266                         END DO !layer 
    267                      END DO ! jk 
    268  
    269                      zesum = 0.0 
    270                      DO jk = 1, nlay_i 
    271                         zesum = zesum + e_i(ji,jj,jk,jl) 
    272                      END DO 
    273  
    274                   ELSE ! ind_im .EQ. 0, total melt 
    275                      e_i(ji,jj,jk,jl) = 0.0 
    276                   ENDIF 
    277  
    278                ENDIF ! internal_melt 
    279  
    280             END DO ! ji 
    281          END DO !jj 
    282       END DO !jl 
    283  
    284       internal_melt(:,:,:) = 0 
    285  
    286  
    287       ! Melt of snow 
    288       !-------------- 
    289       DO jl = 1, jpl 
    290          DO jj = 1, jpj  
    291             DO ji = 1, jpi 
    292                ! snow energy of melting 
    293                zinda   =  MAX( 0._wp, SIGN( 1._wp, v_s(ji,jj,jl) - epsi10 ) ) 
    294                ze_s = zinda * e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) / MAX( v_s(ji,jj,jl), epsi10 )  ! snow energy of melting 
    295  
    296                ! If snow energy of melting smaller then Lf 
    297                ! Then all snow melts and meltwater, heat go to the ocean 
    298                IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1 
    299  
     120               ENDIF 
    300121            END DO 
    301122         END DO 
    302123      END DO 
    303  
    304       DO jl = 1, jpl 
    305          DO jj = 1, jpj  
    306             DO ji = 1, jpi 
    307                IF ( internal_melt(ji,jj,jl) == 1 ) THEN 
    308                   zdvres = v_s(ji,jj,jl) 
    309                   ! release heat 
    310                   fheat_res(ji,jj) = fheat_res(ji,jj) + ze_s * zdvres / rdt_ice 
    311                   ! release mass 
    312                   !rdm_snw(ji,jj) =  rdm_snw(ji,jj) - zdvres * rhosn 
    313                   ! 
    314                   v_s(ji,jj,jl)   = 0.0 
    315                   e_s(ji,jj,1,jl) = 0.0 
    316                  ENDIF 
    317             END DO 
    318          END DO 
    319       END DO 
    320  
    321       zbigvalue      = 1.0e+20 
    322       DO jl = 1, jpl 
    323          DO jj = 1, jpj  
    324             DO ji = 1, jpi 
    325  
    326                !switches 
    327                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    328                !switch = 1 if a_i > 1e-06 and 0 if not 
    329                zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) !=1 if hs > 1e-10 and 0 if not 
    330                zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) !=1 if hi > 1e-10 and 0 if not 
    331                ! bug fix 25 avril 2007 
    332                zindb         = zindb*zindic 
    333  
    334                !--- 2.3 Correction to ice age  
    335                !------------------------------ 
    336                !                IF ((o_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*float(numit))) THEN 
    337                !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/rday 
    338                !                ENDIF 
    339                IF ((oa_i(ji,jj,jl)-1.0)*rday.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN 
    340                   oa_i(ji,jj,jl) = rdt_ice*numit/rday*a_i(ji,jj,jl) 
    341                ENDIF 
    342                oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl) 
    343  
    344                !--- 2.4 Correction to snow thickness 
    345                !------------------------------------- 
    346                zdvres = (zindsn * zindb - 1._wp) * v_s(ji,jj,jl) 
    347                v_s(ji,jj,jl) = v_s(ji,jj,jl) + zdvres 
    348  
    349                !rdm_snw(ji,jj) = rdm_snw(ji,jj) + zdvres * rhosn 
    350   
    351                !--- 2.5 Correction to ice thickness 
    352                !------------------------------------- 
    353                zdvres = (zindb - 1._wp) * v_i(ji,jj,jl) 
    354                v_i(ji,jj,jl) = v_i(ji,jj,jl) + zdvres 
    355  
    356                !rdm_ice(ji,jj) = rdm_ice(ji,jj) + zdvres * rhoic 
    357                !sfx_res(ji,jj)  = sfx_res(ji,jj) - sm_i(ji,jj,jl) * ( rhoic * zdvres / rdt_ice ) 
    358  
    359                !--- 2.6 Snow is transformed into ice if the original ice cover disappears 
    360                !---------------------------------------------------------------------------- 
    361                zindg          = tms(ji,jj) *  MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    362                zdvres         = zindg * rhosn * v_s(ji,jj,jl) / rau0 
    363                v_i(ji,jj,jl)  = v_i(ji,jj,jl)  + zdvres 
    364  
    365                zdvres         = zindsn*zindb * ( - zindg * v_s(ji,jj,jl) + zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn ) 
    366                v_s(ji,jj,jl)  = v_s(ji,jj,jl)  + zdvres 
    367  
    368                !--- 2.7 Correction to ice concentrations  
    369                !-------------------------------------------- 
    370                a_i(ji,jj,jl) = zindb * a_i(ji,jj,jl) 
    371  
    372                !------------------------- 
    373                ! 2.8) Snow heat content 
    374                !------------------------- 
    375                e_s(ji,jj,1,jl) = zindsn * ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) 
    376  
    377             END DO ! ji 
    378          END DO ! jj 
    379       END DO ! jl 
    380  
    381       !------------------------ 
    382       ! 2.9) Ice heat content  
    383       !------------------------ 
    384  
    385       DO jl = 1, jpl 
    386          DO jk = 1, nlay_i 
    387             DO jj = 1, jpj  
    388                DO ji = 1, jpi 
    389                   zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) )  
    390                   e_i(ji,jj,jk,jl)= zindic * ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) 
    391                END DO ! ji 
    392             END DO ! jj 
    393          END DO !jk 
    394       END DO !jl 
    395  
    396  
    397       DO jm = 1, jpm 
    398          DO jj = 1, jpj  
    399             DO ji = 1, jpi 
    400                jl = ice_cat_bounds(jm,1) 
    401                !--- 2.12 Constrain the thickness of the smallest category above 5 cm 
    402                !---------------------------------------------------------------------- 
    403                zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    404                ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi10) 
    405                zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi10 ) ) 
    406                ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh 
    407                ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh 
    408                a_i (ji,jj,jl) = a_i(ji,jj,jl) / zh 
    409                !CLEM 
    410                v_i (ji,jj,jl) = a_i(ji,jj,jl) * ht_i(ji,jj,jl) 
    411                v_s (ji,jj,jl) = a_i(ji,jj,jl) * ht_s(ji,jj,jl) 
    412             END DO !ji 
    413          END DO !jj 
    414       END DO !jm 
    415124 
    416125      at_i(:,:) = 0.0 
    … …  
    418127         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    419128      END DO 
    420        
    421       !--- 2.13 ice concentration should not exceed amax  
    422       !         (it should not be the case)  
    423       !----------------------------------------------------- 
    424       DO jj = 1, jpj 
    425          DO ji = 1, jpi 
    426             z_da_ex =  MAX( at_i(ji,jj) - amax , 0.0 )         
    427             zindb   =  MAX( rzero, SIGN( rone, at_i(ji,jj) - epsi10 ) )  
    428             DO jl  = 1, jpl 
    429                z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi10 ) * zindb 
    430                a_i(ji,jj,jl) = MAX( 0._wp, a_i(ji,jj,jl) - z_da_i ) 
    431                ! 
    432                zinda   =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi10 ) )  
    433                ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zinda 
    434                !v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) ! makes ice shrinken but should not be used 
    435             END DO 
    436          END DO 
    437       END DO 
    438       at_i(:,:) = 0.0 
    439       DO jl = 1, jpl 
    440          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    441       END DO 
    442  
     129 
     130      ! -------------------------------------- 
    443131      ! Final thickness distribution rebinning 
    444132      ! -------------------------------------- 
    445       DO jm = 1, jpm 
    446          jbnd1 = ice_cat_bounds(jm,1) 
    447          jbnd2 = ice_cat_bounds(jm,2) 
    448          IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm) 
    449          IF (ice_ncat_types(jm) .EQ. 1 ) THEN 
    450          ENDIF 
    451       END DO 
     133      IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 
     134 
     135      !----------------- 
     136      ! zap small values 
     137      !----------------- 
     138      CALL lim_itd_me_zapsmall 
    452139 
    453140      !--------------------- 
    454141      ! 2.11) Ice salinity 
    455142      !--------------------- 
    456       ! clem correct bug on smv_i 
    457       smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    458  
    459       IF (  num_sal == 2  ) THEN ! general case 
     143      IF (  num_sal == 2  ) THEN  
    460144         DO jl = 1, jpl 
    461             !DO jk = 1, nlay_i 
    462                DO jj = 1, jpj  
    463                   DO ji = 1, jpi 
    464                      ! salinity stays in bounds 
    465                      !clem smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)),0.1 * v_i(ji,jj,jl) ) 
    466                      smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) 
    467                      i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, -v_i(ji,jj,jl) ) ) 
    468                      smv_i(ji,jj,jl) = i_ice_switch * smv_i(ji,jj,jl) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
    469                   END DO ! ji 
    470                END DO ! jj 
    471             !END DO !jk 
     145            DO jj = 1, jpj  
     146               DO ji = 1, jpi 
     147                  zsal            = smv_i(ji,jj,jl) 
     148                  smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
     149                  ! salinity stays in bounds 
     150                  i_ice_switch    = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) 
     151                  smv_i(ji,jj,jl) = i_ice_switch * MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) ) !+ s_i_min * ( 1._wp - i_ice_switch ) * v_i(ji,jj,jl) 
     152                  ! associated salt flux 
     153                  sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice 
     154               END DO ! ji 
     155            END DO ! jj 
    472156         END DO !jl 
    473157      ENDIF 
    474  
    475       ! ------------------- 
    476       at_i(:,:) = a_i(:,:,1) 
    477       DO jl = 2, jpl 
    478          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    479       END DO 
    480158 
    481159      !------------------------------------------------------------------------------ 
    … …  
    486164      DO jj = 2, jpjm1 
    487165         DO ji = 2, jpim1 
    488             IF ( at_i(ji,jj) .EQ. 0.0 ) THEN ! what to do if there is no ice 
    489                IF ( at_i(ji+1,jj) .EQ. 0.0 ) u_ice(ji,jj)   = 0.0 ! right side 
    490                IF ( at_i(ji-1,jj) .EQ. 0.0 ) u_ice(ji-1,jj) = 0.0 ! left side 
    491                IF ( at_i(ji,jj+1) .EQ. 0.0 ) v_ice(ji,jj)   = 0.0 ! upper side 
    492                IF ( at_i(ji,jj-1) .EQ. 0.0 ) v_ice(ji,jj-1) = 0.0 ! bottom side 
     166            IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice 
     167               IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj)   = 0._wp ! right side 
     168               IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side 
     169               IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj)   = 0._wp ! upper side 
     170               IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side 
    493171            ENDIF 
    494172         END DO 
    … …  
    501179      v_ice(:,:) = v_ice(:,:) * tmv(:,:) 
    502180  
    503       !-------------------------------- 
    504       ! Update mass/salt fluxes (clem) 
    505       !-------------------------------- 
    506       DO jl = 1, jpl 
    507          DO jj = 1, jpj  
    508             DO ji = 1, jpi 
    509                diag_res_pr(ji,jj) = diag_res_pr(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) / rdt_ice  
    510                rdm_ice(ji,jj) = rdm_ice(ji,jj) + ( v_i(ji,jj,jl) - zviold(ji,jj,jl) ) * rhoic  
    511                rdm_snw(ji,jj) = rdm_snw(ji,jj) + ( v_s(ji,jj,jl) - zvsold(ji,jj,jl) ) * rhosn  
    512                sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsmvold(ji,jj,jl) ) * rhoic / rdt_ice  
    513             END DO 
    514          END DO 
    515       END DO 
    516  
    517       ! ------------------------------- 
    518       !- check conservation (C Rousset) 
    519       IF (ln_limdiahsb) THEN 
    520  
    521          zchk_fs  = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 
    522          zchk_fw  = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b 
    523   
    524          zchk_v_i = ( glob_sum( SUM(   v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_v_i_b - ( zchk_fw / rhoic ) ) * r1_rdtice 
    525          zchk_smv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) - zchk_smv_b ) * r1_rdtice + ( zchk_fs / rhoic ) 
    526  
    527          zchk_vmin = glob_min(v_i) 
    528          zchk_amax = glob_max(SUM(a_i,dim=3)) 
    529          zchk_amin = glob_min(a_i) 
    530  
    531          IF(lwp) THEN 
    532             IF ( ABS( zchk_v_i   ) >  1.e-5 ) WRITE(numout,*) 'violation volume [m3/day]     (limupdate2) = ',(zchk_v_i * rday) 
    533             IF ( ABS( zchk_smv   ) >  1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limupdate2) = ',(zchk_smv * rday) 
    534             IF ( zchk_vmin <  0.            ) WRITE(numout,*) 'violation v_i<0  [mm]         (limupdate2) = ',(zchk_vmin * 1.e-3) 
    535             IF ( zchk_amax >  amax+epsi10   ) WRITE(numout,*) 'violation a_i>amax            (limupdate2) = ',zchk_amax 
    536             IF ( zchk_amin <  0.            ) WRITE(numout,*) 'violation a_i<0               (limupdate2) = ',zchk_amin 
    537          ENDIF 
    538       ENDIF 
    539       !- check conservation (C Rousset) 
    540       ! ------------------------------- 
     181      ! ------------------------------------------------- 
     182      ! Diagnostics 
     183      ! ------------------------------------------------- 
     184      d_a_i_thd(:,:,:)   = a_i(:,:,:)   - a_i_b(:,:,:)  
     185      d_v_s_thd(:,:,:)   = v_s(:,:,:)   - v_s_b(:,:,:) 
     186      d_v_i_thd(:,:,:)   = v_i(:,:,:)   - v_i_b(:,:,:)   
     187      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - e_s_b(:,:,:,:)  
     188      d_e_i_thd(:,:,1:nlay_i,:) = e_i(:,:,1:nlay_i,:) - e_i_b(:,:,1:nlay_i,:) 
     189      !?? d_oa_i_thd(:,:,:)  = oa_i (:,:,:) - oa_i_b (:,:,:) 
     190      d_smv_i_thd(:,:,:) = 0._wp 
     191      IF( num_sal == 2 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - smv_i_b(:,:,:) 
     192      ! diag only (clem) 
     193      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 
     194 
     195      ! heat content variation (W.m-2) 
     196      DO jj = 1, jpj 
     197         DO ji = 1, jpi             
     198            diag_heat_dhc(ji,jj) = ( SUM( d_e_i_trp(ji,jj,1:nlay_i,:) + d_e_i_thd(ji,jj,1:nlay_i,:) ) +  &  
     199               &                     SUM( d_e_s_trp(ji,jj,1:nlay_s,:) + d_e_s_thd(ji,jj,1:nlay_s,:) )    & 
     200               &                   ) * unit_fac * r1_rdtice / area(ji,jj)    
     201         END DO 
     202      END DO 
     203 
     204      ! conservation test 
     205      IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    541206 
    542207      IF(ln_ctl) THEN   ! Control print 
    … …  
    550215         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update2  : strength    :') 
    551216         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update2  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :') 
    552          CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update2  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_v_ice   :') 
     217         CALL prt_ctl(tab2d_1=u_ice_b    , clinfo1=' lim_update2  : u_ice_b     :', tab2d_2=v_ice_b    , clinfo2=' v_ice_b     :') 
    553218 
    554219         DO jl = 1, jpl 
    … …  
    563228            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update2  : o_i         : ') 
    564229            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update2  : a_i         : ') 
    565             CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_a_i     : ') 
     230            CALL prt_ctl(tab2d_1=a_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : a_i_b       : ') 
    566231            CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_a_i_thd   : ') 
    567232            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update2  : v_i         : ') 
    568             CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_i     : ') 
     233            CALL prt_ctl(tab2d_1=v_i_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_i_b       : ') 
    569234            CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_i_thd   : ') 
    570235            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update2  : v_s         : ') 
    571             CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update2  : old_v_s     : ') 
     236            CALL prt_ctl(tab2d_1=v_s_b      (:,:,jl)        , clinfo1= ' lim_update2  : v_s_b       : ') 
    572237            CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update2  : d_v_s_thd   : ') 
    573238            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1        : ') 
    574             CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i1    : ') 
     239            CALL prt_ctl(tab2d_1=e_i_b      (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : e_i1_b      : ') 
    575240            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : de_i1_thd   : ') 
    576241            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2        : ') 
    577             CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : old_e_i2    : ') 
     242            CALL prt_ctl(tab2d_1=e_i_b      (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : e_i2_b      : ') 
    578243            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update2  : de_i2_thd   : ') 
    579244            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow      : ') 
    580             CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update2  : old_e_snow  : ') 
     245            CALL prt_ctl(tab2d_1=e_s_b      (:,:,1,jl)      , clinfo1= ' lim_update2  : e_snow_b    : ') 
    581246            CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update2  : d_e_s_thd   : ') 
    582247            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update2  : smv_i       : ') 
    583             CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update2  : old_smv_i   : ') 
     248            CALL prt_ctl(tab2d_1=smv_i_b    (:,:,jl)        , clinfo1= ' lim_update2  : smv_i_b     : ') 
    584249            CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update2  : d_smv_i_thd : ') 
    585250            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update2  : oa_i        : ') 
    586             CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update2  : old_oa_i    : ') 
     251            CALL prt_ctl(tab2d_1=oa_i_b     (:,:,jl)        , clinfo1= ' lim_update2  : oa_i_b      : ') 
    587252            CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update2  : d_oa_i_thd  : ') 
    588253 
    … …  
    596261         CALL prt_ctl_info(' - Heat / FW fluxes : ') 
    597262         CALL prt_ctl_info('   ~~~~~~~~~~~~~~~~~~ ') 
    598          CALL prt_ctl(tab2d_1=fmmec  , clinfo1= ' lim_update2 : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ') 
    599263         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update2 : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ') 
    600          CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update2 : fhbri : ', tab2d_2=fheat_mec , clinfo2= ' fheat_mec : ') 
    601264 
    602265         CALL prt_ctl_info(' ') 
    … …  
    608271      ENDIF 
    609272    
    610       CALL wrk_dealloc( jpi,jpj,jpl, internal_melt )   ! integer 
    611       CALL wrk_dealloc( jkmax, zthick0, zqm0 ) 
    612  
    613       CALL wrk_dealloc( jpi,jpj,jpl,zviold, zvsold, zsmvold )   ! clem 
    614  
    615273      IF( nn_timing == 1 )  CALL timing_stop('limupdate2') 
     274 
    616275   END SUBROUTINE lim_update2 
    617276#else 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r4333 r4921  
    6767 
    6868   REAL(wp) ::   epsi10 = 1.e-10_wp   !    -       - 
    69    REAL(wp) ::   zzero = 0.e0        !    -       - 
    70    REAL(wp) ::   zone  = 1.e0        !    -       - 
    7169 
    7270   !!---------------------------------------------------------------------- 
    … …  
    113111               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration 
    114112               ! 
    115                zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
     113               zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    116114               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda  ! ice thickness 
    117115            END DO 
    … …  
    134132            DO jj = 1, jpj 
    135133               DO ji = 1, jpi 
    136                   zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - epsi10 ) )  
    137                   zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi10 ) )  
     134                  zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )  
     135                  zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )  
    138136                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content 
    139137                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda   ! ice salinity 
    … …  
    205203               DO ji = 1, jpi 
    206204                  !                                                              ! Energy of melting q(S,T) [J.m-3] 
    207                   zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
    208205                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    209                   zq_i    = zq_i * unit_fac * zindb                              !convert units 
     206                  zq_i    = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)  
     207                  zq_i    = zq_i * unit_fac                             !convert units 
    210208                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature 
    211209                  ! 
    … …  
    231229               DO ji = 1, jpi 
    232230                  !Energy of melting q(S,T) [J.m-3] 
    233                   zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
    234231                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) )     ! zindb = 0 if no ice and 1 if yes 
    235                   zq_s  = zq_s * unit_fac * zindb                                    ! convert units 
     232                  zq_s  = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp) 
     233                  zq_s  = zq_s * unit_fac                                    ! convert units 
    236234                  ! 
    237235                  t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 ) 
    … …  
    320318            DO jj = 1, jpj 
    321319               DO ji = 1, jpi 
    322                   z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) ) 
     320                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 
    323321               END DO 
    324322            END DO 
    … …  
    466464      ! Vertically constant, constant in time 
    467465      !--------------------------------------- 
    468       IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal 
     466      IF( num_sal == 1 )   s_i_1d(:,:) = bulk_sal 
    469467 
    470468      !------------------------------------------------------ 
    … …  
    475473         ! 
    476474         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero 
    477             z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(ji) ) 
     475            z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 
    478476         END DO 
    479477 
    … …  
    491489               ij =     ( npb(ji) - 1 ) / jpi + 1 
    492490               ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise 
    493                zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) )  
     491               zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_1d(ji) ) )  
    494492               ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws  
    495                zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) )  
     493               zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )  
    496494               ! if 2.sm_i GE sss_m then zindbal = 1 
    497495               ! this is to force a constant salinity profile in the Baltic Sea 
    498                zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(ii,ij) ) ) 
     496               zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    499497               ! 
    500                zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal ) 
     498               zalpha = (  zind0 + zind01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal ) 
    501499               ! 
    502                zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2 
     500               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2 
    503501               ! weighting the profile 
    504                s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji) 
     502               s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 
    505503            END DO ! ji 
    506504         END DO ! jk 
    … …  
    514512      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    515513         ! 
    516          sm_i_b(:) = 2.30_wp 
     514         sm_i_1d(:) = 2.30_wp 
    517515         ! 
    518516!CDIR NOVERRCHK 
    … …  
    521519            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    522520            DO ji = kideb, kiut 
    523                s_i_b(ji,jk) = zsal 
     521               s_i_1d(ji,jk) = zsal 
    524522            END DO 
    525523         END DO 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r4624 r4921  
    99   !!---------------------------------------------------------------------- 
    1010   !!   lim_wri      : write of the diagnostics variables in ouput file  
    11    !!   lim_wri_init : initialization and namelist read 
    1211   !!   lim_wri_state : write for initial state or/and abandon 
    1312   !!---------------------------------------------------------------------- 
    … …  
    3635   PUBLIC lim_wri_state  ! called by dia_wri_state  
    3736 
    38    INTEGER, PARAMETER ::   jpnoumax = 43   !: maximum number of variable for ice output 
    39     
    40    INTEGER  ::   noumef             ! number of fields 
    41    INTEGER  ::   noumefa            ! number of additional fields 
    42    INTEGER  ::   add_diag_swi       ! additional diagnostics 
    43    INTEGER  ::   nz                                         ! dimension for the itd field 
    44  
    45    REAL(wp) , DIMENSION(jpnoumax) ::   cmulti         ! multiplicative constant 
    46    REAL(wp) , DIMENSION(jpnoumax) ::   cadd           ! additive constant 
    47    REAL(wp) , DIMENSION(jpnoumax) ::   cmultia        ! multiplicative constant 
    48    REAL(wp) , DIMENSION(jpnoumax) ::   cadda          ! additive constant 
    49    CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn, titna   ! title of the field 
    50    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam , nama    ! name of the field 
    51    CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni , unia    ! unit of the field 
    52    INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 ) 
    53  
    5437   REAL(wp)  ::   epsi06 = 1.e-6_wp 
    55    REAL(wp)  ::   zzero  = 0._wp 
    56    REAL(wp)  ::   zone   = 1._wp       
    5738   !!---------------------------------------------------------------------- 
    5839   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    … …  
    7859      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere 
    7960      ! 
    80       INTEGER ::  ji, jj, jk, jl, jf, ipl ! dummy loop indices 
    81       INTEGER ::  ierr 
    82       REAL(wp),DIMENSION(1) ::   zdept 
    83       REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb, zindc 
    84       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa 
    85       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield 
    86       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei 
    87  
    88       CHARACTER(len = 60) ::   clhstnam, clop, clhstnama 
    89  
    90       INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid 
    91       INTEGER , SAVE ::   nicea, nhorida, ndimitd 
    92       INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndex51 
    93       INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd 
     61      INTEGER ::  ji, jj, jk, jl  ! dummy loop indices 
     62      REAL(wp) ::  zinda, zindb, z1_365 
     63      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zoi, zei 
     64      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d, z2da, z2db, zind    ! 2D workspace 
    9465      !!------------------------------------------------------------------- 
    9566 
    9667      IF( nn_timing == 1 )  CALL timing_start('limwri') 
    9768 
    98       CALL wrk_alloc( jpi, jpj, zfield ) 
    99       CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    100       CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
    101  
    102       ipl = jpl 
    103  
    104       IF( numit == nstart ) THEN  
    105  
    106          ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr ) 
    107          IF( lk_mpp    )   CALL mpp_sum ( ierr ) 
    108          IF( ierr /= 0 ) THEN 
    109             CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' )   ;   RETURN 
    110          ENDIF 
    111  
    112          CALL lim_wri_init  
    113  
    114          IF(lwp) WRITE(numout,*) ' lim_wri, first time step ' 
    115          IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    116  
    117          !-------------------- 
    118          !  1) Initialization 
    119          !-------------------- 
    120  
    121          !------------- 
    122          ! Normal file 
    123          !------------- 
    124          niter    = ( nit000 - 1 ) / nn_fsbc 
    125          CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 
    126          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    127 !clem 
    128 !         zsto     = rdt_ice 
    129 !         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!) 
    130 !         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time) 
    131 !         ENDIF 
    132 !         zout     = nwrite * rdt_ice / nn_fsbc 
    133 !         zdept(1) = 0. 
    134 ! 
    135 !         CALL dia_nam ( clhstnam, nwrite, 'icemod_old' ) 
    136 !         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   & 
    137 !            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set ) 
    138 !         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    139 !         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    140 ! 
    141 !         DO jf = 1 , noumef 
    142 !            IF(lwp) WRITE(numout,*) 'jf', jf 
    143 !            IF ( nc(jf) == 1 ) THEN 
    144 !               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj & 
    145 !                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout ) 
    146 !               IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout' 
    147 !               IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout  
    148 !            ENDIF 
    149 !         END DO 
    150 ! 
    151 !         CALL histend(nice, snc4set) 
    152 !clem 
    153          ! 
    154          !----------------- 
    155          ! ITD file output 
    156          !----------------- 
    157          zsto     = rdt_ice 
    158          clop     = "ave(x)" 
    159          zout     = nwrite * rdt_ice / nn_fsbc 
    160          zdept(1) = 0. 
    161  
    162          CALL dia_nam ( clhstnama, nwrite, 'icemoa' ) 
    163          CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         & 
    164             1, jpi, 1, jpj,            & ! zoom 
    165             niter, zjulian, rdt_ice,   & ! time 
    166             nhorida,                   & ! ? linked with horizontal ... 
    167             nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file  
    168          CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz ) 
     69      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei ) 
     70      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zind ) 
     71 
     72      !----------------------------- 
     73      ! Mean category values 
     74      !----------------------------- 
     75 
     76      CALL lim_var_icetm      ! mean sea ice temperature 
     77 
     78      CALL lim_var_bv         ! brine volume 
     79 
     80      DO jj = 1, jpj          ! presence indicator of ice 
     81         DO ji = 1, jpi 
     82            zind(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) 
     83         END DO 
     84      END DO 
     85      ! 
     86      ! 
     87      !                                              
     88      IF ( iom_use( "icethic_cea" ) ) THEN                       ! mean ice thickness 
     89         DO jj = 1, jpj  
     90            DO ji = 1, jpi 
     91               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 
     92            END DO 
     93         END DO 
     94         CALL iom_put( "icethic_cea"  , z2d              ) 
     95      ENDIF 
     96 
     97      IF ( iom_use( "snowthic_cea" ) ) THEN                      ! snow thickness = mean snow thickness over the cell  
     98         DO jj = 1, jpj                                             
     99            DO ji = 1, jpi 
     100               z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zind(ji,jj) 
     101            END DO 
     102         END DO 
     103         CALL iom_put( "snowthic_cea" , z2d              )        
     104      ENDIF 
     105      ! 
     106      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN  
     107         DO jj = 2 , jpjm1 
     108            DO ji = 2 , jpim1 
     109               z2da(ji,jj)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
     110               z2db(ji,jj)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
     111           END DO 
     112         END DO 
     113         CALL lbc_lnk( z2da, 'T', -1. ) 
     114         CALL lbc_lnk( z2db, 'T', -1. ) 
     115         CALL iom_put( "uice_ipa"     , z2da                )       ! ice velocity u component 
     116         CALL iom_put( "vice_ipa"     , z2db                )       ! ice velocity v component 
     117         DO jj = 1, jpj                                  
     118            DO ji = 1, jpi 
     119               z2d(ji,jj)  = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) )  
     120            END DO 
     121         END DO 
     122         CALL iom_put( "icevel"       , z2d                 )       ! ice velocity module 
     123      ENDIF 
     124      ! 
     125      IF ( iom_use( "miceage" ) ) THEN  
     126         z2d(:,:) = 0.e0 
    169127         DO jl = 1, jpl 
    170             zmaskitd(:,:,jl) = tmask(:,:,1) 
    171          END DO 
    172          CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    173          CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  )   
    174          CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   &   
    175             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    176          CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   &   
    177             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    178          CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   &   
    179             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    180          CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   &   
    181             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    182          CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   &   
    183             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    184          CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   &   
    185             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout ) 
    186          CALL histend(nicea, snc4set) 
    187       ENDIF 
    188  
    189       !     !-----------------------------------------------------------------------! 
    190       !     !--2. Computation of instantaneous values                               !  
    191       !     !-----------------------------------------------------------------------! 
    192  
    193       !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    194       !IF( ln_nicep ) THEN 
    195       !   WRITE(numout,*) 
    196       !   WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit 
    197       !   WRITE(numout,*) '~~~~~~~ ' 
    198       !   WRITE(numout,*) ' kindic = ', kindic 
    199       !ENDIF 
    200       !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 
    201  
    202       !-- calculs des valeurs instantanees 
    203       zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    204       zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp 
    205  
    206       ! Ice surface temperature and some fluxes 
    207       DO jl = 1, jpl 
     128            DO jj = 1, jpj 
     129               DO ji = 1, jpi 
     130                  z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * oa_i(ji,jj,jl) 
     131               END DO 
     132            END DO 
     133         END DO 
     134         z1_365 = 1._wp / 365._wp 
     135         CALL iom_put( "miceage"     , z2d * z1_365         )        ! mean ice age 
     136      ENDIF 
     137 
     138      IF ( iom_use( "micet" ) ) THEN  
    208139         DO jj = 1, jpj 
    209140            DO ji = 1, jpi 
    210                zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    211                zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)  
    212                zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)  
    213                zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 
    214                zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)  
    215             END DO 
    216          END DO 
    217       END DO 
    218  
    219       ! Mean sea ice temperature 
    220       CALL lim_var_icetm 
    221  
    222       ! Brine volume 
    223       CALL lim_var_bv 
    224  
    225       DO jj = 2 , jpjm1 
    226          DO ji = 2 , jpim1 
    227             zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) ) 
    228             zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) ) 
    229  
    230             zcmo(ji,jj,1)  = at_i(ji,jj) 
    231             zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
    232             zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda 
    233             zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * rday     ! Bottom thermodynamic ice production 
    234             zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * rday     ! Dynamic ice production (rid/raft) 
    235             zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday     ! Lateral thermodynamic ice production 
    236             zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday     ! Snow ice production ice production 
    237             zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda 
    238  
    239             zcmo(ji,jj,6)  = fbif(ji,jj)*at_i(ji,jj) 
    240             zcmo(ji,jj,7)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp 
    241             zcmo(ji,jj,8)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp 
    242             zcmo(ji,jj,9)  = sst_m(ji,jj) 
    243             zcmo(ji,jj,10) = sss_m(ji,jj) 
    244  
    245             zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 
    246             zcmo(ji,jj,12) = qsr(ji,jj) 
    247             zcmo(ji,jj,13) = qns(ji,jj) 
    248             zcmo(ji,jj,14) = fhbri(ji,jj) 
    249             zcmo(ji,jj,15) = utau_ice(ji,jj) 
    250             zcmo(ji,jj,16) = vtau_ice(ji,jj) 
    251             zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj) 
    252             zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj) 
    253             zcmo(ji,jj,19) = sprecip(ji,jj) 
    254             zcmo(ji,jj,20) = smt_i(ji,jj) 
    255             zcmo(ji,jj,25) = et_i(ji,jj) 
    256             zcmo(ji,jj,26) = et_s(ji,jj) 
    257             zcmo(ji,jj,28) = sfx_bri(ji,jj) 
    258             zcmo(ji,jj,29) = sfx_thd(ji,jj) 
    259  
    260             zcmo(ji,jj,30) = bv_i(ji,jj) 
    261             zcmo(ji,jj,31) = hicol(ji,jj) * zindb 
    262             zcmo(ji,jj,32) = strength(ji,jj) 
    263             zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  ) 
    264             zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday     ! Surface melt 
    265             zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday     ! Bottom melt 
    266             zcmo(ji,jj,36) = divu_i(ji,jj) 
    267             zcmo(ji,jj,37) = shear_i(ji,jj) 
    268             zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday     ! Bottom melt 
    269             zcmo(ji,jj,39) = vt_i(ji,jj)  ! ice volume 
    270             zcmo(ji,jj,40) = vt_s(ji,jj)  ! snow volume 
    271  
    272             zcmo(ji,jj,41) = sfx_mec(ji,jj) 
    273             zcmo(ji,jj,42) = sfx_res(ji,jj) 
    274  
    275             zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday     ! transport of ice volume 
    276  
    277         END DO 
    278       END DO 
    279  
    280       ! 
    281       ! ecriture d'un fichier netcdf 
    282       ! 
    283       niter = niter + 1 
    284 !clem 
    285 !      DO jf = 1 , noumef 
    286 !         ! 
    287 !         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) 
    288 !         ! 
    289 !         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. ) 
    290 !         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. ) 
    291 !         ENDIF 
    292 !         ! 
    293 !         IF( ln_nicep ) THEN  
    294 !            WRITE(numout,*) 
    295 !            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim' 
    296 !            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim 
    297 !         ENDIF 
    298 !         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 ) 
    299 !         ! 
    300 !      END DO 
    301 ! 
    302 !      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    303 !         IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 
    304 !         CALL histclo( nice ) 
    305 !      ENDIF 
    306 !clem 
    307       ! 
    308        CALL iom_put ('iceconc', zcmo(:,:,1) )          ! field1: ice concentration 
    309        CALL iom_put ('icethic_cea', zcmo(:,:,2) )      ! field2: ice thickness (i.e. icethi(:,:)) 
    310        CALL iom_put ('snowthic_cea', zcmo(:,:,3))      ! field3: snow thickness 
    311        CALL iom_put ('icebopr', zcmo(:,:,4) )   ! field4: daily bottom thermo ice production 
    312        CALL iom_put ('icedypr', zcmo(:,:,5) )   ! field5: daily dynamic ice production 
    313        CALL iom_put ('ioceflxb', zcmo(:,:,6) )         ! field6: Oceanic flux at the ice base 
    314        CALL iom_put ('uice_ipa', zcmo(:,:,7) )         ! field7: ice velocity u component 
    315        CALL iom_put ('vice_ipa', zcmo(:,:,8) )         ! field8: ice velocity v component 
    316        CALL iom_put ('isst', zcmo(:,:,9) )             ! field 9: sea surface temperature 
    317        CALL iom_put ('isss', zcmo(:,:,10) )            ! field 10: sea surface salinity 
    318        CALL iom_put ('qt_oce', zcmo(:,:,11) )           ! field 11: total flux at ocean surface 
    319        CALL iom_put ('qsr_oce', zcmo(:,:,12) )          ! field 12: solar flux at ocean surface 
    320        CALL iom_put ('qns_oce', zcmo(:,:,13) )          ! field 13: non-solar flux at ocean surface 
    321        !CALL iom_put ('hfbri', fhbri )                  ! field 14: heat flux due to brine release 
    322        CALL iom_put( 'utau_ice', zcmo(:,:,15)  )     ! Wind stress over ice along i-axis at I-point 
    323        CALL iom_put( 'vtau_ice', zcmo(:,:,16) )     ! Wind stress over ice along j-axis at I-point 
    324        CALL iom_put ('qsr_io', zcmo(:,:,17) )          ! field 17: solar flux at ice/ocean surface 
    325        CALL iom_put ('qns_io', zcmo(:,:,18) )          ! field 18: non-solar flux at ice/ocean surface 
    326        !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip           
    327        CALL iom_put ('micesalt', zcmo(:,:,20) )        ! field 20 :mean ice salinity 
    328        CALL iom_put ('miceage', zcmo(:,:,21) / 365)    ! field 21: mean ice age 
    329        CALL iom_put ('icelapr',zcmo(:,:,22) )   ! field 22: daily lateral thermo ice prod. 
    330        CALL iom_put ('icesipr',zcmo(:,:,23) )   ! field 23: daily snowice ice prod. 
    331        CALL iom_put ('micet', zcmo(:,:,24) )           ! field 24: mean ice temperature 
    332        CALL iom_put ('icehc', zcmo(:,:,25) )           ! field 25: ice total heat content 
    333        CALL iom_put ('isnowhc', zcmo(:,:,26) )         ! field 26: snow total heat content 
    334        CALL iom_put ('icest', zcmo(:,:,27) )           ! field 27: ice surface temperature 
    335        CALL iom_put ('sfxbri', zcmo(:,:,28) * rday )           ! field 28: brine salt flux 
    336        CALL iom_put ('sfxthd', zcmo(:,:,29) * rday )           ! field 29: equivalent FW salt flux 
    337        CALL iom_put ('ibrinv', zcmo(:,:,30) *100 )     ! field 30: brine volume 
    338        CALL iom_put ('icecolf', zcmo(:,:,31) )         ! field 31: frazil ice collection thickness 
    339        CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 )  ! field 32: ice strength 
    340        CALL iom_put ('icevel', zcmo(:,:,33) )          ! field 33: ice velocity 
    341        CALL iom_put ('isume', zcmo(:,:,34) )    ! field 34: surface melt 
    342        CALL iom_put ('ibome', zcmo(:,:,35) )     ! field 35: bottom melt 
    343        CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8)    ! field 36: divergence 
    344        CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 )  ! field 37: shear 
    345        CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate 
    346        CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume 
    347        CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume 
    348        CALL iom_put ('sfxmec', zcmo(:,:,41) * rday )           ! field 41: salt flux from ridging rafting 
    349        CALL iom_put ('sfxres', zcmo(:,:,42) * rday )           ! field 42: salt flux from limupdate (resultant) 
    350        CALL iom_put ('icetrp', zcmo(:,:,43) )    ! field 43: ice volume transport 
    351  
    352       !----------------------------- 
    353       ! Thickness distribution file 
    354       !----------------------------- 
    355       IF( add_diag_swi == 1 ) THEN 
    356  
    357          DO jl = 1, jpl  
    358             CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. ) 
    359             CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. ) 
    360             CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. ) 
    361             CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. ) 
    362             CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. ) 
    363          END DO 
    364  
    365          ! Compute ice age 
     141               z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zind(ji,jj) 
     142            END DO 
     143         END DO 
     144         CALL iom_put( "micet"       , z2d                  )        ! mean ice temperature 
     145      ENDIF 
     146      ! 
     147      IF ( iom_use( "icest" ) ) THEN  
     148         z2d(:,:) = 0.e0 
     149         DO jl = 1, jpl 
     150            DO jj = 1, jpj 
     151               DO ji = 1, jpi 
     152                  z2d(ji,jj) = z2d(ji,jj) + zind(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 ) 
     153               END DO 
     154            END DO 
     155         END DO 
     156         CALL iom_put( "icest"       , z2d                 )        ! ice surface temperature 
     157      ENDIF 
     158 
     159      IF ( iom_use( "icecolf" ) ) THEN  
     160         DO jj = 1, jpj 
     161            DO ji = 1, jpi 
     162               zindb  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) ) 
     163               z2d(ji,jj) = hicol(ji,jj) * zindb 
     164            END DO 
     165         END DO 
     166         CALL iom_put( "icecolf"     , z2d                 )        ! frazil ice collection thickness 
     167      ENDIF 
     168 
     169      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature 
     170      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity 
     171      CALL iom_put( "iceconc"     , at_i                )        ! ice concentration 
     172      CALL iom_put( "icevolu"     , vt_i                )        ! ice volume = mean ice thickness over the cell 
     173      CALL iom_put( "icehc"       , et_i                )        ! ice total heat content 
     174      CALL iom_put( "isnowhc"     , et_s                )        ! snow total heat content 
     175      CALL iom_put( "ibrinv"      , bv_i * 100._wp      )        ! brine volume 
     176      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point 
     177      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point 
     178      CALL iom_put( "snowpre"     , sprecip             )        ! snow precipitation  
     179      CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity 
     180 
     181      CALL iom_put( "icestr"      , strength * 0.001    )        ! ice strength 
     182      CALL iom_put( "idive"       , divu_i * 1.0e8      )        ! divergence 
     183      CALL iom_put( "ishear"      , shear_i * 1.0e8     )        ! shear 
     184      CALL iom_put( "snowvol"     , vt_s                )        ! snow volume 
     185       
     186      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport 
     187      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport 
     188      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2) 
     189      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2) 
     190 
     191      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from brines 
     192      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from brines 
     193      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from brines 
     194      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from brines 
     195      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from brines 
     196      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting 
     197      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant) 
     198      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines 
     199      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux 
     200 
     201      CALL iom_put( "vfxres"     , wfx_res * rday / rhoic  )        ! daily prod./melting due to limupdate  
     202      CALL iom_put( "vfxopw"     , wfx_opw * rday / rhoic  )        ! daily lateral thermodynamic ice production 
     203      CALL iom_put( "vfxsni"     , wfx_sni * rday / rhoic  )        ! daily snowice ice production 
     204      CALL iom_put( "vfxbog"     , wfx_bog * rday / rhoic  )       ! daily bottom thermodynamic ice production 
     205      CALL iom_put( "vfxdyn"     , wfx_dyn * rday / rhoic  )       ! daily dynamic ice production (rid/raft) 
     206      CALL iom_put( "vfxsum"     , wfx_sum * rday / rhoic  )        ! surface melt  
     207      CALL iom_put( "vfxbom"     , wfx_bom * rday / rhoic  )        ! bottom melt  
     208      CALL iom_put( "vfxice"     , wfx_ice * rday / rhoic  )        ! total ice growth/melt  
     209      CALL iom_put( "vfxsnw"     , wfx_snw * rday / rhoic  )        ! total snw growth/melt  
     210      CALL iom_put( "vfxsub"     , wfx_sub * rday / rhoic  )        ! sublimation (snow)  
     211      CALL iom_put( "vfxspr"     , wfx_spr * rday / rhoic  )        ! precip (snow)  
     212 
     213      CALL iom_put ('hfxthd', hfx_thd(:,:) )   !   
     214      CALL iom_put ('hfxdyn', hfx_dyn(:,:) )   !   
     215      CALL iom_put ('hfxres', hfx_res(:,:) )   !   
     216      CALL iom_put ('hfxout', hfx_out(:,:) )   !   
     217      CALL iom_put ('hfxin' , hfx_in(:,:) )   !   
     218      CALL iom_put ('hfxsnw', hfx_snw(:,:) )   !   
     219      CALL iom_put ('hfxsub', hfx_sub(:,:) )   !   
     220      CALL iom_put ('hfxerr', hfx_err(:,:) )   !   
     221      CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) )   !   
     222       
     223      CALL iom_put ('hfxsum', hfx_sum(:,:) )   !   
     224      CALL iom_put ('hfxbom', hfx_bom(:,:) )   !   
     225      CALL iom_put ('hfxbog', hfx_bog(:,:) )   !   
     226      CALL iom_put ('hfxdif', hfx_dif(:,:) )   !   
     227      CALL iom_put ('hfxopw', hfx_opw(:,:) )   !   
     228      CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) )   ! turbulent heat flux at ice base  
     229      CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) )          ! Heat content variation in snow and ice  
     230      CALL iom_put ('hfxspr', hfx_spr(:,:) )          ! Heat content of snow precip  
     231       
     232      !-------------------------------- 
     233      ! Output values for each category 
     234      !-------------------------------- 
     235      CALL iom_put( "iceconc_cat"      , a_i         )        ! area for categories 
     236      CALL iom_put( "icethic_cat"      , ht_i        )        ! thickness for categories 
     237      CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories 
     238      CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories 
     239 
     240      ! Compute ice age 
     241      IF ( iom_use( "iceage_cat" ) ) THEN  
    366242         DO jl = 1, jpl  
    367243            DO jj = 1, jpj 
    368244               DO ji = 1, jpi 
    369                   zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
     245                  zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    370246                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda 
    371247               END DO 
    372248            END DO 
    373249         END DO 
    374  
    375          ! Compute brine volume 
     250         CALL iom_put( "iceage_cat"     , zoi         )        ! ice age for categories 
     251      ENDIF 
     252 
     253      ! Compute brine volume 
     254      IF ( iom_use( "brinevol_cat" ) ) THEN  
    376255         zei(:,:,:) = 0._wp 
    377256         DO jl = 1, jpl  
    … …  
    379258               DO jj = 1, jpj 
    380259                  DO ji = 1, jpi 
    381                      zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) ) 
     260                     zinda = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    382261                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* & 
    383262                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * & 
    … …  
    387266            END DO 
    388267         END DO 
    389  
    390          DO jl = 1, jpl  
    391             CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. ) 
    392          END DO 
    393  
    394          CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area 
    395          CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness 
    396          CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth 
    397          CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity 
    398          CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age 
    399          CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume 
    400  
    401          !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
    402          !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
    403          !     not yet implemented 
    404  
    405          IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    406             IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 
    407             CALL histclo( nicea )  
    408          ENDIF 
    409          ! 
    410       ENDIF 
    411  
    412       CALL wrk_dealloc( jpi, jpj, zfield ) 
    413       CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa ) 
    414       CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei ) 
     268         CALL iom_put( "brinevol_cat"     , zei         )        ! brine volume for categories 
     269      ENDIF 
     270 
     271      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
     272      !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' ) 
     273      !     not yet implemented 
     274       
     275      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei ) 
     276      CALL wrk_dealloc( jpi, jpj     , z2d, zind, z2da, z2db ) 
    415277 
    416278      IF( nn_timing == 1 )  CALL timing_stop('limwri') 
    … …  
    419281#endif 
    420282 
    421    SUBROUTINE lim_wri_init 
    422       !!------------------------------------------------------------------- 
    423       !!                    ***   ROUTINE lim_wri_init  *** 
    424       !!                 
    425       !! ** Purpose :   ??? 
    426       !! 
    427       !! ** Method  : Read the namicewri namelist and check the parameter  
    428       !!       values called at the first timestep (nit000) 
    429       !! 
    430       !! ** input   :   Namelist namicewri 
    431       !!------------------------------------------------------------------- 
    432       INTEGER ::   nf      ! ??? 
    433       INTEGER ::   ios     ! Local integer output status for namelist read 
    434  
    435       TYPE FIELD  
    436          CHARACTER(len = 35) :: ztitle  
    437          CHARACTER(len = 8 ) :: zname           
    438          CHARACTER(len = 8 ) :: zunit 
    439          INTEGER             :: znc    
    440          REAL                :: zcmulti  
    441          REAL                :: zcadd         
    442       END TYPE FIELD 
    443  
    444       TYPE(FIELD) ::  & 
    445          field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
    446          field_7 , field_8 , field_9 , field_10, field_11, field_12,   & 
    447          field_13, field_14, field_15, field_16, field_17, field_18,   & 
    448          field_19, field_20, field_21, field_22, field_23, field_24,   & 
    449          field_25, field_26, field_27, field_28, field_29, field_30,   & 
    450          field_31, field_32, field_33, field_34, field_35, field_36,   & 
    451          field_37, field_38, field_39, field_40, field_41, field_42, field_43 
    452  
    453       TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield 
    454       ! 
    455       NAMELIST/namiceout/ noumef, & 
    456          field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   & 
    457          field_7 , field_8 , field_9 , field_10, field_11, field_12,   & 
    458          field_13, field_14, field_15, field_16, field_17, field_18,   & 
    459          field_19, field_20, field_21, field_22, field_23, field_24,   & 
    460          field_25, field_26, field_27, field_28, field_29, field_30,   & 
    461          field_31, field_32, field_33, field_34, field_35, field_36,   & 
    462          field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi 
    463       !!------------------------------------------------------------------- 
    464       REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs 
    465       READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901) 
    466 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp ) 
    467  
    468       REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs 
    469       READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 ) 
    470 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp ) 
    471       IF(lwm) WRITE ( numoni, namiceout ) 
    472  
    473       zfield(1)  = field_1 
    474       zfield(2)  = field_2 
    475       zfield(3)  = field_3 
    476       zfield(4)  = field_4 
    477       zfield(5)  = field_5 
    478       zfield(6)  = field_6 
    479       zfield(7)  = field_7 
    480       zfield(8)  = field_8 
    481       zfield(9)  = field_9 
    482       zfield(10) = field_10 
    483       zfield(11) = field_11 
    484       zfield(12) = field_12 
    485       zfield(13) = field_13 
    486       zfield(14) = field_14 
    487       zfield(15) = field_15 
    488       zfield(16) = field_16 
    489       zfield(17) = field_17 
    490       zfield(18) = field_18 
    491       zfield(19) = field_19 
    492       zfield(20) = field_20 
    493       zfield(21) = field_21 
    494       zfield(22) = field_22 
    495       zfield(23) = field_23 
    496       zfield(24) = field_24 
    497       zfield(25) = field_25 
    498       zfield(26) = field_26 
    499       zfield(27) = field_27 
    500       zfield(28) = field_28 
    501       zfield(29) = field_29 
    502       zfield(30) = field_30 
    503       zfield(31) = field_31 
    504       zfield(32) = field_32 
    505       zfield(33) = field_33 
    506       zfield(34) = field_34 
    507       zfield(35) = field_35 
    508       zfield(36) = field_36 
    509       zfield(37) = field_37 
    510       zfield(38) = field_38 
    511       zfield(39) = field_39 
    512       zfield(40) = field_40 
    513       zfield(41) = field_41 
    514       zfield(42) = field_42 
    515       zfield(43) = field_43 
    516  
    517       DO nf = 1, noumef 
    518          titn  (nf) = zfield(nf)%ztitle 
    519          nam   (nf) = zfield(nf)%zname 
    520          uni   (nf) = zfield(nf)%zunit 
    521          nc    (nf) = zfield(nf)%znc 
    522          cmulti(nf) = zfield(nf)%zcmulti 
    523          cadd  (nf) = zfield(nf)%zcadd 
    524       END DO 
    525  
    526       IF(lwp) THEN                        ! control print 
    527          WRITE(numout,*) 
    528          WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs' 
    529          WRITE(numout,*) '~~~~~~~~~~~~' 
    530          WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef 
    531          WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   & 
    532             &            '    multiplicative constant       additive constant ' 
    533          DO nf = 1 , noumef          
    534             WRITE(numout,*) '   ', titn(nf), '   '    , nam   (nf), '      '  , uni (nf),   & 
    535                &            '  ' , nc  (nf),'        ', cmulti(nf), '        ', cadd(nf) 
    536          END DO 
    537          WRITE(numout,*) ' add_diag_swi ', add_diag_swi 
    538       ENDIF 
    539       ! 
    540    END SUBROUTINE lim_wri_init 
    541283  
    542284   SUBROUTINE lim_wri_state( kt, kid, kh_i ) 
    … …  
    555297      INTEGER, INTENT( in ) ::   kid , kh_i        
    556298      !!---------------------------------------------------------------------- 
    557       !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz ) 
    558  
    559       CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    560       CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    561       CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    562       CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    563       CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    564       CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    565       CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    566       CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    567       CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    568       CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    569       CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    570       CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    571       CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
    572       CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    573       CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    574       CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    575       CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    576       CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    577       CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    578       CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    579       CALL histdef( kid, "iisfxthd", "Salt flux from thermo"   , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    580       CALL histdef( kid, "iisfxmec", "Salt flux from dynmics"  , ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    581       CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    582  
    583  
    584       !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    585       !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    586       !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
    587       !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )  
     299 
     300      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      ,   & 
     301      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     302      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      ,   & 
     303      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     304      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      ,   & 
     305      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     306      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    ,   & 
     307      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     308      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    ,   & 
     309      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     310      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa",   & 
     311      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     312      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa",   & 
     313      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     314      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2" ,   & 
     315      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     316      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" ,   & 
     317      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     318      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   & 
     319      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     320      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    ,   & 
     321      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     322      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      ,   & 
     323      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     324      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1",   & 
     325      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )  
     326      CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"    ,   & 
     327      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     328      CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"    ,   & 
     329      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     330      CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"    ,   & 
     331      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     332      CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"    ,   & 
     333      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     334      CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"    ,   & 
     335      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     336      CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"    ,   & 
     337      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     338      CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"    ,   & 
     339      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     340      CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""       ,   & 
     341      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
     342      CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""       ,   & 
     343      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
    588344 
    589345      CALL histend( kid, snc4set )   ! end of the file definition 
    … …  
    603359      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) ) 
    604360 
    605       CALL histwrite( kid, "iicebopr", kt, diag_bot_gr        , jpi*jpj, (/1/) ) 
    606       CALL histwrite( kid, "iicedypr", kt, diag_dyn_gr        , jpi*jpj, (/1/) ) 
    607       CALL histwrite( kid, "iicelapr", kt, diag_lat_gr        , jpi*jpj, (/1/) ) 
    608       CALL histwrite( kid, "iicesipr", kt, diag_sni_gr        , jpi*jpj, (/1/) ) 
    609       CALL histwrite( kid, "iicerepr", kt, diag_res_pr        , jpi*jpj, (/1/) ) 
    610       CALL histwrite( kid, "iicebome", kt, diag_bot_me        , jpi*jpj, (/1/) ) 
    611       CALL histwrite( kid, "iicesume", kt, diag_sur_me        , jpi*jpj, (/1/) ) 
    612       CALL histwrite( kid, "iisfxthd", kt, sfx_thd        , jpi*jpj, (/1/) ) 
    613       CALL histwrite( kid, "iisfxmec", kt, sfx_mec        , jpi*jpj, (/1/) ) 
     361      CALL histwrite( kid, "iicebopr", kt, wfx_bog        , jpi*jpj, (/1/) ) 
     362      CALL histwrite( kid, "iicedypr", kt, wfx_dyn        , jpi*jpj, (/1/) ) 
     363      CALL histwrite( kid, "iicelapr", kt, wfx_opw        , jpi*jpj, (/1/) ) 
     364      CALL histwrite( kid, "iicesipr", kt, wfx_sni        , jpi*jpj, (/1/) ) 
     365      CALL histwrite( kid, "iicerepr", kt, wfx_res        , jpi*jpj, (/1/) ) 
     366      CALL histwrite( kid, "iicebome", kt, wfx_bom        , jpi*jpj, (/1/) ) 
     367      CALL histwrite( kid, "iicesume", kt, wfx_sum        , jpi*jpj, (/1/) ) 
     368      CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn        , jpi*jpj, (/1/) ) 
    614369      CALL histwrite( kid, "iisfxres", kt, sfx_res        , jpi*jpj, (/1/) ) 
    615370 
    616       !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area 
    617       !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness 
    618       !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth 
    619       !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity 
     371      ! Close the file 
     372      ! ----------------- 
     373      !CALL histclo( kid ) 
    620374 
    621375    END SUBROUTINE lim_wri_state 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90

    r3764 r4921  
    8989   DO jj = 2 , jpjm1 
    9090      DO ji = 2 , jpim1   ! NO vector opt. 
    91          zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    92          zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     91         zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     92         zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    9393         zindb  = zindh * zinda 
    94          ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
     94         ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )  
    9595         zcmo(ji,jj,1)  = ht_s (ji,jj,1) 
    9696         zcmo(ji,jj,2)  = ht_i (ji,jj,1) 
    97          zcmo(ji,jj,3)  = hicifp(ji,jj) 
     97         zcmo(ji,jj,3)  = 0. 
    9898         zcmo(ji,jj,4)  = frld  (ji,jj) 
    9999         zcmo(ji,jj,5)  = sist  (ji,jj) 
    100          zcmo(ji,jj,6)  = fbif  (ji,jj) 
     100         zcmo(ji,jj,6)  = fhtur  (ji,jj) 
    101101         zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    102102            + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 
    … …  
    132132         DO jj = 2 , jpjm1 
    133133            DO ji = 2 , jpim1   ! NO vector opt. 
    134                zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
    135                zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
     134               zindh  = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,1) * (1.0 - frld(ji,jj) ) - 0.10 ) ) 
     135               zinda  = MAX( 0._wp , SIGN( 1._wp , ( 1.0 - frld(ji,jj) ) - 0.10 ) ) 
    136136               zindb  = zindh * zinda 
    137                ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
     137               ztmu   = MAX( 0.5 * 1._wp , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
    138138               rcmoy(ji,jj,1)  = ht_s (ji,jj,1) 
    139139               rcmoy(ji,jj,2)  = ht_i (ji,jj,1) 
    140                rcmoy(ji,jj,3)  = hicifp(ji,jj) 
     140               rcmoy(ji,jj,3)  = 0. 
    141141               rcmoy(ji,jj,4)  = frld  (ji,jj) 
    142142               rcmoy(ji,jj,5)  = sist  (ji,jj) 
    143                rcmoy(ji,jj,6)  = fbif  (ji,jj) 
     143               rcmoy(ji,jj,6)  = fhtur  (ji,jj) 
    144144               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   & 
    145145                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90

    r2528 r4921  
    1212 
    1313   !                                             !!! ice thermodynamics 
    14    INTEGER, PUBLIC, PARAMETER ::   jkmax    = 6   !: maximum number of ice layers 
     14   INTEGER, PUBLIC, PARAMETER ::   nlay_i   = 5   !: number of ice layers 
    1515   INTEGER, PUBLIC, PARAMETER ::   nlay_s   = 1   !: number of snow layers 
    1616 
    1717   !                                             !!! ice mechanical redistribution 
    1818   INTEGER, PUBLIC, PARAMETER ::   jpl      = 5   !: number of ice categories 
    19    INTEGER, PUBLIC, PARAMETER ::   jpm      = 1   !: number of ice types 
    2019 
    2120   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r4205 r4921  
    2020   !                               !!! ** ice-thermo namelist (namicethd) ** 
    2121   REAL(wp), PUBLIC ::   hmelt       !: maximum melting at the bottom; active only for one category 
    22    REAL(wp), PUBLIC ::   hicmin      !: (REMOVE) 
    2322   REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness 
    24    REAL(wp), PUBLIC ::   sbeta       !: numerical scheme for diffusion in ice  (REMOVE) 
    25    REAL(wp), PUBLIC ::   parlat      !: (REMOVE) 
    26    REAL(wp), PUBLIC ::   hakspl      !: (REMOVE) 
    27    REAL(wp), PUBLIC ::   hibspl      !: (REMOVE) 
    28    REAL(wp), PUBLIC ::   exld        !: (REMOVE) 
    29    REAL(wp), PUBLIC ::   hakdif      !: (REMOVE) 
    30    REAL(wp), PUBLIC ::   thth        !: (REMOVE) 
    3123   REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp. 
    3224   REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not 
    33    REAL(wp), PUBLIC ::   alphs       !: coef. for snow density when snow-ice formation 
    34    REAL(wp), PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1.0) or not (0.0) 
    3525   REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom 
    3626   REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice 
    3727   REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice 
     28   REAL(wp), PUBLIC ::   hiccrit     !: ice th. for lateral accretion in the NH (SH) (m) 
    3829 
    39    REAL(wp), PUBLIC, DIMENSION(2) ::   hiccrit   !: ice th. for lateral accretion in the NH (SH) (m) 
     30   INTEGER , PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1) or not (0) 
    4031 
    4132   !!----------------------------- 
    … …  
    4334   !!----------------------------- 
    4435   !: In ice thermodynamics, to spare memory, the vectors are folded 
    45    !: from 1D to 2D vectors. The following variables, with ending _1d (or _b) 
     36   !: from 1D to 2D vectors. The following variables, with ending _1d 
    4637   !: are the variables corresponding to 2d vectors 
    4738 
    … …  
    4940   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion) 
    5041 
    51    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif 
    52    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif 
    53    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric 
    54    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq 
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice 
    57    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0 
    59    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq 
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlead_1d      
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftr_ice_1d    
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d   
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d    
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d    
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qns_ice_1d   
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_1d      
     49 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sum_1d 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bom_1d 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_bog_1d 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_dif_1d 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_opw_1d 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_snw_1d 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_1d 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_err_rem_1d 
     58 
     59   ! heat flux associated with ice-atmosphere mass exchange 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_sub_1d 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_spr_1d 
     62 
     63   ! heat flux associated with ice-ocean mass exchange 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_thd_1d 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hfx_res_1d 
     66 
     67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_snw_1d  
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sub_1d 
     69 
     70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bog_1d     
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_bom_1d    
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sum_1d   
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_sni_1d  
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_opw_1d 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_res_1d  
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   wfx_spr_1d 
     77 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bog_1d     
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bom_1d     
     81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sum_1d     
     82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_sni_1d     
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_opw_1d    
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_res_1d   
    6285 
    6386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip 
    6487   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld 
    65    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld 
    66    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif 
    67    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_ice_1d    !: <==> the 2D  rdm_ice 
    68    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_snw_1d    !: <==> the 2D  rdm_snw 
    69    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq 
    70    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif 
    72    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif 
    73    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif 
    74    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_1d        !: <==> the 2D  at_i 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhtur_1d      !: <==> the 2D  fhtur 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhld_1d       !: <==> the 2D  fhld 
    7591   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice 
    7692   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice 
    … …  
    7894   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice 
    7995   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics 
    80    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m 
    81    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation 
    8296   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice 
    83    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m] 
    84    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m] 
    85    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri 
    86    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage 
    87    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_thd_1d    !: <==> the 2D sfx_thd 
    8897   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing 
    8998   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage 
    9099   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment 
    91100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion     
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_1d      !: Ice collection thickness accumulated in leads 
    93102 
    94    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su 
    95    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s 
    97    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> the 2D  ht_i 
    98    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su       !: Surface Conduction flux  
    99    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i     !: Bottom  Conduction flux  
    100    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot    !: Snow accretion/ablation        [m] 
    101    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf   !: Ice surface accretion/ablation [m] 
    102    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott   !: Ice bottom accretion/ablation  [m] 
    103    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice  !: Snow ice formation             [m of ice] 
    104    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt] 
    105    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom 
    106    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice 
    107    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days] 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_1d       !: <==> the 2D  t_su 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_1d        !: <==> the 2D  a_i 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_1d       !: <==> the 2D  ht_s 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_1d       !: <==> the 2D  ht_i 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su         !: Surface Conduction flux  
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i       !: Bottom  Conduction flux  
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot      !: Snow accretion/ablation        [m] 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf     !: Ice surface accretion/ablation [m] 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott     !: Ice bottom accretion/ablation  [m] 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice    !: Snow ice formation             [m of ice] 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_1d       !: Ice bulk salinity [ppt] 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new       !: Salinity of new ice at the bottom 
    108115 
    109    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
    110    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: clem attenuation coef of the input solar flux (unitless) 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   iatte_1d   !: attenuation coef of the input solar flux (unitless) 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   oatte_1d   !: attenuation coef of the input solar flux (unitless) 
    111118 
    112    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s 
    113    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i 
    114    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity 
    115    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume 
    116    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_1d   !: corresponding to the 2D var  t_s 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_1d   !: corresponding to the 2D var  t_i 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_1d   !: profiled ice salinity 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_1d   !:    Ice  enthalpy per unit volume 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_1d   !:    Snow enthalpy per unit volume 
    117124 
    118    ! Clean the following ... 
    119    ! These variables are coded for conservation checks 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial) 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final) 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qh_i_old !: ice heat content (q*h, J.m-2) 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   h_i_old  !: ice thickness layer (m) 
    126127 
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash 
    128    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash 
    129    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash 
    130  
    131    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux 
    132    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux 
    133  
    134    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s 
    135    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i 
    136    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay 
    138     
    139128   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point 
    140129 
    … …  
    151140      !!---------------------------------------------------------------------! 
    152141      INTEGER ::   thd_ice_alloc   ! return value 
    153       INTEGER ::   ierr(4) 
     142      INTEGER ::   ierr(3) 
    154143      !!---------------------------------------------------------------------! 
    155144 
    156145      ALLOCATE( npb      (jpij) , npac     (jpij),                          & 
    157146         !                                                                  ! 
    158          &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     & 
    159          &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     & 
    160          &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     & 
    161          &      qfvbq_1d (jpij) , t_bo_b   (jpij) , iatte_1d   (jpij) ,     & 
    162          &      oatte_1d (jpij)                                       , STAT=ierr(1) ) 
     147         &      qlead_1d (jpij) , ftr_ice_1d  (jpij) ,     & 
     148         &      qsr_ice_1d (jpij) ,     & 
     149         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) ,     & 
     150         &      t_bo_1d   (jpij) , iatte_1d  (jpij) , oatte_1d (jpij) ,     & 
     151         &      hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij),     & 
     152         &      hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 
     153         &      hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 
     154         &      hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 
     155         &      hfx_res_1d(jpij) , hfx_err_rem_1d(jpij),       STAT=ierr(1) ) 
    163156      ! 
    164       ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     & 
    165          &      fbif_1d    (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) ,     & 
    166          &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,    & 
    167          &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     & 
     157      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_1d     (jpij) ,     & 
     158         &      fhtur_1d   (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) ,     & 
     159         &      fhld_1d    (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , & 
     160         &      wfx_sum_1d(jpij)  , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) ,  wfx_res_1d (jpij) ,  & 
    168161         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     & 
    169          &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &    
    170          &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &   
    171          &      sfx_bri_1d (jpij) , fhbri_1d   (jpij) , sfx_thd_1d (jpij) ,     & 
     162         &      tatm_ice_1d(jpij) ,      &    
     163         &      i0         (jpij) ,     &   
     164         &      sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) ,   & 
     165         &      sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 
    172166         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &      
    173          &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) ) 
     167         &      dsm_i_si_1d(jpij) , hicol_1d    (jpij)                     , STAT=ierr(2) ) 
    174168      ! 
    175       ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &    
    176          &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
     169      ALLOCATE( t_su_1d    (jpij) , a_i_1d    (jpij) , ht_i_1d   (jpij) ,    &    
     170         &      ht_s_1d    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &     
    177171         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &     
    178          &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &     
    179          &      s_snowice (jpij) , o_i_b    (jpij)                   ,    & 
    180          !                                                                ! 
    181          &      t_s_b(jpij,nlay_s),                                       & 
    182          !                                                                ! 
    183          &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &             
    184          &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3)) 
     172         &      dh_snowice(jpij) , sm_i_1d   (jpij) , s_i_new  (jpij) ,    & 
     173         &      t_s_1d(jpij,nlay_s),                                       & 
     174         &      t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1)                ,     &             
     175         &      q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1)                ,     & 
     176         &      qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 
    185177      ! 
    186       ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     & 
    187          &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     & 
    188          &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     & 
    189          &      surf_error(jpij,jpl)                                             ,     & 
    190          !                                                                             ! 
    191          &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     & 
    192          &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     & 
    193          !                                                                             ! 
    194          &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     & 
    195          !                                                                             ! 
    196          &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     & 
    197          &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) ) 
    198  
    199178      thd_ice_alloc = MAXVAL( ierr ) 
    200179 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r4640 r4921  
    5151   USE trcnam 
    5252   USE trcrst 
     53   USE diaptr         ! Need to initialise this as some variables are used in if statements later 
    5354 
    5455   IMPLICIT NONE 
    … …  
    298299      !                                     ! Passive tracers 
    299300                            CALL     trc_init   ! Passive tracers initialization 
    300  
     301      ! 
     302      ! Initialise diaptr as some variables are used in if statements later (in 
     303      ! various advection and diffusion routines. 
     304                            CALL dia_ptr_init 
     305      ! 
    301306      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    302307      ! 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r4608 r4921  
    104104   REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points 
    105105 
    106 #if ( defined key_lim2 || defined key_lim3 ) 
    107106   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables  
    108107   INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ;  
    109108                                                              !: = 1 read it in a NetCDF file 
    110 #endif 
     109   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_tem             !: choice of the temperature of incoming sea ice 
     110   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_sal             !: choice of the salinity    of incoming sea ice 
     111   REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_age             !: choice of the age         of incoming sea ice 
    111112   ! 
    112113    

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r4624 r4921  
    676676               CALL iom_close ( inum ) 
    677677               !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 
    678                !CALL iom_open ( bn_a_i %clname, inum ) 
     678               !CALL iom_open ( bn_a_i%clname, inum ) 
    679679               !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
    680680                IF ( zndims == 4 ) THEN 
    … …  
    740740      jstart = 1 
    741741      DO ib_bdy = 1, nb_bdy 
    742          jend = nb_bdy_fld(ib_bdy)  
     742         jend = jstart - 1 + nb_bdy_fld(ib_bdy)  
    743743         CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(ib_bdy), 'bdy_dta',   & 
    744744         &              'open boundary conditions', 'nambdy_dta' ) 
    … …  
    907907   !!============================================================================== 
    908908END MODULE bdydta 
    909  
    910  

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r4370 r4921  
    3030   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3131   USE in_out_manager  ! 
    32    USE domvvl 
     32   USE domvvl          ! variable volume 
    3333 
    3434   IMPLICIT NONE 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r4333 r4921  
    2424   USE par_ice_2 
    2525   USE ice_2           ! LIM_2 ice variables 
     26   USE dom_ice_2       ! sea-ice domain 
    2627#elif defined key_lim3 
    2728   USE par_ice 
    2829   USE ice             ! LIM_3 ice variables 
     30   USE dom_ice         ! sea-ice domain 
    2931#endif  
    3032   USE par_oce         ! ocean parameters 
    3133   USE dom_oce         ! ocean space and time domain variables  
    32    USE dom_ice          ! sea-ice domain 
    3334   USE sbc_oce         ! Surface boundary condition: ocean fields 
    3435   USE bdy_oce         ! ocean open boundary conditions 
    … …  
    99100      REAL(wp) ::   zinda, ztmelts, zdh 
    100101 
    101       REAL(wp), PARAMETER  ::   zsal = 6.3    ! arbitrary salinity    for incoming ice 
    102       REAL(wp), PARAMETER  ::   ztem = 270.0  ! arbitrary temperature for incoming ice 
    103       REAL(wp), PARAMETER  ::   zage = 30.0   ! arbitrary age         for incoming ice 
    104102      !!------------------------------------------------------------------------------ 
    105103      ! 
    … …  
    233231 
    234232               ! Ice salinity, age, temperature 
    235                sm_i(ji,jj,jl)   = zinda * zsal  + ( 1.0 - zinda ) * s_i_min 
    236                o_i(ji,jj,jl)    = zinda * zage  + ( 1.0 - zinda ) 
    237                t_su(ji,jj,jl)   = zinda * ztem  + ( 1.0 - zinda ) * ztem 
     233               sm_i(ji,jj,jl)   = zinda * rn_ice_sal(ib_bdy)  + ( 1.0 - zinda ) * s_i_min 
     234               o_i(ji,jj,jl)    = zinda * rn_ice_age(ib_bdy)  + ( 1.0 - zinda ) 
     235               t_su(ji,jj,jl)   = zinda * rn_ice_tem(ib_bdy)  + ( 1.0 - zinda ) * rn_ice_tem(ib_bdy) 
    238236               DO jk = 1, nlay_s 
    239                   t_s(ji,jj,jk,jl) = zinda * ztem + ( 1.0 - zinda ) * rtt 
     237                  t_s(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt 
    240238               END DO 
    241239               DO jk = 1, nlay_i 
    242                   t_i(ji,jj,jk,jl) = zinda * ztem + ( 1.0 - zinda ) * rtt  
    243                   s_i(ji,jj,jk,jl) = zinda * zsal + ( 1.0 - zinda ) * s_i_min 
     240                  t_i(ji,jj,jk,jl) = zinda * rn_ice_tem(ib_bdy) + ( 1.0 - zinda ) * rtt  
     241                  s_i(ji,jj,jk,jl) = zinda * rn_ice_sal(ib_bdy) + ( 1.0 - zinda ) * s_i_min 
    244242               END DO 
    245243                
    … …  
    259257 
    260258            END SELECT 
     259 
     260            ! if salinity is constant, then overwrite rn_ice_sal 
     261            IF( num_sal == 1 ) THEN 
     262               sm_i(ji,jj,jl)   = bulk_sal 
     263               s_i (ji,jj,:,jl) = bulk_sal 
     264            ENDIF 
    261265 
    262266            ! contents 
    … …  
    338342      DO ib_bdy=1, nb_bdy 
    339343         ! 
    340          SELECT CASE( nn_ice_lim(ib_bdy) ) 
     344         SELECT CASE( cn_ice_lim(ib_bdy) ) 
    341345 
    342346         CASE('none') 
    … …  
    355359                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    356360                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    357                   zflag = idx_bdy(ib_bdy)%flagu(jb) 
     361                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 
    358362                   
    359363                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
    … …  
    384388                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    385389                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    386                   zflag = idx_bdy(ib_bdy)%flagv(jb) 
     390                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 
    387391                   
    388392                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r4624 r4921  
    100100         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
    101101         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    102 #if ( defined key_lim2 || defined key_lim3 ) 
    103102         &             cn_ice_lim, nn_ice_lim_dta,                           & 
    104 #endif 
     103         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
    105104         &             ln_vol, nn_volctl, nn_rimwidth 
    106105      !! 
    … …  
    359358        ENDIF 
    360359        IF(lwp) WRITE(numout,*) 
     360        IF(lwp) WRITE(numout,*) '      tem of bdy sea-ice = ', rn_ice_tem(ib_bdy)          
     361        IF(lwp) WRITE(numout,*) '      sal of bdy sea-ice = ', rn_ice_sal(ib_bdy)          
     362        IF(lwp) WRITE(numout,*) '      age of bdy sea-ice = ', rn_ice_age(ib_bdy)          
    361363#endif 
    362364 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r4624 r4921  
    418418      DO ib_bdy = 1,nb_bdy 
    419419 
    420          ! line below should be simplified (runoff case) 
    421 !! CHANUT: TO BE SORTED OUT 
    422 !!         IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 
    423420         IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    424421 
    … …  
    453450            IF ( PRESENT(kit) ) THEN 
    454451               IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data: 
    455                   dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 
    456                   dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 
    457                   dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 
     452                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 
     453                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 
     454                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 
    458455 
    459456               ELSE ! Initialize arrays from slow varying open boundary data:             
    460                   dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    461                   dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    462                   dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
     457                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
     458                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
     459                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    463460               ENDIF 
    464461            ENDIF 
    … …  
    471468               z_sist = zramp * SIN( z_sarg ) 
    472469               ! 
    473                igrd=1                              ! SSH on tracer grid 
    474                DO ib = 1, ilen0(igrd) 
    475                   dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
    476                      &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
    477                      &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist ) 
    478                END DO 
    479                ! 
    480                igrd=2                              ! U grid 
    481                DO ib = 1, ilen0(igrd) 
    482                   dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
    483                      &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
    484                      &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
    485                END DO 
    486                ! 
    487                igrd=3                              ! V grid 
    488                DO ib = 1, ilen0(igrd)  
    489                   dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
    490                      &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
    491                      &                        tides(ib_bdy)%v(ib,itide,2)*z_sist ) 
    492                END DO 
    493             END DO 
     470               IF ( dta_bdy(ib_bdy)%ll_ssh ) THEN 
     471                  igrd=1                              ! SSH on tracer grid 
     472                  DO ib = 1, ilen0(igrd) 
     473                     dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 
     474                        &                      ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & 
     475                        &                        tides(ib_bdy)%ssh(ib,itide,2)*z_sist ) 
     476                  END DO 
     477               ENDIF 
     478               ! 
     479               IF ( dta_bdy(ib_bdy)%ll_u2d ) THEN 
     480                  igrd=2                              ! U grid 
     481                  DO ib = 1, ilen0(igrd) 
     482                     dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 
     483                        &                      ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 
     484                        &                        tides(ib_bdy)%u(ib,itide,2)*z_sist ) 
     485                  END DO 
     486               ENDIF 
     487               ! 
     488               IF ( dta_bdy(ib_bdy)%ll_v2d ) THEN 
     489                  igrd=3                              ! V grid 
     490                  DO ib = 1, ilen0(igrd)  
     491                     dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 
     492                        &                      ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & 
     493                        &                        tides(ib_bdy)%v(ib,itide,2)*z_sist ) 
     494                  END DO 
     495               ENDIF 
     496            END DO              
    494497         END IF 
    495498      END DO 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90

    r4624 r4921  
    2727   REAL(wp), PUBLIC            ::  rn_lat1d     ! Column latitude 
    2828   REAL(wp), PUBLIC            ::  rn_lon1d     ! Column longitude 
     29   LOGICAL , PUBLIC            ::  ln_c1d_locpt ! Localization (or not) of 1D column in a grid 
    2930 
    3031   !!---------------------------------------------------------------------- 
    … …  
    4445      !!---------------------------------------------------------------------- 
    4546      INTEGER ::   ios                 ! Local integer output status for namelist read 
    46       NAMELIST/namc1d/ rn_lat1d, rn_lon1d 
     47      NAMELIST/namc1d/ rn_lat1d, rn_lon1d , ln_c1d_locpt 
    4748      !!---------------------------------------------------------------------- 
    4849      ! 
    … …  
    6364         WRITE(numout,*) '~~~~~~~~' 
    6465         WRITE(numout,*) '   Namelist namc1d : set options for the C1D model' 
    65          WRITE(numout,*) '      column latitude                 rn_lat1d = ', rn_lat1d 
    66          WRITE(numout,*) '      column longitude                rn_lon1d = ', rn_lon1d 
     66         WRITE(numout,*) '      column latitude                 rn_lat1d     = ', rn_lat1d 
     67         WRITE(numout,*) '      column longitude                rn_lon1d     = ', rn_lon1d 
     68         WRITE(numout,*) '      column localization in a grid   ln_c1d_locpt = ', ln_c1d_locpt 
    6769      ENDIF 
    6870      ! 
    … …  
    7880   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated 
    7981   REAL(wp)                   ::   rn_lat1d, rn_lon1d 
     82   LOGICAL , PUBLIC           ::   ln_c1d_locpt = .FALSE.  
     83 
    8084CONTAINS 
    8185 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    r4245 r4921  
    4343      !! ** Action  : Recalculate jpizoom, jpjzoom (indices of C1D zoom) 
    4444      !!---------------------------------------------------------------------- 
     45      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
     46         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
     47         &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    & 
     48         &             jphgr_msh, & 
     49         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
     50         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
     51         &             ppa2, ppkth2, ppacr2 
     52 
    4553      INTEGER  ::  ji, jj                          ! Dummy loop indices 
    4654      INTEGER  ::  inum                            ! Coordinate file handle (case 0) 
    4755      INTEGER  ::  ijeq                            ! Index of equator T point (case 4) 
     56      INTEGER  ::  ios                             ! Local integer output status for namelist read 
    4857 
    4958      INTEGER , DIMENSION(2) ::   iloc             ! Minloc returned indices 
    … …  
    6372      IF( nn_timing == 1 )   CALL timing_start('dom_c1d') 
    6473 
     74      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
     75      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 ) 
     76901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
     77   
     78      ! 
     79      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
     80      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 ) 
     81902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     82 
    6583      CALL wrk_alloc( jpidta, jpjdta, gphidta, glamdta, zdist ) 
    6684 
    … …  
    8098         CALL iom_get( inum, jpdom_unknown, 'gphit', gphidta ) ! so use jpdom_unknown not jpdom_data 
    8199         CALL iom_close ( inum ) 
    82  
    83          PRINT *,'Check dom_c1d coordinates file data read in:' !!! 
    84          PRINT *,'Bottom-left most glamdta is ', glamdta(1,1)    !!! Need to check 
    85          PRINT *,'Bottom-left most gphidta is ', gphidta(1,1)    !!! field read 
    86          PRINT *,'We are using nimpp,njmpp = ' , nimpp,njmpp     !!! 
    87100 
    88101      CASE ( 1 )                 ! geographical mesh on the sphere with regular grid-spacing 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90

    r4624 r4921  
    1818   USE daymod 
    1919   USE tide_mod 
     20   ! 
    2021   USE in_out_manager  ! I/O units 
    2122   USE iom             ! I/0 library 
    … …  
    3435   INTEGER, PARAMETER :: jpdimsparse  = jpincomax*300*24 
    3536 
    36    !                            !!!namelist variables 
     37   !                         !!** namelist variables ** 
    3738   INTEGER ::   nit000_han    ! First time step used for harmonic analysis 
    3839   INTEGER ::   nitend_han    ! Last time step used for harmonic analysis 
    3940   INTEGER ::   nstep_han     ! Time step frequency for harmonic analysis 
    40    INTEGER ::   nb_ana           ! Number of harmonics to analyse 
     41   INTEGER ::   nb_ana        ! Number of harmonics to analyse 
    4142 
    4243   INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name 
    … …  
    119120            ENDIF 
    120121         END DO 
    121       ENDDO 
     122      END DO 
    122123      ! 
    123124      IF(lwp) THEN 
    … …  
    158159      ! ---------------------------- 
    159160      ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    160       ana_temp(:,:,:,:) = 0.e0 
     161      ana_temp(:,:,:,:) = 0._wp 
    161162 
    162163   END SUBROUTINE dia_harm_init 
    … …  
    179180      IF( nn_timing == 1 )   CALL timing_start('dia_harm') 
    180181 
    181       IF ( kt == nit000 ) CALL dia_harm_init 
    182  
    183       IF ( ((kt.GE.nit000_han).AND.(kt.LE.nitend_han)).AND. & 
    184            (MOD(kt,nstep_han).EQ.0) ) THEN 
    185  
    186         ztime = (kt-nit000+1)*rdt  
     182      IF( kt == nit000 ) CALL dia_harm_init 
     183 
     184      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 
     185 
     186         ztime = (kt-nit000+1) * rdt  
    187187        
    188         nhc = 0 
    189         DO jh = 1,nb_ana 
    190           DO jc = 1,2 
    191             nhc = nhc+1 
    192             ztemp =(     MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))  & 
    193                     +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
    194  
    195             DO jj = 1,jpj 
    196               DO ji = 1,jpi 
    197                 ! Elevation 
    198                 ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask(ji,jj,1)         
     188         nhc = 0 
     189         DO jh = 1, nb_ana 
     190            DO jc = 1, 2 
     191               nhc = nhc+1 
     192               ztemp =(     MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh))  & 
     193                  &    +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 
     194 
     195               DO jj = 1, jpj 
     196                  DO ji = 1, jpi 
     197                     ! Elevation 
     198                     ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)           *tmask(ji,jj,1) 
    199199#if defined key_dynspg_ts 
    200                 ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1) 
    201                 ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1) 
    202 #endif 
    203               END DO 
    204             END DO 
    205  
    206           END DO 
    207         END DO 
    208         
     200                     ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1) 
     201                     ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1) 
     202#endif 
     203                  END DO 
     204               END DO 
     205               ! 
     206            END DO 
     207         END DO 
     208         !        
    209209      END IF 
    210210 
    … …  
    249249         keq = keq + 1 
    250250         kun = 0 
    251          DO jh = 1,nb_ana 
    252             DO jc = 1,2 
     251         DO jh = 1, nb_ana 
     252            DO jc = 1, 2 
    253253               kun = kun + 1 
    254254               ksp = ksp + 1 
    … …  
    296296               out_eta(ji,jj,jh       ) = X1 * tmask(ji,jj,1) 
    297297               out_eta(ji,jj,jh+nb_ana) = X2 * tmask(ji,jj,1) 
    298             ENDDO 
    299          ENDDO 
    300       ENDDO 
     298            END DO 
     299         END DO 
     300      END DO 
    301301 
    302302      ! ubar: 
    … …  
    309309                  kun = kun + 1 
    310310                  ztmp4(kun)=ana_temp(ji,jj,kun,2) 
    311                ENDDO 
    312             ENDDO 
     311               END DO 
     312            END DO 
    313313 
    314314            CALL SUR_DETERMINE(jj+1) 
    … …  
    316316            ! Fill output array 
    317317            DO jh = 1, nb_ana 
    318                ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 
    319                ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 
     318               ana_amp(ji,jj,jh,1) = ztmp7((jh-1)*2+1) 
     319               ana_amp(ji,jj,jh,2) = ztmp7((jh-1)*2+2) 
    320320            END DO 
    321321 
    … …  
    326326         DO ji = 1, jpi 
    327327            DO jh = 1, nb_ana  
    328                X1=ana_amp(ji,jj,jh,1) 
    329                X2=-ana_amp(ji,jj,jh,2) 
    330                out_u(ji,jj,jh) = X1 * umask(ji,jj,1) 
    331                out_u (ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 
    332             ENDDO 
    333          ENDDO 
    334       ENDDO 
     328               X1 = ana_amp(ji,jj,jh,1) 
     329               X2 =-ana_amp(ji,jj,jh,2) 
     330               out_u(ji,jj,jh       ) = X1 * umask(ji,jj,1) 
     331               out_u(ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1) 
     332            END DO 
     333         END DO 
     334      END DO 
    335335 
    336336      ! vbar: 
    … …  
    343343                  kun = kun + 1 
    344344                  ztmp4(kun)=ana_temp(ji,jj,kun,3) 
    345                ENDDO 
    346             ENDDO 
     345               END DO 
     346            END DO 
    347347 
    348348            CALL SUR_DETERMINE(jj+1) 
    … …  
    364364               out_v(ji,jj,jh)=X1 * vmask(ji,jj,1) 
    365365               out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1) 
    366             ENDDO 
    367          ENDDO 
    368       ENDDO 
     366            END DO 
     367         END DO 
     368      END DO 
    369369 
    370370      CALL dia_wri_harm ! Write results in files 
    … …  
    437437#else 
    438438      DO jh = 1, nb_ana 
    439          CALL iom_put( TRIM(tname(jh))//'x_v', out_u(:,:,jh       ) ) 
    440          CALL iom_put( TRIM(tname(jh))//'y_v', out_u(:,:,jh+nb_ana) ) 
    441       END DO 
    442 #endif 
    443  
     439         CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh       ) ) 
     440         CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) ) 
     441      END DO 
     442#endif 
     443      ! 
    444444   END SUBROUTINE dia_wri_harm 
    445445 
    446446 
    447447   SUBROUTINE SUR_DETERMINE(init) 
    448    !!--------------------------------------------------------------------------------- 
    449    !!                      *** ROUTINE SUR_DETERMINE *** 
    450    !!     
    451    !!     
    452    !!        
    453    !!--------------------------------------------------------------------------------- 
    454    INTEGER, INTENT(in) ::   init  
    455    ! 
    456    INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
    457    REAL(wp)                        :: zval1, zval2, zx1 
    458    REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2 
    459    INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot 
    460    !--------------------------------------------------------------------------------- 
    461    CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
    462    CALL wrk_alloc( jpincomax , ipos2 , ipivot        ) 
     448      !!--------------------------------------------------------------------------------- 
     449      !!                      *** ROUTINE SUR_DETERMINE *** 
     450      !!     
     451      !!     
     452      !!        
     453      !!--------------------------------------------------------------------------------- 
     454      INTEGER, INTENT(in) ::   init  
     455      ! 
     456      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
     457      REAL(wp)                        :: zval1, zval2, zx1 
     458      REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2 
     459      INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot 
     460      !--------------------------------------------------------------------------------- 
     461      CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
     462      CALL wrk_alloc( jpincomax , ipos2 , ipivot        ) 
    463463             
    464    IF( init == 1 ) THEN 
    465       IF( nsparse > jpdimsparse )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 
    466       IF( ninco   > jpincomax   )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 
    467       ! 
    468       ztmp3(:,:) = 0._wp 
    469       ! 
    470       DO jk1_sd = 1, nsparse 
    471          DO jk2_sd = 1, nsparse 
    472             nisparse(jk2_sd) = nisparse(jk2_sd) 
    473             njsparse(jk2_sd) = njsparse(jk2_sd) 
    474             IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
    475                ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
    476                                                         + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
    477             ENDIF 
    478          END DO 
    479       END DO 
    480  
    481       DO jj_sd = 1 ,ninco 
    482           ipos1(jj_sd) = jj_sd 
    483           ipos2(jj_sd) = jj_sd 
    484       ENDDO 
    485  
    486       DO ji_sd = 1 , ninco 
    487  
    488          !find greatest non-zero pivot: 
    489          zval1 = ABS(ztmp3(ji_sd,ji_sd)) 
    490  
    491          ipivot(ji_sd) = ji_sd 
    492          DO jj_sd = ji_sd, ninco 
    493             zval2 = ABS(ztmp3(ji_sd,jj_sd)) 
    494             IF( zval2.GE.zval1 )THEN 
    495                ipivot(ji_sd) = jj_sd 
    496                zval1         = zval2 
    497             ENDIF 
    498          ENDDO 
    499  
    500          DO ji1_sd = 1, ninco 
    501             zcol1(ji1_sd)               = ztmp3(ji1_sd,ji_sd) 
    502             zcol2(ji1_sd)               = ztmp3(ji1_sd,ipivot(ji_sd)) 
    503             ztmp3(ji1_sd,ji_sd)         = zcol2(ji1_sd) 
    504             ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 
    505          ENDDO 
    506  
    507          ipos2(ji_sd)         = ipos1(ipivot(ji_sd)) 
    508          ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 
    509          ipos1(ji_sd)         = ipos2(ji_sd) 
    510          ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 
    511          zpivot(ji_sd)        = ztmp3(ji_sd,ji_sd) 
    512          DO jj_sd = 1, ninco 
    513             ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 
    514          ENDDO 
    515  
     464      IF( init == 1 ) THEN 
     465         IF( nsparse > jpdimsparse )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') 
     466         IF( ninco   > jpincomax   )   CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax') 
     467         ! 
     468         ztmp3(:,:) = 0._wp 
     469         ! 
     470         DO jk1_sd = 1, nsparse 
     471            DO jk2_sd = 1, nsparse 
     472               nisparse(jk2_sd) = nisparse(jk2_sd) 
     473               njsparse(jk2_sd) = njsparse(jk2_sd) 
     474               IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
     475                  ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
     476                     &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
     477               ENDIF 
     478            END DO 
     479         END DO 
     480         ! 
     481         DO jj_sd = 1 ,ninco 
     482            ipos1(jj_sd) = jj_sd 
     483            ipos2(jj_sd) = jj_sd 
     484         END DO 
     485         ! 
     486         DO ji_sd = 1 , ninco 
     487            ! 
     488            !find greatest non-zero pivot: 
     489            zval1 = ABS(ztmp3(ji_sd,ji_sd)) 
     490            ! 
     491            ipivot(ji_sd) = ji_sd 
     492            DO jj_sd = ji_sd, ninco 
     493               zval2 = ABS(ztmp3(ji_sd,jj_sd)) 
     494               IF( zval2.GE.zval1 )THEN 
     495                  ipivot(ji_sd) = jj_sd 
     496                  zval1         = zval2 
     497               ENDIF 
     498            END DO 
     499            ! 
     500            DO ji1_sd = 1, ninco 
     501               zcol1(ji1_sd)               = ztmp3(ji1_sd,ji_sd) 
     502               zcol2(ji1_sd)               = ztmp3(ji1_sd,ipivot(ji_sd)) 
     503               ztmp3(ji1_sd,ji_sd)         = zcol2(ji1_sd) 
     504               ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd) 
     505            END DO 
     506            ! 
     507            ipos2(ji_sd)         = ipos1(ipivot(ji_sd)) 
     508            ipos2(ipivot(ji_sd)) = ipos1(ji_sd) 
     509            ipos1(ji_sd)         = ipos2(ji_sd) 
     510            ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd)) 
     511            zpivot(ji_sd)        = ztmp3(ji_sd,ji_sd) 
     512            DO jj_sd = 1, ninco 
     513               ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd) 
     514            END DO 
     515            ! 
     516            DO ji2_sd = ji_sd+1, ninco 
     517               zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 
     518               DO jj_sd=1,ninco 
     519                  ztmp3(ji2_sd,jj_sd)=  ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 
     520               END DO 
     521            END DO 
     522            ! 
     523         END DO 
     524         ! 
     525      ENDIF ! End init==1 
     526 
     527      DO ji_sd = 1, ninco 
     528         ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 
    516529         DO ji2_sd = ji_sd+1, ninco 
    517             zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 
    518             DO jj_sd=1,ninco 
    519                ztmp3(ji2_sd,jj_sd)=  ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd) 
    520             ENDDO 
    521          ENDDO 
    522  
    523       ENDDO 
    524  
    525    ENDIF ! End init==1 
    526  
    527    DO ji_sd = 1, ninco 
    528       ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd) 
    529       DO ji2_sd = ji_sd+1, ninco 
    530          ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 
    531       ENDDO 
    532    ENDDO 
    533  
    534    !system solving:  
    535    ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 
    536    ji_sd = ninco 
    537    DO ji_sd = ninco-1, 1, -1 
    538       zx1=0. 
    539       DO jj_sd = ji_sd+1, ninco 
    540          zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 
    541       ENDDO 
    542       ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 
    543    ENDDO 
    544  
    545    DO jj_sd =1, ninco 
    546       ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 
    547    ENDDO 
    548  
    549    CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
    550    CALL wrk_dealloc( jpincomax , ipos2 , ipivot        ) 
    551  
    552   END SUBROUTINE SUR_DETERMINE 
     530            ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd) 
     531         END DO 
     532      END DO 
     533 
     534      !system solving:  
     535      ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco) 
     536      ji_sd = ninco 
     537      DO ji_sd = ninco-1, 1, -1 
     538         zx1 = 0._wp 
     539         DO jj_sd = ji_sd+1, ninco 
     540            zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd) 
     541         END DO 
     542         ztmpx(ji_sd) = ztmp4(ji_sd)-zx1 
     543      END DO 
     544 
     545      DO jj_sd =1, ninco 
     546         ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 
     547      END DO 
     548 
     549      CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 ) 
     550      CALL wrk_dealloc( jpincomax , ipos2 , ipivot        ) 
     551      ! 
     552   END SUBROUTINE SUR_DETERMINE 
    553553 
    554554#else 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4570 r4921  
    4545   USE diadimg         ! dimg direct access file format output 
    4646   USE diaar5, ONLY :   lk_diaar5 
    47    USE dynadv, ONLY :   ln_dynadv_vec 
    4847   USE iom 
    4948   USE ioipsl 
    … …  
    131130      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    132131      !! 
    133       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d       ! 2D workspace 
     132      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace 
     133      REAL(wp), POINTER, DIMENSION(:,:)   :: z2ds     ! 2D workspace 
    134134      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
    135135      !!---------------------------------------------------------------------- 
    … …  
    137137      IF( nn_timing == 1 )   CALL timing_start('dia_wri') 
    138138      !  
    139       CALL wrk_alloc( jpi , jpj      , z2d ) 
     139      CALL wrk_alloc( jpi , jpj      , z2d , z2ds ) 
    140140      CALL wrk_alloc( jpi , jpj, jpk , z3d ) 
    141141      ! 
    … …  
    193193      CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    194194 
     195      ! clem: heat and salt content 
     196      z2d(:,:)  = 0._wp  
     197      z2ds(:,:) = 0._wp  
     198      DO jk = 1, jpkm1 
     199         DO jj = 2, jpjm1 
     200            DO ji = fs_2, fs_jpim1   ! vector opt. 
     201               z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     202               z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     203            END DO 
     204         END DO 
     205      END DO 
     206      CALL lbc_lnk( z2d, 'T', 1. ) 
     207      CALL lbc_lnk( z2ds, 'T', 1. ) 
     208      CALL iom_put( "heatc", z2d )    ! vertically integrated heat content (J/m2) 
     209      CALL iom_put( "saltc", z2ds )   ! vertically integrated salt content (PSU*kg/m2) 
     210   
     211      ! 
     212      rke(:,:,jk) = 0._wp                               !      kinetic energy  
     213      DO jk = 1, jpkm1 
     214         DO jj = 2, jpjm1 
     215            DO ji = fs_2, fs_jpim1   ! vector opt. 
     216               zztmp   = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     217               zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    & 
     218                  &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk) )  & 
     219                  &          *  zztmp  
     220               ! 
     221               zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)    & 
     222                  &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) )  & 
     223                  &          *  zztmp  
     224               ! 
     225               rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 
     226               ! 
     227            ENDDO 
     228         ENDDO 
     229      ENDDO 
     230      CALL lbc_lnk( rke, 'T', 1. ) 
     231      CALL iom_put( "eken", rke )            
     232 
    195233      IF( lk_diaar5 ) THEN 
    196234         z3d(:,:,jpk) = 0.e0 
    197235         DO jk = 1, jpkm1 
    198             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 
     236            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
    199237         END DO 
    200238         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     239 
    201240         zztmp = 0.5 * rcp 
    202241         z2d(:,:) = 0.e0  
     242         z2ds(:,:) = 0.e0  
    203243         DO jk = 1, jpkm1 
    204244            DO jj = 2, jpjm1 
    205245               DO ji = fs_2, fs_jpim1   ! vector opt. 
    206246                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     247                  z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    207248               END DO 
    208249            END DO 
    209250         END DO 
    210251         CALL lbc_lnk( z2d, 'U', -1. ) 
     252         CALL lbc_lnk( z2ds, 'U', -1. ) 
    211253         CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction 
     254         CALL iom_put( "u_salttr", z2ds )                 ! salt transport in i-direction 
     255 
     256         z3d(:,:,jpk) = 0.e0 
    212257         DO jk = 1, jpkm1 
    213             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 
     258            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
    214259         END DO 
    215260         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
     261 
    216262         z2d(:,:) = 0.e0  
     263         z2ds(:,:) = 0.e0  
    217264         DO jk = 1, jpkm1 
    218265            DO jj = 2, jpjm1 
    219266               DO ji = fs_2, fs_jpim1   ! vector opt. 
    220267                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     268                  z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
    221269               END DO 
    222270            END DO 
    223271         END DO 
    224272         CALL lbc_lnk( z2d, 'V', -1. ) 
    225          CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction 
    226       ENDIF 
    227       ! 
    228       CALL wrk_dealloc( jpi , jpj      , z2d ) 
     273         CALL lbc_lnk( z2ds, 'V', -1. ) 
     274         CALL iom_put( "v_heattr", z2d )                  !  heat transport in j-direction 
     275         CALL iom_put( "v_salttr", z2ds )                 !  salt transport in j-direction 
     276      ENDIF 
     277      ! 
     278      CALL wrk_dealloc( jpi , jpj      , z2d , z2ds ) 
    229279      CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 
    230280      ! 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r4488 r4921  
    153153   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    154154   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
     155   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit 
    155156 
    156157   !!---------------------------------------------------------------------- 
    … …  
    329330      ierr(:) = 0 
    330331      ! 
    331       ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
     332      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  & 
     333         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 
    332334         ! 
    333335      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

    r4245 r4921  
    8282      !!---------------------------------------------------------------------- 
    8383      !                              ! recalculate jpizoom/jpjzoom given lat/lon 
    84       IF( lk_c1d )  CALL dom_c1d( rn_lat1d, rn_lon1d ) 
     84      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d ) 
    8585      ! 
    8686      !                        ! ============== ! 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r4624 r4921  
    808808            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
    809809            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    810             id5 = iom_varid( numror, 'hdif_lf', ldstop = .FALSE. ) 
     810            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
    811811            !                             ! --------- ! 
    812812            !                             ! all cases ! 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r4624 r4921  
    14451445            DO jk = 1, jpkm1 
    14461446               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk ) 
    1447                IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0 
    1448             END DO 
     1447            END DO 
     1448            IF( scobot(ji,jj) == 0._wp               )   mbathy(ji,jj) = 0 
    14491449         END DO 
    14501450      END DO 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r4881 r4921  
    5454   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg] 
    5555   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg] 
    56    REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin] 
    57    REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J] 
     56   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/kg/K] 
     57   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [kg.K/J] 
    5858   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp ) 
    5959 
    … …  
    6969#if defined key_lim3 || defined key_cice 
    7070   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    71    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    72    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    73    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     71   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     72   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K]  
     73   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice                                 [J/kg/K] 
    7474   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7575   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    76    REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity 
     76   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity          [degC/ppt] 
    7777   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3] 
    7878#else 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4624 r4921  
    4444   USE agrif_opa_interp ! agrif 
    4545#endif 
    46  
     46#if defined key_asminc    
     47   USE asminc          ! Assimilation increment 
     48#endif 
    4749 
    4850   IMPLICIT NONE 
    … …  
    290292      ! 
    291293      DO jk = 1, jpkm1 
    292 #if defined key_vectopt_loop 
    293          DO jj = 1, 1         !Vector opt. => forced unrolling 
    294             DO ji = 1, jpij 
    295 #else  
    296          DO jj = 1, jpj 
    297             DO ji = 1, jpi 
    298 #endif                                                                    
    299                zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    300                zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)          
    301             END DO 
    302          END DO 
     294         zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     295         zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
    303296      END DO 
    304297      ! 
    … …  
    464457      !                                             ! ==================== !   
    465458      ! Initialize barotropic variables:       
     459      IF( ll_init )THEN 
     460         sshbb_e(:,:) = 0._wp 
     461         ubb_e  (:,:) = 0._wp 
     462         vbb_e  (:,:) = 0._wp 
     463         sshb_e (:,:) = 0._wp 
     464         ub_e   (:,:) = 0._wp 
     465         vb_e   (:,:) = 0._wp 
     466      ENDIF 
     467      ! 
    466468      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    467469         sshn_e(:,:) = sshn (:,:)             

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4650 r4921  
    3232   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    3333   USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes 
     34#if defined key_lim3 
     35   USE par_ice 
     36#elif defined key_lim2 
     37   USE par_ice_2 
     38#endif 
    3439   USE domngb          ! ocean space and time domain 
    3540   USE phycst          ! physical constants 
    … …  
    4954#endif 
    5055   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    51    PUBLIC iom_getatt, iom_context_finalize 
     56   PUBLIC iom_getatt, iom_use, iom_context_finalize 
    5257 
    5358   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    … …  
    143148      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 
    144149# endif 
     150#if defined key_lim3 || defined key_lim2 
     151      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
     152#endif 
    145153      CALL iom_set_axis_attr( "icbcla", class_num ) 
    146154       
    … …  
    10151023      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    10161024      REAL(wp)        , INTENT(in) ::   pfield0d 
     1025      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    10171026#if defined key_iomput 
    1018       CALL xios_send_field(cdname, (/pfield0d/)) 
     1027      zz(:,:)=pfield0d 
     1028      CALL xios_send_field(cdname, zz) 
     1029      !CALL xios_send_field(cdname, (/pfield0d/))  
    10191030#else 
    10201031      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    12071218      !! 
    12081219      !!---------------------------------------------------------------------- 
    1209       REAL(wp), DIMENSION(1,1) ::   zz = 1. 
     1220      REAL(wp), DIMENSION(1) ::   zz = 1. 
    12101221      !!---------------------------------------------------------------------- 
    12111222      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
    1212       CALL iom_set_domain_attr('scalarpoint', data_dim=1) 
    1213       CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 
     1223      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 
     1224      zz=REAL(narea,wp) 
     1225      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    12141226 
    12151227   END SUBROUTINE set_scalar 
    … …  
    14991511 
    15001512#endif 
     1513 
     1514   LOGICAL FUNCTION iom_use( cdname ) 
     1515      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     1516#if defined key_iomput 
     1517      iom_use = xios_field_is_active( cdname ) 
     1518#else 
     1519      iom_use = .FALSE. 
     1520#endif 
     1521   END FUNCTION iom_use 
    15011522    
    15021523   !!====================================================================== 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r4292 r4921  
    217217         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
    218218         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
    219          iom_file(kiomid)%dimsz(:,kiv) = 0   ! reset dimsz in case previously used 
     219         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used 
    220220         DO ji = 1, i_nvd                       ! dimensions size 
    221221            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4334 r4921  
    120120                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    121121                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
     122      IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    122123                     ! 
    123124                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    … …  
    210211         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    211212         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
     213         IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    212214      ELSE 
    213215         neuler = 0 
    … …  
    245247         hdivb(:,:,:)   = hdivn(:,:,:) 
    246248         sshb (:,:)     = sshn (:,:) 
    247       ENDIF 
    248       ! 
    249       IF( lk_lim3 ) THEN  
     249         IF( lk_lim3 ) THEN 
     250            DO jk = 1, jpk 
     251               fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     252            END DO 
     253         ENDIF 
     254      ENDIF 
     255      ! 
     256      IF( lk_lim3 ) THEN 
    250257         CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 
    251258         CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r4230 r4921  
    3333 
    3434   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3 
    35    INTEGER, PUBLIC                                  ::   nsndto 
     35   INTEGER, PUBLIC                                  ::   nsndto, nfsloop, nfeloop 
    3636   INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate 
    3737 
    … …  
    412412            SELECT CASE ( cd_type ) 
    413413            CASE ( 'T' , 'W' )                         ! T-, W-point 
    414                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     414               IF (nimpp .ne. 1) THEN 
    415415                 startloop = 1 
    416416               ELSE 
    … …  
    420420               DO jk = 1, jpk 
    421421                  DO ji = startloop, nlci 
    422                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     422                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    423423                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    424424                  END DO 
     425                  IF(nimpp .eq. 1) THEN 
     426                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 
     427                  ENDIF 
    425428               END DO 
    426429 
    … …  
    435438                 DO jk = 1, jpk 
    436439                    DO ji = startloop, nlci 
    437                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     440                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    438441                       jia = ji + nimpp - 1 
    439442                       ijta = jpiglo - jia + 2 
    … …  
    448451 
    449452 
    450  
    451453            CASE ( 'U' )                               ! U-point 
    452                IF (narea .ne. (jpnij)) THEN 
     454               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    453455                  endloop = nlci 
    454456               ELSE 
    … …  
    457459               DO jk = 1, jpk 
    458460                  DO ji = 1, endloop 
    459                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     461                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    460462                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    461463                  END DO 
    462                END DO 
    463  
    464                IF (narea .ne. (jpnij)) THEN 
     464                  IF(nimpp .eq. 1) THEN 
     465                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk) 
     466                  ENDIF 
     467                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     468                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 
     469                  ENDIF 
     470               END DO 
     471 
     472               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    465473                  endloop = nlci 
    466474               ELSE 
    … …  
    477485                 DO jk = 1, jpk 
    478486                    DO ji = startloop, endloop 
    479                       iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     487                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    480488                      jia = ji + nimpp - 1 
    481489                      ijua = jpiglo - jia + 1 
    … …  
    490498 
    491499            CASE ( 'V' )                               ! V-point 
    492                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     500               IF (nimpp .ne. 1) THEN 
    493501                  startloop = 1 
    494502               ELSE 
    … …  
    497505               DO jk = 1, jpk 
    498506                  DO ji = startloop, nlci 
    499                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     507                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    500508                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    501509                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 
    502510                  END DO 
     511                  IF(nimpp .eq. 1) THEN 
     512                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 
     513                  ENDIF 
    503514               END DO 
    504515            CASE ( 'F' )                               ! F-point 
    505                IF (narea .ne. (jpnij)) THEN 
     516               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    506517                  endloop = nlci 
    507518               ELSE 
    … …  
    510521               DO jk = 1, jpk 
    511522                  DO ji = 1, endloop 
    512                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     523                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    513524                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    514525                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 
    515526                  END DO 
     527                  IF(nimpp .eq. 1) THEN 
     528                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk) 
     529                  ENDIF 
     530                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     531                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 
     532                  ENDIF 
    516533               END DO 
    517534            END SELECT 
    … …  
    524541               DO jk = 1, jpk 
    525542                  DO ji = 1, nlci 
    526                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     543                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    527544                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 
    528545                  END DO 
    … …  
    530547 
    531548            CASE ( 'U' )                               ! U-point 
    532                IF (narea .ne. (jpnij)) THEN 
     549               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    533550                  endloop = nlci 
    534551               ELSE 
    … …  
    537554               DO jk = 1, jpk 
    538555                  DO ji = 1, endloop 
    539                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     556                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    540557                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 
    541558                  END DO 
     559                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     560                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 
     561                  ENDIF 
    542562               END DO 
    543563 
    … …  
    545565               DO jk = 1, jpk 
    546566                  DO ji = 1, nlci 
    547                      ijt = jpiglo - ji- nimpp - nimppt(isendto(1)) + 3 
     567                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 
    548568                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    549569                  END DO 
    … …  
    560580                 DO jk = 1, jpk 
    561581                    DO ji = startloop, nlci 
    562                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     582                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    563583                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
    564584                    END DO 
    … …  
    567587 
    568588            CASE ( 'F' )                               ! F-point 
    569                IF (narea .ne. (jpnij)) THEN 
     589               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    570590                  endloop = nlci 
    571591               ELSE 
    … …  
    574594               DO jk = 1, jpk 
    575595                  DO ji = 1, endloop 
    576                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     596                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    577597                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    578598                  END DO 
    579                END DO 
    580  
    581                IF (narea .ne. (jpnij)) THEN 
     599                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     600                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 
     601                  ENDIF 
     602               END DO 
     603 
     604               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    582605                  endloop = nlci 
    583606               ELSE 
    … …  
    594617                  DO jk = 1, jpk 
    595618                     DO ji = startloop, endloop 
    596                         iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     619                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    597620                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
    598621                     END DO 
    … …  
    656679         ! 
    657680         CASE ( 'T' , 'W' )                               ! T- , W-points 
    658             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     681            IF (nimpp .ne. 1) THEN 
    659682              startloop = 1 
    660683            ELSE 
    … …  
    662685            ENDIF 
    663686            DO ji = startloop, nlci 
    664               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     687              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    665688              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    666689            END DO 
     690            IF (nimpp .eq. 1) THEN 
     691              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2) 
     692            ENDIF 
    667693 
    668694            IF(nimpp .ge. (jpiglo/2+1)) THEN 
    … …  
    674700            ENDIF 
    675701            DO ji = startloop, nlci 
    676                ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     702               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    677703               jia = ji + nimpp - 1 
    678704               ijta = jpiglo - jia + 2 
    … …  
    685711 
    686712         CASE ( 'U' )                                     ! U-point 
    687             IF (narea .ne. (jpnij)) THEN 
     713            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    688714               endloop = nlci 
    689715            ELSE 
    … …  
    691717            ENDIF 
    692718            DO ji = 1, endloop 
    693                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     719               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    694720               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    695721            END DO 
    696722 
    697             IF (narea .ne. (jpnij)) THEN 
     723            IF (nimpp .eq. 1) THEN 
     724              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2) 
     725              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 
     726            ENDIF 
     727            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     728              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2) 
     729            ENDIF 
     730 
     731            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    698732               endloop = nlci 
    699733            ELSE 
    … …  
    708742            ENDIF 
    709743            DO ji = startloop, endloop 
    710                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     744               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    711745               jia = ji + nimpp - 1 
    712746               ijua = jpiglo - jia + 1 
    … …  
    719753 
    720754         CASE ( 'V' )                                     ! V-point 
    721             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     755            IF (nimpp .ne. 1) THEN 
    722756              startloop = 1 
    723757            ELSE 
    … …  
    725759            ENDIF 
    726760            DO ji = startloop, nlci 
    727               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     761              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    728762              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 
    729763              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 
    730764            END DO 
     765            IF (nimpp .eq. 1) THEN 
     766              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3)  
     767            ENDIF 
    731768 
    732769         CASE ( 'F' )                                     ! F-point 
    733             IF (narea .ne. (jpnij)) THEN 
     770            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    734771               endloop = nlci 
    735772            ELSE 
    … …  
    737774            ENDIF 
    738775            DO ji = 1, endloop 
    739                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     776               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    740777               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 
    741778               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 
    742779            END DO 
     780            IF (nimpp .eq. 1) THEN 
     781              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3) 
     782              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2) 
     783            ENDIF 
     784            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     785              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3) 
     786              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)  
     787            ENDIF 
    743788 
    744789         CASE ( 'I' )                                     ! ice U-V point (I-point) 
    745             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     790            IF (nimpp .ne. 1) THEN 
    746791               startloop = 1 
    747792            ELSE 
    … …  
    750795            ENDIF 
    751796            DO ji = startloop, nlci 
    752                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     797               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    753798               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    754799            END DO 
    755800 
    756801         CASE ( 'J' )                                     ! first ice U-V point 
    757             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     802            IF (nimpp .ne. 1) THEN 
    758803               startloop = 1 
    759804            ELSE 
    … …  
    762807            ENDIF 
    763808            DO ji = startloop, nlci 
    764                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     809               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    765810               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    766811            END DO 
    767812 
    768813         CASE ( 'K' )                                     ! second ice U-V point 
    769             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     814            IF (nimpp .ne. 1) THEN 
    770815               startloop = 1 
    771816            ELSE 
    … …  
    774819            ENDIF 
    775820            DO ji = startloop, nlci 
    776                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     821               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    777822               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    778823            END DO 
    … …  
    785830         CASE ( 'T' , 'W' )                               ! T-, W-point 
    786831            DO ji = 1, nlci 
    787                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     832               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    788833               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 
    789834            END DO 
    790835 
    791836         CASE ( 'U' )                                     ! U-point 
    792             IF (narea .ne. (jpnij)) THEN 
     837            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    793838               endloop = nlci 
    794839            ELSE 
    … …  
    796841            ENDIF 
    797842            DO ji = 1, endloop 
    798                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     843               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    799844               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    800845            END DO 
     846            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     847               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 
     848            ENDIF 
    801849 
    802850         CASE ( 'V' )                                     ! V-point 
    803851            DO ji = 1, nlci 
    804                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     852               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    805853               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    806854            END DO 
    … …  
    813861            ENDIF 
    814862            DO ji = startloop, nlci 
    815                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     863               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    816864               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
    817865            END DO 
    818866 
    819867         CASE ( 'F' )                               ! F-point 
    820             IF (narea .ne. (jpnij)) THEN 
     868            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    821869               endloop = nlci 
    822870            ELSE 
    … …  
    824872            ENDIF 
    825873            DO ji = 1, endloop 
    826                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     874               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    827875               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    828876            END DO 
    829  
    830             IF (narea .ne. (jpnij)) THEN 
     877            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     878                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 
     879            ENDIF 
     880 
     881            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    831882               endloop = nlci 
    832883            ELSE 
    … …  
    842893 
    843894            DO ji = startloop, endloop 
    844                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     895               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    845896               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
    846897            END DO 
    847898 
    848899         CASE ( 'I' )                                  ! ice U-V point (I-point) 
    849                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     900               IF (nimpp .ne. 1) THEN 
    850901                  startloop = 1 
    851902               ELSE 
    852903                  startloop = 2 
    853904               ENDIF 
    854                IF (narea .ne. jpnij) THEN 
     905               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    855906                  endloop = nlci 
    856907               ELSE 
    … …  
    858909               ENDIF 
    859910               DO ji = startloop , endloop 
    860                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     911                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    861912                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    862913               END DO 
    863914 
    864915         CASE ( 'J' )                                  ! first ice U-V point 
    865                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     916               IF (nimpp .ne. 1) THEN 
    866917                  startloop = 1 
    867918               ELSE 
    868919                  startloop = 2 
    869920               ENDIF 
    870                IF (narea .ne. jpnij) THEN 
     921               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    871922                  endloop = nlci 
    872923               ELSE 
    … …  
    874925               ENDIF 
    875926               DO ji = startloop , endloop 
    876                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     927                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    877928                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
    878929               END DO 
    879930 
    880931         CASE ( 'K' )                                  ! second ice U-V point 
    881                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     932               IF (nimpp .ne. 1) THEN 
    882933                  startloop = 1 
    883934               ELSE 
    884935                  startloop = 2 
    885936               ENDIF 
    886                IF (narea .ne. jpnij) THEN 
     937               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    887938                  endloop = nlci 
    888939               ELSE 
    … …  
    890941               ENDIF 
    891942               DO ji = startloop, endloop 
    892                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     943                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    893944                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 
    894945               END DO 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4645 r4921  
    20262026      ijpjm1 = 3 
    20272027      ! 
     2028      znorthloc(:,:,:) = 0 
    20282029      DO jk = 1, jpk 
    20292030         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
    … …  
    20362037      itaille = jpi * jpk * ijpj 
    20372038 
    2038  
    20392039      IF ( l_north_nogather ) THEN 
    20402040         ! 
    20412041        ztabr(:,:,:) = 0 
     2042        ztabl(:,:,:) = 0 
     2043 
    20422044        DO jk = 1, jpk 
    20432045           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    20442046              ij = jj - nlcj + ijpj 
    2045               DO ji = 1, nlci 
     2047              DO ji = nfsloop, nfeloop 
    20462048                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 
    20472049              END DO 
    … …  
    20502052 
    20512053         DO jr = 1,nsndto 
    2052             IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 
     2054            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2055              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
     2056            ENDIF 
    20532057         END DO 
    20542058         DO jr = 1,nsndto 
    2055             iproc = isendto(jr) 
    2056             ildi = nldit (iproc) 
    2057             ilei = nleit (iproc) 
    2058             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2059             IF(isendto(jr) .ne. narea) THEN 
    2060               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2059            iproc = nfipproc(isendto(jr),jpnj) 
     2060            IF(iproc .ne. -1) THEN 
     2061               ilei = nleit (iproc+1) 
     2062               ildi = nldit (iproc+1) 
     2063               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2064            ENDIF 
     2065            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2066              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    20612067              DO jk = 1, jpk 
    20622068                 DO jj = 1, ijpj 
    2063                     DO ji = 1, ilei 
     2069                    DO ji = ildi, ilei 
    20642070                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 
    20652071                    END DO 
    20662072                 END DO 
    20672073              END DO 
    2068            ELSE 
     2074           ELSE IF (iproc .eq. (narea-1)) THEN 
    20692075              DO jk = 1, jpk 
    20702076                 DO jj = 1, ijpj 
    2071                     DO ji = 1, ilei 
     2077                    DO ji = ildi, ilei 
    20722078                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
    20732079                    END DO 
    … …  
    20782084         IF (l_isend) THEN 
    20792085            DO jr = 1,nsndto 
    2080                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2086               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2087                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2088               ENDIF     
    20812089            END DO 
    20822090         ENDIF 
    20832091         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2084          ! 
    20852092         DO jk = 1, jpk 
    20862093            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
    … …  
    21902197         ! 
    21912198         ztabr(:,:) = 0 
     2199         ztabl(:,:) = 0 
     2200 
    21922201         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    21932202            ij = jj - nlcj + ijpj 
    2194             DO ji = 1, nlci 
     2203              DO ji = nfsloop, nfeloop 
    21952204               ztabl(ji,ij) = pt2d(ji,jj) 
    21962205            END DO 
    … …  
    21982207 
    21992208         DO jr = 1,nsndto 
    2200             IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2209            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2210               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
     2211            ENDIF 
    22012212         END DO 
    22022213         DO jr = 1,nsndto 
    2203             iproc = isendto(jr) 
    2204             ildi = nldit (iproc) 
    2205             ilei = nleit (iproc) 
    2206             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2207             IF(isendto(jr) .ne. narea) THEN 
    2208               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2214            iproc = nfipproc(isendto(jr),jpnj) 
     2215            IF(iproc .ne. -1) THEN 
     2216               ilei = nleit (iproc+1) 
     2217               ildi = nldit (iproc+1) 
     2218               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2219            ENDIF 
     2220            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2221              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    22092222              DO jj = 1, ijpj 
    2210                  DO ji = 1, ilei 
     2223                 DO ji = ildi, ilei 
    22112224                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 
    22122225                 END DO 
    22132226              END DO 
    2214             ELSE 
     2227            ELSE IF (iproc .eq. (narea-1)) THEN 
    22152228              DO jj = 1, ijpj 
    2216                  DO ji = 1, ilei 
     2229                 DO ji = ildi, ilei 
    22172230                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
    22182231                 END DO 
    … …  
    22222235         IF (l_isend) THEN 
    22232236            DO jr = 1,nsndto 
    2224                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2237               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2238                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2239               ENDIF 
    22252240            END DO 
    22262241         ENDIF 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r3294 r4921  
    177177       
    178178#endif 
     179      nfilcit(:,:) = ilcit(:,:) 
    179180      IF( irestj == 0 )   irestj = jpnj 
    180181 
    … …  
    255256         END DO 
    256257      ENDIF 
     258      nfiimpp(:,:)=iimppt(:,:) 
    257259 
    258260      IF( jpnj > 1 ) THEN 
    … …  
    270272         ii = 1 + MOD( jn-1, jpni ) 
    271273         ij = 1 + (jn-1) / jpni 
     274         nfipproc(ii,ij) = jn - 1 
    272275         nimppt(jn) = iimppt(ii,ij) 
    273276         njmppt(jn) = ijmppt(ii,ij) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r4647 r4921  
    144144#endif 
    145145 
     146      nfilcit(:,:) = ilci(:,:) 
     147 
    146148      IF(lwp) WRITE(numout,*) 
    147149      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' 
    … …  
    175177         END DO 
    176178      ENDIF 
     179      nfiimpp(:,:) = iimppt(:,:) 
    177180 
    178181      IF( jpnj > 1 )THEN 
    … …  
    195198         ili = ilci(ii,ij) 
    196199         ilj = ilcj(ii,ij) 
    197  
    198200         ibondj(ii,ij) = -1 
    199201         IF( jarea >  jpni          )   ibondj(ii,ij) = 0 
    200202         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1 
    201203         IF( jpnj  == 1             )   ibondj(ii,ij) = 2 
    202  
    203204         ibondi(ii,ij) = 0 
    204205         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1 
    … …  
    308309      END DO 
    309310 
     311      nfipproc(:,:) = ipproc(:,:) 
     312 
     313 
    310314      ! Control 
    311315      IF(icont+1 /= jpnij) THEN 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r4624 r4921  
    208208      !----------------------------------------------------------------------- 
    209209 
     210      !Initalise all values in namelist arrays 
     211      enactfiles(:) = '' 
     212      coriofiles(:) = '' 
     213      profbfiles(:) = '' 
     214      slafilesact(:) = '' 
     215      slafilespas(:) = '' 
     216      slafbfiles(:) = '' 
     217      sstfiles(:)   = '' 
     218      sstfbfiles(:) = '' 
     219      seaicefiles(:) = '' 
    210220      velcurfiles(:) = '' 
    211221      veladcpfiles(:) = '' 
     222      velavcurfiles(:) = '' 
     223      velhrcurfiles(:) = '' 
     224      velavadcpfiles(:) = '' 
     225      velhradcpfiles(:) = '' 
     226      velfbfiles(:) = '' 
     227      velcurfiles(:) = '' 
     228      veladcpfiles(:) = '' 
     229      endailyavtypes(:) = -1 
     230      endailyavtypes(1) = 820 
     231      ln_profb_ena(:) = .FALSE. 
     232      ln_profb_enatim(:) = .TRUE. 
     233      ln_velfb_av(:) = .FALSE. 
     234      ln_ignmis = .FALSE. 
    212235      CALL ini_date( dobsini ) 
    213236      CALL fin_date( dobsend ) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r3294 r4921  
    286286         IF ( llaction ) THEN 
    287287             
    288             kinfo = OASIS_Rcv 
    289288            pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 
    290289             
    … …  
    304303               WRITE(numout,*) '****************' 
    305304            ENDIF 
     305 
     306            ! Ideally we would not reuse kinfo, but define a separate variable 
     307            ! for use as the return code from this routine to avoid confusion 
     308            ! with the return code previously obtained from the coupler. 
     309            kinfo = OASIS_Rcv 
    306310             
    307311         ELSE 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r4371 r4921  
    4040      LOGICAL              ::   ln_clim     ! climatology or not (T/F) 
    4141      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
    42       CHARACTER(len = 34) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
     42      CHARACTER(len = 256) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    4343      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
    4444      !                                     ! a string starting with "U" or "V" for each component    
    … …  
    473473            !       forcing record :    1  
    474474            !                             
    475             ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 
     475            ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 
     476           &       + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 
    476477            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    477478            ! swap at the middle of the year 
    478             IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 
    479             ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)    
     479            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 
     480                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1)  
     481            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 
     482                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2)  
    480483            ENDIF 
    481484         ELSE                                    ! no time interpolation 
    … …  
    501504            !       forcing record :  nmonth  
    502505            !                             
    503             ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 
     506            ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 
     507           &       + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 
    504508            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    505509            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4881 r4921  
    563563      zcoef_dqsb   = rhoa * cpa * Cice 
    564564      zcoef_frca   = 1.0  - 0.3 
     565      ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 
     566      zcoef_frca   = 1.0  - 0.19 
    565567 
    566568!!gm brutal.... 
    … …  
    648650               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    649651               ! Long  Wave (lw) 
    650                ! iovino 
    651                IF( ff(ji,jj) .GT. 0._wp ) THEN 
    652                   z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    653                ELSE 
    654                   z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    655                ENDIF 
     652               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    656653               ! lw sensitivity 
    657654               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    668665                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    669666               ! Latent heat sensitivity for ice (Dqla/Dt) 
    670                p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     667               ! MV we also have to cap the sensitivity if the flux is zero 
     668               IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     669                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     670               ELSE 
     671                  p_dqla(ji,jj,jl) = 0.0 
     672               ENDIF 
     673                              
    671674               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    672675               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    … …  
    820823           sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
    821824         ELSE 
    822            !! Shifting the wind speed to 10m and neutral stability : 
    823            U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a) 
     825           !! Shifting the wind speed to 10m and neutral stability :  L & Y eq. (9a) 
     826           !   In very rare low-wind conditions, the old way of estimating the 
     827           !   neutral wind speed at 10m leads to a negative value that causes the code 
     828           !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
     829           U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    824830 
    825831           !! Updating the neutral 10m transfer coefficients : 
    … …  
    956962         zpsi_m  = psi_m(zeta_u) 
    957963         !! 
    958          !! Shifting the wind speed to 10m and neutral stability : (L & Y eq.(9a)) 
    959 !        U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - psi_m(zeta_u))) 
    960          U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) 
     964         !! Shifting the wind speed to 10m and neutral stability : L & Y eq.(9a) 
     965         !   In very rare low-wind conditions, the old way of estimating the 
     966         !   neutral wind speed at 10m leads to a negative value that causes the code 
     967         !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
     968         U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    961969         !! 
    962970         !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c)) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4881 r4921  
    13741374            END SELECT 
    13751375         CASE( 'mixed oce-ice'        )    
    1376             ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
     1376            ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    13771377            DO jl=1,jpl 
    13781378               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r4881 r4921  
    5757      !!                =1 global mean of emp set to zero at each nn_fsbc time step 
    5858      !!                =2 annual global mean corrected from previous year 
     59      !!                =3 global mean of emp set to zero at each nn_fsbc time step 
     60      !!                   & spread out over erp area depending its sign 
    5961      !! Note: if sea ice is embedded it is taken into account when computing the budget  
    6062      !!---------------------------------------------------------------------- 
    … …  
    8183            IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero' 
    8284            IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget' 
    83          ENDIF 
     85            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area' 
     86         ENDIF 
     87         ! 
     88         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 
    8489         ! 
    8590         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
    … …  
    142147         ENDIF 
    143148         ! 
     149      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==! 
     150         ! 
     151         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
     152            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp 
     153            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp 
     154            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
     155            ! 
     156            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
     157            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
     158            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
     159            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 
     160            !             
     161            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
     162                zsurf_tospread      = zsurf_pos 
     163                ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
     164            ELSE                             ! spread out over <0 erp area to increase precipitation 
     165                zsurf_tospread      = zsurf_neg 
     166                ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
     167            ENDIF 
     168            ! 
     169            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
     170!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so.... 
     171            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
     172            !                                                  ! weight to respect erp field 2D structure  
     173            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
     174            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
     175            !                                                  ! final correction term to apply 
     176            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 
     177            ! 
     178!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
     179            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
     180            ! 
     181            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
     182            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     183            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
     184            ! 
     185            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     186               IF( z_fwf < 0._wp ) THEN 
     187                  WRITE(numout,*)'   z_fwf < 0' 
     188                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     189               ELSE 
     190                  WRITE(numout,*)'   z_fwf >= 0' 
     191                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     192               ENDIF 
     193               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 
     194               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
     195               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
     196               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)  
     197               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)  
     198            ENDIF 
     199         ENDIF 
     200         ! 
    144201      CASE DEFAULT                           !==  you should never be there  ==! 
    145          CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1 or 2' ) 
     202         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) 
    146203         ! 
    147204      END SELECT 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4333 r4921  
    5959   USE prtctl          ! Print control 
    6060   USE lib_fortran     !  
     61   USE cpl_oasis3, ONLY : lk_cpl 
    6162 
    6263#if defined key_bdy  
    … …  
    6869 
    6970   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90 
     71   PUBLIC lim_prt_state 
    7072    
    7173   !! * Substitutions 
    … …  
    133135      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    134136      !! 
    135       INTEGER  ::   jl      ! dummy loop index 
     137      INTEGER  ::   ji, jj, jl, jk      ! dummy loop index 
    136138      REAL(wp) ::   zcoef   ! local scalar 
    137139      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky 
    … …  
    146148      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories 
    147149      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories 
     150      REAL(wp) ::   ztmelts           ! clem 2014: for HC diags 
     151      REAL(wp) ::   epsi20 = 1.e-20   ! 
    148152      !!---------------------------------------------------------------------- 
    149153 
    … …  
    152156      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    153157 
    154       CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    155  
    156 #if defined key_coupled 
    157       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 
    158       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    159          &   CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    160 #endif 
     158      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     159 
     160      IF( lk_cpl ) THEN 
     161         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     162            &   CALL wrk_alloc( jpi, jpj, ztem_ice_all , zalb_ice_all  , z_qsr_ice_all, z_qns_ice_all,  & 
     163            &                            z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     164      ENDIF 
    161165 
    162166      IF( kt == nit000 ) THEN 
    … …  
    168172         ! 
    169173         IF( ln_nicep ) THEN      ! control print at a given point 
    170             jiindx = 177   ;   jjindx = 112 
     174            jiindx = 15    ;   jjindx =  44 
    171175            IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    172176         ENDIF 
    … …  
    176180      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    177181         !                                     !----------------------! 
    178          !                                           !  Bulk Formulea ! 
     182         !                                           !  Bulk Formulae ! 
    179183         !                                           !----------------! 
    180184         ! 
    181185         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point 
    182186         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean) 
    183          ! 
    184          t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin] 
    185          !                                           ! (set to rt0 over land) 
     187 
     188         ! masked sea surface freezing temperature [Kelvin] 
     189         t_bo(:,:) = ( tfreez( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) 
     190 
    186191         CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo 
    187192 
    … …  
    192197         IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
    193198          
    194 #if defined key_coupled 
    195          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    196             ! 
    197             ! Compute mean albedo and temperature 
    198             zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
    199             ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
    200             ! 
     199         IF( lk_cpl ) THEN 
     200            IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     201               ! 
     202               ! Compute mean albedo and temperature 
     203               zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
     204               ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
     205               ! 
     206            ENDIF 
    201207         ENDIF 
    202 #endif 
    203208                                               ! Bulk formulea - provides the following fields: 
    204209         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
    … …  
    218223            !          
    219224         CASE( 4 )                                       ! CORE bulk formulation 
    220             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               & 
     225            ! MV 2014 
     226            ! We must account for cloud fraction in the computation of the albedo 
     227            ! The present ref just uses the clear sky value 
     228            ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 
     229            ! CORE has no cloud fraction, hence we must prescribe it 
     230            ! Mean summer cloud fraction computed from CLIO = 0.81 
     231            zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 
     232            ! Following line, we replace zalb_ice_cs by simply zalb_ice 
     233            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    221234               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    222235               &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
    … …  
    239252 
    240253         ! Average over all categories 
    241 #if defined key_coupled 
     254         IF( lk_cpl ) THEN 
    242255         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    243256 
    … …  
    269282            END IF 
    270283         END IF 
    271 #endif 
     284         ENDIF 
    272285         !                                           !----------------------! 
    273286         !                                           ! LIM-3  time-stepping ! 
    … …  
    277290         ! 
    278291         !                                           ! Store previous ice values 
    279 !!gm : remark   old_...   should becomes ...b  as tn versus tb   
    280          old_a_i  (:,:,:)   = a_i  (:,:,:)     ! ice area 
    281          old_e_i  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
    282          old_v_i  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
    283          old_v_s  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
    284          old_e_s  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
    285          old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content 
    286          old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content 
    287          ! 
    288          old_u_ice(:,:) = u_ice(:,:) 
    289          old_v_ice(:,:) = v_ice(:,:) 
    290          !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
     292         a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
     293         e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
     294         v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
     295         v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume  
     296         e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
     297         smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
     298         oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content 
     299         u_ice_b(:,:)     = u_ice(:,:) 
     300         v_ice_b(:,:)     = v_ice(:,:) 
     301 
     302         ! trends    !!gm is it truly necessary ??? 
    291303         d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp 
    292304         d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp 
    … …  
    296308         d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp 
    297309         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
    298          ! 
    299          d_u_ice_dyn(:,:) = 0._wp 
    300          d_v_ice_dyn(:,:) = 0._wp 
    301          ! 
    302          sfx    (:,:) = 0._wp   ;   sfx_thd  (:,:) = 0._wp 
    303          sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
    304          fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
    305          fhmec  (:,:) = 0._wp   ;    
    306          fmmec  (:,:) = 0._wp 
    307          fmmflx (:,:) = 0._wp      
    308          focea2D(:,:) = 0._wp 
    309          fsup2D (:,:) = 0._wp 
    310  
    311          ! used in limthd.F90 
    312          rdvosif(:,:) = 0._wp   ! variation of ice volume at surface 
    313          rdvobif(:,:) = 0._wp   ! variation of ice volume at bottom 
    314          fdvolif(:,:) = 0._wp   ! total variation of ice volume 
    315          rdvonif(:,:) = 0._wp   ! lateral variation of ice volume 
    316          fstric (:,:) = 0._wp   ! part of solar radiation transmitted through the ice 
    317          ffltbif(:,:) = 0._wp   ! linked with fstric 
    318          qfvbq  (:,:) = 0._wp   ! linked with fstric 
    319          rdm_snw(:,:) = 0._wp   ! variation of snow mass per unit area 
    320          rdm_ice(:,:) = 0._wp   ! variation of ice mass per unit area 
    321          hicifp (:,:) = 0._wp   ! daily thermodynamic ice production.  
    322          ! 
    323          diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
    324          diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
    325          diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
    326          diag_res_pr(:,:) = 0._wp   ;   diag_trp_vi(:,:) = 0._wp 
     310         d_u_ice_dyn(:,:)     = 0._wp   ;   d_v_ice_dyn(:,:)     = 0._wp 
     311 
     312         ! salt, heat and mass fluxes 
     313         sfx    (:,:) = 0._wp   ; 
     314         sfx_bri(:,:) = 0._wp   ;  
     315         sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
     316         sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     317         sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
     318         sfx_res(:,:) = 0._wp 
     319 
     320         wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
     321         wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     322         wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
     323         wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
     324         wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
     325         wfx_spr(:,:) = 0._wp   ;    
     326 
     327         hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
     328         hfx_thd(:,:) = 0._wp   ;    
     329         hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
     330         hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
     331         hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
     332         hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
     333         hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
     334         hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
     335 
     336         ! 
     337         fhld  (:,:)    = 0._wp  
     338         fmmflx(:,:)    = 0._wp      
     339         ! part of solar radiation transmitted through the ice 
     340         ftr_ice(:,:,:) = 0._wp 
     341 
     342         ! diags 
     343         diag_trp_vi  (:,:) = 0._wp  ; diag_trp_vs(:,:) = 0._wp  ;  diag_trp_ei(:,:) = 0._wp  ;  diag_trp_es(:,:) = 0._wp 
     344         diag_heat_dhc(:,:) = 0._wp   
     345 
    327346         ! dynamical invariants 
    328347         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
    … …  
    352371         ENDIF 
    353372!                         !- Change old values for new values 
    354                           old_u_ice(:,:)   = u_ice (:,:) 
    355                           old_v_ice(:,:)   = v_ice (:,:) 
    356                           old_a_i(:,:,:)   = a_i (:,:,:) 
    357                           old_v_s(:,:,:)   = v_s (:,:,:) 
    358                           old_v_i(:,:,:)   = v_i (:,:,:) 
    359                           old_e_s(:,:,:,:) = e_s (:,:,:,:) 
    360                           old_e_i(:,:,:,:) = e_i (:,:,:,:) 
    361                           old_oa_i(:,:,:)  = oa_i(:,:,:) 
    362                           old_smv_i(:,:,:) = smv_i (:,:,:) 
     373                          u_ice_b(:,:)     = u_ice(:,:) 
     374                          v_ice_b(:,:)     = v_ice(:,:) 
     375                          a_i_b  (:,:,:)   = a_i (:,:,:) 
     376                          v_s_b  (:,:,:)   = v_s (:,:,:) 
     377                          v_i_b  (:,:,:)   = v_i (:,:,:) 
     378                          e_s_b  (:,:,:,:) = e_s (:,:,:,:) 
     379                          e_i_b  (:,:,:,:) = e_i (:,:,:,:) 
     380                          oa_i_b (:,:,:)   = oa_i (:,:,:) 
     381                          smv_i_b(:,:,:)   = smv_i(:,:,:) 
    363382  
    364383         ! ---------------------------------------------- 
    … …  
    375394                          zcoef = rdt_ice /rday           !  Ice natural aging 
    376395                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    377                           CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
    378396         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
    379397                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  ! 
    … …  
    391409         !                                           ! Diagnostics and outputs  
    392410         IF (ln_limdiaout) CALL lim_diahsb 
    393 !clem # if ! defined key_iomput 
     411 
    394412                          CALL lim_wri( 1  )              ! Ice outputs  
    395 !clem # endif 
     413 
    396414         IF( kt == nit000 .AND. ln_rstart )   & 
    397415            &             CALL iom_close( numrir )        ! clem: close input ice restart file 
    … …  
    413431       
    414432!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    415       ! 
    416       CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    417  
    418 #if defined key_coupled 
    419       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 
    420       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    421          &    CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    422 #endif 
     433      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     434 
     435      IF( lk_cpl ) THEN 
     436         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     437            &    CALL wrk_dealloc( jpi, jpj, ztem_ice_all , zalb_ice_all , z_qsr_ice_all, z_qns_ice_all,   & 
     438            &                                z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     439      ENDIF 
    423440      ! 
    424441      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
    … …  
    456473                  !WRITE(numout,*) ' at_i     ', at_i(ji,jj) 
    457474                  !WRITE(numout,*) ' Point - category', ji, jj, jl 
    458                   !WRITE(numout,*) ' a_i *** a_i_old ', a_i      (ji,jj,jl), old_a_i  (ji,jj,jl) 
    459                   !WRITE(numout,*) ' v_i *** v_i_old ', v_i      (ji,jj,jl), old_v_i  (ji,jj,jl) 
     475                  !WRITE(numout,*) ' a_i *** a_i_b   ', a_i      (ji,jj,jl), a_i_b  (ji,jj,jl) 
     476                  !WRITE(numout,*) ' v_i *** v_i_b   ', v_i      (ji,jj,jl), v_i_b  (ji,jj,jl) 
    460477                  !WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl) 
    461478                  !WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl) 
    … …  
    534551!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    535552!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    536 !                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl) 
    537553!                 WRITE(numout,*)  
    538554                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    568584               !DO jl = 1, jpl 
    569585                  !WRITE(numout,*) ' Category no: ', jl 
    570                   !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' old_a_i    : ', old_a_i  (ji,jj,jl)    
     586                  !WRITE(numout,*) ' a_i        : ', a_i      (ji,jj,jl) , ' a_i_b      : ', a_i_b  (ji,jj,jl)    
    571587                  !WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    572                   !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' old_v_i    : ', old_v_i  (ji,jj,jl)    
     588                  !WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' v_i_b      : ', v_i_b  (ji,jj,jl)    
    573589                  !WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    574590                  !WRITE(numout,*) ' ' 
    … …  
    591607               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    592608               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    593                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) 
    594                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) 
    595                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice 
    596                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice 
    597                !WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj) 
    598                !WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj) 
    599                !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice 
    600                !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice 
    601                !WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
    602                !WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
    603                !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)  
    604                !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
    605                !WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
    606609               ! 
    607610               !CALL lim_prt_state( kt, ji, jj, 2, '   ') 
    … …  
    759762               WRITE(numout,*) ' strength      : ', strength(ji,jj) 
    760763               WRITE(numout,*) ' d_u_ice_dyn   : ', d_u_ice_dyn(ji,jj), ' d_v_ice_dyn   : ', d_v_ice_dyn(ji,jj) 
    761                WRITE(numout,*) ' old_u_ice     : ', old_u_ice(ji,jj)  , ' old_v_ice     : ', old_v_ice(ji,jj)   
     764               WRITE(numout,*) ' u_ice_b       : ', u_ice_b(ji,jj)    , ' v_ice_b       : ', v_ice_b(ji,jj)   
    762765               WRITE(numout,*) 
    763766                
    … …  
    769772                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)             , ' t_s        : ', t_s(ji,jj,1,jl) 
    770773                  WRITE(numout,*) ' sm_i       : ', sm_i(ji,jj,jl)             , ' o_i        : ', o_i(ji,jj,jl) 
    771                   WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' old_a_i    : ', old_a_i(ji,jj,jl)    
     774                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)              , ' a_i_b      : ', a_i_b(ji,jj,jl)    
    772775                  WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl)        , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl)  
    773                   WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' old_v_i    : ', old_v_i(ji,jj,jl)    
     776                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl)              , ' v_i_b      : ', v_i_b(ji,jj,jl)    
    774777                  WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl)        , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl)  
    775                   WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' old_v_s    : ', old_v_s(ji,jj,jl)   
     778                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)              , ' v_s_b      : ', v_s_b(ji,jj,jl)   
    776779                  WRITE(numout,*) ' d_v_s_trp  : ', d_v_s_trp(ji,jj,jl)        , ' d_v_s_thd  : ', d_v_s_thd(ji,jj,jl) 
    777                   WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' old_ei1    : ', old_e_i(ji,jj,1,jl)/1.0e9  
     780                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9      , ' ei1        : ', e_i_b(ji,jj,1,jl)/1.0e9  
    778781                  WRITE(numout,*) ' de_i1_trp  : ', d_e_i_trp(ji,jj,1,jl)/1.0e9, ' de_i1_thd  : ', d_e_i_thd(ji,jj,1,jl)/1.0e9 
    779                   WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' old_ei2    : ', old_e_i(ji,jj,2,jl)/1.0e9   
     782                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9      , ' ei2_b      : ', e_i_b(ji,jj,2,jl)/1.0e9   
    780783                  WRITE(numout,*) ' de_i2_trp  : ', d_e_i_trp(ji,jj,2,jl)/1.0e9, ' de_i2_thd  : ', d_e_i_thd(ji,jj,2,jl)/1.0e9 
    781                   WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' old_e_snow : ', old_e_s(ji,jj,1,jl)  
     784                  WRITE(numout,*) ' e_snow     : ', e_s(ji,jj,1,jl)            , ' e_snow_b   : ', e_s_b(ji,jj,1,jl)  
    782785                  WRITE(numout,*) ' d_e_s_trp  : ', d_e_s_trp(ji,jj,1,jl)      , ' d_e_s_thd  : ', d_e_s_thd(ji,jj,1,jl) 
    783                   WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' old_smv_i  : ', old_smv_i(ji,jj,jl)    
     786                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl)            , ' smv_i_b    : ', smv_i_b(ji,jj,jl)    
    784787                  WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ji,jj,jl)      , ' d_smv_i_thd: ', d_smv_i_thd(ji,jj,jl)  
    785                   WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' old_oa_i   : ', old_oa_i(ji,jj,jl) 
     788                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)             , ' oa_i_b     : ', oa_i_b(ji,jj,jl) 
    786789                  WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ji,jj,jl)       , ' d_oa_i_thd : ', d_oa_i_thd(ji,jj,jl) 
    787790               END DO !jl 
    … …  
    790793               WRITE(numout,*) ' - Heat / FW fluxes ' 
    791794               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    792                WRITE(numout,*) ' emp        : ', emp      (ji,jj) 
    793                WRITE(numout,*) ' sfx        : ', sfx      (ji,jj) 
    794                WRITE(numout,*) ' sfx_thd    : ', sfx_thd(ji,jj) 
    795                WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ji,jj) 
    796                WRITE(numout,*) ' sfx_mec    : ', sfx_mec  (ji,jj) 
    797                WRITE(numout,*) ' sfx_res    : ', sfx_res(ji,jj) 
    798                WRITE(numout,*) ' fmmec      : ', fmmec    (ji,jj) 
    799                WRITE(numout,*) ' fhmec      : ', fhmec    (ji,jj) 
    800                WRITE(numout,*) ' fhbri      : ', fhbri    (ji,jj) 
    801                WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ji,jj) 
     795               WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 
     796               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) ) 
     797               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) ) 
     798               WRITE(numout,*) 
    802799               WRITE(numout,*)  
    803800               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)   
    … …  
    829826               WRITE(numout,*) ' qsr       : ', qsr(ji,jj) 
    830827               WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    831                WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj) 
    832                WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) * r1_rdtice 
    833                WRITE(numout,*) ' qldif     : ', qldif(ji,jj) * r1_rdtice 
     828               WRITE(numout,*) 
     829               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 
     830               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
     831               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
     832               WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)               
     833               WRITE(numout,*) 
     834               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 
     835               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
     836               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
     837               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
     838               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
    834839               WRITE(numout,*) 
    835840               WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    836841               WRITE(numout,*) ' emp       : ', emp    (ji,jj) 
    837                WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
    838842               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj) 
    839843               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj) 
    840                WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ji,jj) 
    841                WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    842                WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 
     844               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
     845               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj) 
    843846               WRITE(numout,*) 
    844847               WRITE(numout,*) ' - Momentum fluxes ' 
    845848               WRITE(numout,*) ' utau      : ', utau(ji,jj)  
    846849               WRITE(numout,*) ' vtau      : ', vtau(ji,jj) 
    847             ENDIF 
     850            ENDIF  
    848851            WRITE(numout,*) ' ' 
    849852            ! 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4621 r4921  
    5353   USE agrif_lim2_update 
    5454# endif 
     55 
     56#if defined key_bdy  
     57   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
     58#endif 
    5559 
    5660   IMPLICIT NONE 
    … …  
    205209                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion ) 
    206210           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
     211#if defined key_bdy 
     212                           CALL bdy_ice_lim( kt ) ! bdy ice thermo 
     213#endif 
    207214         END IF 
    208215#if defined key_coupled 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4624 r4921  
    186186  
    187187      fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation 
     188       
     189      taum(:,:) = 0.0_wp                           ! Initialise taum for use in gls in case of reduced restart 
    188190 
    189191      !                                            ! restartability    

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r4624 r4921  
    203203      ! 
    204204      !                                      !==  structure function value at uw- and vw-points  ==! 
    205       zhu(:,:) = 1._wp / zhu(:,:)                   ! hu --> 1/hu 
    206       zhv(:,:) = 1._wp / zhv(:,:) 
     205      DO jj = 1, jpjm1 
     206         DO ji = 1, fs_jpim1   ! vector opt. 
     207            zhu(ji,jj) = 1._wp / zhu(ji,jj)                   ! hu --> 1/hu 
     208            zhv(ji,jj) = 1._wp / zhv(ji,jj) 
     209         END DO 
     210      END DO 
     211      ! 
    207212      zpsi_uw(:,:,:) = 0._wp 
    208213      zpsi_vw(:,:,:) = 0._wp 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4624 r4921  
    129129      IF( kt == nit000 ) THEN                     ! Set the forcing field at nit000 - 1 
    130130         !                                        ! ----------------------------------- 
     131         qsr_hc(:,:,:) = 0.e0 
     132         ! 
    131133         IF( ln_rstart .AND.    &                    ! Restart: read in restart file 
    132134              & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r4624 r4921  
    12581258               en  (:,:,:) = rn_emin 
    12591259               mxln(:,:,:) = 0.001         
     1260               avt_k (:,:,:) = avt (:,:,:) 
     1261               avm_k (:,:,:) = avm (:,:,:) 
     1262               avmu_k(:,:,:) = avmu(:,:,:) 
     1263               avmv_k(:,:,:) = avmv(:,:,:) 
    12601264               DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_gls( jit )   ;   END DO 
    12611265            ENDIF 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r4624 r4921  
    121121      IF(lwp) WRITE(numout,*) 
    122122      IF(lwp) WRITE(numout,*) '   convection :' 
     123      ! 
     124      IF( ln_zdfnpc )   CALL ctl_stop( ' zdf_init: non penetrative convective scheme is not working',   & 
     125         &                                       ' set ln_zdfnpc to FALSE' ) 
     126      ! 
    123127      ioptio = 0 
    124128      IF( ln_zdfnpc ) THEN 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4645 r4921  
    8686   USE sbctide, ONLY: lk_tide 
    8787   USE crsini          ! initialise grid coarsening utility 
    88    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
     88   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    8989 
    9090   IMPLICIT NONE 
    … …  
    568568      ENDIF 
    569569      ! 
    570       IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   & 
    571          &                                               'with the IOM Input/Output manager. '         ,   & 
    572          &                                               'Compile with key_iomput enabled' ) 
    573       ! 
    574570      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    575571         &                                               'f2003 standard. '                              ,  & 
    … …  
    803799          !loop over the other north-fold processes to find the processes 
    804800          !managing the points belonging to the sxT-dxT range 
    805           DO jn = jpnij - jpni +1, jpnij 
    806              IF ( njmppt(jn) == njmppmax ) THEN 
     801   
     802          DO jn = 1, jpni 
    807803                !sxT is the first point (in the global domain) of the jn 
    808804                !process 
    809                 sxT = nimppt(jn) 
     805                sxT = nfiimpp(jn, jpnj) 
    810806                !dxT is the last point (in the global domain) of the jn 
    811807                !process 
    812                 dxT = nimppt(jn) + nlcit(jn) - 1 
     808                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    813809                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    814810                   nsndto = nsndto + 1 
    815                    isendto(nsndto) = jn 
     811                     isendto(nsndto) = jn 
    816812                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    817813                   nsndto = nsndto + 1 
    818                    isendto(nsndto) = jn 
     814                     isendto(nsndto) = jn 
    819815                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    820816                   nsndto = nsndto + 1 
    821                    isendto(nsndto) = jn 
     817                     isendto(nsndto) = jn 
    822818                END IF 
    823              END IF 
    824819          END DO 
     820          nfsloop = 1 
     821          nfeloop = nlci 
     822          DO jn = 2,jpni-1 
     823           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     824              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     825                 nfsloop = nldi 
     826              ENDIF 
     827              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     828                 nfeloop = nlei 
     829              ENDIF 
     830           ENDIF 
     831        END DO 
     832 
    825833      ENDIF 
    826834      l_north_nogather = .TRUE. 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r4354 r4921  
    8585      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         & 
    8686         &     rhop(jpi,jpj,jpk) ,                                         & 
     87         &     rke(jpi,jpj,jpk)  ,                                         & 
    8788         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     & 
    8889         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     & 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4624 r4921  
    302302      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    303303 
    304       IF( lrst_oce .AND. ln_diahsb )   CALL dia_hsb_rst( kstp, 'WRITE' ) 
    305304      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    306305      ! Control and restarts 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r4624 r4921  
    244244               ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6  
    245245#endif 
    246                IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust * rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 
     246               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 
    247247               zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc 
    248248               zscave = zfeequi * zlam1b * zstep 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r4624 r4921  
    163163              zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      & 
    164164               &          * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)          & 
    165                &          * ( 0.1 + 3.9 * zratio2 / ( 1.**2 + zratio2 ) ) 
     165               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    166166              zfracfe   = zfrac * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    167167 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r4624 r4921  
    137137               !    Various remineralization and excretion terms 
    138138               !    -------------------------------------------- 
    139                zgrasrat  = zgraztotf / ( zgraztot + rtrn ) 
    140                zgrasratn = zgraztotn / ( zgraztot + rtrn ) 
     139               zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztot + rtrn ) 
     140               zgrasratn = ( zgraztotn + rtrn ) / ( zgraztot + rtrn ) 
    141141               zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3) 
    142142               zepsherv  = zepshert * MIN( epsher, (1. - unass) * zgrasrat / ferat3, (1. - unass) * zgrasratn ) 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r4641 r4921  
    3535   REAL(wp) :: ryyss                    !: number of seconds per year  
    3636   REAL(wp) :: r1_ryyss                 !: inverse of ryyss 
    37    REAL(wp) :: rmtss                    !: number of seconds per month 
    3837   REAL(wp) :: r1_rday                  !: inverse of rday 
    3938 
    … …  
    8584      IF( kt == nittrc000 .AND. jnt == 1 )  THEN 
    8685         ryyss    = nyear_len(1) * rday    ! number of seconds per year and per month 
    87          rmtss    = ryyss / raamo 
    8886         r1_rday  = 1. / rday 
    8987         r1_ryyss = 1. / ryyss 
    … …  
    9997      zdenit2d(:,:) = 0.e0 
    10098      zbureff (:,:) = 0.e0 
     99      zwork1  (:,:) = 0.e0 
     100      zwork2  (:,:) = 0.e0 
     101      zwork3  (:,:) = 0.e0 
     102      zwork4  (:,:) = 0.e0 
    101103 
    102104      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
    … …  
    132134         !                                              ! Iron and Si deposition at the surface 
    133135         IF( ln_solub ) THEN 
    134             zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss  
     136            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    135137         ELSE 
    136             zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss  
     138            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    137139         ENDIF 
    138          zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 28.1  * rmtss ) 
    139          zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / ( 31.   * rmtss ) / po4r  
     140         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1  
     141         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r  
    140142         !                                              ! Iron solubilization of particles in the water column 
    141143         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    … …  
    250252      DO jj = 1, jpj 
    251253         DO ji = 1, jpi 
    252             ikt = mbkt(ji,jj)  
     254            IF( tmask(ji,jj,1) == 1 ) THEN 
     255               ikt = mbkt(ji,jj)  
    253256# if defined key_kriest 
    254             zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 
    255             zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
     257               zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 
     258               zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
    256259# else 
    257             zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
    258             zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
     260               zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
     261               zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
    259262# endif 
    260             ! For calcite, burial efficiency is made a function of saturation 
    261             zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
    262             zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    263             zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
     263               ! For calcite, burial efficiency is made a function of saturation 
     264               zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
     265               zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     266               zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
     267            ENDIF 
    264268         END DO 
    265269      END DO 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-x3750_ADA

    r4255 r4921  
    6565# 
    6666  if [ MPI_FLAG == "yes" ]; then 
    67      echo "Running time ${MPIRUN} ./opa" 
    68      time ${MPIRUN} ./opa 
     67     echo "Running time ${MPIRUN} ./opa -procs $OCEANCORES" 
     68     time ${MPIRUN} ./opa -procs $OCEANCORES 
    6969  else 
    7070     echo "Running time ./opa" 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/iodef_sette.xml

    r4242 r4921  
    22<simulation>  
    33 
    4  <context id="nemo" time_origin="1900-01-01 00:00:00" > 
     4 <context id="nemo" time_origin="1950-01-01 00:00:00" > 
    55     
    66    <!-- $id$ --> 
    … …  
    2121    --> 
    2222     
    23     <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4"> 
     23    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
    2424     
    25       <file_group id="1h" output_freq="1h"  output_level="10" enabled=".FALSE."/> <!-- 1h files --> 
    26       <file_group id="2h" output_freq="2h"  output_level="10" enabled=".FALSE."/> <!-- 2h files --> 
    27       <file_group id="3h" output_freq="3h"  output_level="10" enabled=".FALSE."/> <!-- 3h files -->      
    28       <file_group id="4h" output_freq="4h"  output_level="10" enabled=".FALSE."/> <!-- 4h files --> 
    29       <file_group id="6h" output_freq="6h"  output_level="10" enabled=".FALSE."/> <!-- 6h files --> 
    30       
    31       <file_group id="1d" output_freq="1d"  output_level="10" enabled=".FALSE."/> <!-- 1d files --> 
     25      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
     26      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
     27      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
     28      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->      
     29      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files --> 
     30      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->      
     31      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files --> 
     32      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
     33      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
     34      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
     35      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
     36      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
     37      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files --> 
     38      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files --> 
    3239 
    33       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".FALSE."/> <!-- 3d files --> 
    34       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".FALSE."/> <!-- 5d files --> 
    35  
    36       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".FALSE."/> <!-- real monthly files --> 
    37       <file_group id="2m" output_freq="2mo" output_level="10" enabled=".FALSE."/> <!-- real 2m files --> 
    38       <file_group id="3m" output_freq="3mo" output_level="10" enabled=".FALSE."/> <!-- real 3m files --> 
    39       <file_group id="4m" output_freq="4mo" output_level="10" enabled=".FALSE."/> <!-- real 4m files --> 
    40       <file_group id="6m" output_freq="6mo" output_level="10" enabled=".FALSE."/> <!-- real 6m files --> 
    41  
    42       <file_group id="1y"  output_freq="1y" output_level="10" enabled=".FALSE."/> <!-- real yearly files --> 
    43       <file_group id="2y"  output_freq="2y" output_level="10" enabled=".FALSE."/> <!-- real 2y files --> 
    44       <file_group id="5y"  output_freq="5y" output_level="10" enabled=".FALSE."/> <!-- real 5y files --> 
    45       <file_group id="10y" output_freq="10y" output_level="10" enabled=".FALSE."/> <!-- real 10y files --> 
     40      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files --> 
     41      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files --> 
     42      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files --> 
     43      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files --> 
    4644 
    4745   </file_definition> 
    … …  
    6462   <domain_definition src="./domain_def.xml"/> 
    6563    
    66    <grid_definition />     
    67    
     64   <grid_definition>     
     65     <grid id="grid_T_2D" domain_ref="grid_T"/> 
     66     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/> 
     67     <grid id="grid_U_2D" domain_ref="grid_U"/> 
     68     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/> 
     69     <grid id="grid_V_2D" domain_ref="grid_V"/> 
     70     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/> 
     71     <grid id="grid_W_2D" domain_ref="grid_W"/> 
     72     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/> 
     73    </grid_definition>    
    6874  </context> 
    6975   
    … …  
    8692============================================================================================================ 
    8793    --> 
    88   
     94     
    8995    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
    9096     
    91       <file_group id="1h" output_freq="1h"  output_level="10" enabled=".FALSE."/> <!-- 1h files --> 
    92       <file_group id="2h" output_freq="2h"  output_level="10" enabled=".FALSE."/> <!-- 2h files --> 
    93       <file_group id="3h" output_freq="3h"  output_level="10" enabled=".FALSE."/> <!-- 3h files -->      
    94       <file_group id="4h" output_freq="4h"  output_level="10" enabled=".FALSE."/> <!-- 4h files --> 
    95       <file_group id="6h" output_freq="6h"  output_level="10" enabled=".FALSE."/> <!-- 6h files --> 
    96       
    97       <file_group id="1d" output_freq="1d"  output_level="10" enabled=".FALSE."/> <!-- 1d files --> 
     97      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
     98      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
     99      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
     100      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->      
     101      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files --> 
     102      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->      
     103      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files --> 
     104      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
     105      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE."/>  <!-- 5d files -->   
     106      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
     107      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
     108      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
     109      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files --> 
     110      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files --> 
    98111 
    99       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".FALSE."/> <!-- 3d files --> 
    100       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".FALSE."/> <!-- 5d files --> 
     112      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files --> 
     113      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files --> 
     114      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files --> 
     115      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files --> 
    101116 
    102       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".FALSE."/> <!-- real monthly files --> 
    103       <file_group id="2m" output_freq="2mo" output_level="10" enabled=".FALSE."/> <!-- real 2m files --> 
    104       <file_group id="3m" output_freq="3mo" output_level="10" enabled=".FALSE."/> <!-- real 3m files --> 
    105       <file_group id="4m" output_freq="4mo" output_level="10" enabled=".FALSE."/> <!-- real 4m files --> 
    106       <file_group id="6m" output_freq="6mo" output_level="10" enabled=".FALSE."/> <!-- real 6m files --> 
    107  
    108       <file_group id="1y"  output_freq="1y" output_level="10" enabled=".FALSE."/> <!-- real yearly files --> 
    109       <file_group id="2y"  output_freq="2y" output_level="10" enabled=".FALSE."/> <!-- real 2y files --> 
    110       <file_group id="5y"  output_freq="5y" output_level="10" enabled=".FALSE."/> <!-- real 5y files --> 
    111       <file_group id="10y" output_freq="10y" output_level="10" enabled=".FALSE."/> <!-- real 10y files --> 
    112       <file_group id="1h" output_freq="1h"  output_level="10" enabled=".FALSE."/> <!-- 1h files --> 
    113       <file_group id="2h" output_freq="2h"  output_level="10" enabled=".FALSE."/> <!-- 2h files --> 
    114       <file_group id="3h" output_freq="3h"  output_level="10" enabled=".FALSE."/> <!-- 3h files -->      
    115       <file_group id="4h" output_freq="4h"  output_level="10" enabled=".FALSE."/> <!-- 4h files --> 
    116       <file_group id="6h" output_freq="6h"  output_level="10" enabled=".FALSE."/> <!-- 6h files --> 
    117       
    118117   </file_definition> 
    119118     
    … …  
    130129      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 
    131130      <axis id="nfloat" long_name="Float number"      unit="-"  /> 
     131      <axis id="icbcla" long_name="Iceberg class"     unit="-"  /> 
    132132   </axis_definition>  
    133133     
    … …  
    146146  </context> 
    147147 
    148  
    149148  <context id="xios"> 
    150149 
    … …  
    154153        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size) 
    155154--> 
    156      <variable id="buffer_size"               type="integer">10000000</variable> 
     155     <variable id="buffer_size"               type="integer">10155778</variable> 
    157156     <variable id="buffer_server_factor_size" type="integer">2</variable> 
    158157     <variable id="info_level"                type="integer">0</variable> 
    … …  
    164163                
    165164  </context> 
    166    
    167165</simulation> 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/prepare_exe_dir.sh

    r4373 r4921  
    7171 
    7272cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/. 
    73 #cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml 
     73cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml 
    7474cd ${EXE_DIR} 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/prepare_job.sh

    r4373 r4921  
    182182fi 
    183183 
    184 # example for NOCS Altix system using PBS batch submission (requires ${SETTE_DIR}/sette_batch_template file) 
     184# example for NOCS ClusterVision system using SLURM batch submission (requires ${SETTE_DIR}/sette_batch_template file) 
    185185# 
    186186  #  if [ ${MPI_FLAG} == "no" ] ; then 
    187187      case ${COMPILER} in  
    188          ALTIX_NAUTILUS_MPT) 
    189                                 NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 4}') 
     188         X64_MOBILIS) 
     189                                NB_REM=$( echo $NB_PROC $NXIO_PROC | awk '{print ( $1 + $2 ) % 16}') 
    190190               if [ ${NB_REM} == 0 ] ; then 
    191                # number of processes required is an integer multiple of 4 
     191               # number of processes required is an integer multiple of 16 
    192192               # 
    193                NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1 + $2 ) / 4}') 
     193               NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1 + $2 ) / 16}') 
    194194            else 
    195195               # 
    196                # number of processes required is not an integer multiple of 4 
     196               # number of processes required is not an integer multiple of 16 
    197197               # round up the number of nodes required. 
    198198               # 
    199                NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1 + $2 ) / 4 + 1 )}') 
     199               NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{printf("%d",($1 + $2 ) / 16 + 1 )}') 
    200200                  fi 
    201201            ;; 
     202                        XC_ARCHER_INTEL) 
     203                                # ocean cores are packed 24 to a node 
     204                                NB_REM=$( echo $NB_PROC | awk '{print ( $1 % 24 ) }') 
     205                                if [ ${NB_REM} == 0 ] ; then 
     206                                        # number of processes required is an integer multiple of 24 
     207                                        # 
     208                                        NB_NODES=$( echo $NB_PROC $NXIO_PROC | awk '{print ($1) / 24}') 
     209                                else 
     210                                        # 
     211                                        # number of processes required is not an integer multiple of 24 
     212                                        # round up the number of nodes required. 
     213                                        # 
     214                                        NB_NODES=$( echo $NB_PROC | awk '{printf("%d",($1) / 24 + 1 )}') 
     215                                fi 
     216                                # xios cores are sparsely packed at 4 to a node 
     217                                # but can not share nodes with the ocean cores 
     218                                NB_REM=$( echo $NXIO_PROC | awk '{print ( $2 % 4 ) }') 
     219                                if [ ${NB_REM} == 0 ] ; then 
     220                                        # number of processes required is an integer multiple of 4                            
     221                                        # 
     222                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ))}')                     
     223                                else 
     224                                        # 
     225                                        # number of processes required is not an integer multiple of 4                              
     226                                        # round up the number of nodes required. 
     227                                        # 
     228                                        NB_NODES=$( echo $NB_NODES $NXIO_PROC | awk '{print ($1 + ( $2 / 4 ) + 1)}')                     
     229                                fi 
     230                                ;; 
    202231                        ifort_MERCATOR_CLUSTER) 
    203232                                echo NB_PROCS ${NB_PROC} 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/sette.sh

    r4379 r4921  
    136136# ORCA2_LIM_PISCES: 3 &  4 
    137137# ORCA2_OFF_PISCES: 5 &  6 
    138 # AMM12           : 7 &  8 
    139 # SAS             : 9 & 10 
    140 # ORCA2_AGRIF_LIM: 11 
    141 for config in 1 2 3 4 5 6 7 8 9 10 11 
     138# ORCA2_LIM3      : 7 &  8 
     139# AMM12           : 9 & 10  
     140# SAS             :11 & 12 
     141# ORCA2_AGRIF_LIM :13 
     142for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 
    142143 
    143144do 
    … …  
    629630fi 
    630631 
     632 
     633# TESTS FOR ORCA2_LIM3 CONFIGURATION 
     634if [ ${config} -eq 7 ] ;  then 
     635    ## Restartability tests for ORCA2_LIM3 
     636    export TEST_NAME="LONG" 
     637    cd ${CONFIG_DIR} 
     638    . ./makenemo -m ${CMP_NAM} -n ORCA2LIM3_LONG -r ORCA2_LIM3 -j 8 del_key ${DEL_KEYS} 
     639    cd ${SETTE_DIR} 
     640    . ./param.cfg 
     641    . ./all_functions.sh 
     642    . ./prepare_exe_dir.sh 
     643    JOB_FILE=${EXE_DIR}/run_job.sh 
     644    NPROC=4 
     645    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
     646    cd ${EXE_DIR} 
     647    set_namelist namelist_cfg cn_exp \"O2L3_LONG\" 
     648    set_namelist namelist_cfg nn_it000 1 
     649    set_namelist namelist_cfg nn_itend 150 
     650    set_namelist namelist_cfg nn_stock 75 
     651    set_namelist namelist_cfg ln_clobber .true. 
     652    set_namelist namelist_cfg nn_fwb 0 
     653    set_namelist namelist_cfg jpni 2 
     654    set_namelist namelist_cfg jpnj 2 
     655    set_namelist namelist_cfg jpnij 4 
     656    set_namelist namelist_cfg nn_solv 2 
     657    if [ ${USING_MPMD} == "yes" ] ; then 
     658       set_xio_using_server iodef.xml true 
     659    else 
     660       set_xio_using_server iodef.xml false 
     661    fi 
     662    cd ${SETTE_DIR} 
     663    . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     664     
     665    cd ${SETTE_DIR} 
     666    export TEST_NAME="SHORT" 
     667    . ./prepare_exe_dir.sh 
     668    cd ${EXE_DIR} 
     669    set_namelist namelist_cfg cn_exp \"O2L3_SHORT\" 
     670    set_namelist namelist_cfg nn_it000 76 
     671    set_namelist namelist_cfg nn_itend 150 
     672    set_namelist namelist_cfg nn_stock 75 
     673    set_namelist namelist_cfg ln_rstart .true. 
     674    set_namelist namelist_cfg nn_rstctl 2 
     675    set_namelist namelist_cfg ln_clobber .true. 
     676    set_namelist namelist_cfg nn_fwb 0 
     677    set_namelist namelist_cfg jpni 2 
     678    set_namelist namelist_cfg jpnj 2 
     679    set_namelist namelist_cfg jpnij 4 
     680    set_namelist namelist_cfg nn_solv 2 
     681    set_namelist namelist_cfg cn_ocerst_in \"O2L3_LONG_00000075_restart\" 
     682    set_namelist namelist_ice_cfg cn_icerst_in \"O2L3_LONG_00000075_restart_ice\" 
     683    for (( i=1; i<=$NPROC; i++)) ; do 
     684        L_NPROC=$(( $i - 1 )) 
     685        L_NPROC=`printf "%04d\n" ${L_NPROC}` 
     686        ln -sf ../LONG/O2L3_LONG_00000075_restart_${L_NPROC}.nc . 
     687        ln -sf ../LONG/O2L3_LONG_00000075_restart_ice_${L_NPROC}.nc . 
     688    done 
     689    if [ ${USING_MPMD} == "yes" ] ; then 
     690       set_xio_using_server iodef.xml true 
     691    else 
     692       set_xio_using_server iodef.xml false 
     693    fi 
     694    cd ${SETTE_DIR} 
     695    . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     696    cd ${SETTE_DIR} 
     697    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     698fi 
     699 
     700if [ ${config} -eq 8 ] ;  then 
     701    ## Reproducibility tests for ORCA2_LIM3 
     702    export TEST_NAME="REPRO_4_4" 
     703    cd ${CONFIG_DIR} 
     704    . ./makenemo -m ${CMP_NAM} -n ORCA2LIM3_16 -r ORCA2_LIM3 -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
     705    cd ${SETTE_DIR} 
     706    . ./param.cfg 
     707    . ./all_functions.sh 
     708    . ./prepare_exe_dir.sh 
     709    JOB_FILE=${EXE_DIR}/run_job.sh 
     710    NPROC=16 
     711    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
     712    cd ${EXE_DIR} 
     713    set_namelist namelist_cfg nn_it000 1 
     714    set_namelist namelist_cfg nn_itend 75 
     715    set_namelist namelist_cfg nn_fwb 0 
     716    set_namelist namelist_cfg ln_ctl .false. 
     717    set_namelist namelist_cfg ln_clobber .true. 
     718    set_namelist namelist_cfg jpni 4 
     719    set_namelist namelist_cfg jpnj 4 
     720    set_namelist namelist_cfg jpnij 16 
     721    set_namelist namelist_cfg nn_solv 2 
     722    if [ ${USING_MPMD} == "yes" ] ; then 
     723       set_xio_using_server iodef.xml true 
     724    else 
     725       set_xio_using_server iodef.xml false 
     726    fi 
     727    cd ${SETTE_DIR} 
     728    . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     729    cd ${SETTE_DIR} 
     730    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     731 
     732    cd ${SETTE_DIR} 
     733    export TEST_NAME="REPRO_2_8" 
     734    . ./prepare_exe_dir.sh 
     735    JOB_FILE=${EXE_DIR}/run_job.sh 
     736    NPROC=16 
     737    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
     738    cd ${EXE_DIR} 
     739    set_namelist namelist_cfg nn_it000 1 
     740    set_namelist namelist_cfg nn_itend 75 
     741    set_namelist namelist_cfg ln_clobber .true. 
     742    set_namelist namelist_cfg nn_fwb 0 
     743    set_namelist namelist_cfg jpni 2 
     744    set_namelist namelist_cfg jpnj 8 
     745    set_namelist namelist_cfg jpnij 16 
     746    set_namelist namelist_cfg nn_solv 2 
     747    if [ ${USING_MPMD} == "yes" ] ; then 
     748       set_xio_using_server iodef.xml true 
     749    else 
     750       set_xio_using_server iodef.xml false 
     751    fi 
     752 
     753    cd ${SETTE_DIR} 
     754    . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     755    cd ${SETTE_DIR} 
     756    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     757fi 
     758 
     759 
    631760# TESTS FOR AMM12 CONFIGURATION 
    632 if [ ${config} -eq 7 ] ;  then 
     761if [ ${config} -eq 9 ] ;  then 
    633762    ## Restartability tests for AMM12 
    634763    export TEST_NAME="LONG" 
    … …  
    692821fi 
    693822 
    694 if [ ${config} -eq 8 ] ;  then 
     823if [ ${config} -eq 10 ] ;  then 
    695824## Reproducibility tests for AMM12 
    696825    export TEST_NAME="REPRO_8_4" 
    … …  
    748877 
    749878# TESTS FOR ORCA2_SAS_LIM CONFIGURATION 
    750 if [ ${config} -eq 9 ] ;  then 
     879if [ ${config} -eq 11 ] ;  then 
    751880    ## Restartability tests for SAS 
    752881    export TEST_NAME="LONG" 
    … …  
    810939fi 
    811940 
    812 if [ ${config} -eq 10 ] ;  then 
     941if [ ${config} -eq 12 ] ;  then 
    813942## Reproducibility tests for ORCA2_SAS_LIM 
    814943    export TEST_NAME="REPRO_8_4" 
    … …  
    866995 
    867996# TEST FOR ORCA2_LIM_AGRIF : simple test of running AGRIF (no restartability neither reproducibility tests) 
    868 if [ ${config} -eq 11 ] ;  then 
     997if [ ${config} -eq 13 ] ;  then 
    869998    ## ORCA2_LIM with Agulhas AGRIF zoom in MPI 
    870999    export TEST_NAME="SHORT" 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/sette_beginner.sh

    r4147 r4921  
    44# Contact : sflod@locean-ipsl.upmc.fr 
    55# 
    6 # sette.sh   : principal script of SET TEsts for NEMO (SETTE) 
     6# sette_beginner.sh   : example of script of SET TEsts for NEMO (SETTE) 
    77# ---------------------------------------------------------------------- 
    88# NEMO/SETTE , NEMO Consortium (2010) 
    … …  
    2121# =================== 
    2222# 
    23 # ---------------------------------------------- 
    24 # Set of tests for NEMO for beginners 
    25 # ---------------------------------------------- 
     23# COMPILER          : name of compiler as defined in NEMOGCM/ARCH directory  
     24# BATCH_COMMAND_PAR :  name of the command for submitting parallel batch jobs 
     25# BATCH_COMMAND_SEQ :  name of the command for submitting sequential batch jobs   
     26# INTERACT_FLAG     : flag to run in interactive mode "yes" 
     27#                           to run in batch mode "no" 
     28# MPIRUN_FLAG       : flag to run in parallel (MPI) "yes" 
     29#                           to run in sequential mode (NB_PROC = 1) "no" 
     30# USING_XIOS        : flag to control the activation of key_iomput 
     31#                      "yes" to compile using key_iomput and link to the external XIOS library 
     32#                      "no"  to compile without key_iomput and link to the old IOIPSL library 
     33# USING_MPMD        : flag to control the use of stand-alone IO servers 
     34#                     requires USING_XIOS="yes" 
     35#                      "yes" to run in MPMD (detached) mode with stand-alone IO servers 
     36#                      "no"  to run in SPMD (attached) mode without separate IO servers  
     37# NUM_XIOSERVERS    : number of stand-alone IO servers to employ 
     38#                     set to zero if USING_MPMD="no" 
    2639# 
    27 # SYNOPSIS 
    28 # ======== 
     40# Principal script is sette.sh, that calls  
    2941# 
    30 # :: 
     42#  makenemo  : to create successive exectuables in ${CONFIG_NAME}/BLD/bin/nemo.exe  
     43#              and links to opa in ${CONFIG_NAME}/EXP00) 
    3144# 
    32 #  $ ./sette_beginner.sh 
     45#  param.cfg : sets and loads following directories: 
    3346# 
    34 # DESCRIPTION 
    35 # =========== 
    36 # First simple example of how to use SETTE: create GYRE_SHORT configuration, compile it with 1 proc, and test it for a SHORT test: 5days 
    37 #- 
     47#   FORCING_DIR         : is the directory for forcing files (tarfile) 
     48#   INPUT_DIR           : is the directory for input files storing  
     49#   TMPDIR              : is the temporary directory (if needed) 
     50#   NEMO_VALIDATION_DIR : is the validation directory 
     51# 
     52#   (NOTE: this file is the same for all configrations to be tested with sette) 
     53# 
     54#   all_functions.sh : loads functions used by sette (note: new functions can be added here) 
     55#   set_namelist     : function declared in all_functions that sets namelist parameters  
     56#   post_test_tidyup : creates validation storage directory and copies required output files  
     57#                      (solver.stat and ocean.output) in it after execution of test. 
     58# 
     59#  VALIDATION tree is: 
     60# 
     61#   NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE) 
     62# 
     63#  prepare_exe_dir.sh : defines and creates directory where the test is executed 
     64#                       execution directory takes name of TEST_NAME defined for every test  
     65#                       in sette.sh. (each test in executed in its own directory) 
     66# 
     67#  prepare_job.sh     : to generate the script run_job.sh 
     68# 
     69#  fcm_job.sh         : run in batch (INTERACT_FLAG="no") or interactive (INTERACT_FLAG="yes") 
     70#                        see sette.sh and BATCH_TEMPLATE directory 
     71# 
     72#  NOTE: jobs requiring initial or forcing data need to have an input_CONFIG.cfg in which  
     73#        can be found paths to the input tar file) 
     74#  NOTE: if job is not launched for any reason you have the executable ready in ${EXE_DIR}  
     75#        directory 
     76#  NOTE: the changed namelists are left in ${EXE_DIR} directory whereas original namelists  
     77#        remain in ${NEW_CONF}/EXP00 
     78#  
     79#  NOTE: a log file, output.sette, is created in ${SETTE_DIR} with the echoes of  
     80#        executed commands 
     81# 
     82#  NOTE: if sette.sh is stopped in output.sette there is written the last command  
     83#        executed by sette.sh 
     84# 
     85# example use: ./sette_beginner.sh  
     86######################################################################################### 
    3887# 
    3988# Compiler among those in NEMOGCM/ARCH 
    40 COMPILER=macport_osx 
     89COMPILER=x3750_ADA 
    4190export BATCH_COMMAND_PAR="llsubmit" 
    4291export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR 
    4392export INTERACT_FLAG="yes" 
    4493export MPIRUN_FLAG="yes" 
     94 
     95export DEL_KEYS="key_iomput" 
     96if [ ${USING_XIOS} == "yes" ] 
     97 then  
     98   export DEL_KEYS="" 
     99fi 
     100 
     101# 
     102# Settings which control the use of stand alone servers (only relevant if using xios) 
     103# 
     104export USING_MPMD="no" 
     105export NUM_XIOSERVERS=4 
     106export JOB_PREFIX=batch-mpmd 
     107# 
     108if [ ${USING_MPMD} == "no" ]  
     109 then 
     110   export NUM_XIOSERVERS=0 
     111   export JOB_PREFIX=batch 
     112fi 
     113# 
     114# 
     115if [ ${USING_MPMD} == "yes" ] && [ ${USING_XIOS} == "no"] 
     116 then 
     117   echo "Incompatible choices. MPMD mode requires the XIOS server" 
     118   exit 
     119fi 
     120# 
    45121 
    46122# Directory to run the tests 
    … …  
    54130# Copy job_batch_COMPILER file for specific compiler into job_batch_template 
    55131cd ${SETTE_DIR} 
    56 ##if [ ${INTERACT_FLAG} == no ] ;  then 
    57     cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit 
    58 ##fi  
     132cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit 
    59133 
    60134# Run for GYRE CONFIG 
    … …  
    63137export TEST_NAME="SHORT_TEST" 
    64138cd ${CONFIG_DIR} 
    65 . ./makenemo -m ${CMP_NAM} -n GYRE_SHORT -r GYRE -j 10 add_key "key_mpp_mpi key_nosignedzero" 
     139. ./makenemo -m ${CMP_NAM} -n GYRE_SHORT -r GYRE -j 10 add_key "key_nosignedzero" del_key ${DEL_KEYS} 
    66140cd ${SETTE_DIR} 
    67 . param.cfg  
    68 . all_functions.sh 
     141. ./param.cfg  
     142. ./all_functions.sh 
     143. ./prepare_exe_dir.sh 
    69144# creation of execution directory 
    70 . prepare_exe_dir.sh 
    71145JOB_FILE=${EXE_DIR}/run_job.sh 
     146# setting number of procs used 
    72147NPROC=4 
    73 \rm $JOB_FILE 
     148if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    74149cd ${EXE_DIR} 
    75150# setting namelist parameters 
    … …  
    82157# frequency of creation of a restart file 
    83158set_namelist namelist_cfg nn_stock 60 
    84  
     159if [ ${USING_MPMD} == "yes" ] ; then 
     160      set_xio_using_server iodef.xml true 
     161   else 
     162      set_xio_using_server iodef.xml false 
     163fi 
    85164cd ${SETTE_DIR} 
    86 . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} 
     165. ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
    87166# run job, with 4 processors, test named SHORT (= 60 time steps) 
    88167cd ${SETTE_DIR}    

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/sette_rpt

    r3725 r4921  
    1717  cd $NEMO_VALID 
    1818# 
    19 # The script also needs the date or revision tag. Currently this is taken from the latest sub-directory 
    20 # found in the WGYRE_LONG directory 
    21 # 
    22   set dorv = `ls -1rtd ./WGYRE_LONG/{$mach}/* | tail -1l ` 
    23   set dorv = $dorv:t 
     19# The script also needs the date or revision tag. Currently this is taken from the latest sub-directory found in each directory 
     20# 
    2421# 
    2522# Now loop through all the test directories. On the second pass the user can optionally examine any mismatched 
    … …  
    3027foreach pass (0 1 ) 
    3128  if ( -d ./WGYRE_LONG ) then 
     29    set dorv = `ls -1rtd ./WGYRE_LONG/{$mach}/* | tail -1l ` 
     30    set dorv = $dorv:t 
    3231    set f1o = ./WGYRE_LONG/{$mach}/{$dorv}/LONG/ocean.output 
    3332    set f1s = ./WGYRE_LONG/{$mach}/{$dorv}/LONG/solver.stat 
    … …  
    3938    cmp -s f1.tmp$$ $f2s 
    4039    if ( $status == 0 ) then 
    41       echo "GYRE     restartability  passed" 
    42     else 
    43       echo "GYRE     restartability  FAILED" 
     40      echo "GYRE        restartability  passed" 
     41    else 
     42      echo "GYRE        restartability  FAILED" 
    4443      if ( $pass == 1 ) then 
    4544        echo "<return> to view solver.stat differences" 
    … …  
    5756   
    5857  if ( -d ./WORCA2LIMPIS_LONG ) then 
     58    set dorv = `ls -1rtd ./WORCA2LIMPIS_LONG/{$mach}/* | tail -1l ` 
     59    set dorv = $dorv:t 
    5960    set f1o = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/ocean.output 
    6061    set f1s = ./WORCA2LIMPIS_LONG/{$mach}/{$dorv}/LONG/solver.stat 
    … …  
    8485 
    8586  if ( -d ./WORCA2OFFPIS_LONG ) then 
     87    set dorv = `ls -1rtd ./WORCA2OFFPIS_LONG/{$mach}/* | tail -1l ` 
     88    set dorv = $dorv:t 
    8689    set f1o = ./WORCA2OFFPIS_LONG/{$mach}/{$dorv}/LONG/ocean.output 
    8790    set f1s = ./WORCA2OFFPIS_LONG/{$mach}/{$dorv}/LONG/tracer.stat 
    … …  
    111114   
    112115  if ( -d ./WAMM12_LONG ) then 
     116    set dorv = `ls -1rtd ./WAMM12_LONG/{$mach}/* | tail -1l ` 
     117    set dorv = $dorv:t 
    113118    set f1o = ./WAMM12_LONG/{$mach}/{$dorv}/LONG/ocean.output 
    114119    set f1s = ./WAMM12_LONG/{$mach}/{$dorv}/LONG/solver.stat 
    … …  
    136141    rm f1.tmp$$ 
    137142  endif 
    138  
     143NEXT0: 
     144  if ( -d ./WSAS_LONG ) then 
     145    set dorv = `ls -1rtd ./WSAS_LONG/{$mach}/* | tail -1l ` 
     146    set dorv = $dorv:t 
     147    set f1o = ./WSAS_LONG/{$mach}/{$dorv}/LONG/ocean.output 
     148    set f1s = ./WSAS_LONG/{$mach}/{$dorv}/LONG/solver.stat 
     149    set f2o = ./WSAS_LONG/{$mach}/{$dorv}/SHORT/ocean.output 
     150    set f2s = ./WSAS_LONG/{$mach}/{$dorv}/SHORT/solver.stat 
     151 
     152    foreach f ( $f1o $f1s $f2o $f2s ) 
     153     if ( ! -f $f ) then 
     154      echo 'SAS         restartability  inconclusive ( ' $f:t ' not found )' 
     155      goto NEXT 
     156     endif 
     157    end 
     158 
     159    set nl = `wc -l $f2s` 
     160    tail -$nl[1] $f1s > f1.tmp$$ 
     161    cmp -s f1.tmp$$ $f2s 
     162    if ( $status == 0 ) then 
     163      echo "SAS         restartability  passed" 
     164    else 
     165      echo "SAS         restartability  FAILED" 
     166      if ( $pass == 1 ) then 
     167        echo "<return> to view solver.stat differences" 
     168        set y = $< 
     169        sdiff f1.tmp$$ $f2s 
     170        echo "<return> to view ocean.output differences" 
     171        set y = $< 
     172        sdiff $f1o $f2o | grep "|" 
     173        echo "<return> to continue" 
     174        set y = $< 
     175      endif 
     176    endif 
     177    rm f1.tmp$$ 
     178  endif 
     179 
     180NEXT: 
    139181echo 
    140182   
    141183  if ( -d ./WGYRE_4 ) then 
     184    set dorv = `ls -1rtd ./WGYRE_4/{$mach}/* | tail -1l ` 
     185    set dorv = $dorv:t 
    142186    set f1o = ./WGYRE_4/{$mach}/{$dorv}/REPRO_1_4/ocean.output 
    143187    set f1s = ./WGYRE_4/{$mach}/{$dorv}/REPRO_1_4/solver.stat 
    … …  
    147191    cmp -s $f1s $f2s 
    148192    if ( $status == 0 ) then 
    149       echo "GYRE     reproducibility passed" 
    150     else 
    151       echo "GYRE     reproducibility FAILED" 
     193      echo "GYRE        reproducibility passed" 
     194    else 
     195      echo "GYRE        reproducibility FAILED" 
    152196      if ( $pass == 1 ) then 
    153197        echo "<return> to view solver.stat differences" 
    … …  
    164208   
    165209  if ( -d ./WORCA2LIMPIS_16 ) then 
     210    set dorv = `ls -1rtd ./WORCA2LIMPIS_16/{$mach}/* | tail -1l ` 
     211    set dorv = $dorv:t 
    166212    set f1o = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output 
    167213    set f1s = ./WORCA2LIMPIS_16/{$mach}/{$dorv}/REPRO_2_8/solver.stat 
    … …  
    188234 
    189235  if ( -d ./WORCA2OFFPIS_16 ) then 
     236    set dorv = `ls -1rtd ./WORCA2OFFPIS_16/{$mach}/* | tail -1l ` 
     237    set dorv = $dorv:t 
    190238    set f1o = ./WORCA2OFFPIS_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output 
    191239    set f1s = ./WORCA2OFFPIS_16/{$mach}/{$dorv}/REPRO_2_8/tracer.stat 
    … …  
    212260   
    213261  if ( -d ./WAMM12_32 ) then 
     262    set dorv = `ls -1rtd ./WAMM12_32/{$mach}/* | tail -1l ` 
     263    set dorv = $dorv:t 
    214264    set f1o = ./WAMM12_32/{$mach}/{$dorv}/REPRO_4_8/ocean.output 
    215265    set f1s = ./WAMM12_32/{$mach}/{$dorv}/REPRO_4_8/solver.stat 
    … …  
    235285  endif 
    236286 
     287  if ( -d ./WSAS_32 ) then 
     288    set dorv = `ls -1rtd ./WSAS_32/{$mach}/* | tail -1l ` 
     289    set dorv = $dorv:t 
     290    set f1o = ./WSAS_32/{$mach}/{$dorv}/REPRO_4_8/ocean.output 
     291    set f1s = ./WSAS_32/{$mach}/{$dorv}/REPRO_4_8/solver.stat 
     292    set f2o = ./WSAS_32/{$mach}/{$dorv}/REPRO_8_4/ocean.output 
     293    set f2s = ./WSAS_32/{$mach}/{$dorv}/REPRO_8_4/solver.stat 
     294 
     295    foreach f ( $f1o $f1s $f2o $f2s ) 
     296     if ( ! -f $f ) then 
     297      echo 'SAS         reproducibility inconclusive ( ' $f:t ' not found )' 
     298      goto NEXT1 
     299     endif 
     300    end 
     301 
     302    cmp -s $f1s $f2s 
     303    if ( $status == 0 ) then 
     304      echo "SAS reproducibility passed" 
     305    else 
     306      echo "SAS reproducibility FAILED" 
     307      if ( $pass == 1 ) then 
     308        echo "<return> to view solver.stat differences" 
     309        set y = $< 
     310        sdiff $f1s $f2s 
     311        echo "<return> to view ocean.output differences" 
     312        set y = $< 
     313        sdiff $f1o $f2o | grep "|" 
     314        echo "<return> to continue" 
     315        set y = $< 
     316      endif 
     317    endif 
     318  endif 
     319NEXT1: 
     320 
    237321  if ( -d ./WORCA2AGUL_1_2 ) then 
     322    set dorv = `ls -1rtd ./WORCA2AGUL_1_2/{$mach}/* | tail -1l ` 
     323    set dorv = $dorv:t 
    238324    set f1o = ./WORCA2AGUL_1_2/{$mach}/{$dorv}/SHORT/ocean.output 
    239325    set f1s = ./WORCA2AGUL_1_2/{$mach}/{$dorv}/SHORT/solver.stat 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/SETTE/sette_xios.sh

    r4373 r4921  
    11#!/bin/bash 
    22############################################################ 
    3 # Author : Simona Flavoni for NEMO 
    4 # Contact: sflod@locean-ipsl.upmc.fr 
    5 # 2013   : A.C. Coward added options for testing with XIOS in dettached mode 
    6 # 
    7 # sette.sh   : principal script of SET TEsts for NEMO (SETTE) 
     3# Author : Italo Epicoco - CMCC 
     4# Contact: italo.epicoco@unisalento.it 
     5# 2014   : A.C. Coward added new namelist settings for GYRE configuration 
     6# 
     7# sette_xios.sh   : additional script of SET TEsts for XIOS within NEMO 
    88# ---------------------------------------------------------------------- 
    9 # NEMO/SETTE , NEMO Consortium (2010) 
     9# NEMO/SETTE , NEMO Consortium (2014) 
    1010# Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    1111# ---------------------------------------------------------------------- 
    … …  
    2929# MPIRUN_FLAG       : flag to run in parallel (MPI) "yes" 
    3030#                           to run in sequential mode (NB_PROC = 1) "no" 
    31 # USING_XIOS        : flag to control the activation of key_iomput 
    32 #                      "yes" to compile using key_iomput and link to the external XIOS library 
    33 #                      "no"  to compile without key_iomput and link to the old IOIPSL library 
    3431# USING_MPMD        : flag to control the use of stand-alone IO servers 
    35 #                     requires USING_XIOS="yes" 
    36 #                      "yes" to run in MPMD (detached) mode with stand-alone IO servers 
    37 #                      "no"  to run in SPMD (attached) mode without separate IO servers  
     32#                      "true" to run in MPMD (detached) mode with stand-alone IO servers 
     33#                      "false"  to run in SPMD (attached) mode without separate IO servers  
    3834# NUM_XIOSERVERS    : number of stand-alone IO servers to employ 
    39 #                     set to zero if USING_MPMD="no" 
    40 # 
    41 # Principal script is sette.sh, that calls  
     35#                     set to zero if USING_MPMD="false" 
     36# 
     37# Principal script is sette_xios.sh, that calls  
    4238# 
    4339#  makenemo  : to create successive exectuables in ${CONFIG_NAME}/BLD/bin/nemo.exe  
    … …  
    8177#        executed commands 
    8278# 
    83 #  NOTE: if sette.sh is stopped in output.sette there is written the last command  
    84 #        executed by sette.sh 
    85 # 
    86 # example use: ./sette.sh  
     79#  NOTE: if sette_xios.sh is stopped in output.sette there is written the last command  
     80#        executed by sette_xios.sh 
     81# 
     82# example use: ./sette_xios.sh  
    8783######################################################################################### 
    8884# 
    … …  
    10399 
    104100CMP_NAM=${1:-$COMPILER} 
     101# 
     102#================================================================================= 
    105103# Copy job_batch_COMPILER file for specific compiler into job_batch_template 
     104# Note this batch template needs to be capable of launching both SPMD and MPMD 
     105# tasks with internal selection depending on the value of NUM_XIOSERVERS 
     106# (0=SPMD; >0 = MPMD) 
     107#================================================================================= 
     108# 
    106109cd ${SETTE_DIR} 
    107110cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit 
    108111 
    109 for config in 2   
     112for config in 1 2   
    110113 
    111114do 
    112115 
    113 # TESTS FOR GYRE CONFIGURATION 
     116#========================================================== 
     117# TESTS FOR XIOS USING GYRE CONFIGURATION AT LOW RESOLUTION 
     118#========================================================== 
     119 
    114120if [ ${config} -eq 1 ] ;  then 
    115     ## Restartability tests for GYRE 
     121    ## Test of XIOS configured in attached mode with multiple output files (one for each process).  
     122    ## $NPROC processes are used  
    116123 
    117124    NPROC=4 
     125    jp_cfg=1 
     126    jpni=2 
     127    jpnj=2 
    118128    export NUM_XIOSERVERS=0 
    119129    export USING_MPMD="false" 
    … …  
    124134    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_XIOS_LR -r GYRE_XIOS -j 8  
    125135    cd ${SETTE_DIR} 
    126     . param.cfg 
    127     . all_functions.sh 
    128     . prepare_exe_dir.sh 
     136    . ./param.cfg 
     137    . ./all_functions.sh 
     138    . ./prepare_exe_dir.sh 
    129139    JOB_FILE=${EXE_DIR}/run_job.sh 
    130140    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    133143    set_namelist namelist_cfg nn_it000 1 
    134144    set_namelist namelist_cfg nn_itend 120 
    135     set_namelist namelist_cfg nn_stock 60 
    136     set_namelist namelist_cfg ln_clobber .true. 
    137     set_namelist namelist_cfg jp_cfg 1 
    138     set_namelist namelist_cfg jpni 2 
    139     set_namelist namelist_cfg jpnj 2 
     145    set_namelist namelist_cfg nn_stock 120 
     146    set_namelist namelist_cfg ln_clobber .true. 
     147    set_namelist namelist_cfg jp_cfg $jp_cfg 
     148    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     149    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     150    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     151    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     152    set_namelist namelist_cfg jpni $jpni 
     153    set_namelist namelist_cfg jpnj $jpnj 
    140154    set_namelist namelist_cfg jpnij $NPROC 
    141155 
    … …  
    149163    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
    150164 
     165 
     166    ## Test of XIOS configured in attached mode with a single output file.  
    151167 
    152168    export TEST_NAME="ATTACHED_ONE" 
    … …  
    154170    export USING_MPMD="false" 
    155171    cd ${SETTE_DIR}  
    156     . prepare_exe_dir.sh 
     172    . ./prepare_exe_dir.sh 
    157173    JOB_FILE=${EXE_DIR}/run_job.sh 
    158174    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    161177    set_namelist namelist_cfg nn_it000 1 
    162178    set_namelist namelist_cfg nn_itend 120 
    163     set_namelist namelist_cfg nn_stock 60 
    164     set_namelist namelist_cfg ln_clobber .true. 
    165     set_namelist namelist_cfg jp_cfg 1 
    166     set_namelist namelist_cfg jpni 2 
    167     set_namelist namelist_cfg jpnj 2 
     179    set_namelist namelist_cfg nn_stock 120 
     180    set_namelist namelist_cfg ln_clobber .true. 
     181    set_namelist namelist_cfg jp_cfg $jp_cfg 
     182    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     183    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     184    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     185    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     186    set_namelist namelist_cfg jpni $jpni 
     187    set_namelist namelist_cfg jpnj $jpnj 
    168188    set_namelist namelist_cfg jpnij $NPROC 
    169189 
    … …  
    177197    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
    178198 
     199 
     200    ## Test of XIOS configured in detached mode with a single output file.  
     201    ## $NUM_XIOSERVERS IO server are used. 
     202    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC  
    179203 
    180204    export TEST_NAME="DETACHED_ONE" 
    … …  
    182206    export USING_MPMD="true" 
    183207    cd ${SETTE_DIR} 
    184     . prepare_exe_dir.sh 
     208# 
     209    . ./prepare_exe_dir.sh 
    185210    JOB_FILE=${EXE_DIR}/run_job.sh 
    186211    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    189214    set_namelist namelist_cfg nn_it000 1 
    190215    set_namelist namelist_cfg nn_itend 120 
    191     set_namelist namelist_cfg nn_stock 60 
    192     set_namelist namelist_cfg ln_clobber .true. 
    193     set_namelist namelist_cfg jp_cfg 1 
    194     set_namelist namelist_cfg jpni 2 
    195     set_namelist namelist_cfg jpnj 2 
     216    set_namelist namelist_cfg nn_stock 120 
     217    set_namelist namelist_cfg ln_clobber .true. 
     218    set_namelist namelist_cfg jp_cfg $jp_cfg 
     219    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     220    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     221    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     222    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     223    set_namelist namelist_cfg jpni $jpni 
     224    set_namelist namelist_cfg jpnj $jpnj 
    196225    set_namelist namelist_cfg jpnij $NPROC 
    197226 
    … …  
    204233    cd ${SETTE_DIR} 
    205234    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     235 
     236    ## Test of XIOS configured in detached mode with multiple output files (one for each IO server).  
     237    ## $NUM_XIOSERVERS IO server are used. 
     238    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC  
     239 
    206240 
    207241    export TEST_NAME="DETACHED_MULTIPLE" 
    … …  
    209243    export USING_MPMD="true" 
    210244    cd ${SETTE_DIR} 
    211     . prepare_exe_dir.sh 
     245    . ./prepare_exe_dir.sh 
    212246    JOB_FILE=${EXE_DIR}/run_job.sh 
    213247    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    216250    set_namelist namelist_cfg nn_it000 1 
    217251    set_namelist namelist_cfg nn_itend 120 
    218     set_namelist namelist_cfg nn_stock 60 
    219     set_namelist namelist_cfg ln_clobber .true. 
    220     set_namelist namelist_cfg jp_cfg 1 
    221     set_namelist namelist_cfg jpni 2 
    222     set_namelist namelist_cfg jpnj 2 
     252    set_namelist namelist_cfg nn_stock 120 
     253    set_namelist namelist_cfg ln_clobber .true. 
     254    set_namelist namelist_cfg jp_cfg $jp_cfg 
     255    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     256    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     257    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     258    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     259    set_namelist namelist_cfg jpni $jpni 
     260    set_namelist namelist_cfg jpnj $jpnj 
    223261    set_namelist namelist_cfg jpnij $NPROC 
    224262 
    … …  
    234272fi 
    235273 
     274#========================================================== 
     275# TESTS FOR XIOS USING GYRE CONFIGURATION AT HIGH RESOLUTION 
     276#========================================================== 
     277 
    236278if [ ${config} -eq 2 ] ;  then 
    237     ## Restartability tests for GYRE 
    238  
    239     NPROC=152 
     279    ## Test of XIOS configured in attached mode with multiple output files (one for each process).  
     280    ## $NPROC processes are used  
     281 
     282    NPROC=64 
     283    jp_cfg=30 
     284    jpni=8 
     285    jpnj=8 
    240286    export NUM_XIOSERVERS=0 
    241287    export USING_MPMD="false" 
    … …  
    246292    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_XIOS_HR -r GYRE_XIOS -j 8 
    247293    cd ${SETTE_DIR} 
    248     . param.cfg 
    249     . all_functions.sh 
    250     . prepare_exe_dir.sh 
     294# 
     295    . ./param.cfg 
     296    . ./all_functions.sh 
     297    . ./prepare_exe_dir.sh 
     298# 
    251299    JOB_FILE=${EXE_DIR}/run_job.sh 
    252300    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    258306    set_namelist namelist_cfg nn_bench 1 
    259307    set_namelist namelist_cfg ln_clobber .true. 
    260     set_namelist namelist_cfg jp_cfg 144 
    261     set_namelist namelist_cfg jpni 19 
    262     set_namelist namelist_cfg jpnj 8 
     308    set_namelist namelist_cfg jp_cfg $jp_cfg 
     309    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     310    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     311    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     312    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     313    set_namelist namelist_cfg jpni $jpni 
     314    set_namelist namelist_cfg jpnj $jpnj 
    263315    set_namelist namelist_cfg jpnij $NPROC 
    264316 
    … …  
    273325 
    274326 
     327    ## Test of XIOS configured in attached mode with a single output file.  
    275328 
    276329    export TEST_NAME="ATTACHED_ONE" 
    … …  
    278331    export USING_MPMD="false" 
    279332    cd ${SETTE_DIR} 
    280     . prepare_exe_dir.sh 
     333# 
     334    . ./prepare_exe_dir.sh 
     335# 
    281336    JOB_FILE=${EXE_DIR}/run_job.sh 
    282337    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    288343    set_namelist namelist_cfg nn_bench 1 
    289344    set_namelist namelist_cfg ln_clobber .true. 
    290     set_namelist namelist_cfg jp_cfg 144 
    291     set_namelist namelist_cfg jpni 19 
    292     set_namelist namelist_cfg jpnj 8 
     345    set_namelist namelist_cfg jp_cfg $jp_cfg 
     346    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     347    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     348    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     349    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     350    set_namelist namelist_cfg jpni $jpni 
     351    set_namelist namelist_cfg jpnj $jpnj 
    293352    set_namelist namelist_cfg jpnij $NPROC 
    294353 
    … …  
    301360    cd ${SETTE_DIR} 
    302361    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     362 
     363 
     364    ## Test of XIOS configured in detached mode with a single output file.  
     365    ## $NUM_XIOSERVERS IO server are used. 
     366    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC  
    303367 
    304368    export TEST_NAME="DETACHED_ONE" 
    … …  
    306370    export USING_MPMD="true" 
    307371    cd ${SETTE_DIR} 
    308     . prepare_exe_dir.sh 
     372# 
     373    . ./prepare_exe_dir.sh 
     374# 
    309375    JOB_FILE=${EXE_DIR}/run_job.sh 
    310376    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    316382    set_namelist namelist_cfg nn_bench 1 
    317383    set_namelist namelist_cfg ln_clobber .true. 
    318     set_namelist namelist_cfg jp_cfg 144 
    319     set_namelist namelist_cfg jpni 19 
    320     set_namelist namelist_cfg jpnj 8 
     384    set_namelist namelist_cfg jp_cfg $jp_cfg 
     385    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     386    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     387    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     388    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     389    set_namelist namelist_cfg jpni $jpni 
     390    set_namelist namelist_cfg jpnj $jpnj 
    321391    set_namelist namelist_cfg jpnij $NPROC 
    322392 
    … …  
    329399    cd ${SETTE_DIR} 
    330400    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     401 
     402    ## Test of XIOS configured in detached mode with multiple output files (one for each IO server).  
     403    ## $NUM_XIOSERVERS IO server are used. 
     404    ## the total number of allocated cores is $NUM_XIOSERVERS + $NPROC  
    331405 
    332406    export TEST_NAME="DETACHED_MULTIPLE" 
    … …  
    334408    export USING_MPMD="true" 
    335409    cd ${SETTE_DIR} 
    336     . prepare_exe_dir.sh 
     410    . ./prepare_exe_dir.sh 
    337411    JOB_FILE=${EXE_DIR}/run_job.sh 
    338412    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    … …  
    344418    set_namelist namelist_cfg nn_bench 1 
    345419    set_namelist namelist_cfg ln_clobber .true. 
    346     set_namelist namelist_cfg jp_cfg 144 
    347     set_namelist namelist_cfg jpni 19 
    348     set_namelist namelist_cfg jpnj 8 
     420    set_namelist namelist_cfg jp_cfg $jp_cfg 
     421    set_namelist namelist_cfg jpidta $(( $jp_cfg * 30 + 2 )) 
     422    set_namelist namelist_cfg jpjdta $(( $jp_cfg * 20 + 2 )) 
     423    set_namelist namelist_cfg jpiglo $(( $jp_cfg * 30 + 2 )) 
     424    set_namelist namelist_cfg jpjglo $(( $jp_cfg * 20 + 2 )) 
     425    set_namelist namelist_cfg jpni $jpni 
     426    set_namelist namelist_cfg jpnj $jpnj 
    349427    set_namelist namelist_cfg jpnij $NPROC 
    350428 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/TOOLS/COMPILE/bld.cfg

    r3695 r4921  
    2424 
    2525 
     26bld::tool::cpp       %CPP 
     27bld::tool::fpp       %CPP 
    2628bld::tool::fc        %FC  
    2729bld::tool::fflags    %FCFLAGS %USER_INC 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg

    r3850 r4921  
    3434bld::pp::nemo     1 
    3535bld::pp::nemo/agrif2model     0 
    36 bld::tool::fpp       cpp 
     36bld::tool::cpp       %CPP 
     37bld::tool::fpp       %CPP 
    3738bld::tool::fppflags::nemo  %FPPFLAGS 
    3839 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg

    r2281 r4921  
    1616dir::root            $NEMO_TDIR/$NEW_CONF/BLD 
    1717 
     18bld::tool::cpp       %CPP 
     19bld::tool::fpp       %CPP 
    1820bld::tool::fc        %FC  
    1921bld::tool::fflags    %FCFLAGS %USER_INC 

  • branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/TOOLS/COMPILE/bldxag.cfg

    r3695 r4921  
    2323 
    2424 
     25bld::tool::cpp       %CPP 
     26bld::tool::fpp       %CPP 
    2527bld::tool::fc        %FC  
    2628bld::tool::fflags    %FCFLAGS %USER_INC 
Note: See TracChangeset for help on using the changeset viewer.