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 6204 for branches/2015/nemo_v3_6_STABLE – NEMO

Ignore:
Timestamp:
2016-01-04T14:47:06+01:00 (8 years ago)
Author:
cetlod
Message:

back the nemo_v3_6_STABLE_XIOS2 branch into 3_6_STABLE, including bugfixes, XIOS2 and new AGRIF

Location:
branches/2015/nemo_v3_6_STABLE/NEMOGCM
Files:
1 deleted
97 edited
2 copied

Legend:

Unmodified
Added
Removed

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm

    r4865 r6204  
    1313# USER_INC    additional include files for the compiler,  e.g. -I<include dir>  
    1414# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517 
    1618 
    … …  
    2931%USER_INC            %NCDF_INC 
    3032%USER_LIB            %NCDF_LIB  
     33%CC                  xlc 
     34%CFLAGS              -O -qcpluscmt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm

    r4865 r6204  
    1313# USER_INC    additional include files for the compiler,  e.g. -I<include dir>  
    1414# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517 
    1618 
    … …  
    2931%USER_INC            %NCDF_INC 
    3032%USER_LIB            %NCDF_LIB  
     33%CC                  xlc 
     34%CFLAGS              -O -qcpluscmt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm

    r4865 r6204  
    1313# USER_INC    additional include files for the compiler,  e.g. -I<include dir>  
    1414# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517 
    1618 
    … …  
    2931%USER_INC            %NCDF_INC 
    3032%USER_LIB            %NCDF_LIB  
     33%CC                  xlc 
     34%CFLAGS              -O -qcpluscmt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm

    r4865 r6204  
    2525# USER_INC    complete list of include files 
    2626# USER_LIB    complete list of libraries to pass to the linker 
     27# CC          C compiler used to compile conv for AGRIF 
     28# CFLAGS      compiler flags used with CC 
    2729# 
    2830# Note that: 
    … …  
    5658%USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC 
    5759%USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB  -lnetcdff -lnetcdf -lstdc++ -lz -lcurl -lgpfs 
     60 
     61%CC                  cc 
     62%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm

    r4865 r6204  
    1313# USER_INC additional include files for the compiler, e.g. -I<include dir> 
    1414# USER_LIB additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517 
    1618 
    … …  
    2931%USER_INC %NCDF_INC 
    3032%USER_LIB %NCDF_LIB 
     33%CC                  icc 
     34%CFLAGS              -O0 
    3135 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm

    r4865 r6204  
    1313# USER_INC additional include files for the compiler, e.g. -I<include dir> 
    1414# USER_LIB additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517 
    1618 
    … …  
    2931%USER_INC %NCDF_INC 
    3032%USER_LIB %NCDF_LIB 
     33%CC                  icc 
     34%CFLAGS              -O0 
    3135 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm

    r4865 r6204  
    1313# USER_INC additional include files for the compiler, e.g. -I<include dir> 
    1414# USER_LIB additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517 
    1618 
    … …  
    2931%USER_INC %NCDF_INC 
    3032%USER_LIB %NCDF_LIB 
     33%CC                  icc 
     34%CFLAGS              -O0 
    3135 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm

    r4997 r6204  
    2525# USER_INC    complete list of include files 
    2626# USER_LIB    complete list of libraries to pass to the linker 
     27# CC          C compiler used to compile conv for AGRIF 
     28# CFLAGS      compiler flags used with CC 
    2729# 
    2830# Note that: 
    … …  
    5557%USER_INC            %XIOS_INC %NCDF_INC %HDF5_INC 
    5658%USER_LIB            %XIOS_LIB %NCDF_LIB %HDF5_LIB 
     59%CC                  icc 
     60%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm

    r5301 r6204  
    1515# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
    1616# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     17# CC          C compiler used to compile conv for AGRIF 
     18# CFLAGS      compiler flags used with CC 
    1719 
    1820%NCDF_INC            -I/srv/lib/netcdf-x/include 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm

    r5385 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5860#FCFLAGS             -g -traceback -r8 -O0 -xT -ip -vec-report0 
    5961#FFLAGS              -g -traceback -r8 -O0 -xT -ip -vec-report0 
     62 
     63%CC                  cc 
     64%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm

    r4865 r6204  
    1717# USER_INC    complete list of include files 
    1818# USER_LIB    complete list of libraries to pass to the linker 
     19# CC          C compiler used to compile conv for AGRIF 
     20# CFLAGS      compiler flags used with CC 
    1921# 
    2022# Note that: 
    … …  
    4850%USER_INC            %XIOS_INC %NCDF_INC 
    4951%USER_LIB            %XIOS_LIB %NCDF_LIB %XLF90_LIB 
     52 
     53%CC                  xlc 
     54%CFLAGS              -O -qcpluscmt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-PW7_METO.fcm

    r5415 r6204  
    1515# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
    1616# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     17# CC          C compiler used to compile conv for AGRIF 
     18# CFLAGS      compiler flags used with CC 
    1719 
    1820 
    … …  
    2426%FC                  mpxlf90_r 
    2527%FCFLAGS             -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 
     28%FFLAGS             -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF 
    2729%LD                  mpCC_r 
    2830%LDFLAGS             -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS 
    … …  
    3335%USER_INC            %NCDF_INC %XIOS_INC 
    3436%USER_LIB            %NCDF_LIB %XIOS_LIB 
     37%CC                  xlc 
     38%CFLAGS              -O -qcpluscmt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm

    r5027 r6204  
    1515# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
    1616# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     17# CC          C compiler used to compile conv for AGRIF 
     18# CFLAGS      compiler flags used with CC 
    1719 
    1820%NCDF_INC            -I/home/dcalve/netcdf/4.1.3_seq/include 
    … …  
    3234%USER_INC            %NCDF_INC %XIOS_INC 
    3335%USER_LIB            %NCDF_LIB %XIOS_LIB 
     36 
     37%CC                  xlc 
     38%CFLAGS              -O -qcpluscmt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_ADA.fcm

    r5385 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5456%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5557%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     58 
     59%CC                  icc 
     60%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm

    r4990 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5355%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5456%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     57 
     58%CC                  icc 
     59%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_CURIE.fcm

    r5407 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5860%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5961%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     62 
     63%CC                  cc 
     64%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm

    r5118 r6204  
    2929# USER_INC    complete list of include files 
    3030# USER_LIB    complete list of libraries to pass to the linker 
     31# CC          C compiler used to compile conv for AGRIF 
     32# CFLAGS      compiler flags used with CC 
    3133# 
    3234# Note that: 
    … …  
    5860%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5961%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     62 
     63%CC                  cc 
     64%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_VAYU.fcm

    r4865 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5355%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5456%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     57 
     58%CC                  cc 
     59%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm

    r4865 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5355%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5456%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     57 
     58%CC                  cc 
     59%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-XC40_METO.fcm

    r5480 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    3133%NCDF_HOME           /opt/cray/netcdf-hdf5parallel/4.3.2/CRAY/83 
    3234%HDF5_HOME           /opt/cray/hdf5-parallel/1.8.13/CRAY/83 
    33 %XIOS_HOME           /projects/ocean/nemo/xios/xios_1.0_r618_20150619/XIOS 
     35%XIOS_HOME           /projects/ocean/nemo/xios/xios_1.0_r629_20150625/XIOS 
    3436 
    3537%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include 
    … …  
    5153%USER_INC            %XIOS_INC 
    5254%USER_LIB            %XIOS_LIB 
     55 
     56%CC                  cc 
     57%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-XC_ARCHER.fcm

    r4865 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5759#USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5860#USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     61 
     62%CC                  cc 
     63%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm

    r4865 r6204  
    2424# USER_INC    complete list of include files 
    2525# USER_LIB    complete list of libraries to pass to the linker 
     26# CC          C compiler used to compile conv for AGRIF 
     27# CFLAGS      compiler flags used with CC 
    2628# 
    2729# Note that: 
    … …  
    5557#USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    5658#USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     59 
     60%CC                  cc 
     61%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-macport_osx.fcm

    r5407 r6204  
    3333# USER_INC    complete list of include files 
    3434# USER_LIB    complete list of libraries to pass to the linker 
     35# CC          C compiler used to compile conv for AGRIF 
     36# CFLAGS      compiler flags used with CC 
    3537# 
    3638# Note that: 
    … …  
    6264%USER_INC            %XIOS_INC %OASIS_INC %NCDF_INC 
    6365%USER_LIB            %XIOS_LIB %OASIS_LIB %NCDF_LIB 
     66 
     67%CC                  cc 
     68%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm

    r4865 r6204  
    1313# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
    1414# USER_LIB    additional libraries to pass to the linker, e.g. -l<library> 
     15# CC          C compiler used to compile conv for AGRIF 
     16# CFLAGS      compiler flags used with CC 
    1517# debug: -g  -check bounds -check uninit -check pointers -traceback 
    1618 
    … …  
    3133%USER_INC            -I$XIOS_INC %NCDF_INC 
    3234%USER_LIB            -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++ 
     35 
     36%CC                  cc 
     37%CFLAGS              -O0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml

    r5363 r6204  
    22<simulation>  
    33 
    4  <context id="nemo" time_origin="1900-01-01 00:00:00" > 
     4 <context id="nemo" > 
    55     
    66    <!-- $id$ --> 
    … …  
    1919=                                         put the variables you want...                                    = 
    2020============================================================================================================ 
    21     --> 
    22      
    23     <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4"> 
    24      
    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       
    32       <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files --> 
    33       <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
    34       <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->   
     21       --> 
     22 
     23    <file_definition src="./file_def.xml"/> 
     24 
     25    <!-- 
    3526  
    36    <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 
    37      <field field_ref="toce"         name="votemper"  /> 
    38      <field field_ref="soce"         name="vosaline"  /> 
    39      <field field_ref="sst"          name="sosstsst"  /> 
    40      <field field_ref="sss"          name="sosaline"  /> 
    41      <field field_ref="ssh"          name="sossheig"  /> 
    42      <field field_ref="empmr"        name="sowaflup"  /> 
    43      <field field_ref="qsr"          name="soshfldo"  /> 
    44       <field field_ref="saltflx"      name="sosfldow"  /> 
    45      <field field_ref="qt"           name="sohefldo"  /> 
    46      <field field_ref="mldr10_1"     name="somxl010"  /> 
    47      <field field_ref="mldkz5"       name="somixhgt"  /> 
    48     </file> 
    49     
    50    <file id="file2" name_suffix="_grid_U" description="ocean U grid variables" > 
    51           <field field_ref="uoce"         name="vozocrtx"  /> 
    52           <field field_ref="utau"         name="sozotaux"  /> 
    53     </file> 
    54     
    55    <file id="file3" name_suffix="_grid_V" description="ocean V grid variables" > 
    56           <field field_ref="voce"         name="vomecrty"  />  
    57           <field field_ref="vtau"         name="sometauy"  />  
    58     </file> 
    59     
    60    <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" > 
    61           <field field_ref="woce"         name="vovecrtz" /> 
    62           <field field_ref="avt"          name="votkeavt" /> 
    63           <field field_ref="aht2d"        name="soleahtw" /> 
    64     </file> 
    65  
    66       </file_group> 
    67        
    68       <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
    69       <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
    70       <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
    71       <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files --> 
    72       <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files --> 
    73  
    74       <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files --> 
    75       <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files --> 
    76       <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files --> 
    77       <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files --> 
    78  
    79    </file_definition> 
    80      
    81     <!--  
    8227============================================================================================================ 
    8328= grid definition = = DO NOT CHANGE = 
    … …  
    10045    
    10146   <grid_definition>     
    102      <grid id="grid_T_2D" domain_ref="grid_T"/> 
    103      <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/> 
    104      <grid id="grid_U_2D" domain_ref="grid_U"/> 
    105      <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/> 
    106      <grid id="grid_V_2D" domain_ref="grid_V"/> 
    107      <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/> 
    108      <grid id="grid_W_2D" domain_ref="grid_W"/> 
    109      <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/> 
     47     <grid id="grid_T_2D" > 
     48       <domain id="grid_T" /> 
     49     </grid> 
     50     <grid id="grid_T_3D" > 
     51       <domain id="grid_T" /> 
     52       <axis id="deptht" /> 
     53     </grid> 
     54     <grid id="grid_U_2D" > 
     55       <domain id="grid_U" /> 
     56     </grid> 
     57     <grid id="grid_U_3D" > 
     58       <domain id="grid_U" /> 
     59       <axis id="depthu" /> 
     60     </grid> 
     61     <grid id="grid_V_2D" > 
     62       <domain id="grid_V" /> 
     63     </grid> 
     64     <grid id="grid_V_3D" > 
     65       <domain id="grid_V" /> 
     66       <axis id="depthv" /> 
     67     </grid> 
     68     <grid id="grid_W_2D" > 
     69       <domain id="grid_W" /> 
     70     </grid> 
     71     <grid id="grid_W_3D" > 
     72       <domain id="grid_W" /> 
     73       <axis id="depthw" /> 
     74     </grid> 
     75     <grid id="scalarpoint" /> 
     76 
    11077    </grid_definition>  
    11178 
    … …  
    12087        We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size) 
    12188--> 
    122      <variable id="buffer_size"               type="integer">10000000</variable> 
    123      <variable id="buffer_server_factor_size" type="integer">2</variable> 
    124      <variable id="info_level"                type="integer">0</variable> 
    125      <variable id="using_server"              type="boolean">false</variable> 
    126      <variable id="using_oasis"               type="boolean">false</variable> 
     89     <variable id="info_level"                type="int">0</variable> 
     90     <variable id="using_server"              type="bool">false</variable> 
     91     <variable id="using_oasis"               type="bool">false</variable> 
    12792     <variable id="oasis_codes_id"            type="string" >oceanx</variable> 
    12893    

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm

    r4373 r6204  
    1  bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_xios2 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg

    r5499 r6204  
    66!----------------------------------------------------------------------- 
    77   cn_exp      = "Agulhas" !  experience name  
    8    nn_itend    =     480   !  last  time step 
     8   nn_itend    =   10950   !  last  time step 
    99   nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1) 
    1010   nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml

    r5407 r6204  
    153153  </context> 
    154154   
     155 <context id="1_nemo" time_origin="1950-01-01 00:00:00" > 
     156     
     157    <!-- $id$ --> 
     158     
     159    <!--  
     160============================================================================================================ 
     161=                                  definition of all existing variables                                    = 
     162=                                            DO NOT CHANGE                                                 = 
     163============================================================================================================ 
     164    --> 
     165    <field_definition src="./field_def.xml"/> 
     166    <!--  
     167============================================================================================================ 
     168=                                           output files definition                                        = 
     169=                                            Define your own files                                         = 
     170=                                         put the variables you want...                                    = 
     171============================================================================================================ 
     172    --> 
     173     
     174    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
     175     
     176      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
     177      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
     178      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
     179      <file_group id="3h" output_freq="3h"  output_level="10" enabled=".TRUE."/> <!-- 3h files -->      
     180      <file_group id="4h" output_freq="4h"  output_level="10" enabled=".TRUE."/> <!-- 4h files --> 
     181      <file_group id="6h" output_freq="6h"  output_level="10" enabled=".TRUE."/> <!-- 6h files -->      
     182      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."/> <!-- 1d files --> 
     183      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
     184 
     185      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE." >  <!-- 5d files -->   
     186  
     187   <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 
     188     <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
     189     <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          /> 
     190     <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                /> 
     191     <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               /> 
     192     <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            /> 
     193     <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             /> 
     194     <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      /> 
     195     <field field_ref="mldkz5"       /> 
     196     <field field_ref="mldr10_1"     /> 
     197     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
     198     <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
     199     <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
     200     <field field_ref="saltflx"      name="sosflxdo"  /> 
     201     <field field_ref="taum"         name="taum" /> 
     202     <field field_ref="wspd"         name="sowindsp"  /> 
     203          <field field_ref="precip"       name="soprecip" /> 
     204   </file> 
     205 
     206   <file id="file3" name_suffix="_grid_U" description="ocean U grid variables" > 
     207     <field field_ref="ssu"          name="uos"     long_name="sea_surface_x_velocity"    /> 
     208     <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      /> 
     209     <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" /> 
     210          <!-- variables available with MLE 
     211          <field field_ref="psiu_mle"     name="psiu_mle"  long_name="MLE_streamfunction_along_i-axis" /> 
     212     --> 
     213   </file> 
     214    
     215   <file id="file4" name_suffix="_grid_V" description="ocean V grid variables" > 
     216     <field field_ref="ssv"          name="vos"     long_name="sea_surface_y_velocity"    /> 
     217     <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      /> 
     218     <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" /> 
     219          <!-- variables available with MLE 
     220          <field field_ref="psiv_mle"     name="psiv_mle"  long_name="MLE_streamfunction_along_j-axis" /> 
     221     --> 
     222   </file> 
     223    
     224   <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 
     225     <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         /> 
     226     <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" /> 
     227   </file> 
     228<!-- 
     229   <file id="file6" name_suffix="_icemod" description="ice variables" > 
     230     <field field_ref="ice_pres"                     /> 
     231     <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
     232     <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
     233     <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
     234     <field field_ref="ist_ipa"      /> 
     235     <field field_ref="uice_ipa"     /> 
     236     <field field_ref="vice_ipa"     /> 
     237     <field field_ref="utau_ice"     /> 
     238     <field field_ref="vtau_ice"     /> 
     239     <field field_ref="qsr_io_cea"   /> 
     240     <field field_ref="qns_io_cea"   /> 
     241     <field field_ref="snowpre"      /> 
     242   </file> 
     243 
     244   <file id="file8" name_suffix="_Tides" description="tidal harmonics" > 
     245     <field field_ref="M2x"          name="M2x"      long_name="M2 Elevation harmonic real part"                       /> 
     246     <field field_ref="M2y"          name="M2y"      long_name="M2 Elevation harmonic imaginary part"                  /> 
     247     <field field_ref="M2x_u"        name="M2x_u"    long_name="M2 current barotrope along i-axis harmonic real part "       /> 
     248     <field field_ref="M2y_u"        name="M2y_u"    long_name="M2 current barotrope along i-axis harmonic imaginary part "  /> 
     249     <field field_ref="M2x_v"        name="M2x_v"    long_name="M2 current barotrope along j-axis harmonic real part "       /> 
     250     <field field_ref="M2y_v"        name="M2y_v"    long_name="M2 current barotrope along j-axis harmonic imaginary part "  /> 
     251   </file> 
     252   --> 
     253      </file_group> 
     254 
     255 
     256      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 
     257 
     258 
     259      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
     260      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
     261      <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files --> 
     262      <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files --> 
     263 
     264      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files --> 
     265      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files --> 
     266      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files --> 
     267      <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files --> 
     268 
     269   </file_definition> 
     270     
     271    <!--  
     272============================================================================================================ 
     273= grid definition = = DO NOT CHANGE = 
     274============================================================================================================ 
     275    --> 
     276     
     277   <axis_definition>   
     278      <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 
     279      <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> 
     280      <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 
     281      <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 
     282      <axis id="nfloat" long_name="Float number"      unit="-"  /> 
     283      <axis id="icbcla" long_name="Iceberg class"     unit="-"  /> 
     284   </axis_definition>  
     285     
     286   <domain_definition src="./domain_def.xml"/> 
     287    
     288   <grid_definition>     
     289     <grid id="grid_T_2D" domain_ref="grid_T"/> 
     290     <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/> 
     291     <grid id="grid_U_2D" domain_ref="grid_U"/> 
     292     <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/> 
     293     <grid id="grid_V_2D" domain_ref="grid_V"/> 
     294     <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/> 
     295     <grid id="grid_W_2D" domain_ref="grid_W"/> 
     296     <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/> 
     297    </grid_definition>    
     298  </context> 
    155299 
    156300  <context id="xios"> 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif2model.F90

    r3680 r6204  
    11#if defined key_agrif 
    2    !!---------------------------------------------------------------------- 
    3    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    4    !! $Id$ 
    5    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6    !!---------------------------------------------------------------------- 
    7    SUBROUTINE Agrif2Model 
    8       !!--------------------------------------------- 
    9       !!   *** ROUTINE Agrif2Model *** 
    10       !!---------------------------------------------  
    11    END SUBROUTINE Agrif2model 
     2!!---------------------------------------------------------------------- 
     3!! NEMO/NST 3.6 , NEMO Consortium (2010) 
     4!! $Id$ 
     5!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     6!!---------------------------------------------------------------------- 
     7SUBROUTINE Agrif2Model 
     8   !!--------------------------------------------- 
     9   !!   *** ROUTINE Agrif2Model *** 
     10   !!---------------------------------------------  
     11END SUBROUTINE Agrif2model 
    1212 
    13    SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr) 
    14       !!--------------------------------------------- 
    15       !!   *** ROUTINE Agrif_Set_numberofcells *** 
    16       !!---------------------------------------------  
    17       USE Agrif_Types 
    18       IMPLICIT NONE 
     13SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr) 
     14   !!--------------------------------------------- 
     15   !!   *** ROUTINE Agrif_Set_numberofcells *** 
     16   !!---------------------------------------------  
     17   USE Agrif_Grids 
     18   IMPLICIT NONE 
    1919 
    20       Type(Agrif_Grid), Pointer :: Agrif_Gr 
     20   TYPE(Agrif_Grid), POINTER :: Agrif_Gr 
    2121 
    22       IF ( associated(Agrif_Curgrid) )THEN 
     22   IF ( ASSOCIATED(Agrif_Curgrid) )THEN 
    2323#include "SetNumberofcells.h" 
    24       ENDIF 
     24   ENDIF 
    2525 
    26    END SUBROUTINE Agrif_Set_numberofcells 
     26END SUBROUTINE Agrif_Set_numberofcells 
    2727 
    28    SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr) 
    29       !!--------------------------------------------- 
    30       !!   *** ROUTINE Agrif_Get_numberofcells *** 
    31       !!---------------------------------------------  
    32       USE Agrif_Types 
    33       IMPLICIT NONE 
     28SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr) 
     29   !!--------------------------------------------- 
     30   !!   *** ROUTINE Agrif_Get_numberofcells *** 
     31   !!---------------------------------------------  
     32   USE Agrif_Grids 
     33   IMPLICIT NONE 
    3434 
    35       Type(Agrif_Grid), Pointer :: Agrif_Gr 
     35   TYPE(Agrif_Grid), POINTER :: Agrif_Gr 
    3636 
     37   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN 
    3738#include "GetNumberofcells.h" 
     39   ENDIF 
    3840 
    39    END SUBROUTINE Agrif_Get_numberofcells 
     41END SUBROUTINE Agrif_Get_numberofcells 
    4042 
    41    SUBROUTINE Agrif_Allocationcalls(Agrif_Gr) 
    42       !!--------------------------------------------- 
    43       !!   *** ROUTINE Agrif_Allocationscalls *** 
    44       !!---------------------------------------------  
    45       USE Agrif_Types  
     43SUBROUTINE Agrif_Allocationcalls(Agrif_Gr) 
     44   !!--------------------------------------------- 
     45   !!   *** ROUTINE Agrif_Allocationscalls *** 
     46   !!---------------------------------------------  
     47   USE Agrif_Grids  
    4648#include "include_use_Alloc_agrif.h" 
    47       IMPLICIT NONE 
     49   IMPLICIT NONE 
    4850 
    49       Type(Agrif_Grid), Pointer :: Agrif_Gr 
     51   TYPE(Agrif_Grid), POINTER :: Agrif_Gr 
    5052 
    5153#include "allocations_calls_agrif.h" 
    5254 
    53    END SUBROUTINE Agrif_Allocationcalls 
     55END SUBROUTINE Agrif_Allocationcalls 
    5456 
    55    SUBROUTINE Agrif_probdim_modtype_def() 
    56       !!--------------------------------------------- 
    57       !!   *** ROUTINE Agrif_probdim_modtype_def *** 
    58       !!---------------------------------------------  
    59       USE Agrif_Types 
    60       IMPLICIT NONE 
     57SUBROUTINE Agrif_probdim_modtype_def() 
     58   !!--------------------------------------------- 
     59   !!   *** ROUTINE Agrif_probdim_modtype_def *** 
     60   !!---------------------------------------------  
     61   USE Agrif_Types 
     62   IMPLICIT NONE 
    6163 
    6264#include "modtype_agrif.h" 
    … …  
    6466#include "keys_agrif.h" 
    6567 
    66       Return 
     68   RETURN 
    6769 
    68    END SUBROUTINE Agrif_probdim_modtype_def 
     70END SUBROUTINE Agrif_probdim_modtype_def 
    6971 
    70    SUBROUTINE Agrif_clustering_def() 
    71       !!--------------------------------------------- 
    72       !!   *** ROUTINE Agrif_clustering_def *** 
    73       !!---------------------------------------------  
    74       Use Agrif_Types 
    75       IMPLICIT NONE 
     72SUBROUTINE Agrif_clustering_def() 
     73   !!--------------------------------------------- 
     74   !!   *** ROUTINE Agrif_clustering_def *** 
     75   !!---------------------------------------------  
     76   IMPLICIT NONE 
    7677 
    77       Return 
     78   RETURN 
    7879 
    79    END SUBROUTINE Agrif_clustering_def 
     80END SUBROUTINE Agrif_clustering_def 
    8081 
    81    SUBROUTINE Agrif_comm_def(modelcomm) 
    82  
    83       !!--------------------------------------------- 
    84       !!   *** ROUTINE Agrif_clustering_def *** 
    85       !!---------------------------------------------  
    86       Use Agrif_Types 
    87       Use lib_mpp 
    88  
    89       IMPLICIT NONE 
    90  
    91       INTEGER :: modelcomm 
    92  
    93 #if defined key_mpp_mpi 
    94       modelcomm = mpi_comm_opa 
     82#else 
     83SUBROUTINE Agrif2Model 
     84   !!--------------------------------------------- 
     85   !!   *** ROUTINE Agrif2Model *** 
     86   !!---------------------------------------------  
     87   WRITE(*,*) 'Impossible to bet here' 
     88END SUBROUTINE Agrif2model 
    9589#endif 
    96       Return 
    97  
    98    END SUBROUTINE Agrif_comm_def 
    99 #else 
    100    SUBROUTINE Agrif2Model 
    101       !!--------------------------------------------- 
    102       !!   *** ROUTINE Agrif2Model *** 
    103       !!---------------------------------------------  
    104       WRITE(*,*) 'Impossible to bet here' 
    105    END SUBROUTINE Agrif2model 
    106 #endif 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90

    r3680 r6204  
    99   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_agrif && defined key_lim2 
     11#if defined key_agrif && defined key_lim2  
    1212   !!---------------------------------------------------------------------- 
    1313   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model 
    … …  
    4141   PUBLIC interp_adv_ice 
    4242 
     43   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr 
     44   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr  
     45 
     46 
    4347   !!---------------------------------------------------------------------- 
    4448   !! NEMO/NST 3.4 , NEMO Consortium (2012) 
    … …  
    6569      u_ice_nst(:,:) = 0. 
    6670      v_ice_nst(:,:) = 0. 
    67       CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. ) 
    68       CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. ) 
     71      CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. ) 
     72      CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. ) 
    6973      Agrif_SpecialValue=0. 
    7074      Agrif_UseSpecialValue = .FALSE. 
    … …  
    138142      !!  we are in inside a new parent ice time step 
    139143      !!----------------------------------------------------------------------- 
    140       REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice 
    141144      INTEGER :: ji,jj 
    142145      REAL(wp) :: zrhox, zrhoy 
    … …  
    155158         Agrif_SpecialValue=-9999. 
    156159         Agrif_UseSpecialValue = .TRUE. 
    157          zuice = 0. 
    158          zvice = 0. 
    159          CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.) 
    160          CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.) 
     160         IF( .NOT. ALLOCATED(uice_agr) )THEN 
     161            ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj)) 
     162         ENDIF 
     163         uice_agr = 0. 
     164         vice_agr = 0. 
     165         CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.) 
     166         CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.) 
    161167         Agrif_SpecialValue=0. 
    162168         Agrif_UseSpecialValue = .FALSE. 
    163169         !   
    164170         zrhox = agrif_rhox() ;    zrhoy = agrif_rhoy()       
    165          zuice(:,:) =  zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 
    166          zvice(:,:) =  zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 
     171         uice_agr(:,:) =  uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 
     172         vice_agr(:,:) =  vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 
    167173         ! fill  boundaries 
    168174         DO jj = 1, jpj 
    169175            DO ji = 1, 2 
    170                u_ice_oe(ji,  jj,2) = zuice(ji       ,jj)  
    171                u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj) 
     176               u_ice_oe(ji,  jj,2) = uice_agr(ji       ,jj)  
     177               u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj) 
    172178            END DO 
    173179         END DO 
    174180         DO jj = 1, jpj 
    175             v_ice_oe(2,jj,2) = zvice(2     ,jj)  
    176             v_ice_oe(4,jj,2) = zvice(nlci-1,jj) 
     181            v_ice_oe(2,jj,2) = vice_agr(2     ,jj)  
     182            v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj) 
    177183         END DO 
    178184         DO ji = 1, jpi 
    179             u_ice_sn(ji,2,2) = zuice(ji,2     )  
    180             u_ice_sn(ji,4,2) = zuice(ji,nlcj-1) 
     185            u_ice_sn(ji,2,2) = uice_agr(ji,2     )  
     186            u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1) 
    181187         END DO 
    182188         DO jj = 1, 2 
    183189            DO ji = 1, jpi 
    184                v_ice_sn(ji,jj  ,2) = zvice(ji,jj       )  
    185                v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3) 
     190               v_ice_sn(ji,jj  ,2) = vice_agr(ji,jj       )  
     191               v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3) 
    186192            END DO 
    187193         END DO 
    … …  
    334340      !!  we are in inside a new parent ice time step 
    335341     !!----------------------------------------------------------------------- 
    336       REAL(wp), DIMENSION(jpi,jpj,7) :: ztab  
    337342      INTEGER :: ji,jj,jn 
    338343      !!----------------------------------------------------------------------- 
    … …  
    345350         adv_ice_sn(:,:,:,1) =  adv_ice_sn(:,:,:,2) 
    346351         ! interpolation of boundaries 
    347          ztab(:,:,:) = 0. 
     352         IF(.NOT.ALLOCATED(tabice_agr))THEN 
     353            ALLOCATE(tabice_agr(jpi,jpj,7))    
     354         ENDIF 
     355         tabice_agr(:,:,:) = 0. 
    348356         Agrif_SpecialValue=-9999. 
    349357         Agrif_UseSpecialValue = .TRUE. 
    350          CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 
     358         CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 
    351359         Agrif_SpecialValue=0. 
    352360         Agrif_UseSpecialValue = .FALSE. 
    … …  
    356364            DO jj = 1, jpj 
    357365               DO ji=1,2 
    358                   adv_ice_oe(ji  ,jj,jn,2) = ztab(ji       ,jj,jn)  
    359                   adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn) 
     366                  adv_ice_oe(ji  ,jj,jn,2) = tabice_agr(ji       ,jj,jn)  
     367                  adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn) 
    360368               END DO 
    361369            END DO 
    … …  
    365373            Do jj =1,2 
    366374               DO ji = 1, jpi 
    367                   adv_ice_sn(ji,jj  ,jn,2) = ztab(ji,jj       ,jn)  
    368                   adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn) 
     375                  adv_ice_sn(ji,jj  ,jn,2) = tabice_agr(ji,jj       ,jn)  
     376                  adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn) 
    369377               END DO 
    370378            END DO 
    … …  
    384392      INTEGER :: ji,jj,jn 
    385393      REAL(wp) :: zalpha 
    386       REAL(wp), DIMENSION(jpi,jpj,7) :: ztab  
     394      REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr  
    387395      !!-----------------------------------------------------------------------       
    388396      ! 
    … …  
    391399      zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 
    392400      ! 
    393       ztab(:,:,:) = 0.e0 
     401      tabice_agr(:,:,:) = 0.e0 
    394402      DO jn =1,7 
    395403         DO jj =1,2 
    396404            DO ji = 1, jpi 
    397                ztab(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2)  
    398                ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)  
     405               tabice_agr(ji,jj        ,jn) = (1-zalpha)*adv_ice_sn(ji,jj  ,jn,1) + zalpha*adv_ice_sn(ji,jj  ,jn,2)  
     406               tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)  
    399407            END DO 
    400408         END DO 
    … …  
    404412         DO jj = 1, jpj 
    405413            DO ji=1,2 
    406                ztab(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2)  
    407                ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)  
     414               tabice_agr(ji       ,jj,jn) = (1-zalpha)*adv_ice_oe(ji  ,jj,jn,1) + zalpha*adv_ice_oe(ji  ,jj,jn,2)  
     415               tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)  
    408416            END DO 
    409417         END DO 
    410418      END DO 
    411419      ! 
    412       CALL parcoursT( ztab(:,:, 1), frld  ) 
    413       CALL parcoursT( ztab(:,:, 2), hicif ) 
    414       CALL parcoursT( ztab(:,:, 3), hsnif ) 
    415       CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) ) 
    416       CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) ) 
    417       CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) ) 
    418       CALL parcoursT( ztab(:,:, 7), qstoif ) 
     420      CALL parcoursT( tabice_agr(:,:, 1), frld  ) 
     421      CALL parcoursT( tabice_agr(:,:, 2), hicif ) 
     422      CALL parcoursT( tabice_agr(:,:, 3), hsnif ) 
     423      CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) ) 
     424      CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) ) 
     425      CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) ) 
     426      CALL parcoursT( tabice_agr(:,:, 7), qstoif ) 
    419427      ! 
    420428   END SUBROUTINE agrif_trp_lim2 
    … …  
    499507 
    500508 
    501    SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 ) 
     509   SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before ) 
    502510      !!----------------------------------------------------------------------- 
    503511      !!                     *** ROUTINE interp_u_ice *** 
    … …  
    505513      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    506514      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     515      LOGICAL, INTENT(in) :: before 
    507516      !! 
    508517      INTEGER :: ji,jj 
    … …  
    510519      ! 
    511520#if defined key_lim2_vp 
    512       DO jj=MAX(j1,2),j2 
    513          DO ji=MAX(i1,2),i2 
    514             IF( tmu(ji,jj) == 0. ) THEN 
    515                tabres(ji,jj) = -9999. 
    516             ELSE 
    517                tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 
    518             ENDIF 
    519          END DO 
    520       END DO 
     521      IF( before ) THEN 
     522         DO jj=MAX(j1,2),j2 
     523            DO ji=MAX(i1,2),i2 
     524               IF( tmu(ji,jj) == 0. ) THEN 
     525                  tabres(ji,jj) = -9999. 
     526               ELSE 
     527                  tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 
     528               ENDIF 
     529            END DO 
     530         END DO 
     531      ENDIF 
    521532#else 
    522       DO jj= j1, j2 
    523          DO ji= i1, i2 
    524             IF( umask(ji,jj,1) == 0. ) THEN 
    525                tabres(ji,jj) = -9999. 
    526             ELSE 
    527                tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 
    528             ENDIF 
    529          END DO 
    530       END DO 
     533      IF( before ) THEN 
     534         DO jj= j1, j2 
     535            DO ji= i1, i2 
     536               IF( umask(ji,jj,1) == 0. ) THEN 
     537                  tabres(ji,jj) = -9999. 
     538               ELSE 
     539                  tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 
     540               ENDIF 
     541            END DO 
     542         END DO 
     543      ENDIF 
    531544#endif 
    532545   END SUBROUTINE interp_u_ice 
    533546 
    534547 
    535    SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 ) 
     548   SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before ) 
    536549      !!----------------------------------------------------------------------- 
    537550      !!                    *** ROUTINE interp_v_ice *** 
    … …  
    539552      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    540553      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     554      LOGICAL, INTENT(in) :: before 
    541555      !! 
    542556      INTEGER :: ji, jj 
    … …  
    544558      ! 
    545559#if defined key_lim2_vp 
    546       DO jj=MAX(j1,2),j2 
    547          DO ji=MAX(i1,2),i2 
    548             IF( tmu(ji,jj) == 0. ) THEN 
    549                tabres(ji,jj) = -9999. 
    550             ELSE 
    551                tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 
    552             ENDIF 
    553          END DO 
    554       END DO 
     560      IF( before ) THEN 
     561         DO jj=MAX(j1,2),j2 
     562            DO ji=MAX(i1,2),i2 
     563               IF( tmu(ji,jj) == 0. ) THEN 
     564                  tabres(ji,jj) = -9999. 
     565               ELSE 
     566                  tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 
     567               ENDIF 
     568            END DO 
     569         END DO 
     570      ENDIF    
    555571#else 
    556       DO jj= j1 ,j2 
    557          DO ji = i1, i2 
    558             IF( vmask(ji,jj,1) == 0. ) THEN 
    559                tabres(ji,jj) = -9999. 
    560             ELSE 
    561                tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 
    562             ENDIF 
    563          END DO 
    564       END DO 
     572      IF( before ) THEN 
     573         DO jj= j1 ,j2 
     574            DO ji = i1, i2 
     575               IF( vmask(ji,jj,1) == 0. ) THEN 
     576                  tabres(ji,jj) = -9999. 
     577               ELSE 
     578                  tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 
     579               ENDIF 
     580            END DO 
     581         END DO 
     582      ENDIF 
    565583#endif 
    566584   END SUBROUTINE interp_v_ice 
    567585 
    568586 
    569    SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 ) 
     587   SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before ) 
    570588      !!----------------------------------------------------------------------- 
    571589      !!                    *** ROUTINE interp_adv_ice ***                            
    … …  
    577595      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    578596      REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 
     597      LOGICAL, INTENT(in) :: before 
    579598      !! 
    580599      INTEGER :: ji, jj, jk 
    581600      !!----------------------------------------------------------------------- 
    582601      ! 
    583       DO jj=j1,j2 
    584          DO ji=i1,i2 
    585             IF( tms(ji,jj) == 0. ) THEN 
    586                tabres(ji,jj,:) = -9999.  
    587             ELSE 
    588                tabres(ji,jj, 1) = frld  (ji,jj) 
    589                tabres(ji,jj, 2) = hicif (ji,jj) 
    590                tabres(ji,jj, 3) = hsnif (ji,jj) 
    591                tabres(ji,jj, 4) = tbif  (ji,jj,1) 
    592                tabres(ji,jj, 5) = tbif  (ji,jj,2) 
    593                tabres(ji,jj, 6) = tbif  (ji,jj,3) 
    594                tabres(ji,jj, 7) = qstoif(ji,jj) 
    595             ENDIF 
    596          END DO 
    597       END DO 
     602      IF( before ) THEN 
     603         DO jj=j1,j2 
     604            DO ji=i1,i2 
     605               IF( tms(ji,jj) == 0. ) THEN 
     606                  tabres(ji,jj,:) = -9999.  
     607               ELSE 
     608                  tabres(ji,jj, 1) = frld  (ji,jj) 
     609                  tabres(ji,jj, 2) = hicif (ji,jj) 
     610                  tabres(ji,jj, 3) = hsnif (ji,jj) 
     611                  tabres(ji,jj, 4) = tbif  (ji,jj,1) 
     612                  tabres(ji,jj, 5) = tbif  (ji,jj,2) 
     613                  tabres(ji,jj, 6) = tbif  (ji,jj,3) 
     614                  tabres(ji,jj, 7) = qstoif(ji,jj) 
     615               ENDIF 
     616            END DO 
     617         END DO 
     618      ENDIF 
    598619      ! 
    599620   END SUBROUTINE interp_adv_ice 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90

    r3680 r6204  
    5252      INTEGER, INTENT(in) :: kt 
    5353      !! 
    54       REAL(wp), DIMENSION(jpi,jpj)  :: zvel 
    55       REAL(wp), DIMENSION(jpi,jpj,7):: zadv 
    5654      !!---------------------------------------------------------------------- 
    5755      ! 
    … …  
    6058      Agrif_UseSpecialValueInUpdate = .TRUE. 
    6159      Agrif_SpecialValueFineGrid = 0. 
    62  
    6360# if defined TWO_WAY 
    6461      IF( MOD(nbcline,nbclineupdate) == 0) THEN 
    65          CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  ) 
    66          CALL Agrif_Update_Variable( zvel , u_ice_id   , procname = update_u_ice    ) 
    67          CALL Agrif_Update_Variable( zvel , v_ice_id   , procname = update_v_ice    ) 
    68       ELSE 
    69          CALL Agrif_Update_Variable( zadv , adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  ) 
    70          CALL Agrif_Update_Variable( zvel , u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
    71          CALL Agrif_Update_Variable( zvel , v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
     62         CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice  ) 
     63         CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
     64         CALL Agrif_Update_Variable( v_ice_id   , procname = update_v_ice    ) 
     65      ELSE 
     66         CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice  ) 
     67         CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 
     68         CALL Agrif_Update_Variable( v_ice_id   , locupdate=(/0,1/), procname = update_v_ice    ) 
    7269      ENDIF 
    7370# endif 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r4491 r6204  
    1212   USE par_oce      ! ocean parameters 
    1313   USE dom_oce      ! domain parameters 
    14     
     14 
    1515   IMPLICIT NONE 
    1616   PRIVATE  
    … …  
    1919 
    2020   !                                              !!* Namelist namagrif: AGRIF parameters 
    21    LOGICAL , PUBLIC ::   ln_spc_dyn      !: 
    22    INTEGER , PUBLIC ::   nn_cln_update   !: update frequency  
    23    REAL(wp), PUBLIC ::   rn_sponge_tra   !: sponge coeff. for tracers 
    24    REAL(wp), PUBLIC ::   rn_sponge_dyn   !: sponge coeff. for dynamics 
     21   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: 
     22   INTEGER , PUBLIC ::   nn_cln_update = 3         !: update frequency  
     23   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points) 
     24   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
     25   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
     26   LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry  
    2527 
    2628   !                                              !!! OLD namelist names 
    … …  
    3032   REAL(wp), PUBLIC ::   visc_dyn                  !: sponge coeff. for dynamics 
    3133 
    32    LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator 
    33    LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator 
    34    LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step 
     34   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator 
     35   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator 
     36   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE.     !: if true: first step 
     37   LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE.     !: if true: send update from current grid 
     38   LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE.    !: if true: print debugging info 
    3539 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ??? 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    38     
    39    INTEGER :: tsn_id,tsb_id,tsa_id 
    40    INTEGER :: un_id, vn_id, ua_id, va_id 
    41    INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
    42    INTEGER :: trn_id, trb_id, tra_id 
    43    INTEGER :: unb_id, vnb_id, ub2b_id, vb2b_id 
     40   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn 
     41# if defined key_top 
     42   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn 
     43# endif 
     44   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u 
     45   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities 
     48 
     49   ! Barotropic arrays used to store open boundary data during 
     50   ! time-splitting loop: 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s 
     55 
     56   INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
     57   INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations 
     58   INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates 
     59   INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers 
     60# if defined key_top 
     61   INTEGER :: trn_id, trn_sponge_id 
     62# endif   
     63   INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id 
     64   INTEGER :: ub2b_update_id, vb2b_update_id 
     65   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 
     66   INTEGER :: scales_t_id 
     67# if defined key_zdftke 
     68   INTEGER :: avt_id, avm_id, en_id 
     69# endif   
     70   INTEGER :: umsk_id, vmsk_id 
     71   INTEGER :: kindic_agr 
    4472 
    4573   !!---------------------------------------------------------------------- 
    … …  
    5482      !!                ***  FUNCTION agrif_oce_alloc  *** 
    5583      !!---------------------------------------------------------------------- 
    56       ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      & 
    57          &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc )  
     84      INTEGER, DIMENSION(2) :: ierr 
     85      !!---------------------------------------------------------------------- 
     86      ierr(:) = 0 
     87      ! 
     88      ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj),   & 
     89         &      fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj),   & 
     90         &      tabspongedone_tsn(jpi,jpj),           & 
     91# if defined key_top          
     92         &      tabspongedone_trn(jpi,jpj),           & 
     93# endif          
     94         &      tabspongedone_u  (jpi,jpj),           & 
     95         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) ) 
     96 
     97      ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj),   & 
     98         &      ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj),   &  
     99         &      ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi),   &  
     100         &      ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) ) 
     101 
     102      agrif_oce_alloc = MAXVAL(ierr) 
     103      ! 
    58104   END FUNCTION agrif_oce_alloc 
    59105 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r4486 r6204  
    77   !!             -   !  2005-11  (XXX)  
    88   !!            3.2  !  2009-04  (R. Benshila)  
     9   !!            3.6  !  2014-09  (R. Benshila)  
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_agrif && ! defined key_offline 
    … …  
    2930   USE wrk_nemo 
    3031   USE dynspg_oce 
    31  
     32   USE zdf_oce 
     33  
    3234   IMPLICIT NONE 
    3335   PRIVATE 
    3436 
    35    ! Barotropic arrays used to store open boundary data during 
    36    ! time-splitting loop: 
    37    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w 
    38    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e 
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n 
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s 
    41      
     37   INTEGER :: bdy_tinterp = 0 
     38 
    4239   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    43    PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn 
     40   PUBLIC   interpun, interpvn, interpun2d, interpvn2d  
     41   PUBLIC   interptsn,  interpsshn 
     42   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
     43   PUBLIC   interpe3t, interpumsk, interpvmsk 
     44# if defined key_zdftke 
     45   PUBLIC   Agrif_tke, interpavm 
     46# endif 
    4447 
    4548#  include "domzgr_substitute.h90"   
    4649#  include "vectopt_loop_substitute.h90" 
    4750   !!---------------------------------------------------------------------- 
    48    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     51   !! NEMO/NST 3.6 , NEMO Consortium (2010) 
    4952   !! $Id$ 
    5053   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5154   !!---------------------------------------------------------------------- 
    5255 
    53    CONTAINS 
    54     
     56CONTAINS 
     57 
    5558   SUBROUTINE Agrif_tra 
    5659      !!---------------------------------------------------------------------- 
    57       !!                  ***  ROUTINE Agrif_Tra  *** 
    58       !!---------------------------------------------------------------------- 
    59       !! 
    60       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    61       REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
    62       REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    63       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa 
     60      !!                  ***  ROUTINE Agrif_tra  *** 
    6461      !!---------------------------------------------------------------------- 
    6562      ! 
    6663      IF( Agrif_Root() )   RETURN 
    67  
    68       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa )  
    6964 
    7065      Agrif_SpecialValue    = 0.e0 
    7166      Agrif_UseSpecialValue = .TRUE. 
    72       ztsa(:,:,:,:) = 0.e0 
    73  
    74       CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 
     67 
     68      CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 
    7569      Agrif_UseSpecialValue = .FALSE. 
    76  
    77       zrhox = Agrif_Rhox() 
    78  
    79       alpha1 = ( zrhox - 1. ) * 0.5 
    80       alpha2 = 1. - alpha1 
    81  
    82       alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
    83       alpha4 = 1. - alpha3 
    84  
    85       alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    86       alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    87       alpha5 = 1. - alpha6 - alpha7 
    88  
    89       IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    90  
    91          DO jn = 1, jpts 
    92             tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn) 
    93             DO jk = 1, jpkm1 
    94                DO jj = 1, jpj 
    95                   IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    96                      tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    97                   ELSE 
    98                      tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    99                      IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    100                         tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  & 
    101                            &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
    102                      ENDIF 
    103                   ENDIF 
    104                END DO 
    105             END DO 
    106          ENDDO 
    107       ENDIF 
    108  
    109       IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    110  
    111          DO jn = 1, jpts 
    112             tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn) 
    113             DO jk = 1, jpkm1 
    114                DO ji = 1, jpi 
    115                   IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    116                      tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    117                   ELSE 
    118                      tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
    119                      IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    120                         tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  & 
    121                            &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
    122                      ENDIF 
    123                   ENDIF 
    124                END DO 
    125             END DO 
    126          ENDDO  
    127       ENDIF 
    128  
    129       IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    130          DO jn = 1, jpts 
    131             tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn) 
    132             DO jk = 1, jpkm1 
    133                DO jj = 1, jpj 
    134                   IF( umask(2,jj,jk) == 0.e0 ) THEN 
    135                      tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
    136                   ELSE 
    137                      tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
    138                      IF( un(2,jj,jk) < 0.e0 ) THEN 
    139                         tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
    140                      ENDIF 
    141                   ENDIF 
    142                END DO 
    143             END DO 
    144          END DO 
    145       ENDIF 
    146  
    147       IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    148          DO jn = 1, jpts 
    149             tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn) 
    150             DO jk=1,jpk       
    151                DO ji=1,jpi 
    152                   IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    153                      tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
    154                   ELSE 
    155                      tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
    156                      IF( vn(ji,2,jk) < 0.e0 ) THEN 
    157                         tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
    158                      ENDIF 
    159                   ENDIF 
    160                END DO 
    161             END DO 
    162          ENDDO 
    163       ENDIF 
    164       ! 
    165       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa )  
    16670      ! 
    16771   END SUBROUTINE Agrif_tra 
    … …  
    17579      INTEGER, INTENT(in) ::   kt 
    17680      !! 
    177       INTEGER :: ji,jj,jk 
     81      INTEGER :: ji,jj,jk, j1,j2, i1,i2 
    17882      REAL(wp) :: timeref 
    17983      REAL(wp) :: z2dt, znugdt 
    18084      REAL(wp) :: zrhox, zrhoy 
    181       REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 
    182       REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d 
     85      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 
    18386      !!----------------------------------------------------------------------   
    18487 
    18588      IF( Agrif_Root() )   RETURN 
    18689 
    187       CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 
    188       CALL wrk_alloc( jpi, jpj, jpk, zua, zva ) 
     90      CALL wrk_alloc( jpi, jpj, spgv1, spgu1 ) 
     91 
     92      Agrif_SpecialValue=0. 
     93      Agrif_UseSpecialValue = ln_spc_dyn 
     94 
     95      CALL Agrif_Bc_variable(un_interp_id,procname=interpun) 
     96      CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 
     97 
     98#if defined key_dynspg_flt 
     99      CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d) 
     100      CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d) 
     101#endif 
     102 
     103      Agrif_UseSpecialValue = .FALSE. 
    189104 
    190105      zrhox = Agrif_Rhox() 
    … …  
    192107 
    193108      timeref = 1. 
    194  
    195109      ! time step: leap-frog 
    196110      z2dt = 2. * rdt 
    … …  
    200114      znugdt =  grav * z2dt     
    201115 
    202       Agrif_SpecialValue=0. 
    203       Agrif_UseSpecialValue = ln_spc_dyn 
    204  
    205       zua = 0. 
    206       zva = 0. 
    207       CALL Agrif_Bc_variable(zua,un_id,procname=interpu) 
    208       CALL Agrif_Bc_variable(zva,vn_id,procname=interpv) 
    209       zua2d = 0. 
    210       zva2d = 0. 
    211  
     116      ! prevent smoothing in ghost cells 
     117      i1=1 
     118      i2=jpi 
     119      j1=1 
     120      j2=jpj 
     121      IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3 
     122      IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2 
     123      IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3 
     124      IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2 
     125 
     126 
     127      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    212128#if defined key_dynspg_flt 
    213       Agrif_SpecialValue=0. 
    214       Agrif_UseSpecialValue = ln_spc_dyn 
    215       CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d) 
    216       CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d) 
    217 #endif 
    218       Agrif_UseSpecialValue = .FALSE. 
    219  
    220  
    221       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    222  
    223 #if defined key_dynspg_flt 
    224          DO jj=1,jpj 
    225             laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1) 
    226          END DO 
    227 #endif 
     129         DO jk=1,jpkm1 
     130            DO jj=j1,j2 
     131               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 
     132            END DO 
     133         END DO 
     134 
     135         spgu(2,:)=0. 
    228136 
    229137         DO jk=1,jpkm1 
    230138            DO jj=1,jpj 
    231                ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj))) 
    232                ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u_a(1:2,jj,jk) 
    233             END DO 
    234          END DO 
    235  
    236 #if defined key_dynspg_flt 
    237          DO jk=1,jpkm1 
    238             DO jj=1,jpj 
    239                ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 
    240             END DO 
    241          END DO 
    242  
    243          spgu(2,:)=0. 
    244  
    245          DO jk=1,jpkm1 
    246             DO jj=1,jpj 
    247                spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 
     139               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
    248140            END DO 
    249141         END DO 
    … …  
    251143         DO jj=1,jpj 
    252144            IF (umask(2,jj,1).NE.0.) THEN 
    253                spgu(2,jj)=spgu(2,jj)*hur_a(2,jj) 
     145               spgu(2,jj)=spgu(2,jj)/hu(2,jj) 
    254146            ENDIF 
    255147         END DO 
    … …  
    259151 
    260152         DO jk=1,jpkm1 
    261             DO jj=1,jpj 
     153            DO jj=j1,j2 
    262154               ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk)) 
    263155               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
    … …  
    269161         DO jk=1,jpkm1 
    270162            DO jj=1,jpj 
    271                spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 
     163               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
    272164            END DO 
    273165         END DO 
    … …  
    275167         DO jj=1,jpj 
    276168            IF (umask(2,jj,1).NE.0.) THEN 
    277                spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj) 
    278             ENDIF 
    279          END DO 
    280  
    281          DO jk=1,jpkm1 
    282             DO jj=1,jpj 
     169               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 
     170            ENDIF 
     171         END DO 
     172 
     173         DO jk=1,jpkm1 
     174            DO jj=j1,j2 
    283175               ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk) 
    284             END DO 
    285          END DO 
    286  
    287          DO jk=1,jpkm1 
    288             DO jj=1,jpj 
    289                va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk) 
    290                va(2,jj,jk) = va(2,jj,jk) / fse3v_a(2,jj,jk) 
    291176            END DO 
    292177         END DO 
    … …  
    300185            END DO 
    301186         END DO 
    302  
    303187         DO jj=1,jpj 
    304188            spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 
    305189         END DO 
    306  
    307190         DO jk=1,jpkm1 
    308191            DO jj=1,jpj 
    … …  
    316199      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    317200#if defined key_dynspg_flt 
    318          DO jj=1,jpj 
    319             laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj))) 
    320          END DO 
    321 #endif 
    322  
     201         DO jk=1,jpkm1 
     202            DO jj=j1,j2 
     203               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 
     204            END DO 
     205         END DO 
     206         spgu(nlci-2,:)=0. 
    323207         DO jk=1,jpkm1 
    324208            DO jj=1,jpj 
    325                ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj))) 
    326                ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u_a(nlci-2:nlci-1,jj,jk) 
    327             END DO 
    328          END DO 
    329  
    330 #if defined key_dynspg_flt 
    331          DO jk=1,jpkm1 
    332             DO jj=1,jpj 
    333                ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 
    334             END DO 
    335          END DO 
    336  
    337  
    338          spgu(nlci-2,:)=0. 
    339  
    340          do jk=1,jpkm1 
    341             do jj=1,jpj 
    342                spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
    343             enddo 
    344          enddo 
    345  
     209               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
     210            ENDDO 
     211         ENDDO 
    346212         DO jj=1,jpj 
    347213            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    348                spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj) 
     214               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 
    349215            ENDIF 
    350216         END DO 
    … …  
    352218         spgu(nlci-2,:) = ua_b(nlci-2,:) 
    353219#endif 
    354  
     220         DO jk=1,jpkm1 
     221            DO jj=j1,j2 
     222               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 
     223 
     224               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 
     225 
     226            END DO 
     227         END DO 
     228         spgu1(nlci-2,:)=0. 
    355229         DO jk=1,jpkm1 
    356230            DO jj=1,jpj 
    357                ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 
    358  
    359                ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 
    360  
    361             END DO 
    362          END DO 
    363  
    364          spgu1(nlci-2,:)=0. 
    365  
    366          DO jk=1,jpkm1 
    367             DO jj=1,jpj 
    368                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
    369             END DO 
    370          END DO 
    371  
     231               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
     232            END DO 
     233         END DO 
    372234         DO jj=1,jpj 
    373235            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    374                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj) 
    375             ENDIF 
    376          END DO 
    377  
    378          DO jk=1,jpkm1 
    379             DO jj=1,jpj 
     236               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 
     237            ENDIF 
     238         END DO 
     239         DO jk=1,jpkm1 
     240            DO jj=j1,j2 
    380241               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk) 
    381             END DO 
    382          END DO 
    383  
    384          DO jk=1,jpkm1 
    385             DO jj=1,jpj-1 
    386                va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk) 
    387                va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v_a(nlci-1,jj,jk) 
    388242            END DO 
    389243         END DO 
    … …  
    414268 
    415269#if defined key_dynspg_flt 
    416          DO ji=1,jpi 
    417             laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2))) 
    418          END DO 
    419 #endif 
    420  
    421          DO jk=1,jpkm1 
    422             DO ji=1,jpi 
    423                va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2))) 
    424                va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk) 
    425             END DO 
    426          END DO 
    427  
    428 #if defined key_dynspg_flt 
    429270         DO jk=1,jpkm1 
    430271            DO ji=1,jpi 
    … …  
    437278         DO jk=1,jpkm1 
    438279            DO ji=1,jpi 
    439                spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk) 
     280               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 
    440281            END DO 
    441282         END DO 
    … …  
    443284         DO ji=1,jpi 
    444285            IF (vmask(ji,2,1).NE.0.) THEN 
    445                spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2) 
     286               spgv(ji,2)=spgv(ji,2)/hv(ji,2) 
    446287            ENDIF 
    447288         END DO 
    … …  
    451292 
    452293         DO jk=1,jpkm1 
    453             DO ji=1,jpi 
     294            DO ji=i1,i2 
    454295               va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 
    455296               va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 
    … …  
    461302         DO jk=1,jpkm1 
    462303            DO ji=1,jpi 
    463                spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
     304               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
    464305            END DO 
    465306         END DO 
    … …  
    467308         DO ji=1,jpi 
    468309            IF (vmask(ji,2,1).NE.0.) THEN 
    469                spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2) 
     310               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 
    470311            ENDIF 
    471312         END DO 
    … …  
    474315            DO ji=1,jpi 
    475316               va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk) 
    476             END DO 
    477          END DO 
    478  
    479          DO jk=1,jpkm1 
    480             DO ji=1,jpi 
    481                ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk)  
    482                ua(ji,2,jk) = ua(ji,2,jk) / fse3u_a(ji,2,jk) 
    483317            END DO 
    484318         END DO 
    … …  
    508342 
    509343#if defined key_dynspg_flt 
    510          DO ji=1,jpi 
    511             laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2))) 
    512          END DO 
    513 #endif 
    514  
    515          DO jk=1,jpkm1 
    516             DO ji=1,jpi 
    517                va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1))) 
    518                va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v_a(ji,nlcj-2:nlcj-1,jk) 
    519             END DO 
    520          END DO 
    521  
    522 #if defined key_dynspg_flt 
    523344         DO jk=1,jpkm1 
    524345            DO ji=1,jpi 
    … …  
    527348         END DO 
    528349 
     350 
    529351         spgv(:,nlcj-2)=0. 
    530352 
    531353         DO jk=1,jpkm1 
    532354            DO ji=1,jpi 
    533                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     355               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    534356            END DO 
    535357         END DO 
    … …  
    537359         DO ji=1,jpi 
    538360            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    539                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2) 
    540             ENDIF 
    541          END DO 
     361               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 
     362            ENDIF 
     363         END DO 
     364 
    542365#else 
    543366         spgv(:,nlcj-2)=va_b(:,nlcj-2) 
    … …  
    545368 
    546369         DO jk=1,jpkm1 
    547             DO ji=1,jpi 
     370            DO ji=i1,i2 
    548371               va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 
    549372               va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
    … …  
    555378         DO jk=1,jpkm1 
    556379            DO ji=1,jpi 
    557                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     380               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    558381            END DO 
    559382         END DO 
    … …  
    561384         DO ji=1,jpi 
    562385            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    563                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2) 
     386               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 
    564387            ENDIF 
    565388         END DO 
    … …  
    568391            DO ji=1,jpi 
    569392               va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 
    570             END DO 
    571          END DO 
    572  
    573          DO jk=1,jpkm1 
    574             DO ji=1,jpi 
    575                ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk) 
    576                ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u_a(ji,nlcj-1,jk) 
    577393            END DO 
    578394         END DO 
    … …  
    600416      ENDIF 
    601417      ! 
    602       CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 
    603       CALL wrk_dealloc( jpi, jpj, jpk, zua, zva ) 
     418      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 
    604419      ! 
    605420   END SUBROUTINE Agrif_dyn 
    … …  
    620435         DO jj=1,jpj 
    621436            va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 
    622 ! Specified fluxes: 
     437            ! Specified fluxes: 
    623438            ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 
    624 ! Characteristics method: 
    625 !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
    626 !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
     439            ! Characteristics method: 
     440            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
     441            !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
    627442         END DO 
    628443      ENDIF 
    … …  
    631446         DO jj=1,jpj 
    632447            va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 
    633 ! Specified fluxes: 
     448            ! Specified fluxes: 
    634449            ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 
    635 ! Characteristics method: 
    636 !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
    637 !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
     450            ! Characteristics method: 
     451            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
     452            !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
    638453         END DO 
    639454      ENDIF 
    … …  
    642457         DO ji=1,jpi 
    643458            ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 
    644 ! Specified fluxes: 
     459            ! Specified fluxes: 
    645460            va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 
    646 ! Characteristics method: 
    647 !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
    648 !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
     461            ! Characteristics method: 
     462            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
     463            !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
    649464         END DO 
    650465      ENDIF 
    … …  
    653468         DO ji=1,jpi 
    654469            ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 
    655 ! Specified fluxes: 
     470            ! Specified fluxes: 
    656471            va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 
    657 ! Characteristics method: 
    658 !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
    659 !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
     472            ! Characteristics method: 
     473            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
     474            !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
    660475         END DO 
    661476      ENDIF 
    … …  
    672487      INTEGER :: ji, jj 
    673488      LOGICAL :: ll_int_cons 
    674       REAL(wp) :: zrhox, zrhoy, zrhot, zt 
    675       REAL(wp) :: zaa, zab, zat 
    676       REAL(wp) :: zt0, zt1 
    677       REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn 
    678       REAL(wp), POINTER, DIMENSION(:,:) :: zuab, zvab, zubb, zvbb, zutn, zvtn 
     489      REAL(wp) :: zrhot, zt 
    679490      !!----------------------------------------------------------------------   
    680491 
    … …  
    682493 
    683494      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 
    684                              ! the forward case only 
    685  
    686       zrhox = Agrif_Rhox() 
    687       zrhoy = Agrif_Rhoy() 
     495      ! the forward case only 
     496 
    688497      zrhot = Agrif_rhot() 
    689  
    690       IF ( kt==nit000 ) THEN ! Allocate boundary data arrays 
    691          ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj)) 
    692          ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj)) 
    693          ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi)) 
    694          ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi)) 
    695       ENDIF 
    696  
    697       CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn ) 
    698498 
    699499      ! "Central" time index for interpolation: 
    … …  
    707507      Agrif_SpecialValue    = 0.e0 
    708508      Agrif_UseSpecialValue = .TRUE. 
    709       CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn ) 
     509      CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn ) 
    710510      Agrif_UseSpecialValue = .FALSE. 
    711511 
    … …  
    715515 
    716516      IF (ll_int_cons) THEN ! Conservative interpolation 
    717          CALL wrk_alloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn ) 
    718          zuab(:,:) = 0._wp ; zvab(:,:) = 0._wp 
    719          zubb(:,:) = 0._wp ; zvbb(:,:) = 0._wp 
    720          zutn(:,:) = 0._wp ; zvtn(:,:) = 0._wp 
    721          CALL Agrif_Bc_variable(zubb,unb_id ,calledweight=0._wp, procname=interpunb) ! Before 
    722          CALL Agrif_Bc_variable(zvbb,vnb_id ,calledweight=0._wp, procname=interpvnb) 
    723          CALL Agrif_Bc_variable(zuab,unb_id ,calledweight=1._wp, procname=interpunb) ! After 
    724          CALL Agrif_Bc_variable(zvab,vnb_id ,calledweight=1._wp, procname=interpvnb) 
    725          CALL Agrif_Bc_variable(zutn,ub2b_id,calledweight=1._wp, procname=interpub2b)! Time integrated 
    726          CALL Agrif_Bc_variable(zvtn,vb2b_id,calledweight=1._wp, procname=interpvb2b) 
    727           
     517         ! orders matters here !!!!!! 
     518         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated 
     519         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b) 
     520         bdy_tinterp = 1 
     521         CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After 
     522         CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb) 
     523         bdy_tinterp = 2 
     524         CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before 
     525         CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)          
     526      ELSE ! Linear interpolation 
     527         bdy_tinterp = 0 
     528         ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0  
     529         ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0  
     530         ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0  
     531         ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0  
     532         CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb) 
     533         CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb) 
     534      ENDIF 
     535      Agrif_UseSpecialValue = .FALSE. 
     536      !  
     537   END SUBROUTINE Agrif_dta_ts 
     538 
     539   SUBROUTINE Agrif_ssh( kt ) 
     540      !!---------------------------------------------------------------------- 
     541      !!                  ***  ROUTINE Agrif_DYN  *** 
     542      !!----------------------------------------------------------------------   
     543      INTEGER, INTENT(in) ::   kt 
     544      !! 
     545      !!----------------------------------------------------------------------   
     546 
     547      IF( Agrif_Root() )   RETURN 
     548 
     549      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     550         ssha(2,:)=ssha(3,:) 
     551         sshn(2,:)=sshn(3,:) 
     552      ENDIF 
     553 
     554      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     555         ssha(nlci-1,:)=ssha(nlci-2,:) 
     556         sshn(nlci-1,:)=sshn(nlci-2,:) 
     557      ENDIF 
     558 
     559      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     560         ssha(:,2)=ssha(:,3) 
     561         sshn(:,2)=sshn(:,3) 
     562      ENDIF 
     563 
     564      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     565         ssha(:,nlcj-1)=ssha(:,nlcj-2) 
     566         sshn(:,nlcj-1)=sshn(:,nlcj-2) 
     567      ENDIF 
     568 
     569   END SUBROUTINE Agrif_ssh 
     570 
     571   SUBROUTINE Agrif_ssh_ts( jn ) 
     572      !!---------------------------------------------------------------------- 
     573      !!                  ***  ROUTINE Agrif_ssh_ts  *** 
     574      !!----------------------------------------------------------------------   
     575      INTEGER, INTENT(in) ::   jn 
     576      !! 
     577      INTEGER :: ji,jj 
     578      !!----------------------------------------------------------------------   
     579 
     580      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     581         DO jj=1,jpj 
     582            ssha_e(2,jj) = hbdy_w(jj) 
     583         END DO 
     584      ENDIF 
     585 
     586      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     587         DO jj=1,jpj 
     588            ssha_e(nlci-1,jj) = hbdy_e(jj) 
     589         END DO 
     590      ENDIF 
     591 
     592      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     593         DO ji=1,jpi 
     594            ssha_e(ji,2) = hbdy_s(ji) 
     595         END DO 
     596      ENDIF 
     597 
     598      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     599         DO ji=1,jpi 
     600            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
     601         END DO 
     602      ENDIF 
     603 
     604   END SUBROUTINE Agrif_ssh_ts 
     605 
     606# if defined key_zdftke 
     607   SUBROUTINE Agrif_tke 
     608      !!---------------------------------------------------------------------- 
     609      !!                  ***  ROUTINE Agrif_tke  *** 
     610      !!----------------------------------------------------------------------   
     611      REAL(wp) ::   zalpha 
     612      ! 
     613      zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 
     614      IF( zalpha > 1. )   zalpha = 1. 
     615       
     616      Agrif_SpecialValue    = 0.e0 
     617      Agrif_UseSpecialValue = .TRUE. 
     618       
     619      CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
     620               
     621      Agrif_UseSpecialValue = .FALSE. 
     622      ! 
     623   END SUBROUTINE Agrif_tke 
     624# endif 
     625 
     626   SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
     627      !!--------------------------------------------- 
     628      !!   *** ROUTINE interptsn *** 
     629      !!--------------------------------------------- 
     630      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
     631      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     632      LOGICAL, INTENT(in) :: before 
     633      INTEGER, INTENT(in) :: nb , ndir 
     634      ! 
     635      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     636      INTEGER :: imin, imax, jmin, jmax 
     637      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
     638      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
     639      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     640 
     641      IF (before) THEN          
     642         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     643      ELSE 
     644         ! 
     645         western_side  = (nb == 1).AND.(ndir == 1) 
     646         eastern_side  = (nb == 1).AND.(ndir == 2) 
     647         southern_side = (nb == 2).AND.(ndir == 1) 
     648         northern_side = (nb == 2).AND.(ndir == 2) 
     649         ! 
     650         zrhox = Agrif_Rhox() 
     651         !  
     652         zalpha1 = ( zrhox - 1. ) * 0.5 
     653         zalpha2 = 1. - zalpha1 
     654         !  
     655         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     656         zalpha4 = 1. - zalpha3 
     657         !  
     658         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     659         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     660         zalpha5 = 1. - zalpha6 - zalpha7 
     661         ! 
     662         imin = i1 
     663         imax = i2 
     664         jmin = j1 
     665         jmax = j2 
     666         !  
     667         ! Remove CORNERS 
     668         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     669         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     670         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     671         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     672         ! 
     673         IF( eastern_side) THEN 
     674            DO jn = 1, jpts 
     675               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     676               DO jk = 1, jpkm1 
     677                  DO jj = jmin,jmax 
     678                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     679                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     680                     ELSE 
     681                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     682                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     683                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) &  
     684                                 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     685                        ENDIF 
     686                     ENDIF 
     687                  END DO 
     688               END DO 
     689            ENDDO 
     690         ENDIF 
     691         !  
     692         IF( northern_side ) THEN             
     693            DO jn = 1, jpts 
     694               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     695               DO jk = 1, jpkm1 
     696                  DO ji = imin,imax 
     697                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     698                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     699                     ELSE 
     700                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     701                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     702                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  & 
     703                                 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     704                        ENDIF 
     705                     ENDIF 
     706                  END DO 
     707               END DO 
     708            ENDDO 
     709         ENDIF 
     710         ! 
     711         IF( western_side) THEN             
     712            DO jn = 1, jpts 
     713               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
     714               DO jk = 1, jpkm1 
     715                  DO jj = jmin,jmax 
     716                     IF( umask(2,jj,jk) == 0.e0 ) THEN 
     717                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     718                     ELSE 
     719                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     720                        IF( un(2,jj,jk) < 0.e0 ) THEN 
     721                           tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     722                        ENDIF 
     723                     ENDIF 
     724                  END DO 
     725               END DO 
     726            END DO 
     727         ENDIF 
     728         ! 
     729         IF( southern_side ) THEN            
     730            DO jn = 1, jpts 
     731               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
     732               DO jk=1,jpk       
     733                  DO ji=imin,imax 
     734                     IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     735                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     736                     ELSE 
     737                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     738                        IF( vn(ji,2,jk) < 0.e0 ) THEN 
     739                           tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     740                        ENDIF 
     741                     ENDIF 
     742                  END DO 
     743               END DO 
     744            ENDDO 
     745         ENDIF 
     746         ! 
     747         ! Treatment of corners 
     748         !  
     749         ! East south 
     750         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     751            tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
     752         ENDIF 
     753         ! East north 
     754         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     755            tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
     756         ENDIF 
     757         ! West south 
     758         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     759            tsa(2,2,:,:) = ptab(2,2,:,:) 
     760         ENDIF 
     761         ! West north 
     762         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     763            tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
     764         ENDIF 
     765         ! 
     766      ENDIF 
     767      ! 
     768   END SUBROUTINE interptsn 
     769 
     770   SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir) 
     771      !!---------------------------------------------------------------------- 
     772      !!                  ***  ROUTINE interpsshn  *** 
     773      !!----------------------------------------------------------------------   
     774      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     775      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     776      LOGICAL, INTENT(in) :: before 
     777      INTEGER, INTENT(in) :: nb , ndir 
     778      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     779      !!----------------------------------------------------------------------   
     780      ! 
     781      IF( before) THEN 
     782         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 
     783      ELSE 
     784         western_side  = (nb == 1).AND.(ndir == 1) 
     785         eastern_side  = (nb == 1).AND.(ndir == 2) 
     786         southern_side = (nb == 2).AND.(ndir == 1) 
     787         northern_side = (nb == 2).AND.(ndir == 2) 
     788         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
     789         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
     790         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
     791         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
     792      ENDIF 
     793      ! 
     794   END SUBROUTINE interpsshn 
     795 
     796   SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before) 
     797      !!--------------------------------------------- 
     798      !!   *** ROUTINE interpun *** 
     799      !!---------------------------------------------     
     800      !! 
     801      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     802      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     803      LOGICAL, INTENT(in) :: before 
     804      !! 
     805      INTEGER :: ji,jj,jk 
     806      REAL(wp) :: zrhoy  
     807      !!---------------------------------------------     
     808      ! 
     809      IF (before) THEN  
     810         DO jk=1,jpk 
     811            DO jj=j1,j2 
     812               DO ji=i1,i2 
     813                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
     814                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk) 
     815               END DO 
     816            END DO 
     817         END DO 
     818      ELSE 
     819         zrhoy = Agrif_Rhoy() 
     820         DO jk=1,jpkm1 
     821            DO jj=j1,j2 
     822               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 
     823               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk) 
     824            END DO 
     825         END DO 
     826      ENDIF 
     827      !  
     828   END SUBROUTINE interpun 
     829 
     830 
     831   SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before) 
     832      !!--------------------------------------------- 
     833      !!   *** ROUTINE interpun *** 
     834      !!---------------------------------------------     
     835      ! 
     836      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     837      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     838      LOGICAL, INTENT(in) :: before 
     839      ! 
     840      INTEGER :: ji,jj 
     841      REAL(wp) :: ztref 
     842      REAL(wp) :: zrhoy  
     843      !!---------------------------------------------     
     844      ! 
     845      ztref = 1. 
     846 
     847      IF (before) THEN  
     848         DO jj=j1,j2 
     849            DO ji=i1,MIN(i2,nlci-1) 
     850               ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj))  
     851            END DO 
     852         END DO 
     853      ELSE 
     854         zrhoy = Agrif_Rhoy() 
     855         DO jj=j1,j2 
     856            laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1) 
     857         END DO 
     858      ENDIF 
     859      !  
     860   END SUBROUTINE interpun2d 
     861 
     862 
     863   SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 
     864      !!--------------------------------------------- 
     865      !!   *** ROUTINE interpvn *** 
     866      !!---------------------------------------------     
     867      ! 
     868      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     869      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     870      LOGICAL, INTENT(in) :: before 
     871      ! 
     872      INTEGER :: ji,jj,jk 
     873      REAL(wp) :: zrhox  
     874      !!---------------------------------------------     
     875      !       
     876      IF (before) THEN           
     877         !interpv entre 1 et k2 et interpv2d en jpkp1 
     878         DO jk=k1,jpk 
     879            DO jj=j1,j2 
     880               DO ji=i1,i2 
     881                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
     882                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 
     883               END DO 
     884            END DO 
     885         END DO 
     886      ELSE           
     887         zrhox= Agrif_Rhox() 
     888         DO jk=1,jpkm1 
     889            DO jj=j1,j2 
     890               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 
     891               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk) 
     892            END DO 
     893         END DO 
     894      ENDIF 
     895      !         
     896   END SUBROUTINE interpvn 
     897 
     898   SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before) 
     899      !!--------------------------------------------- 
     900      !!   *** ROUTINE interpvn *** 
     901      !!---------------------------------------------     
     902      ! 
     903      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     904      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     905      LOGICAL, INTENT(in) :: before 
     906      ! 
     907      INTEGER :: ji,jj 
     908      REAL(wp) :: zrhox  
     909      REAL(wp) :: ztref 
     910      !!---------------------------------------------     
     911      !  
     912      ztref = 1.     
     913      IF (before) THEN  
     914         !interpv entre 1 et k2 et interpv2d en jpkp1 
     915         DO jj=j1,MIN(j2,nlcj-1) 
     916            DO ji=i1,i2 
     917               ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1) 
     918            END DO 
     919         END DO 
     920      ELSE            
     921         zrhox = Agrif_Rhox() 
     922         DO ji=i1,i2 
     923            laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2))) 
     924         END DO 
     925      ENDIF 
     926      !       
     927   END SUBROUTINE interpvn2d 
     928 
     929   SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     930      !!---------------------------------------------------------------------- 
     931      !!                  ***  ROUTINE interpunb  *** 
     932      !!----------------------------------------------------------------------   
     933      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     934      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     935      LOGICAL, INTENT(in) :: before 
     936      INTEGER, INTENT(in) :: nb , ndir 
     937      !! 
     938      INTEGER :: ji,jj 
     939      REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 
     940      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     941      !!----------------------------------------------------------------------   
     942      ! 
     943      IF (before) THEN  
     944         DO jj=j1,j2 
     945            DO ji=i1,i2 
     946               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
     947            END DO 
     948         END DO 
     949      ELSE 
     950         western_side  = (nb == 1).AND.(ndir == 1) 
     951         eastern_side  = (nb == 1).AND.(ndir == 2) 
     952         southern_side = (nb == 2).AND.(ndir == 1) 
     953         northern_side = (nb == 2).AND.(ndir == 2) 
     954         zrhoy = Agrif_Rhoy() 
     955         zrhot = Agrif_rhot() 
     956         ! Time indexes bounds for integration 
     957         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     958         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
     959         ! Polynomial interpolation coefficients: 
     960         IF( bdy_tinterp == 1 ) THEN 
     961            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     962                  &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     963         ELSEIF( bdy_tinterp == 2 ) THEN 
     964            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     965                  &      - zt0        * (       zt0 - 1._wp)**2._wp )  
     966 
     967         ELSE 
     968            ztcoeff = 1 
     969         ENDIF 
     970         !    
     971         IF(western_side) THEN 
     972            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     973         ENDIF 
     974         IF(eastern_side) THEN 
     975            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     976         ENDIF 
     977         IF(southern_side) THEN 
     978            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
     979         ENDIF 
     980         IF(northern_side) THEN 
     981            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
     982         ENDIF 
     983         !             
     984         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
     985            IF(western_side) THEN 
     986               ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
     987                     &                                  * umask(i1,j1:j2,1) 
     988            ENDIF 
     989            IF(eastern_side) THEN 
     990               ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
     991                     &                                  * umask(i1,j1:j2,1) 
     992            ENDIF 
     993            IF(southern_side) THEN 
     994               ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
     995                     &                                  * umask(i1:i2,j1,1) 
     996            ENDIF 
     997            IF(northern_side) THEN 
     998               ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
     999                     &                                  * umask(i1:i2,j1,1) 
     1000            ENDIF 
     1001         ENDIF 
     1002      ENDIF 
     1003      !  
     1004   END SUBROUTINE interpunb 
     1005 
     1006   SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     1007      !!---------------------------------------------------------------------- 
     1008      !!                  ***  ROUTINE interpvnb  *** 
     1009      !!----------------------------------------------------------------------   
     1010      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1011      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1012      LOGICAL, INTENT(in) :: before 
     1013      INTEGER, INTENT(in) :: nb , ndir 
     1014      !! 
     1015      INTEGER :: ji,jj 
     1016      REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff    
     1017      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1018      !!----------------------------------------------------------------------   
     1019      !  
     1020      IF (before) THEN  
     1021         DO jj=j1,j2 
     1022            DO ji=i1,i2 
     1023               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)  
     1024            END DO 
     1025         END DO 
     1026      ELSE 
     1027         western_side  = (nb == 1).AND.(ndir == 1) 
     1028         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1029         southern_side = (nb == 2).AND.(ndir == 1) 
     1030         northern_side = (nb == 2).AND.(ndir == 2) 
     1031         zrhox = Agrif_Rhox() 
     1032         zrhot = Agrif_rhot() 
     1033         ! Time indexes bounds for integration 
     1034         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     1035         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
     1036         IF( bdy_tinterp == 1 ) THEN 
     1037            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     1038                  &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     1039         ELSEIF( bdy_tinterp == 2 ) THEN 
     1040            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     1041                  &      - zt0        * (       zt0 - 1._wp)**2._wp )  
     1042 
     1043         ELSE 
     1044            ztcoeff = 1 
     1045         ENDIF 
     1046         ! 
     1047         IF(western_side) THEN 
     1048            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     1049         ENDIF 
     1050         IF(eastern_side) THEN 
     1051            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     1052         ENDIF 
     1053         IF(southern_side) THEN 
     1054            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
     1055         ENDIF 
     1056         IF(northern_side) THEN 
     1057            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
     1058         ENDIF 
     1059         !             
     1060         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
     1061            IF(western_side) THEN 
     1062               vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
     1063                     &                                  * vmask(i1,j1:j2,1) 
     1064            ENDIF 
     1065            IF(eastern_side) THEN 
     1066               vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
     1067                     &                                  * vmask(i1,j1:j2,1) 
     1068            ENDIF 
     1069            IF(southern_side) THEN 
     1070               vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
     1071                     &                                  * vmask(i1:i2,j1,1) 
     1072            ENDIF 
     1073            IF(northern_side) THEN 
     1074               vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
     1075                     &                                  * vmask(i1:i2,j1,1) 
     1076            ENDIF 
     1077         ENDIF 
     1078      ENDIF 
     1079      ! 
     1080   END SUBROUTINE interpvnb 
     1081 
     1082   SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     1083      !!---------------------------------------------------------------------- 
     1084      !!                  ***  ROUTINE interpub2b  *** 
     1085      !!----------------------------------------------------------------------   
     1086      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1087      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1088      LOGICAL, INTENT(in) :: before 
     1089      INTEGER, INTENT(in) :: nb , ndir 
     1090      !! 
     1091      INTEGER :: ji,jj 
     1092      REAL(wp) :: zrhot, zt0, zt1,zat 
     1093      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1094      !!----------------------------------------------------------------------   
     1095      IF( before ) THEN 
     1096         DO jj=j1,j2 
     1097            DO ji=i1,i2 
     1098               ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 
     1099            END DO 
     1100         END DO 
     1101      ELSE 
     1102         western_side  = (nb == 1).AND.(ndir == 1) 
     1103         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1104         southern_side = (nb == 2).AND.(ndir == 1) 
     1105         northern_side = (nb == 2).AND.(ndir == 2) 
     1106         zrhot = Agrif_rhot() 
    7281107         ! Time indexes bounds for integration 
    7291108         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    7301109         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    731  
    7321110         ! Polynomial interpolation coefficients: 
    733          zaa = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    734                  &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
    735          zab = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    736                  &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
    7371111         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
    738                  &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
    739  
    740          ! Do time interpolation 
    741          IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    742             DO jj=1,jpj 
    743                zunb(2,jj) = zaa * zuab(2,jj) + zab * zubb(2,jj) + zat * zutn(2,jj) 
    744                zvnb(2,jj) = zaa * zvab(2,jj) + zab * zvbb(2,jj) + zat * zvtn(2,jj) 
    745             END DO 
    746          ENDIF 
    747          IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    748             DO jj=1,jpj 
    749                zunb(nlci-2,jj) = zaa * zuab(nlci-2,jj) + zab * zubb(nlci-2,jj) + zat * zutn(nlci-2,jj) 
    750                zvnb(nlci-1,jj) = zaa * zvab(nlci-1,jj) + zab * zvbb(nlci-1,jj) + zat * zvtn(nlci-1,jj) 
    751             END DO 
    752          ENDIF 
    753          IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    754             DO ji=1,jpi 
    755                zunb(ji,2) = zaa * zuab(ji,2) + zab * zubb(ji,2) + zat * zutn(ji,2) 
    756                zvnb(ji,2) = zaa * zvab(ji,2) + zab * zvbb(ji,2) + zat * zvtn(ji,2) 
    757             END DO 
    758          ENDIF 
    759          IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    760             DO ji=1,jpi 
    761                zunb(ji,nlcj-1) = zaa * zuab(ji,nlcj-1) + zab * zubb(ji,nlcj-1) + zat * zutn(ji,nlcj-1) 
    762                zvnb(ji,nlcj-2) = zaa * zvab(ji,nlcj-2) + zab * zvbb(ji,nlcj-2) + zat * zvtn(ji,nlcj-2) 
    763             END DO 
    764          ENDIF 
    765          CALL wrk_dealloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn ) 
    766  
    767       ELSE ! Linear interpolation 
    768          zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp 
    769          CALL Agrif_Bc_variable(zunb,unb_id,calledweight=zt, procname=interpunb) 
    770          CALL Agrif_Bc_variable(zvnb,vnb_id,calledweight=zt, procname=interpvnb) 
    771       ENDIF 
    772       Agrif_UseSpecialValue = .FALSE. 
    773  
    774       ! Fill boundary data arrays: 
    775       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    776          DO jj=1,jpj 
    777                ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) * umask(2,jj,1) 
    778                vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) * vmask(2,jj,1) 
    779                hbdy_w(jj) = zsshn(2,jj) * tmask(2,jj,1) 
    780          END DO 
    781       ENDIF 
    782  
    783       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    784          DO jj=1,jpj 
    785                ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) * umask(nlci-2,jj,1) 
    786                vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) * vmask(nlci-1,jj,1) 
    787                hbdy_e(jj) = zsshn(nlci-1,jj) * tmask(nlci-1,jj,1) 
    788          END DO 
    789       ENDIF 
    790  
    791       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    792          DO ji=1,jpi 
    793                ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) * umask(ji,2,1) 
    794                vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) * vmask(ji,2,1) 
    795                hbdy_s(ji) = zsshn(ji,2) * tmask(ji,2,1) 
    796          END DO 
    797       ENDIF 
    798  
    799       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    800          DO ji=1,jpi 
    801             ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) * umask(ji,nlcj-1,1) 
    802             vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) * vmask(ji,nlcj-2,1) 
    803             hbdy_n(ji) = zsshn(ji,nlcj-1) * tmask(ji,nlcj-1,1) 
    804          END DO 
    805       ENDIF 
    806  
    807       CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn ) 
    808  
    809    END SUBROUTINE Agrif_dta_ts 
    810  
    811    SUBROUTINE Agrif_ssh( kt ) 
    812       !!---------------------------------------------------------------------- 
    813       !!                  ***  ROUTINE Agrif_DYN  *** 
    814       !!----------------------------------------------------------------------   
    815       INTEGER, INTENT(in) ::   kt 
    816       !! 
    817       !!----------------------------------------------------------------------   
    818  
    819       IF( Agrif_Root() )   RETURN 
    820  
    821  
    822       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    823          ssha(2,:)=ssha(3,:) 
    824          sshn(2,:)=sshn(3,:) 
    825       ENDIF 
    826  
    827       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    828          ssha(nlci-1,:)=ssha(nlci-2,:) 
    829          sshn(nlci-1,:)=sshn(nlci-2,:)         
    830       ENDIF 
    831  
    832       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    833          ssha(:,2)=ssha(:,3) 
    834          sshn(:,2)=sshn(:,3) 
    835       ENDIF 
    836  
    837       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    838          ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    839          sshn(:,nlcj-1)=sshn(:,nlcj-2)                 
    840       ENDIF 
    841  
    842    END SUBROUTINE Agrif_ssh 
    843  
    844    SUBROUTINE Agrif_ssh_ts( jn ) 
    845       !!---------------------------------------------------------------------- 
    846       !!                  ***  ROUTINE Agrif_ssh_ts  *** 
    847       !!----------------------------------------------------------------------   
    848       INTEGER, INTENT(in) ::   jn 
     1112               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
     1113         !  
     1114         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1115         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1116         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1117         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1118      ENDIF 
     1119      !  
     1120   END SUBROUTINE interpub2b 
     1121 
     1122   SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     1123      !!---------------------------------------------------------------------- 
     1124      !!                  ***  ROUTINE interpvb2b  *** 
     1125      !!----------------------------------------------------------------------   
     1126      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1127      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1128      LOGICAL, INTENT(in) :: before 
     1129      INTEGER, INTENT(in) :: nb , ndir 
    8491130      !! 
    8501131      INTEGER :: ji,jj 
    851       !!----------------------------------------------------------------------   
    852  
    853       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    854          DO jj=1,jpj 
    855             ssha_e(2,jj) = hbdy_w(jj) 
    856          END DO 
    857       ENDIF 
    858  
    859       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    860          DO jj=1,jpj 
    861             ssha_e(nlci-1,jj) = hbdy_e(jj) 
    862          END DO 
    863       ENDIF 
    864  
    865       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    866          DO ji=1,jpi 
    867             ssha_e(ji,2) = hbdy_s(ji) 
    868          END DO 
    869       ENDIF 
    870  
    871       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    872          DO ji=1,jpi 
    873             ssha_e(ji,nlcj-1) = hbdy_n(ji) 
    874          END DO 
    875       ENDIF 
    876  
    877    END SUBROUTINE Agrif_ssh_ts 
    878  
    879    SUBROUTINE interpsshn(tabres,i1,i2,j1,j2) 
    880       !!---------------------------------------------------------------------- 
    881       !!                  ***  ROUTINE interpsshn  *** 
    882       !!----------------------------------------------------------------------   
    883       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    884       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    885       !! 
    886       INTEGER :: ji,jj 
    887       !!----------------------------------------------------------------------   
    888  
    889       tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 
    890  
    891    END SUBROUTINE interpsshn 
    892  
    893    SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2) 
    894       !!---------------------------------------------------------------------- 
    895       !!                  ***  ROUTINE interpu  *** 
    896       !!----------------------------------------------------------------------   
    897       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    898       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    899       !! 
    900       INTEGER :: ji,jj,jk 
    901       !!----------------------------------------------------------------------   
    902  
    903       DO jk=k1,k2 
     1132      REAL(wp) :: zrhot, zt0, zt1,zat 
     1133      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1134      !!----------------------------------------------------------------------   
     1135      ! 
     1136      IF( before ) THEN 
    9041137         DO jj=j1,j2 
    9051138            DO ji=i1,i2 
    906                tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    907                tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 
    908             END DO 
    909          END DO 
    910       END DO 
    911    END SUBROUTINE interpu 
    912  
    913  
    914    SUBROUTINE interpu2d(tabres,i1,i2,j1,j2) 
    915       !!---------------------------------------------------------------------- 
    916       !!                  ***  ROUTINE interpu2d  *** 
    917       !!----------------------------------------------------------------------   
    918       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    919       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    920       !! 
    921       INTEGER :: ji,jj 
    922       !!----------------------------------------------------------------------   
    923  
    924       DO jj=j1,j2 
    925          DO ji=i1,i2 
    926             tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) & 
    927                * umask(ji,jj,1) 
    928          END DO 
    929       END DO 
    930  
    931    END SUBROUTINE interpu2d 
    932  
    933  
    934    SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2) 
    935       !!---------------------------------------------------------------------- 
    936       !!                  ***  ROUTINE interpv  *** 
    937       !!----------------------------------------------------------------------   
     1139               ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 
     1140            END DO 
     1141         END DO 
     1142      ELSE       
     1143         western_side  = (nb == 1).AND.(ndir == 1) 
     1144         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1145         southern_side = (nb == 2).AND.(ndir == 1) 
     1146         northern_side = (nb == 2).AND.(ndir == 2) 
     1147         zrhot = Agrif_rhot() 
     1148         ! Time indexes bounds for integration 
     1149         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     1150         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
     1151         ! Polynomial interpolation coefficients: 
     1152         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
     1153               &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
     1154         ! 
     1155         IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1156         IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1157         IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1158         IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1159      ENDIF 
     1160      !       
     1161   END SUBROUTINE interpvb2b 
     1162 
     1163   SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1164      !!---------------------------------------------------------------------- 
     1165      !!                  ***  ROUTINE interpe3t  *** 
     1166      !!----------------------------------------------------------------------   
     1167      !  
    9381168      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    939       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    940       !! 
     1169      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     1170      LOGICAL :: before 
     1171      INTEGER, INTENT(in) :: nb , ndir 
     1172      ! 
    9411173      INTEGER :: ji, jj, jk 
    942       !!----------------------------------------------------------------------   
    943  
    944       DO jk=k1,k2 
    945          DO jj=j1,j2 
    946             DO ji=i1,i2 
    947                tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    948                tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 
    949             END DO 
    950          END DO 
    951       END DO 
    952  
    953    END SUBROUTINE interpv 
    954  
    955  
    956    SUBROUTINE interpv2d(tabres,i1,i2,j1,j2) 
    957       !!---------------------------------------------------------------------- 
    958       !!                  ***  ROUTINE interpu2d  *** 
    959       !!----------------------------------------------------------------------   
    960       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    961       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    962       !! 
    963       INTEGER :: ji,jj 
    964       !!----------------------------------------------------------------------   
    965  
    966       DO jj=j1,j2 
    967          DO ji=i1,i2 
    968             tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) & 
    969                * vmask(ji,jj,1) 
    970          END DO 
    971       END DO 
    972  
    973    END SUBROUTINE interpv2d 
    974  
    975    SUBROUTINE interpunb(tabres,i1,i2,j1,j2) 
    976       !!---------------------------------------------------------------------- 
    977       !!                  ***  ROUTINE interpunb  *** 
    978       !!----------------------------------------------------------------------   
    979       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    980       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    981       !! 
    982       INTEGER :: ji,jj 
    983       !!----------------------------------------------------------------------   
    984  
    985       DO jj=j1,j2 
    986          DO ji=i1,i2 
    987             tabres(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
    988          END DO 
    989       END DO 
    990  
    991    END SUBROUTINE interpunb 
    992  
    993    SUBROUTINE interpvnb(tabres,i1,i2,j1,j2) 
    994       !!---------------------------------------------------------------------- 
    995       !!                  ***  ROUTINE interpvnb  *** 
    996       !!----------------------------------------------------------------------   
    997       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    998       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    999       !! 
    1000       INTEGER :: ji,jj 
    1001       !!----------------------------------------------------------------------   
    1002  
    1003       DO jj=j1,j2 
    1004          DO ji=i1,i2 
    1005             tabres(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 
    1006          END DO 
    1007       END DO 
    1008  
    1009    END SUBROUTINE interpvnb 
    1010  
    1011    SUBROUTINE interpub2b(tabres,i1,i2,j1,j2) 
    1012       !!---------------------------------------------------------------------- 
    1013       !!                  ***  ROUTINE interpub2b  *** 
    1014       !!----------------------------------------------------------------------   
    1015       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    1016       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    1017       !! 
    1018       INTEGER :: ji,jj 
    1019       !!----------------------------------------------------------------------   
    1020  
    1021       DO jj=j1,j2 
    1022          DO ji=i1,i2 
    1023             tabres(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 
    1024          END DO 
    1025       END DO 
    1026  
    1027    END SUBROUTINE interpub2b 
    1028  
    1029    SUBROUTINE interpvb2b(tabres,i1,i2,j1,j2) 
    1030       !!---------------------------------------------------------------------- 
    1031       !!                  ***  ROUTINE interpvb2b  *** 
    1032       !!----------------------------------------------------------------------   
    1033       INTEGER, INTENT(in) :: i1,i2,j1,j2 
    1034       REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    1035       !! 
    1036       INTEGER :: ji,jj 
    1037       !!----------------------------------------------------------------------   
    1038  
    1039       DO jj=j1,j2 
    1040          DO ji=i1,i2 
    1041             tabres(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 
    1042          END DO 
    1043       END DO 
    1044  
    1045    END SUBROUTINE interpvb2b 
     1174      LOGICAL :: western_side, eastern_side, northern_side, southern_side 
     1175      REAL(wp) :: ztmpmsk       
     1176      !!----------------------------------------------------------------------   
     1177      !     
     1178      IF (before) THEN 
     1179         DO jk=k1,k2 
     1180            DO jj=j1,j2 
     1181               DO ji=i1,i2 
     1182                  ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
     1183               END DO 
     1184            END DO 
     1185         END DO 
     1186      ELSE 
     1187         western_side  = (nb == 1).AND.(ndir == 1) 
     1188         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1189         southern_side = (nb == 2).AND.(ndir == 1) 
     1190         northern_side = (nb == 2).AND.(ndir == 2) 
     1191 
     1192         DO jk=k1,k2 
     1193            DO jj=j1,j2 
     1194               DO ji=i1,i2 
     1195                  ! Get velocity mask at boundary edge points: 
     1196                  IF (western_side)  ztmpmsk = umask(ji    ,jj    ,1) 
     1197                  IF (eastern_side)  ztmpmsk = umask(nlci-2,jj    ,1) 
     1198                  IF (northern_side) ztmpmsk = vmask(ji    ,nlcj-2,1) 
     1199                  IF (southern_side) ztmpmsk = vmask(ji    ,2     ,1) 
     1200 
     1201                  IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN 
     1202                     IF (western_side) THEN 
     1203                        WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     1204                     ELSEIF (eastern_side) THEN 
     1205                        WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     1206                     ELSEIF (southern_side) THEN 
     1207                        WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
     1208                     ELSEIF (northern_side) THEN 
     1209                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
     1210                     ENDIF 
     1211                     WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
     1212                     kindic_agr = kindic_agr + 1 
     1213                  ENDIF 
     1214               END DO 
     1215            END DO 
     1216         END DO 
     1217 
     1218      ENDIF 
     1219      !  
     1220   END SUBROUTINE interpe3t 
     1221 
     1222   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1223      !!---------------------------------------------------------------------- 
     1224      !!                  ***  ROUTINE interpumsk  *** 
     1225      !!----------------------------------------------------------------------   
     1226      !  
     1227      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     1228      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     1229      LOGICAL :: before 
     1230      INTEGER, INTENT(in) :: nb , ndir 
     1231      ! 
     1232      INTEGER :: ji, jj, jk 
     1233      LOGICAL :: western_side, eastern_side    
     1234      !!----------------------------------------------------------------------   
     1235      !     
     1236      IF (before) THEN 
     1237         DO jk=k1,k2 
     1238            DO jj=j1,j2 
     1239               DO ji=i1,i2 
     1240                  ptab(ji,jj,jk) = umask(ji,jj,jk) 
     1241               END DO 
     1242            END DO 
     1243         END DO 
     1244      ELSE 
     1245 
     1246         western_side  = (nb == 1).AND.(ndir == 1) 
     1247         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1248         DO jk=k1,k2 
     1249            DO jj=j1,j2 
     1250               DO ji=i1,i2 
     1251                   ! Velocity mask at boundary edge points: 
     1252                  IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 
     1253                     IF (western_side) THEN 
     1254                        WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     1255                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 
     1256                        kindic_agr = kindic_agr + 1 
     1257                     ELSEIF (eastern_side) THEN 
     1258                        WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     1259                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 
     1260                        kindic_agr = kindic_agr + 1 
     1261                     ENDIF 
     1262                  ENDIF 
     1263               END DO 
     1264            END DO 
     1265         END DO 
     1266 
     1267      ENDIF 
     1268      !  
     1269   END SUBROUTINE interpumsk 
     1270 
     1271   SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
     1272      !!---------------------------------------------------------------------- 
     1273      !!                  ***  ROUTINE interpvmsk  *** 
     1274      !!----------------------------------------------------------------------   
     1275      !  
     1276      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     1277      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     1278      LOGICAL :: before 
     1279      INTEGER, INTENT(in) :: nb , ndir 
     1280      ! 
     1281      INTEGER :: ji, jj, jk 
     1282      LOGICAL :: northern_side, southern_side      
     1283      !!----------------------------------------------------------------------   
     1284      !     
     1285      IF (before) THEN 
     1286         DO jk=k1,k2 
     1287            DO jj=j1,j2 
     1288               DO ji=i1,i2 
     1289                  ptab(ji,jj,jk) = vmask(ji,jj,jk) 
     1290               END DO 
     1291            END DO 
     1292         END DO 
     1293      ELSE 
     1294 
     1295         southern_side = (nb == 2).AND.(ndir == 1) 
     1296         northern_side = (nb == 2).AND.(ndir == 2) 
     1297         DO jk=k1,k2 
     1298            DO jj=j1,j2 
     1299               DO ji=i1,i2 
     1300                   ! Velocity mask at boundary edge points: 
     1301                  IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 
     1302                     IF (southern_side) THEN 
     1303                        WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     1304                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 
     1305                        kindic_agr = kindic_agr + 1 
     1306                     ELSEIF (northern_side) THEN 
     1307                        WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
     1308                        WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 
     1309                        kindic_agr = kindic_agr + 1 
     1310                     ENDIF 
     1311                  ENDIF 
     1312               END DO 
     1313            END DO 
     1314         END DO 
     1315 
     1316      ENDIF 
     1317      !  
     1318   END SUBROUTINE interpvmsk 
     1319 
     1320# if defined key_zdftke 
     1321 
     1322   SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) 
     1323      !!---------------------------------------------------------------------- 
     1324      !!                  ***  ROUTINE interavm  *** 
     1325      !!----------------------------------------------------------------------   
     1326      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     1327      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     1328      LOGICAL, INTENT(in) :: before 
     1329      !!----------------------------------------------------------------------   
     1330      !       
     1331      IF( before) THEN 
     1332         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     1333      ELSE 
     1334         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
     1335      ENDIF 
     1336      ! 
     1337   END SUBROUTINE interpavm 
     1338 
     1339# endif /* key_zdftke */ 
    10461340 
    10471341#else 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r4153 r6204  
    11#define SPONGE && define SPONGE_TOP 
    22 
    3 Module agrif_opa_sponge 
     3MODULE agrif_opa_sponge 
    44#if defined key_agrif  && ! defined key_offline 
    55   USE par_oce 
    … …  
    99   USE agrif_oce 
    1010   USE wrk_nemo   
     11   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    1112 
    1213   IMPLICIT NONE 
    1314   PRIVATE 
    1415 
    15    PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
    16  
    17   !! * Substitutions 
     16   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn 
     17   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 
     18 
     19   !! * Substitutions 
    1820#  include "domzgr_substitute.h90" 
    1921   !!---------------------------------------------------------------------- 
    … …  
    2325   !!---------------------------------------------------------------------- 
    2426 
    25    CONTAINS 
     27CONTAINS 
    2628 
    2729   SUBROUTINE Agrif_Sponge_Tra 
    … …  
    3032      !!--------------------------------------------- 
    3133      !! 
    32       INTEGER :: ji,jj,jk,jn 
    3334      REAL(wp) :: timecoeff 
    34       REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
    35       REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv 
    36       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    37       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff 
    3835 
    3936#if defined SPONGE 
    40       CALL wrk_alloc( jpi, jpj, ztu, ztv ) 
    41       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    42  
    4337      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    4438 
     39      CALL Agrif_Sponge 
    4540      Agrif_SpecialValue=0. 
    4641      Agrif_UseSpecialValue = .TRUE. 
    47       ztab = 0.e0 
    48       CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 
     42      tabspongedone_tsn = .FALSE. 
     43 
     44      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 
     45 
    4946      Agrif_UseSpecialValue = .FALSE. 
    50  
    51       tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 
    52  
    53       CALL Agrif_Sponge 
    54  
    55       DO jn = 1, jpts 
    56          DO jk = 1, jpkm1 
    57             ! 
    58             DO jj = 1, jpjm1 
    59                DO ji = 1, jpim1 
    60                   zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    61                   zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    62                   ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    63                   ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    64                ENDDO 
    65             ENDDO 
    66  
    67             DO jj = 2, jpjm1 
    68                DO ji = 2, jpim1 
    69                   zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    70                   ! horizontal diffusive trends 
    71                   ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   & 
    72                   &              + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
    73                   ! add it to the general tracer trends 
    74                   tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
    75                END DO 
    76             END DO 
    77             ! 
    78          ENDDO 
    79       ENDDO 
    80  
    81       CALL wrk_dealloc( jpi, jpj, ztu, ztv ) 
    82       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    8347#endif 
    8448 
    … …  
    9054      !!--------------------------------------------- 
    9155      !! 
    92       INTEGER :: ji,jj,jk 
    9356      REAL(wp) :: timecoeff 
    94       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
    95       REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff 
    96       REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff 
    97       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
    9857 
    9958#if defined SPONGE 
    100       CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    101  
    10259      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    10360 
    10461      Agrif_SpecialValue=0. 
    10562      Agrif_UseSpecialValue = ln_spc_dyn 
    106       ztab = 0.e0 
    107       CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun) 
     63 
     64      tabspongedone_u = .FALSE. 
     65      tabspongedone_v = .FALSE.          
     66      CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 
     67 
     68      tabspongedone_u = .FALSE. 
     69      tabspongedone_v = .FALSE. 
     70      CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 
     71 
    10872      Agrif_UseSpecialValue = .FALSE. 
    109  
    110       ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:) 
    111  
    112       ztab = 0.e0 
    113       Agrif_SpecialValue=0. 
    114       Agrif_UseSpecialValue = ln_spc_dyn 
    115       CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn) 
    116       Agrif_UseSpecialValue = .FALSE. 
    117  
    118       vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:) 
    119  
    120       CALL Agrif_Sponge 
    121  
    122       DO jk = 1,jpkm1 
    123          ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:) 
    124          vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:) 
    125       ENDDO 
    126        
    127       hdivdiff = 0. 
    128       rotdiff = 0. 
    129  
    130       DO jk = 1, jpkm1                                 ! Horizontal slab 
    131          !                                             ! =============== 
    132  
    133          !                                             ! -------- 
    134          ! Horizontal divergence                       !   div 
    135          !                                             ! -------- 
    136          DO jj = 2, jpjm1 
    137             DO ji = 2, jpim1   ! vector opt. 
    138                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    139                hdivdiff(ji,jj,jk) =  (  e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) * ubdiff(ji  ,jj  ,jk)     & 
    140                   &                   - e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) * ubdiff(ji-1,jj  ,jk)     & 
    141                   &                   + e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk) * vbdiff(ji  ,jj  ,jk)     & 
    142                   &                   - e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) * vbdiff(ji  ,jj-1,jk)  ) * zbtr 
    143             END DO 
    144          END DO 
    145  
    146          DO jj = 1, jpjm1 
    147             DO ji = 1, jpim1   ! vector opt. 
    148                zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 
    149                rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    & 
    150                   &                 - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) & 
    151                   &               * fmask(ji,jj,jk) * zbtr 
    152             END DO 
    153          END DO 
    154  
    155       ENDDO 
    156  
    157       !                                                ! =============== 
    158       DO jk = 1, jpkm1                                 ! Horizontal slab 
    159          !                                             ! =============== 
    160          DO jj = 2, jpjm1 
    161             DO ji = 2, jpim1   ! vector opt. 
    162                ! horizontal diffusive trends 
    163                zua = - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    164                      + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk) ) / e1u(ji,jj) 
    165  
    166                zva = + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    167                      + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) / e2v(ji,jj) 
    168                ! add it to the general momentum trends 
    169                ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    170                va(ji,jj,jk) = va(ji,jj,jk) + zva 
    171             END DO 
    172          END DO 
    173          !                                             ! =============== 
    174       END DO                                           !   End of slab 
    175       !                                                ! =============== 
    176       CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    17773#endif 
    17874 
    … …  
    19995         CALL wrk_alloc( jpi, jpj, ztabramp ) 
    20096 
    201          ispongearea  = 2 + 2 * Agrif_irhox() 
     97         ispongearea  = 2 + nn_sponge_len * Agrif_irhox() 
    20298         ilci = nlci - ispongearea 
    20399         ilcj = nlcj - ispongearea  
    204100         z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
    205          spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    206  
    207          ztabramp(:,:) = 0. 
     101 
     102         ztabramp(:,:) = 0._wp 
    208103 
    209104         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
    … …  
    254149      ! Tracers 
    255150      IF( .NOT. spongedoneT ) THEN 
    256          spe1ur(:,:) = 0. 
    257          spe2vr(:,:) = 0. 
    258  
    259          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
    260             spe1ur(2:ispongearea-1,:       ) = visc_tra                                        & 
    261                &                             *    0.5 * (  ztabramp(2:ispongearea-1,:      )   & 
    262                &                                         + ztabramp(3:ispongearea  ,:      ) ) & 
    263                &                             * e2u(2:ispongearea-1,:) / e1u(2:ispongearea-1,:) 
    264  
    265             spe2vr(2:ispongearea  ,1:jpjm1 ) = visc_tra                                        & 
    266                &                             *    0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1)   & 
    267                &                                         + ztabramp(2:ispongearea,2  :jpj  ) ) & 
    268                &                             * e1v(2:ispongearea,1:jpjm1) / e2v(2:ispongearea,1:jpjm1) 
    269          ENDIF 
    270  
    271          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
    272             spe1ur(ilci+1:nlci-2,:        ) = visc_tra                                   & 
    273                &                            * 0.5 * (  ztabramp(ilci+1:nlci-2,:      )   &  
    274                &                                     + ztabramp(ilci+2:nlci-1,:      ) ) & 
    275                &                            * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 
    276  
    277             spe2vr(ilci+1:nlci-1,1:jpjm1  )  = visc_tra                                  & 
    278                &                            * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1)   &  
    279                &                                     + ztabramp(ilci+1:nlci-1,2:jpj  ) ) &  
    280                &                            * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 
    281          ENDIF 
    282  
    283          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    284             spe1ur(1:jpim1,2:ispongearea  ) = visc_tra                                     & 
    285                &                            * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  )   &  
    286                &                                     + ztabramp(2:jpi  ,2:ispongearea  ) ) & 
    287                &                            * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 
    288     
    289             spe2vr(:      ,2:ispongearea-1) = visc_tra                                     & 
    290                &                            * 0.5 * (  ztabramp(:      ,2:ispongearea-1)   & 
    291                &                                     + ztabramp(:      ,3:ispongearea  ) ) & 
    292                &                            * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 
    293          ENDIF 
    294  
    295          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    296             spe1ur(1:jpim1,ilcj+1:nlcj-1) = visc_tra                                   & 
    297                &                          * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1)   & 
    298                &                                   + ztabramp(2:jpi  ,ilcj+1:nlcj-1) ) & 
    299                &                                * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 
    300  
    301             spe2vr(:      ,ilcj+1:nlcj-2) = visc_tra                                   & 
    302                &                          * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2)   & 
    303                &                                   + ztabramp(:      ,ilcj+2:nlcj-1) ) & 
    304                &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 
    305          ENDIF 
     151         fsaht_spu(:,:) = 0._wp 
     152         fsaht_spv(:,:) = 0._wp 
     153         DO jj = 2, jpjm1 
     154            DO ji = 2, jpim1   ! vector opt. 
     155               fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj  )) 
     156               fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji  ,jj+1)) 
     157            END DO 
     158         END DO 
     159 
     160         CALL lbc_lnk( fsaht_spu, 'U', 1. )   ! Lateral boundary conditions 
     161         CALL lbc_lnk( fsaht_spv, 'V', 1. ) 
    306162         spongedoneT = .TRUE. 
    307163      ENDIF 
    … …  
    309165      ! Dynamics 
    310166      IF( .NOT. spongedoneU ) THEN 
    311          spe1ur2(:,:) = 0. 
    312          spe2vr2(:,:) = 0. 
    313  
    314          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
    315             spe1ur2(2:ispongearea-1,:      ) = visc_dyn                                   & 
    316                &                             * 0.5 * (  ztabramp(2:ispongearea-1,:      ) & 
    317                &                                      + ztabramp(3:ispongearea  ,:      ) ) 
    318             spe2vr2(2:ispongearea  ,1:jpjm1) = visc_dyn                                   & 
    319                &                             * 0.5 * (  ztabramp(2:ispongearea  ,1:jpjm1) & 
    320                &                                      + ztabramp(2:ispongearea  ,2:jpj  ) )  
    321          ENDIF 
    322  
    323          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
    324             spe1ur2(ilci+1:nlci-2  ,:      ) = visc_dyn                                   & 
    325                &                             * 0.5 * (  ztabramp(ilci+1:nlci-2, :       ) & 
    326                &                                      + ztabramp(ilci+2:nlci-1, :       ) )                       
    327             spe2vr2(ilci+1:nlci-1  ,1:jpjm1) = visc_dyn                                   & 
    328                &                             * 0.5 * (  ztabramp(ilci+1:nlci-1,1:jpjm1  ) & 
    329                &                                      + ztabramp(ilci+1:nlci-1,2:jpj    ) )  
    330          ENDIF 
    331  
    332          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    333             spe1ur2(1:jpim1,2:ispongearea  ) = visc_dyn                                   &   
    334                &                             * 0.5 * (  ztabramp(1:jpim1,2:ispongearea  ) & 
    335                &                                      + ztabramp(2:jpi  ,2:ispongearea  ) )  
    336             spe2vr2(:      ,2:ispongearea-1) = visc_dyn                                   & 
    337                &                             * 0.5 * (  ztabramp(:      ,2:ispongearea-1) & 
    338                &                                      + ztabramp(:      ,3:ispongearea  ) ) 
    339          ENDIF 
    340  
    341          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    342             spe1ur2(1:jpim1,ilcj+1:nlcj-1  ) = visc_dyn                                   & 
    343                &                             * 0.5 * (  ztabramp(1:jpim1,ilcj+1:nlcj-1  ) & 
    344                &                                      + ztabramp(2:jpi  ,ilcj+1:nlcj-1  ) )  
    345             spe2vr2(:      ,ilcj+1:nlcj-2  ) = visc_dyn                                   & 
    346                &                             * 0.5 * (  ztabramp(:      ,ilcj+1:nlcj-2  ) & 
    347                &                                      + ztabramp(:      ,ilcj+2:nlcj-1  ) ) 
    348          ENDIF 
     167         fsahm_spt(:,:) = 0._wp 
     168         fsahm_spf(:,:) = 0._wp 
     169         DO jj = 2, jpjm1 
     170            DO ji = 2, jpim1   ! vector opt. 
     171               fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 
     172               fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) & 
     173                                                     &  +ztabramp(ji,jj) + ztabramp(ji+1,jj  ) ) 
     174            END DO 
     175         END DO 
     176 
     177         CALL lbc_lnk( fsahm_spt, 'T', 1. )   ! Lateral boundary conditions 
     178         CALL lbc_lnk( fsahm_spf, 'F', 1. ) 
    349179         spongedoneU = .TRUE. 
    350          spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) ) 
    351180      ENDIF 
    352181      ! 
    … …  
    357186   END SUBROUTINE Agrif_Sponge 
    358187 
    359    SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
    360       !!--------------------------------------------- 
    361       !!   *** ROUTINE interptsn *** 
     188   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
     189      !!--------------------------------------------- 
     190      !!   *** ROUTINE interptsn_sponge *** 
    362191      !!--------------------------------------------- 
    363192      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    364193      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    365  
    366       tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
    367  
    368    END SUBROUTINE interptsn 
    369  
    370    SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2) 
    371       !!--------------------------------------------- 
    372       !!   *** ROUTINE interpun *** 
    373       !!--------------------------------------------- 
     194      LOGICAL, INTENT(in) :: before 
     195 
     196 
     197      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     198      INTEGER  ::   iku, ikv 
     199      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
     200      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 
     201      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
     202      ! 
     203      IF (before) THEN 
     204         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     205      ELSE    
     206    
     207         tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)     
     208         DO jn = 1, jpts             
     209            DO jk = 1, jpkm1 
     210               DO jj = j1,j2-1 
     211                  DO ji = i1,i2-1 
     212                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     213                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     214                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
     215                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     216                  ENDDO 
     217               ENDDO 
     218 
     219               IF( ln_zps ) THEN      ! set gradient at partial step level 
     220                  DO jj = j1,j2-1 
     221                     DO ji = i1,i2-1 
     222                        ! last level 
     223                        iku = mbku(ji,jj) 
     224                        ikv = mbkv(ji,jj) 
     225                        IF( iku == jk ) THEN 
     226                           ztu(ji,jj,jk) = 0._wp 
     227                        ENDIF 
     228                        IF( ikv == jk ) THEN 
     229                           ztv(ji,jj,jk) = 0._wp 
     230                        ENDIF 
     231                     END DO 
     232                  END DO 
     233               ENDIF 
     234            ENDDO 
     235 
     236            DO jk = 1, jpkm1 
     237               DO jj = j1+1,j2-1 
     238                  DO ji = i1+1,i2-1 
     239 
     240                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
     241                        zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) 
     242                        ! horizontal diffusive trends 
     243                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) 
     244                        ! add it to the general tracer trends 
     245                        tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
     246                     ENDIF 
     247 
     248                  ENDDO 
     249               ENDDO 
     250 
     251            ENDDO 
     252         ENDDO 
     253 
     254         tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
     255 
     256      ENDIF 
     257 
     258   END SUBROUTINE interptsn_sponge 
     259 
     260   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 
     261      !!--------------------------------------------- 
     262      !!   *** ROUTINE interpun_sponge *** 
     263      !!---------------------------------------------     
    374264      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    375265      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    376  
    377       tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2) 
    378  
    379    END SUBROUTINE interpun 
    380  
    381    SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2) 
    382       !!--------------------------------------------- 
    383       !!   *** ROUTINE interpvn *** 
    384       !!--------------------------------------------- 
     266      LOGICAL, INTENT(in) :: before 
     267 
     268      INTEGER :: ji,jj,jk 
     269 
     270      ! sponge parameters  
     271      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
     272      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 
     273      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
     274      INTEGER :: jmax 
     275      ! 
     276 
     277 
     278      IF (before) THEN 
     279         tabres = un(i1:i2,j1:j2,:) 
     280      ELSE 
     281 
     282         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 
     283 
     284         DO jk = 1, jpkm1                                 ! Horizontal slab 
     285            !                                             ! =============== 
     286 
     287            !                                             ! -------- 
     288            ! Horizontal divergence                       !   div 
     289            !                                             ! -------- 
     290            DO jj = j1,j2 
     291               DO ji = i1+1,i2   ! vector opt. 
     292                  zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     293                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
     294                                     &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
     295               END DO 
     296            END DO 
     297 
     298            DO jj = j1,j2-1 
     299               DO ji = i1,i2   ! vector opt. 
     300                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     301                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 
     302                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) &  
     303                                    & ) * fmask(ji,jj,jk) * zbtr  
     304               END DO 
     305            END DO 
     306         ENDDO 
     307 
     308         ! 
     309 
     310 
     311 
     312         DO jj = j1+1, j2-1 
     313            DO ji = i1+1, i2-1   ! vector opt. 
     314 
     315               IF (.NOT. tabspongedone_u(ji,jj)) THEN 
     316                  DO jk = 1, jpkm1                                 ! Horizontal slab 
     317                     ze2u = rotdiff (ji,jj,jk) 
     318                     ze1v = hdivdiff(ji,jj,jk) 
     319                     ! horizontal diffusive trends 
     320                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   & 
     321                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj) 
     322 
     323                     ! add it to the general momentum trends 
     324                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     325 
     326                  END DO 
     327               ENDIF 
     328 
     329            END DO 
     330         END DO 
     331 
     332         tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
     333 
     334         jmax = j2-1 
     335         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3) 
     336 
     337         DO jj = j1+1, jmax 
     338            DO ji = i1+1, i2   ! vector opt. 
     339 
     340               IF (.NOT. tabspongedone_v(ji,jj)) THEN 
     341                  DO jk = 1, jpkm1                                 ! Horizontal slab 
     342                     ze2u = rotdiff (ji,jj,jk) 
     343                     ze1v = hdivdiff(ji,jj,jk) 
     344 
     345                     ! horizontal diffusive trends 
     346                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   & 
     347                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj) 
     348 
     349                     ! add it to the general momentum trends 
     350                     va(ji,jj,jk) = va(ji,jj,jk) + zva 
     351                  END DO 
     352               ENDIF 
     353 
     354            END DO 
     355         END DO 
     356 
     357 
     358         tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 
     359 
     360      ENDIF 
     361 
     362 
     363   END SUBROUTINE interpun_sponge 
     364 
     365 
     366   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir) 
     367      !!--------------------------------------------- 
     368      !!   *** ROUTINE interpvn_sponge *** 
     369      !!---------------------------------------------  
    385370      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    386371      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    387  
    388       tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2) 
    389  
    390    END SUBROUTINE interpvn 
     372      LOGICAL, INTENT(in) :: before 
     373      INTEGER, INTENT(in) :: nb , ndir 
     374 
     375      INTEGER :: ji,jj,jk 
     376 
     377      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
     378 
     379      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 
     380      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
     381      INTEGER :: imax 
     382      ! 
     383 
     384      IF (before) THEN  
     385         tabres = vn(i1:i2,j1:j2,:) 
     386      ELSE 
     387 
     388         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 
     389 
     390         DO jk = 1, jpkm1                                 ! Horizontal slab 
     391            !                                             ! =============== 
     392 
     393            !                                             ! -------- 
     394            ! Horizontal divergence                       !   div 
     395            !                                             ! -------- 
     396            DO jj = j1+1,j2 
     397               DO ji = i1,i2   ! vector opt. 
     398                  zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     399                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
     400                                     &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     401               END DO 
     402            END DO 
     403            DO jj = j1,j2 
     404               DO ji = i1,i2-1   ! vector opt. 
     405                  zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     406                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
     407                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) & 
     408                                    & ) * fmask(ji,jj,jk) * zbtr 
     409               END DO 
     410            END DO 
     411         ENDDO 
     412 
     413         !                                                ! =============== 
     414         !                                                 
     415 
     416         imax = i2-1 
     417         IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 
     418 
     419         DO jj = j1+1, j2 
     420            DO ji = i1+1, imax   ! vector opt. 
     421               IF (.NOT. tabspongedone_u(ji,jj)) THEN 
     422                  DO jk = 1, jpkm1                                 ! Horizontal slab 
     423                     ze2u = rotdiff (ji,jj,jk) 
     424                     ze1v = hdivdiff(ji,jj,jk) 
     425                     ! horizontal diffusive trends 
     426                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
     427                           / e1u(ji,jj) 
     428 
     429 
     430                     ! add it to the general momentum trends 
     431                     ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     432                  END DO 
     433 
     434               ENDIF 
     435            END DO 
     436         END DO 
     437 
     438         tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 
     439 
     440         DO jj = j1+1, j2-1 
     441            DO ji = i1+1, i2-1   ! vector opt. 
     442               IF (.NOT. tabspongedone_v(ji,jj)) THEN 
     443                  DO jk = 1, jpkm1                                 ! Horizontal slab 
     444                     ze2u = rotdiff (ji,jj,jk) 
     445                     ze1v = hdivdiff(ji,jj,jk) 
     446                     ! horizontal diffusive trends 
     447 
     448                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
     449                           / e2v(ji,jj) 
     450 
     451                     ! add it to the general momentum trends 
     452                     va(ji,jj,jk) = va(ji,jj,jk) + zva 
     453                  END DO 
     454               ENDIF 
     455            END DO 
     456         END DO 
     457         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
     458      ENDIF 
     459 
     460   END SUBROUTINE interpvn_sponge 
    391461 
    392462#else 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r4491 r6204  
    1 #define TWO_WAY 
    2  
     1#define TWO_WAY        /* TWO WAY NESTING */ 
     2#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 
     3  
    34MODULE agrif_opa_update 
    45#if defined key_agrif  && ! defined key_offline 
    … …  
    1112   USE wrk_nemo   
    1213   USE dynspg_oce 
     14   USE zdf_oce        ! vertical physics: ocean variables  
    1315 
    1416   IMPLICIT NONE 
    1517   PRIVATE 
    1618 
    17    PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 
    18  
    19    INTEGER, PUBLIC :: nbcline = 0 
    20  
     19   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 
     20# if defined key_zdftke 
     21   PUBLIC Agrif_Update_Tke 
     22# endif 
    2123   !!---------------------------------------------------------------------- 
    22    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     24   !! NEMO/NST 3.6 , NEMO Consortium (2010) 
    2325   !! $Id$ 
    2426   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    2729CONTAINS 
    2830 
    29    SUBROUTINE Agrif_Update_Tra( kt ) 
     31   RECURSIVE SUBROUTINE Agrif_Update_Tra( ) 
    3032      !!--------------------------------------------- 
    3133      !!   *** ROUTINE Agrif_Update_Tra *** 
    3234      !!--------------------------------------------- 
    33       !! 
    34       INTEGER, INTENT(in) :: kt 
    35       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    36  
    37  
    38       IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    39 #if defined TWO_WAY 
    40       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab ) 
     35      !  
     36      IF (Agrif_Root()) RETURN 
     37      ! 
     38#if defined TWO_WAY   
     39      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline 
    4140 
    4241      Agrif_UseSpecialValueInUpdate = .TRUE. 
    4342      Agrif_SpecialValueFineGrid = 0. 
    44  
     43      !  
    4544      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    46          CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 
    47       ELSE 
    48          CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 
    49       ENDIF 
    50  
     45# if ! defined DECAL_FEEDBACK 
     46         CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 
     47# else 
     48         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 
     49# endif 
     50      ELSE 
     51# if ! defined DECAL_FEEDBACK 
     52         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 
     53# else 
     54         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 
     55# endif 
     56      ENDIF 
     57      ! 
    5158      Agrif_UseSpecialValueInUpdate = .FALSE. 
    52  
    53       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 
     59      ! 
     60      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 
     61         CALL Agrif_ChildGrid_To_ParentGrid() 
     62         CALL Agrif_Update_Tra() 
     63         CALL Agrif_ParentGrid_To_ChildGrid() 
     64      ENDIF 
     65      ! 
    5466#endif 
    55  
     67      ! 
    5668   END SUBROUTINE Agrif_Update_Tra 
    5769 
    58    SUBROUTINE Agrif_Update_Dyn( kt ) 
     70   RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 
    5971      !!--------------------------------------------- 
    6072      !!   *** ROUTINE Agrif_Update_Dyn *** 
    6173      !!--------------------------------------------- 
    62       !! 
    63       INTEGER, INTENT(in) :: kt 
    64       REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 
    65       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
    66  
    67  
    68       IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return 
     74      !  
     75      IF (Agrif_Root()) RETURN 
     76      ! 
    6977#if defined TWO_WAY 
    70       CALL wrk_alloc( jpi, jpj,      ztab2d ) 
    71       CALL wrk_alloc( jpi, jpj, jpk, ztab   ) 
    72  
     78      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline 
     79 
     80      Agrif_UseSpecialValueInUpdate = .FALSE. 
     81      Agrif_SpecialValueFineGrid = 0. 
     82      !      
    7383      IF (mod(nbcline,nbclineupdate) == 0) THEN 
    74          CALL Agrif_Update_Variable(ztab,un_id,procname = updateU) 
    75          CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV) 
    76       ELSE 
    77          CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU) 
    78          CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV)          
    79       ENDIF 
    80  
    81       CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d) 
    82       CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d) 
    83  
    84 #if defined key_dynspg_ts 
     84# if ! defined DECAL_FEEDBACK 
     85         CALL Agrif_Update_Variable(un_update_id,procname = updateU) 
     86         CALL Agrif_Update_Variable(vn_update_id,procname = updateV) 
     87# else 
     88         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU) 
     89         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV) 
     90# endif 
     91      ELSE 
     92# if ! defined DECAL_FEEDBACK 
     93         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU) 
     94         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)          
     95# else 
     96         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU) 
     97         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV) 
     98# endif 
     99      ENDIF 
     100 
     101# if ! defined DECAL_FEEDBACK 
     102      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d) 
     103      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)   
     104# else 
     105      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d) 
     106      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)   
     107# endif 
     108 
     109# if defined key_dynspg_ts 
    85110      IF (ln_bt_fw) THEN 
    86111         ! Update time integrated transports 
    87112         IF (mod(nbcline,nbclineupdate) == 0) THEN 
    88             CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b) 
    89             CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b) 
     113#  if ! defined DECAL_FEEDBACK 
     114            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 
     115            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 
     116#  else 
     117            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b) 
     118            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b) 
     119#  endif 
    90120         ELSE 
    91             CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b) 
    92             CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b) 
     121#  if ! defined DECAL_FEEDBACK 
     122            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b) 
     123            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b) 
     124#  else 
     125            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b) 
     126            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b) 
     127#  endif 
    93128         ENDIF 
    94       END IF  
     129      END IF 
     130# endif 
     131      ! 
     132      nbcline = nbcline + 1 
     133      ! 
     134      Agrif_UseSpecialValueInUpdate = .TRUE. 
     135      Agrif_SpecialValueFineGrid = 0. 
     136# if ! defined DECAL_FEEDBACK 
     137      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 
     138# else 
     139      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH) 
     140# endif 
     141      Agrif_UseSpecialValueInUpdate = .FALSE. 
     142      !  
    95143#endif 
    96  
    97       nbcline = nbcline + 1 
    98  
    99       Agrif_UseSpecialValueInUpdate = .TRUE.  
     144      ! 
     145      ! Do recursive update: 
     146      IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 
     147         CALL Agrif_ChildGrid_To_ParentGrid() 
     148         CALL Agrif_Update_Dyn() 
     149         CALL Agrif_ParentGrid_To_ChildGrid() 
     150      ENDIF 
     151      ! 
     152   END SUBROUTINE Agrif_Update_Dyn 
     153 
     154# if defined key_zdftke 
     155   SUBROUTINE Agrif_Update_Tke( kt ) 
     156      !!--------------------------------------------- 
     157      !!   *** ROUTINE Agrif_Update_Tke *** 
     158      !!--------------------------------------------- 
     159      !! 
     160      INTEGER, INTENT(in) :: kt 
     161      !        
     162      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 
     163#  if defined TWO_WAY 
     164 
     165      Agrif_UseSpecialValueInUpdate = .TRUE. 
    100166      Agrif_SpecialValueFineGrid = 0. 
    101       CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH) 
     167 
     168      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  ) 
     169      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 
     170      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 
     171 
    102172      Agrif_UseSpecialValueInUpdate = .FALSE. 
    103173 
    104       CALL wrk_dealloc( jpi, jpj,      ztab2d ) 
    105       CALL wrk_dealloc( jpi, jpj, jpk, ztab   ) 
    106  
    107 !Done in step 
    108 !      CALL Agrif_ChildGrid_To_ParentGrid() 
    109 !      CALL recompute_diags( kt ) 
    110 !      CALL Agrif_ParentGrid_To_ChildGrid() 
    111  
    112 #endif 
    113  
    114    END SUBROUTINE Agrif_Update_Dyn 
    115  
    116    SUBROUTINE recompute_diags( kt ) 
    117       !!--------------------------------------------- 
    118       !!   *** ROUTINE recompute_diags *** 
    119       !!--------------------------------------------- 
    120       INTEGER, INTENT(in) :: kt 
    121  
    122    END SUBROUTINE recompute_diags 
     174#  endif 
     175       
     176   END SUBROUTINE Agrif_Update_Tke 
     177# endif /* key_zdftke */ 
    123178 
    124179   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    … …  
    127182      !!--------------------------------------------- 
    128183#  include "domzgr_substitute.h90" 
    129  
    130184      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    131185      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    132       LOGICAL, iNTENT(in) :: before 
    133  
     186      LOGICAL, INTENT(in) :: before 
     187      !! 
    134188      INTEGER :: ji,jj,jk,jn 
    135  
     189      !!--------------------------------------------- 
     190      ! 
    136191      IF (before) THEN 
    137192         DO jn = n1,n2 
    … …  
    146201      ELSE 
    147202         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    148          ! Add asselin part 
     203            ! Add asselin part 
    149204            DO jn = n1,n2 
    150205               DO jk=k1,k2 
    … …  
    153208                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
    154209                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
    155                               & + atfp * ( tabres(ji,jj,jk,jn) & 
    156                               &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     210                                 & + atfp * ( tabres(ji,jj,jk,jn) & 
     211                                 &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    157212                        ENDIF 
    158213                     ENDDO 
    … …  
    161216            ENDDO 
    162217         ENDIF 
    163  
    164218         DO jn = n1,n2 
    165219            DO jk=k1,k2 
    … …  
    174228         END DO 
    175229      ENDIF 
    176  
     230      !  
    177231   END SUBROUTINE updateTS 
    178232 
    … …  
    182236      !!--------------------------------------------- 
    183237#  include "domzgr_substitute.h90" 
    184  
     238      !! 
    185239      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    186240      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    187241      LOGICAL, INTENT(in) :: before 
    188  
     242      !!  
    189243      INTEGER :: ji, jj, jk 
    190244      REAL(wp) :: zrhoy 
    191  
     245      !!--------------------------------------------- 
     246      !  
    192247      IF (before) THEN 
    193248         zrhoy = Agrif_Rhoy() 
    … …  
    209264                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    210265                     ub(ji,jj,jk) = ub(ji,jj,jk) &  
    211                        & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     266                           & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
    212267                  ENDIF 
    213268                  ! 
    … …  
    217272         END DO 
    218273      ENDIF 
    219  
     274      !  
    220275   END SUBROUTINE updateu 
    221276 
    … …  
    225280      !!--------------------------------------------- 
    226281#  include "domzgr_substitute.h90" 
    227  
     282      !! 
    228283      INTEGER :: i1,i2,j1,j2,k1,k2 
    229284      INTEGER :: ji,jj,jk 
    230285      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 
    231286      LOGICAL :: before 
    232  
     287      !! 
    233288      REAL(wp) :: zrhox 
    234  
     289      !!---------------------------------------------       
     290      ! 
    235291      IF (before) THEN 
    236292         zrhox = Agrif_Rhox() 
    … …  
    252308                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    253309                     vb(ji,jj,jk) = vb(ji,jj,jk) &  
    254                        & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     310                           & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
    255311                  ENDIF 
    256312                  ! 
    … …  
    260316         END DO 
    261317      ENDIF 
    262  
     318      !  
    263319   END SUBROUTINE updatev 
    264320 
    … …  
    268324      !!--------------------------------------------- 
    269325#  include "domzgr_substitute.h90" 
    270  
     326      !! 
    271327      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    272328      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    273329      LOGICAL, INTENT(in) :: before 
    274  
     330      !!  
    275331      INTEGER :: ji, jj, jk 
    276332      REAL(wp) :: zrhoy 
    277333      REAL(wp) :: zcorr 
    278  
     334      !!--------------------------------------------- 
     335      ! 
    279336      IF (before) THEN 
    280337         zrhoy = Agrif_Rhoy() 
    … …  
    326383         END DO 
    327384      ENDIF 
    328  
     385      ! 
    329386   END SUBROUTINE updateu2d 
    330387 
    … …  
    333390      !!          *** ROUTINE updatev2d *** 
    334391      !!--------------------------------------------- 
    335  
    336392      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    337393      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    338394      LOGICAL, INTENT(in) :: before 
    339  
     395      !!  
    340396      INTEGER :: ji, jj, jk 
    341397      REAL(wp) :: zrhox 
    342398      REAL(wp) :: zcorr 
    343  
     399      !!--------------------------------------------- 
     400      ! 
    344401      IF (before) THEN 
    345402         zrhox = Agrif_Rhox() 
    … …  
    391448         END DO 
    392449      ENDIF 
    393  
     450      !  
    394451   END SUBROUTINE updatev2d 
    395452 
     453 
    396454   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 
    397455      !!--------------------------------------------- 
    398456      !!          *** ROUTINE updateSSH *** 
    399457      !!--------------------------------------------- 
    400 #  include "domzgr_substitute.h90" 
    401  
    402458      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    403459      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    404460      LOGICAL, INTENT(in) :: before 
    405  
     461      !! 
    406462      INTEGER :: ji, jj 
    407  
     463      !!--------------------------------------------- 
     464      !  
    408465      IF (before) THEN 
    409466         DO jj=j1,j2 
    … …  
    413470         END DO 
    414471      ELSE 
    415  
    416472#if ! defined key_dynspg_ts 
    417473         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    418474            DO jj=j1,j2 
    419475               DO ji=i1,i2 
    420                 sshb(ji,jj) =   sshb(ji,jj) & 
    421                  & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     476                  sshb(ji,jj) =   sshb(ji,jj) & 
     477                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
    422478               END DO 
    423479            END DO 
    … …  
    430486         END DO 
    431487      ENDIF 
    432  
     488      ! 
    433489   END SUBROUTINE updateSSH 
    434490 
    … …  
    437493      !!          *** ROUTINE updateub2b *** 
    438494      !!--------------------------------------------- 
    439  
    440495      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    441496      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    442497      LOGICAL, INTENT(in) :: before 
    443  
     498      !! 
    444499      INTEGER :: ji, jj 
    445500      REAL(wp) :: zrhoy 
    446  
     501      !!--------------------------------------------- 
     502      ! 
    447503      IF (before) THEN 
    448504         zrhoy = Agrif_Rhoy() 
    … …  
    460516         END DO 
    461517      ENDIF 
    462  
     518      ! 
    463519   END SUBROUTINE updateub2b 
    464520 
    … …  
    467523      !!          *** ROUTINE updatevb2b *** 
    468524      !!--------------------------------------------- 
    469  
    470525      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    471526      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    472527      LOGICAL, INTENT(in) :: before 
    473  
     528      !! 
    474529      INTEGER :: ji, jj 
    475530      REAL(wp) :: zrhox 
    476  
     531      !!--------------------------------------------- 
     532      ! 
    477533      IF (before) THEN 
    478534         zrhox = Agrif_Rhox() 
    … …  
    490546         END DO 
    491547      ENDIF 
    492  
     548      ! 
    493549   END SUBROUTINE updatevb2b 
     550 
     551 
     552   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 
     553      ! currently not used 
     554      !!--------------------------------------------- 
     555      !!           *** ROUTINE updateT *** 
     556      !!--------------------------------------------- 
     557#  include "domzgr_substitute.h90" 
     558 
     559      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     560      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     561      LOGICAL, iNTENT(in) :: before 
     562 
     563      INTEGER :: ji,jj,jk 
     564      REAL(wp) :: ztemp 
     565 
     566      IF (before) THEN 
     567         DO jk=k1,k2 
     568            DO jj=j1,j2 
     569               DO ji=i1,i2 
     570                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 
     571                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk) 
     572                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk) 
     573               END DO 
     574            END DO 
     575         END DO 
     576         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy() 
     577         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox() 
     578         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy() 
     579      ELSE 
     580         DO jk=k1,k2 
     581            DO jj=j1,j2 
     582               DO ji=i1,i2 
     583                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN  
     584                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 
     585                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk) 
     586                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk) 
     587                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3))) 
     588                     print *,'CORR = ',ztemp-1. 
     589                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, & 
     590                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp 
     591                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp 
     592                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp 
     593                  END IF 
     594               END DO 
     595            END DO 
     596         END DO 
     597      ENDIF 
     598      ! 
     599   END SUBROUTINE update_scales 
     600 
     601# if defined key_zdftke 
     602   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 
     603      !!--------------------------------------------- 
     604      !!           *** ROUTINE updateen *** 
     605      !!--------------------------------------------- 
     606      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     607      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     608      LOGICAL, INTENT(in) :: before 
     609      !!--------------------------------------------- 
     610      ! 
     611      IF (before) THEN 
     612         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 
     613      ELSE 
     614         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     615      ENDIF 
     616      ! 
     617   END SUBROUTINE updateEN 
     618 
     619 
     620   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 
     621      !!--------------------------------------------- 
     622      !!           *** ROUTINE updateavt *** 
     623      !!--------------------------------------------- 
     624      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     625      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     626      LOGICAL, INTENT(in) :: before 
     627      !!--------------------------------------------- 
     628      ! 
     629      IF (before) THEN 
     630         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 
     631      ELSE 
     632         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     633      ENDIF 
     634      ! 
     635   END SUBROUTINE updateAVT 
     636 
     637 
     638   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 
     639      !!--------------------------------------------- 
     640      !!           *** ROUTINE updateavm *** 
     641      !!--------------------------------------------- 
     642      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     643      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     644      LOGICAL, INTENT(in) :: before 
     645      !!--------------------------------------------- 
     646      ! 
     647      IF (before) THEN 
     648         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     649      ELSE 
     650         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)  
     651      ENDIF 
     652      ! 
     653   END SUBROUTINE updateAVM 
     654 
     655# endif /* key_zdftke */  
    494656 
    495657#else 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90

    r3680 r6204  
    77   USE agrif_oce 
    88   USE agrif_top_sponge 
     9   USE par_trc 
    910   USE trc 
    1011   USE lib_mpp 
    … …  
    1415   PRIVATE 
    1516 
    16    PUBLIC Agrif_trc 
     17   PUBLIC Agrif_trc, interptrn 
    1718 
    1819#  include "domzgr_substitute.h90"   
    1920#  include "vectopt_loop_substitute.h90" 
    2021  !!---------------------------------------------------------------------- 
    21    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     22   !! NEMO/NST 3.6 , NEMO Consortium (2010) 
    2223   !! $Id$ 
    2324   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    2829   SUBROUTINE Agrif_trc 
    2930      !!---------------------------------------------------------------------- 
    30       !!                  ***  ROUTINE Agrif_Tra  *** 
    31       !!---------------------------------------------------------------------- 
    32       !! 
    33       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    34       REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
    35       REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    36       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 
     31      !!                  ***  ROUTINE Agrif_trc  *** 
    3732      !!---------------------------------------------------------------------- 
    3833      ! 
    3934      IF( Agrif_Root() )   RETURN 
    4035 
    41       CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    42  
    4336      Agrif_SpecialValue    = 0.e0 
    4437      Agrif_UseSpecialValue = .TRUE. 
    45       ztra(:,:,:,:) = 0.e0 
    4638 
    47       CALL Agrif_Bc_variable( ztra, trn_id, procname=interptrn ) 
     39      CALL Agrif_Bc_variable( trn_id, procname=interptrn ) 
    4840      Agrif_UseSpecialValue = .FALSE. 
     41      ! 
     42   END SUBROUTINE Agrif_trc 
    4943 
    50       zrhox = Agrif_Rhox() 
     44   SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
     45      !!--------------------------------------------- 
     46      !!   *** ROUTINE interptrn *** 
     47      !!--------------------------------------------- 
     48      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
     49      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     50      LOGICAL, INTENT(in) :: before 
     51      INTEGER, INTENT(in) :: nb , ndir 
     52      ! 
     53      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     54      INTEGER :: imin, imax, jmin, jmax 
     55      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
     56      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
     57      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
    5158 
    52       alpha1 = ( zrhox - 1. ) * 0.5 
    53       alpha2 = 1. - alpha1 
    54  
    55       alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
    56       alpha4 = 1. - alpha3 
    57  
    58       alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
    59       alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
    60       alpha5 = 1. - alpha6 - alpha7 
    61       IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    62  
    63          DO jn = 1, jptra 
    64             tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 
    65             DO jk = 1, jpkm1 
    66                DO jj = 1, jpj 
    67                   IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    68                      tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
    69                   ELSE 
    70                      tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
    71                      IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    72                         tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn)  & 
    73                            &                 + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     59      IF (before) THEN          
     60         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     61      ELSE 
     62         ! 
     63         western_side  = (nb == 1).AND.(ndir == 1) 
     64         eastern_side  = (nb == 1).AND.(ndir == 2) 
     65         southern_side = (nb == 2).AND.(ndir == 1) 
     66         northern_side = (nb == 2).AND.(ndir == 2) 
     67         ! 
     68         zrhox = Agrif_Rhox() 
     69         !  
     70         zalpha1 = ( zrhox - 1. ) * 0.5 
     71         zalpha2 = 1. - zalpha1 
     72         !  
     73         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     74         zalpha4 = 1. - zalpha3 
     75         !  
     76         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     77         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     78         zalpha5 = 1. - zalpha6 - zalpha7 
     79         ! 
     80         imin = i1 
     81         imax = i2 
     82         jmin = j1 
     83         jmax = j2 
     84         !  
     85         ! Remove CORNERS 
     86         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     87         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     88         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     89         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     90         ! 
     91         IF( eastern_side) THEN 
     92            DO jn = 1, jptra 
     93               tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     94               DO jk = 1, jpkm1 
     95                  DO jj = jmin,jmax 
     96                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     97                        tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     98                     ELSE 
     99                        tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     100                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     101                           tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) &  
     102                                 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     103                        ENDIF 
    74104                     ENDIF 
    75                   ENDIF 
     105                  END DO 
     106               END DO 
     107            ENDDO 
     108         ENDIF 
     109         !  
     110         IF( northern_side ) THEN             
     111            DO jn = 1, jptra 
     112               tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     113               DO jk = 1, jpkm1 
     114                  DO ji = imin,imax 
     115                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     116                        tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     117                     ELSE 
     118                        tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     119                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     120                           tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn)  & 
     121                                 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     122                        ENDIF 
     123                     ENDIF 
     124                  END DO 
     125               END DO 
     126            ENDDO 
     127         ENDIF 
     128         ! 
     129         IF( western_side) THEN             
     130            DO jn = 1, jptra 
     131               tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
     132               DO jk = 1, jpkm1 
     133                  DO jj = jmin,jmax 
     134                     IF( umask(2,jj,jk) == 0.e0 ) THEN 
     135                        tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
     136                     ELSE 
     137                        tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)         
     138                        IF( un(2,jj,jk) < 0.e0 ) THEN 
     139                           tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
     140                        ENDIF 
     141                     ENDIF 
     142                  END DO 
    76143               END DO 
    77144            END DO 
    78          ENDDO 
    79       ENDIF 
    80  
    81       IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    82  
    83          DO jn = 1, jptra 
    84             tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 
    85             DO jk = 1, jpkm1 
    86                DO ji = 1, jpi 
    87                   IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    88                      tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
    89                   ELSE 
    90                      tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 
    91                      IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    92                         tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn)  & 
    93                            &                 + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     145         ENDIF 
     146         ! 
     147         IF( southern_side ) THEN            
     148            DO jn = 1, jptra 
     149               tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
     150               DO jk=1,jpk       
     151                  DO ji=imin,imax 
     152                     IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     153                        tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
     154                     ELSE 
     155                        tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
     156                        IF( vn(ji,2,jk) < 0.e0 ) THEN 
     157                           tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
     158                        ENDIF 
    94159                     ENDIF 
    95                   ENDIF 
     160                  END DO 
    96161               END DO 
    97             END DO 
    98          ENDDO 
    99       ENDIF 
    100       IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    101          DO jn = 1, jptra 
    102             tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 
    103             DO jk = 1, jpkm1 
    104                DO jj = 1, jpj 
    105                   IF( umask(2,jj,jk) == 0.e0 ) THEN 
    106                      tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 
    107                   ELSE 
    108                      tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 
    109                      IF( un(2,jj,jk) < 0.e0 ) THEN 
    110                         tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 
    111                      ENDIF 
    112                   ENDIF 
    113                END DO 
    114             END DO 
    115          END DO 
    116       ENDIF 
    117  
    118       IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    119          DO jn = 1, jptra 
    120             tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 
    121             DO jk=1,jpk 
    122                DO ji=1,jpi 
    123                   IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    124                      tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 
    125                   ELSE 
    126                      tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 
    127                      IF( vn(ji,2,jk) < 0.e0 ) THEN 
    128                         tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 
    129                      ENDIF 
    130                   ENDIF 
    131                END DO 
    132             END DO 
    133          ENDDO 
     162            ENDDO 
     163         ENDIF 
     164         ! 
     165         ! Treatment of corners 
     166         !  
     167         ! East south 
     168         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     169            tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
     170         ENDIF 
     171         ! East north 
     172         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     173            tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
     174         ENDIF 
     175         ! West south 
     176         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     177            tra(2,2,:,:) = ptab(2,2,:,:) 
     178         ENDIF 
     179         ! West north 
     180         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     181            tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
     182         ENDIF 
     183         ! 
    134184      ENDIF 
    135185      ! 
    136       CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
    137       ! 
    138  
    139    END SUBROUTINE Agrif_trc 
     186   END SUBROUTINE interptrn 
    140187 
    141188#else 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r3680 r6204  
    11#define SPONGE_TOP 
    22 
    3 Module agrif_top_sponge 
     3MODULE agrif_top_sponge 
    44#if defined key_agrif && defined key_top 
    55   USE par_oce 
     6   USE par_trc 
    67   USE oce 
    78   USE dom_oce 
    … …  
    1617   PRIVATE 
    1718 
    18    PUBLIC Agrif_Sponge_Trc, interptrn 
     19   PUBLIC Agrif_Sponge_trc, interptrn_sponge 
    1920 
    20   !! * Substitutions 
     21   !! * Substitutions 
    2122#  include "domzgr_substitute.h90" 
    2223   !!---------------------------------------------------------------------- 
    23    !! NEMO/NST 3.3 , NEMO Consortium (2010) 
     24   !! NEMO/NST 3.6 , NEMO Consortium (2010) 
    2425   !! $Id$ 
    2526   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2627   !!---------------------------------------------------------------------- 
    2728 
    28    CONTAINS 
     29CONTAINS 
    2930 
    30    SUBROUTINE Agrif_Sponge_Trc 
     31   SUBROUTINE Agrif_Sponge_trc 
    3132      !!--------------------------------------------- 
    3233      !!   *** ROUTINE Agrif_Sponge_Trc *** 
    3334      !!--------------------------------------------- 
    3435      !!  
    35       INTEGER :: ji,jj,jk,jn 
    3636      REAL(wp) :: timecoeff 
    37       REAL(wp) :: ztra, zabe1, zabe2, zbtr 
    38       REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv 
    39       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr 
    40       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff 
    4137 
    4238#if defined SPONGE_TOP 
    43       CALL wrk_alloc( jpi, jpj, ztru, ztrv ) 
    44       CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff ) 
    45  
    4639      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    47  
     40      CALL Agrif_sponge 
    4841      Agrif_SpecialValue=0. 
    4942      Agrif_UseSpecialValue = .TRUE. 
    50       ztabr = 0.e0 
    51       CALL Agrif_Bc_Variable(ztabr, tra_id,calledweight=timecoeff,procname=interptrn) 
     43      tabspongedone_trn = .FALSE. 
     44      CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge) 
    5245      Agrif_UseSpecialValue = .FALSE. 
    53  
    54       trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:) 
    55  
    56       CALL Agrif_sponge 
    57  
    58       DO jn = 1, jptra 
    59          DO jk = 1, jpkm1 
    60             ! 
    61             DO jj = 1, jpjm1 
    62                DO ji = 1, jpim1 
    63                   zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    64                   zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    65                   ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    66                   ztrv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    67                ENDDO 
    68             ENDDO 
    69  
    70             DO jj = 2,jpjm1 
    71                DO ji = 2,jpim1 
    72                   zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    73                   ! horizontal diffusive trends 
    74                   ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1)  ) 
    75                   ! add it to the general tracer trends 
    76                   tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    77                END DO 
    78             END DO 
    79             ! 
    80          ENDDO 
    81       ENDDO 
    82   
    83       CALL wrk_dealloc( jpi, jpj, ztru, ztrv ) 
    84       CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr ) 
    8546 
    8647#endif 
    … …  
    8849   END SUBROUTINE Agrif_Sponge_Trc 
    8950 
    90    SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
     51   SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
    9152      !!--------------------------------------------- 
    92       !!   *** ROUTINE interptn *** 
     53      !!   *** ROUTINE interptrn_sponge *** 
    9354      !!--------------------------------------------- 
    9455      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    9556      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     57      LOGICAL, INTENT(in) :: before 
     58 
     59 
     60      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     61 
     62      REAL(wp) :: ztra, zabe1, zabe2, zbtr 
     63      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 
     64      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff 
    9665      ! 
    97       tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     66      IF (before) THEN 
     67         tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     68      ELSE       
    9869 
    99    END SUBROUTINE interptrn 
     70         trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)       
     71         DO jn = 1, jptra 
     72            DO jk = 1, jpkm1 
     73 
     74               DO jj = j1,j2-1 
     75                  DO ji = i1,i2-1 
     76                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
     77                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     78                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     79                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     80                  ENDDO 
     81               ENDDO 
     82 
     83               DO jj = j1+1,j2-1 
     84                  DO ji = i1+1,i2-1 
     85 
     86                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN  
     87                        zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk) 
     88                        ! horizontal diffusive trends 
     89                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
     90                        ! add it to the general tracer trends 
     91                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     92                     ENDIF 
     93 
     94                  ENDDO 
     95               ENDDO 
     96 
     97            ENDDO 
     98         ENDDO 
     99 
     100         tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
     101      ENDIF 
     102      !                  
     103   END SUBROUTINE interptrn_sponge 
    100104 
    101105#else 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r4491 r6204  
    11#define TWO_WAY 
     2#undef DECAL_FEEDBACK 
    23 
    34MODULE agrif_top_update 
    … …  
    89   USE dom_oce 
    910   USE agrif_oce 
     11   USE par_trc 
    1012   USE trc 
    1113   USE wrk_nemo   
    … …  
    2426   !!---------------------------------------------------------------------- 
    2527 
    26    CONTAINS 
     28CONTAINS 
    2729 
    2830   SUBROUTINE Agrif_Update_Trc( kt ) 
    … …  
    3032      !!   *** ROUTINE Agrif_Update_Trc *** 
    3133      !!--------------------------------------------- 
    32       !! 
    3334      INTEGER, INTENT(in) :: kt 
    34       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 
    35  
    36    
    37       IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    38  
    39 #if defined TWO_WAY 
    40       CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 
    41  
     35      !!--------------------------------------------- 
     36      !  
     37      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
     38#if defined TWO_WAY    
    4239      Agrif_UseSpecialValueInUpdate = .TRUE. 
    4340      Agrif_SpecialValueFineGrid = 0. 
    44   
    45      IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 
    46          CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC) 
     41      !  
     42      IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 
     43# if ! defined DECAL_FEEDBACK 
     44         CALL Agrif_Update_Variable(trn_id, procname=updateTRC) 
     45# else 
     46         CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC) 
     47# endif 
    4748      ELSE 
    48          CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC) 
     49# if ! defined DECAL_FEEDBACK 
     50         CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC) 
     51# else 
     52         CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC) 
     53# endif 
    4954      ENDIF 
    50  
     55      ! 
    5156      Agrif_UseSpecialValueInUpdate = .FALSE. 
    5257      nbcline_trc = nbcline_trc + 1 
    53  
    54       CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 
    5558#endif 
    56  
     59      ! 
    5760   END SUBROUTINE Agrif_Update_Trc 
    5861 
    59    SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
     62   SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    6063      !!--------------------------------------------- 
    61       !!   *** ROUTINE UpdateTrc *** 
     64      !!           *** ROUTINE updateT *** 
    6265      !!--------------------------------------------- 
     66#  include "domzgr_substitute.h90" 
    6367      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    64       REAL, DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     68      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
    6569      LOGICAL, INTENT(in) :: before 
    66     
     70      !! 
    6771      INTEGER :: ji,jj,jk,jn 
    68  
    69          IF( before ) THEN 
    70             DO jn = n1, n2 
    71                DO jk = k1, k2 
    72                   DO jj = j1, j2 
    73                      DO ji = i1, i2 
    74                         tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    75                      ENDDO 
    76                   ENDDO 
    77                ENDDO 
    78             ENDDO 
    79          ELSE 
    80             IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     72      !!--------------------------------------------- 
     73      ! 
     74      IF (before) THEN 
     75         DO jn = n1,n2 
     76            DO jk=k1,k2 
     77               DO jj=j1,j2 
     78                  DO ji=i1,i2 
     79                     ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     80                  END DO 
     81               END DO 
     82            END DO 
     83         END DO 
     84      ELSE 
     85         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    8186            ! Add asselin part 
    82                DO jn = n1, n2 
    83                   DO jk = k1, k2 
    84                      DO jj = j1, j2 
    85                         DO ji = i1, i2 
    86                            IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
    87                               trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) &  
    88                                  & + atfp * ( tabres(ji,jj,jk,jn) & 
    89                                                - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    90                            ENDIF 
    91                         ENDDO 
    92                      ENDDO 
    93                   ENDDO 
    94                ENDDO 
    95             ENDIF 
    96  
    97             DO jn = n1, n2 
    98                DO jk = k1, k2 
    99                   DO jj = j1, j2 
    100                      DO ji = i1, i2 
    101                         IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
    102                            trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     87            DO jn = n1,n2 
     88               DO jk=k1,k2 
     89                  DO jj=j1,j2 
     90                     DO ji=i1,i2 
     91                        IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 
     92                           trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) &  
     93                                 & + atfp * ( ptab(ji,jj,jk,jn) & 
     94                                 &             - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    10395                        ENDIF 
    10496                     ENDDO 
    … …  
    10799            ENDDO 
    108100         ENDIF 
    109  
     101         DO jn = n1,n2 
     102            DO jk=k1,k2 
     103               DO jj=j1,j2 
     104                  DO ji=i1,i2 
     105                     IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN  
     106                        trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     107                     END IF 
     108                  END DO 
     109               END DO 
     110            END DO 
     111         END DO 
     112      ENDIF 
     113      !  
    110114   END SUBROUTINE updateTRC 
    111115 
    … …  
    119123   END SUBROUTINE agrif_top_update_empty 
    120124#endif 
    121 END Module agrif_top_update 
     125END MODULE agrif_top_update 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r5574 r6204  
    3030      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    3131      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    32       jpk     = jpkdta  
     32! JC: change to allow for different vertical levels 
     33!     jpk is already set 
     34!     keep it jpk possibly different from jpkdta which  
     35!     hold parent grid vertical levels number (set earlier) 
     36!      jpk     = jpkdta  
    3337      jpim1   = jpi-1  
    3438      jpjm1   = jpj-1  
    … …  
    6367   ! 0. Initializations 
    6468   !------------------- 
    65    IF( cp_cfg == 'orca' ) then 
     69   IF( cp_cfg == 'orca' ) THEN 
    6670      IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 & 
    67   &                      .OR. jp_cfg == 4 ) THEN 
     71            &                      .OR. jp_cfg == 4 ) THEN 
    6872         jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    6973         cp_cfg = "default" 
    … …  
    119123SUBROUTINE agrif_declare_var_dom 
    120124   !!---------------------------------------------------------------------- 
    121    !!                 *** ROUTINE agrif_declarE_var *** 
     125   !!                 *** ROUTINE agrif_declare_var *** 
    122126   !! 
    123127   !! ** Purpose :: Declaration of variables to be interpolated 
    124128   !!---------------------------------------------------------------------- 
    125129   USE agrif_util 
    126    USE par_oce       !   ONLY : jpts 
     130   USE par_oce        
    127131   USE oce 
    128132   IMPLICIT NONE 
    … …  
    131135   ! 1. Declaration of the type of variable which have to be interpolated 
    132136   !--------------------------------------------------------------------- 
    133    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    134    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    135  
     137   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     138   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    136139 
    137140   ! 2. Type of interpolation 
    138141   !------------------------- 
    139    Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    140    Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     142   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     143   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    141144 
    142145   ! 3. Location of interpolation 
    143146   !----------------------------- 
    144    Call Agrif_Set_bc(e1u_id,(/0,0/)) 
    145    Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     147   CALL Agrif_Set_bc(e1u_id,(/0,0/)) 
     148   CALL Agrif_Set_bc(e2v_id,(/0,0/)) 
    146149 
    147150   ! 5. Update type 
    148151   !---------------  
    149    Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    150    Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    151  
     152   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     153   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     154 
     155! High order updates 
     156!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting) 
     157!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average) 
     158    ! 
    152159END SUBROUTINE agrif_declare_var_dom 
    153160 
    … …  
    166173   USE nemogcm 
    167174   USE sol_oce 
     175   USE lib_mpp 
    168176   USE in_out_manager 
    169177   USE agrif_opa_update 
    … …  
    173181   IMPLICIT NONE 
    174182   ! 
    175    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
    176    REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    177    REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d 
    178183   LOGICAL :: check_namelist 
    179    !!---------------------------------------------------------------------- 
    180  
    181    ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
    182    ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
    183    ALLOCATE( tab2d(jpi, jpj)                ) 
    184  
     184   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 
     185   !!---------------------------------------------------------------------- 
    185186 
    186187   ! 1. Declaration of the type of variable which have to be interpolated 
    … …  
    192193   Agrif_SpecialValue=0. 
    193194   Agrif_UseSpecialValue = .TRUE. 
    194    Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
    195    Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
    196  
    197    Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
    198    Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
    199    Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
    200    Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    201  
    202    Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb) 
    203    Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb) 
    204    Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn) 
    205    Agrif_UseSpecialValue = .FALSE. 
     195   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     196   CALL Agrif_Sponge 
     197   tabspongedone_tsn = .FALSE. 
     198   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
     199   ! reset tsa to zero 
     200   tsa(:,:,:,:) = 0. 
     201 
     202   Agrif_UseSpecialValue = ln_spc_dyn 
     203   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
     204   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     205   tabspongedone_u = .FALSE. 
     206   tabspongedone_v = .FALSE. 
     207   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
     208   tabspongedone_u = .FALSE. 
     209   tabspongedone_v = .FALSE. 
     210   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     211 
     212#if defined key_dynspg_ts 
     213   Agrif_UseSpecialValue = .TRUE. 
     214   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
     215 
     216   Agrif_UseSpecialValue = ln_spc_dyn 
     217   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
     218   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     219   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
     220   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     221   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
     222   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
     223   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
     224   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
     225#endif 
     226 
     227   Agrif_UseSpecialValue = .FALSE.  
     228   ! reset velocities to zero 
     229   ua(:,:,:) = 0. 
     230   va(:,:,:) = 0. 
    206231 
    207232   ! 3. Some controls 
    208233   !----------------- 
    209    check_namelist = .true. 
    210  
    211    IF( check_namelist ) THEN 
     234   check_namelist = .TRUE. 
     235 
     236   IF( check_namelist ) THEN  
    212237 
    213238      ! Check time steps            
    214       IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    215          WRITE(*,*) 'incompatible time step between grids' 
    216          WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    217          WRITE(*,*) 'child  grid value : ',nint(rdt) 
    218          WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    219          STOP 
     239      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     240         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
     241         WRITE(cl_check2,*)  NINT(rdt) 
     242         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
     243         CALL ctl_warn( 'incompatible time step between grids',   & 
     244               &               'parent grid value : '//cl_check1    ,   &  
     245               &               'child  grid value : '//cl_check2    ,   &  
     246               &               'value on child grid will be changed to : '//cl_check3 ) 
     247         rdt=Agrif_Parent(rdt)/Agrif_Rhot() 
    220248      ENDIF 
    221249 
    222250      ! Check run length 
    223251      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    224            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    225          WRITE(*,*) 'incompatible run length between grids' 
    226          WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    227               Agrif_Parent(nit000)+1),' time step' 
    228          WRITE(*,*) 'child  grid value : ', & 
    229               (nitend-nit000+1),' time step' 
    230          WRITE(*,*) 'value on child grid should be : ', & 
    231               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    232               Agrif_Parent(nit000)+1) 
    233          STOP 
     252            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
     253         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     254         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     255         CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     256               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
     257               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     258         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     259         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    234260      ENDIF 
    235261 
    … …  
    237263      IF( ln_zps ) THEN 
    238264         ! check parameters for partial steps  
    239          IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     265         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    240266            WRITE(*,*) 'incompatible e3zps_min between grids' 
    241267            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    … …  
    252278         ENDIF 
    253279      ENDIF 
     280      ! check if masks and bathymetries match 
     281      IF(ln_chk_bathy) THEN 
     282         ! 
     283         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     284         ! 
     285         kindic_agr = 0 
     286         ! check if umask agree with parent along western and eastern boundaries: 
     287         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
     288         ! check if vmask agree with parent along northern and southern boundaries: 
     289         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
     290    ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
     291         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     292         ! 
     293         IF (lk_mpp) CALL mpp_sum( kindic_agr ) 
     294         IF( kindic_agr /= 0 ) THEN                    
     295            CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 
     296         ELSE 
     297            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 
     298         END IF 
     299      ENDIF 
     300      ! 
    254301   ENDIF 
    255  
    256    CALL Agrif_Update_tra(0) 
    257    CALL Agrif_Update_dyn(0) 
    258  
     302   !  
     303   ! Do update at initialisation because not done before writing restarts 
     304   ! This would indeed change boundary conditions values at initial time 
     305   ! hence produce restartability issues. 
     306   ! Note that update below is recursive (with lk_agrif_doupd=T): 
     307   !  
     308! JC: I am not sure if Agrif_MaxLevel() is the "relative" 
     309!     or the absolute maximum nesting level...TBC                         
     310   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN  
     311      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 
     312      CALL Agrif_Update_tra() 
     313      CALL Agrif_Update_dyn() 
     314   ENDIF 
     315   ! 
     316# if defined key_zdftke 
     317!   CALL Agrif_Update_tke(0) 
     318# endif 
     319   ! 
     320   Agrif_UseSpecialValueInUpdate = .FALSE. 
    259321   nbcline = 0 
    260    ! 
    261    DEALLOCATE(tabtstemp) 
    262    DEALLOCATE(tabuvtemp) 
    263    DEALLOCATE(tab2d) 
     322   lk_agrif_doupd = .FALSE. 
    264323   ! 
    265324END SUBROUTINE Agrif_InitValues_cont 
    … …  
    275334   USE par_oce       !   ONLY : jpts 
    276335   USE oce 
     336   USE agrif_oce 
    277337   IMPLICIT NONE 
    278338   !!---------------------------------------------------------------------- 
    … …  
    280340   ! 1. Declaration of the type of variable which have to be interpolated 
    281341   !--------------------------------------------------------------------- 
    282    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    283    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
    284    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
    285  
    286    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    287    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    288    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
    289    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
    290  
    291    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
    292    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
    293    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    294    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
    295    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id) 
    296    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id) 
     342   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     343   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     344 
     345   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
     346   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
     347   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
     348   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
     349   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
     350   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
     351 
     352   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     353   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
     354   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     355 
     356   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
     357 
     358   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     359   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     360   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     361   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     362   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     363   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     364 
     365   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     366 
     367# if defined key_zdftke 
     368   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     369   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
     370   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     371# endif 
    297372 
    298373   ! 2. Type of interpolation 
    299374   !------------------------- 
    300375   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    301    CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    302  
    303    Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    304    Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    305  
    306    Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    307    Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     376 
     377   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     378   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     379 
     380   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    308381 
    309382   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    310    Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    311    Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    312    Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    313    Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     383   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     384   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     385   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     386   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     387 
     388 
     389   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     390   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     391 
     392   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     393   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
     394   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
     395 
     396# if defined key_zdftke 
     397   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 
     398# endif 
     399 
    314400 
    315401   ! 3. Location of interpolation 
    316402   !----------------------------- 
    317    Call Agrif_Set_bc(un_id,(/0,1/)) 
    318    Call Agrif_Set_bc(vn_id,(/0,1/)) 
    319  
    320    Call Agrif_Set_bc(sshn_id,(/0,1/)) 
    321    Call Agrif_Set_bc(unb_id,(/0,1/)) 
    322    Call Agrif_Set_bc(vnb_id,(/0,1/)) 
    323    Call Agrif_Set_bc(ub2b_id,(/0,1/)) 
    324    Call Agrif_Set_bc(vb2b_id,(/0,1/)) 
    325  
    326    Call Agrif_Set_bc(tsn_id,(/0,1/)) 
    327    Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    328  
    329    Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    330    Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     403   CALL Agrif_Set_bc(tsn_id,(/0,1/)) 
     404   CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 
     405   CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 
     406 
     407!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 
     408!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
     409!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
     410   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     411   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     412   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     413 
     414   CALL Agrif_Set_bc(sshn_id,(/0,0/)) 
     415   CALL Agrif_Set_bc(unb_id ,(/0,0/)) 
     416   CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 
     417   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 
     418   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 
     419 
     420   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9 
     421   CALL Agrif_Set_bc(umsk_id,(/0,0/)) 
     422   CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 
     423 
     424# if defined key_zdftke 
     425   CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
     426# endif 
    331427 
    332428   ! 5. Update type 
    333429   !---------------  
    334    Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    335    Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    336  
    337    Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    338    Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
    339  
    340    Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    341    Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    342  
    343    Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    344    Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    345  
     430   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     431 
     432   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     433 
     434   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     435   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     436 
     437   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     438 
     439   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     440   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     441 
     442# if defined key_zdftke 
     443   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
     444   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
     445   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
     446# endif 
     447 
     448! High order updates 
     449!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     450!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     451!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     452! 
     453!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     454!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     455!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
     456  
     457   ! 
    346458END SUBROUTINE agrif_declare_var 
    347459# endif 
    … …  
    364476   IMPLICIT NONE 
    365477   ! 
    366    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel 
    367    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv 
    368    !!---------------------------------------------------------------------- 
    369  
    370    ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7)) 
     478   !!---------------------------------------------------------------------- 
    371479 
    372480   ! 1. Declaration of the type of variable which have to be interpolated 
    … …  
    400508   CALL Agrif_Update_lim2(0) 
    401509   ! 
    402    DEALLOCATE( zvel, zadv ) 
    403    ! 
    404510END SUBROUTINE Agrif_InitValues_cont_lim2 
    405511 
    … …  
    430536   !------------------------- 
    431537   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 
    432    Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    433    Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     538   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     539   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    434540 
    435541   ! 3. Location of interpolation 
    436542   !----------------------------- 
    437    Call Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
    438    Call Agrif_Set_bc(u_ice_id,(/0,1/)) 
    439    Call Agrif_Set_bc(v_ice_id,(/0,1/)) 
     543   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
     544   CALL Agrif_Set_bc(u_ice_id,(/0,1/)) 
     545   CALL Agrif_Set_bc(v_ice_id,(/0,1/)) 
    440546 
    441547   ! 5. Update type 
    442548   !--------------- 
    443    Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
    444    Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    445    Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    446  
     549   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
     550   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     551   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     552   !  
    447553END SUBROUTINE agrif_declare_var_lim2 
    448554#  endif 
    … …  
    461567   USE nemogcm 
    462568   USE par_trc 
     569   USE lib_mpp 
    463570   USE trc 
    464571   USE in_out_manager 
     572   USE agrif_opa_sponge 
    465573   USE agrif_top_update 
    466574   USE agrif_top_interp 
    … …  
    469577   IMPLICIT NONE 
    470578   ! 
    471    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     579   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    472580   LOGICAL :: check_namelist 
    473581   !!---------------------------------------------------------------------- 
    474  
    475    ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
    476582 
    477583 
    … …  
    484590   Agrif_SpecialValue=0. 
    485591   Agrif_UseSpecialValue = .TRUE. 
    486    Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 
    487    Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
     592   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    488593   Agrif_UseSpecialValue = .FALSE. 
     594   CALL Agrif_Sponge 
     595   tabspongedone_trn = .FALSE. 
     596   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     597   ! reset tsa to zero 
     598   tra(:,:,:,:) = 0. 
     599 
    489600 
    490601   ! 3. Some controls 
    491602   !----------------- 
    492    check_namelist = .true. 
     603   check_namelist = .TRUE. 
    493604 
    494605   IF( check_namelist ) THEN 
    495 #  if defined offline      
     606# if defined key_offline 
    496607      ! Check time steps 
    497       IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    498          WRITE(*,*) 'incompatible time step between grids' 
    499          WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    500          WRITE(*,*) 'child  grid value : ',nint(rdt) 
    501          WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    502          STOP 
     608      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     609         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     610         WRITE(cl_check2,*)  rdt 
     611         WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     612         CALL ctl_warn( 'incompatible time step between grids',   & 
     613               &               'parent grid value : '//cl_check1    ,   &  
     614               &               'child  grid value : '//cl_check2    ,   &  
     615               &               'value on child grid will be changed to  & 
     616               &               :'//cl_check3  ) 
     617         rdt=rdt*Agrif_Rhot() 
    503618      ENDIF 
    504619 
    505620      ! Check run length 
    506621      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    507            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    508          WRITE(*,*) 'incompatible run length between grids' 
    509          WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    510               Agrif_Parent(nit000)+1),' time step' 
    511          WRITE(*,*) 'child  grid value : ', & 
    512               (nitend-nit000+1),' time step' 
    513          WRITE(*,*) 'value on child grid should be : ', & 
    514               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    515               Agrif_Parent(nit000)+1) 
    516          STOP 
     622            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
     623         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     624         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     625         CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     626               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
     627               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     628         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     629         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    517630      ENDIF 
    518631 
    … …  
    520633      IF( ln_zps ) THEN 
    521634         ! check parameters for partial steps  
    522          IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     635         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    523636            WRITE(*,*) 'incompatible e3zps_min between grids' 
    524637            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    … …  
    527640            STOP 
    528641         ENDIF 
    529          IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     642         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN 
    530643            WRITE(*,*) 'incompatible e3zps_rat between grids' 
    531644            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    … …  
    537650#  endif          
    538651      ! Check passive tracer cell 
    539       IF( nn_dttrc .ne. 1 ) THEN 
     652      IF( nn_dttrc .NE. 1 ) THEN 
    540653         WRITE(*,*) 'nn_dttrc should be equal to 1' 
    541654      ENDIF 
    542655   ENDIF 
    543656 
    544 !ch   CALL Agrif_Update_trc(0) 
     657   CALL Agrif_Update_trc(0) 
     658   ! 
     659   Agrif_UseSpecialValueInUpdate = .FALSE. 
    545660   nbcline_trc = 0 
    546    ! 
    547    DEALLOCATE(tabtrtemp) 
    548661   ! 
    549662END SUBROUTINE Agrif_InitValues_cont_top 
    … …  
    557670   !!---------------------------------------------------------------------- 
    558671   USE agrif_util 
     672   USE agrif_oce 
    559673   USE dom_oce 
    560674   USE trc 
    … …  
    564678   ! 1. Declaration of the type of variable which have to be interpolated 
    565679   !--------------------------------------------------------------------- 
    566    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    567    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    568    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
     680   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
     681   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
    569682 
    570683   ! 2. Type of interpolation 
    571684   !------------------------- 
    572685   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
    573    CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
     686   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 
    574687 
    575688   ! 3. Location of interpolation 
    576689   !----------------------------- 
    577    Call Agrif_Set_bc(trn_id,(/0,1/)) 
    578    Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
     690   CALL Agrif_Set_bc(trn_id,(/0,1/)) 
     691!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 
     692   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    579693 
    580694   ! 5. Update type 
    581695   !---------------  
    582    Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    583    Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
    584  
    585  
     696   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     697 
     698!   Higher order update 
     699!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     700 
     701   ! 
    586702END SUBROUTINE agrif_declare_var_top 
    587703# endif 
    … …  
    591707   !!   *** ROUTINE Agrif_detect *** 
    592708   !!---------------------------------------------------------------------- 
    593    USE Agrif_Types 
    594709   ! 
    595710   INTEGER, DIMENSION(2) :: ksizex 
    … …  
    613728   ! 
    614729   INTEGER  ::   ios                 ! Local integer output status for namelist read 
    615    NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    616    !!---------------------------------------------------------------------- 
    617    ! 
    618       REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
    619       READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
    620 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
    621  
    622       REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
    623       READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
    624 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
    625       IF(lwm) WRITE ( numond, namagrif ) 
     730   INTEGER  ::   iminspon 
     731   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
     732   !!-------------------------------------------------------------------------------------- 
     733   ! 
     734   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
     735   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
     736901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
     737 
     738   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
     739   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
     740902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
     741   IF(lwm) WRITE ( numond, namagrif ) 
    626742   ! 
    627743   IF(lwp) THEN                    ! control print 
    … …  
    634750      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    635751      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     752      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    636753      WRITE(numout,*)  
    637754   ENDIF 
    … …  
    642759   visc_dyn      = rn_sponge_dyn 
    643760   ! 
    644    IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     761   ! Check sponge length: 
     762   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 
     763   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 
     764   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large') 
     765   ! 
     766   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
    645767# if defined key_lim2 
    646768   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') 
    … …  
    663785   SELECT CASE( i ) 
    664786   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    665    CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
    666    CASE(3)   ;   indglob = indloc 
    667    CASE(4)   ;   indglob = indloc 
     787   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
     788   CASE DEFAULT 
     789      indglob = indloc 
    668790   END SELECT 
    669791   ! 
    670792END SUBROUTINE Agrif_InvLoc 
     793 
     794SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
     795   !!---------------------------------------------------------------------- 
     796   !!                 *** ROUTINE Agrif_get_proc_info *** 
     797   !!---------------------------------------------------------------------- 
     798   USE par_oce 
     799   IMPLICIT NONE 
     800   ! 
     801   INTEGER, INTENT(out) :: imin, imax 
     802   INTEGER, INTENT(out) :: jmin, jmax 
     803   !!---------------------------------------------------------------------- 
     804   ! 
     805   imin = nimppt(Agrif_Procrank+1)  ! ????? 
     806   jmin = njmppt(Agrif_Procrank+1)  ! ????? 
     807   imax = imin + jpi - 1 
     808   jmax = jmin + jpj - 1 
     809   !  
     810END SUBROUTINE Agrif_get_proc_info 
     811 
     812SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
     813   !!---------------------------------------------------------------------- 
     814   !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
     815   !!---------------------------------------------------------------------- 
     816   USE par_oce 
     817   IMPLICIT NONE 
     818   ! 
     819   INTEGER,  INTENT(in)  :: imin, imax 
     820   INTEGER,  INTENT(in)  :: jmin, jmax 
     821   INTEGER,  INTENT(in)  :: nbprocs 
     822   REAL(wp), INTENT(out) :: grid_cost 
     823   !!---------------------------------------------------------------------- 
     824   ! 
     825   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
     826   ! 
     827END SUBROUTINE Agrif_estimate_parallel_cost 
    671828 
    672829# endif 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r5887 r6204  
    107107      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    108108      REAL(wp) ::   ztmelts, zdh 
     109#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 
     110     USE ice_2, vt_s => hsnm 
     111     USE ice_2, vt_i => hicm 
     112#endif 
    109113 
    110114      !!------------------------------------------------------------------------------ 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r4990 r6204  
    7676      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 
    7777      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers 
    78       INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       - 
     78      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy         !   -       - 
    7979      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       - 
    8080      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    … …  
    777777!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    778778!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1       
    779       iw = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2 
    780       ie = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1 
    781       is = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2 
    782       in = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1 
     779      iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2 
     780      ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1 
     781      iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2 
     782      ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1 
    783783 
    784784      ALLOCATE( nbondi_bdy(nb_bdy)) 
    … …  
    853853               ENDIF 
    854854               ! check if point is in local domain 
    855                IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
    856                   & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN 
     855               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   & 
     856                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN 
    857857                  ! 
    858858                  icount = icount  + 1 
    … …  
    890890         com_south_b = 0 
    891891         com_north_b = 0 
     892 
    892893         DO igrd = 1, jpbgrd 
    893894            icount  = 0 
    … …  
    896897               DO ib = 1, nblendta(igrd,ib_bdy) 
    897898                  ! check if point is in local domain and equals ir 
    898                   IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
    899                      & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   & 
     899                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   & 
     900                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   & 
    900901                     & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    901902                     ! 
    … …  
    15941595            ELSE 
    15951596               ! This is a corner 
    1596                WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 
     1597               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 
    15971598               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 
    15981599               itest=itest+1 
    … …  
    16081609            ELSE 
    16091610               ! This is a corner 
    1610                WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 
     1611               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 
    16111612               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 
    16121613               itest=itest+1 
    … …  
    16381639            ELSE 
    16391640               ! This is a corner 
    1640                WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 
     1641               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 
    16411642               CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 
    16421643               itest=itest+1 
    … …  
    16521653            ELSE 
    16531654               ! This is a corner 
    1654                WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 
     1655               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 
    16551656               CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 
    16561657               itest=itest+1 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r5565 r6204  
    10181018         CALL histdef( id_i, "vovvldep", "T point depth"         , "m"      ,   &   ! t-point depth 
    10191019            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
     1020         CALL histdef( id_i, "vovvle3t", "T point thickness"         , "m"      ,   &   ! t-point depth 
     1021            &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
    10201022      END IF 
    10211023 
    … …  
    10481050      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
    10491051      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
     1052      IF( lk_vvl ) THEN 
     1053         CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )!  T-cell depth        
     1054         CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )!  T-cell thickness   
     1055      END IF 
    10501056 
    10511057      ! 3. Close the file 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r5551 r6204  
    544544         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    545545            IF( .NOT. Agrif_Root() ) THEN 
    546               zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
     546              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   &  
     547                    &           / (ra * rad) 
    547548            ENDIF 
    548549         ENDIF 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r6036 r6204  
    219219         &  ppsur == pp_to_be_computed           ) THEN 
    220220         ! 
     221#if defined key_agrif 
     222         za1  = (  ppdzmin - pphmax / FLOAT(jpkdta-1)  )                                                   & 
     223            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * (  LOG( COSH( (jpkdta - ppkth) / ppacr) )& 
     224            &                                                      - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
     225#else 
    221226         za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      & 
    222227            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      & 
    223228            &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
     229#endif 
    224230         za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr ) 
    225231         zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  ) 
    … …  
    236242              WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers' 
    237243              WRITE(numout,*) '            Total depth    :', zhmax 
     244#if defined key_agrif 
     245              WRITE(numout,*) '            Layer thickness:', zhmax/(jpkdta-1) 
     246#else 
    238247              WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1) 
     248#endif 
    239249         ELSE 
    240250            IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN 
    … …  
    260270      ! Reference z-coordinate (depth - scale factor at T- and W-points) 
    261271      ! ====================== 
    262       IF( ppkth == 0._wp ) THEN            !  uniform vertical grid        
     272      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid  
     273#if defined key_agrif 
     274         za1 = zhmax / FLOAT(jpkdta-1)  
     275#else 
    263276         za1 = zhmax / FLOAT(jpk-1)  
     277#endif 
    264278         DO jk = 1, jpk 
    265279            zw = FLOAT( jk ) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r5516 r6204  
    9797      IF( nn_timing == 1 )  CALL timing_start('div_cur') 
    9898      ! 
    99       CALL wrk_alloc( jpi  , jpj+2, zwu               ) 
    100       CALL wrk_alloc( jpi+4, jpj  , zwv, kistart = -1 ) 
     99      CALL wrk_alloc( jpi  , jpj+2, zwu  ) 
     100      CALL wrk_alloc( jpi+2, jpj  , zwv ) 
    101101      ! 
    102102      IF( kt == nit000 ) THEN 
    … …  
    236236      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change) 
    237237      ! 
    238       CALL wrk_dealloc( jpi  , jpj+2, zwu               ) 
    239       CALL wrk_dealloc( jpi+4, jpj  , zwv, kistart = -1 ) 
     238      CALL wrk_dealloc( jpi  , jpj+2, zwu ) 
     239      CALL wrk_dealloc( jpi+2, jpj  , zwv ) 
    240240      ! 
    241241      IF( nn_timing == 1 )  CALL timing_stop('div_cur') 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5912 r6204  
    465465      ENDIF 
    466466#endif 
    467       !                                   !* Fill boundary data arrays with AGRIF 
    468       !                                   ! ------------------------------------- 
     467      !                                   !* Fill boundary data arrays for AGRIF 
     468      !                                   ! ------------------------------------ 
    469469#if defined key_agrif 
    470470         IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) 
    … …  
    900900#if defined key_agrif 
    901901      ! Save time integrated fluxes during child grid integration 
    902       ! (used to update coarse grid transports) 
    903       ! Useless with 2nd order momentum schemes 
     902      ! (used to update coarse grid transports at next time step) 
    904903      ! 
    905904      IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5628 r6204  
    3131   USE bdydyn2d        ! bdy_ssh routine 
    3232#if defined key_agrif 
    33    USE agrif_opa_update 
    3433   USE agrif_opa_interp 
    3534#endif 
    … …  
    274273      ENDIF 
    275274      ! 
    276       ! Update velocity at AGRIF zoom boundaries 
    277 #if defined key_agrif 
    278       IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt ) 
    279 #endif 
    280       ! 
    281275      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 ) 
    282276      ! 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5426 r6204  
    9494      CHARACTER(len=*), INTENT(in)  :: cdname 
    9595#if defined key_iomput 
    96       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
    97       CHARACTER(len=19) :: cldate  
    98       CHARACTER(len=10) :: clname 
    99       INTEGER           ::   ji 
     96#if ! defined key_xios2 
     97      TYPE(xios_time)     :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
     98      CHARACTER(len=19)   :: cldate  
     99#else 
     100      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0) 
     101      TYPE(xios_date)     :: start_date 
     102#endif 
     103      CHARACTER(len=10)   :: clname 
     104      INTEGER             :: ji 
    100105      ! 
    101106      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
    102107      !!---------------------------------------------------------------------- 
    103  
     108#if ! defined key_xios2 
    104109      ALLOCATE( z_bnds(jpk,2) ) 
     110#else 
     111      ALLOCATE( z_bnds(2,jpk) ) 
     112#endif 
    105113 
    106114      clname = cdname 
    … …  
    110118 
    111119      ! calendar parameters 
     120#if ! defined key_xios2 
    112121      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    113122      CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 
    … …  
    117126      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday  
    118127      CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 
    119  
     128#else 
     129      ! Calendar type is now defined in xml file  
     130      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     131      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 
     132          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     133      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), & 
     134          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     135      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), & 
     136          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     137      END SELECT 
     138#endif 
    120139      ! horizontal grid definition 
     140 
     141#if ! defined key_xios2 
    121142      CALL set_scalar 
     143#endif 
    122144 
    123145      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    … …  
    170192 
    171193      ! Add vertical grid bounds 
     194#if ! defined key_xios2 
    172195      z_bnds(:      ,1) = gdepw_1d(:) 
    173196      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
    174197      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
     198#else 
     199      z_bnds(1      ,:) = gdepw_1d(:) 
     200      z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     201      z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     202#endif 
     203 
    175204      CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    176205      CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    177206      CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
    178       z_bnds(:    ,2) = gdept_1d(:) 
    179       z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
    180       z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
     207 
     208#if ! defined key_xios2 
     209      z_bnds(:    ,2)  = gdept_1d(:) 
     210      z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1) 
     211      z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1) 
     212#else 
     213      z_bnds(2,:    )  = gdept_1d(:) 
     214      z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1) 
     215      z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1) 
     216#endif 
    181217      CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
     218 
    182219 
    183220# if defined key_floats 
    … …  
    11581195      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    11591196 
     1197#if ! defined key_xios2 
    11601198      IF ( xios_is_valid_domain     (cdid) ) THEN 
    11611199         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    … …  
    11641202            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    11651203            &    bounds_lat=bounds_lat, area=area ) 
    1166       ENDIF 
    1167  
     1204     ENDIF 
    11681205      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
    11691206         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    … …  
    11731210            &    bounds_lat=bounds_lat, area=area ) 
    11741211      ENDIF 
     1212 
     1213#else 
     1214      IF ( xios_is_valid_domain     (cdid) ) THEN 
     1215         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1216            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     1217            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1218            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
     1219     ENDIF 
     1220      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
     1221         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1222            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     1223            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
     1224            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
     1225      ENDIF 
     1226#endif 
    11751227      CALL xios_solve_inheritance() 
    11761228 
    11771229   END SUBROUTINE iom_set_domain_attr 
     1230 
     1231#if defined key_xios2 
     1232  SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 
     1233     CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1234     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
     1235 
     1236     IF ( xios_is_valid_domain     (cdid) ) THEN 
     1237         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    & 
     1238           &   nj=nj) 
     1239    ENDIF 
     1240  END SUBROUTINE iom_set_zoom_domain_attr 
     1241#endif 
    11781242 
    11791243 
    … …  
    11831247      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
    11841248      IF ( PRESENT(paxis) ) THEN 
     1249#if ! defined key_xios2 
    11851250         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
    11861251         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
     1252#else 
     1253         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1254         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1255#endif 
    11871256      ENDIF 
    11881257      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    … …  
    11911260   END SUBROUTINE iom_set_axis_attr 
    11921261 
    1193  
    11941262   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 
    11951263      CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
    1196       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    1197       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset 
    1198       IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    1199       IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
     1264#if ! defined key_xios2 
     1265      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_op 
     1266      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_offset 
     1267#else 
     1268      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op 
     1269      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset 
     1270#endif 
     1271      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       & 
     1272    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
     1273      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  & 
     1274    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    12001275      CALL xios_solve_inheritance() 
    12011276   END SUBROUTINE iom_set_field_attr 
    1202  
    12031277 
    12041278   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 
    … …  
    12131287   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 
    12141288      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid 
    1215       CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq 
     1289      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix 
     1290#if ! defined key_xios2 
     1291      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::    output_freq 
     1292#else 
     1293      TYPE(xios_duration)   ,OPTIONAL , INTENT(out) :: output_freq 
     1294#endif   
    12161295      LOGICAL                                 ::   llexist1,llexist2,llexist3 
    12171296      !--------------------------------------------------------------------- 
    12181297      IF( PRESENT( name        ) )   name = ''          ! default values 
    12191298      IF( PRESENT( name_suffix ) )   name_suffix = '' 
     1299#if ! defined key_xios2 
    12201300      IF( PRESENT( output_freq ) )   output_freq = '' 
     1301#else 
     1302      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0) 
     1303#endif 
    12211304      IF ( xios_is_valid_file     (cdid) ) THEN 
    12221305         CALL xios_solve_inheritance() 
    … …  
    12391322      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    12401323      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
     1324#if ! defined key_xios2 
    12411325      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask ) 
    12421326      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask ) 
     1327#else 
     1328      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask3=mask ) 
     1329      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 
     1330#endif 
    12431331      CALL xios_solve_inheritance() 
    12441332   END SUBROUTINE iom_set_grid_attr 
    … …  
    12821370      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    12831371 
    1284       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1372#if ! defined key_xios2 
     1373     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1374#else 
     1375     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1376#endif      
    12851377      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    12861378      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    … …  
    14301522      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
    14311523 
     1524      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1525#if ! defined key_xios2 
    14321526      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
    14331527      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    … …  
    14351529         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    14361530      ! 
    1437       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    14381531      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1532#else 
     1533! Pas teste : attention aux indices ! 
     1534      CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1535      CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1536      CALL iom_set_domain_attr("ptr", lonvalue = zlon,   & 
     1537         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     1538       CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 
     1539#endif 
     1540 
    14391541      CALL iom_update_file_name('ptr') 
    14401542      ! 
    … …  
    14551557      zz=REAL(narea,wp) 
    14561558      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1457  
     1559       
    14581560   END SUBROUTINE set_scalar 
    14591561 
    … …  
    14791581      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings 
    14801582      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings 
     1583#if  defined key_xios2 
     1584      TYPE(xios_duration)            ::   f_op, f_of 
     1585#endif 
     1586  
    14811587      !!---------------------------------------------------------------------- 
    14821588      !  
    14831589      ! frequency of the call of iom_put (attribut: freq_op) 
    1484       WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 
    1485       WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts') 
    1486       WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op = cl1//'ts', freq_offset='0ts') 
    1487       WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
    1488       WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
     1590#if ! defined key_xios2 
     1591      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 
     1592      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op=cl1//'ts', freq_offset='0ts') 
     1593      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op=cl1//'ts', freq_offset='0ts') 
     1594      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op=cl1//'ts', freq_offset='0ts') 
     1595      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op=cl1//'ts', freq_offset='0ts') 
     1596#else 
     1597      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
     1598      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
     1599      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
     1600      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
     1601      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     1602#endif 
    14891603        
    14901604      ! output file names (attribut: name) 
    … …  
    15081622         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    15091623         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     1624#if ! defined key_xios2 
    15101625         CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
     1626#else 
     1627         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 
     1628#endif 
    15111629         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    15121630         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
    … …  
    15881706               ENDIF 
    15891707               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
     1708#if ! defined key_xios2 
    15901709               CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
     1710#else 
     1711               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 
     1712#endif 
    15911713               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         ) 
    15921714               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 
    … …  
    16171739      REAL(wp)           ::   zsec 
    16181740      LOGICAL            ::   llexist 
    1619       !!---------------------------------------------------------------------- 
     1741#if  defined key_xios2 
     1742      TYPE(xios_duration)   ::   output_freq  
     1743#endif       
     1744      !!---------------------------------------------------------------------- 
     1745 
    16201746 
    16211747      DO jn = 1,2 
    1622  
     1748#if ! defined key_xios2 
    16231749         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq ) 
     1750#else 
     1751         output_freq = xios_duration(0,0,0,0,0,0) 
     1752         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq ) 
     1753#endif 
    16241754         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    16251755 
    … …  
    16321762            END DO 
    16331763 
     1764#if ! defined key_xios2 
    16341765            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16351766            DO WHILE ( idx /= 0 )  
    … …  
    16441775               idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16451776            END DO 
    1646  
     1777#else 
     1778            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1779            DO WHILE ( idx /= 0 )  
     1780              IF ( output_freq%hour /= 0 ) THEN 
     1781                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'  
     1782                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1783              ELSE IF ( output_freq%day /= 0 ) THEN 
     1784                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'  
     1785                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1786              ELSE IF ( output_freq%month /= 0 ) THEN    
     1787                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'  
     1788                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1789              ELSE IF ( output_freq%year /= 0 ) THEN    
     1790                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'  
     1791                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1792              ELSE 
     1793                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   & 
     1794                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 
     1795              ENDIF 
     1796              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 
     1797              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1798            END DO 
     1799#endif 
    16471800            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    16481801            DO WHILE ( idx /= 0 )  
    … …  
    16731826            END DO 
    16741827 
     1828            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    16751829            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname ) 
    16761830            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname ) 
    … …  
    17201874      ENDIF 
    17211875       
     1876!$AGRIF_DO_NOT_TREAT       
     1877! Should be fixed in the conv 
    17221878      IF( llfull ) THEN  
    17231879         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 
    … …  
    17301886         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run 
    17311887      ENDIF 
     1888!$AGRIF_END_DO_NOT_TREAT       
    17321889 
    17331890   END FUNCTION iom_sdate 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r5429 r6204  
    298298      ENDIF 
    299299 
     300#if defined key_agrif 
     301      IF (Agrif_Root()) THEN 
     302         CALL Agrif_MPI_Init(mpi_comm_opa) 
     303      ELSE 
     304         CALL Agrif_MPI_set_grid_comm(mpi_comm_opa) 
     305      ENDIF 
     306#endif 
     307 
    300308      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    301309      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r5767 r6204  
    12901290      CHARACTER(LEN=*)          , INTENT(in   ) ::   lsmfile ! land sea mask file name 
    12911291      !!  
    1292       REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta,zfieldo                  ! temporary array of values on input grid 
     1292      REAL(wp),DIMENSION(:,:,:),ALLOCATABLE     ::   ztmp_fly_dta                          ! temporary array of values on input grid 
    12931293      INTEGER, DIMENSION(3)                     ::   rec1,recn                             ! temporary arrays for start and length 
    12941294      INTEGER, DIMENSION(3)                     ::   rec1_lsm,recn_lsm                     ! temporary arrays for start and length in case of seaoverland 
    … …  
    13561356 
    13571357 
    1358          itmpi=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1) 
    1359          itmpj=SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2) 
     1358         itmpi=jpi2_lsm-jpi1_lsm+1 
     1359         itmpj=jpj2_lsm-jpj1_lsm+1 
    13601360         itmpz=kk 
    13611361         ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5487 r6204  
    10291029         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
    10301030         ub (:,:,1) = ssu_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1031         un (:,:,1) = ssu_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
    10311032         CALL iom_put( 'ssu_m', ssu_m ) 
    10321033      ENDIF 
    … …  
    10341035         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
    10351036         vb (:,:,1) = ssv_m(:,:)                             ! will be used in sbcice_lim in the call of lim_sbc_tau 
     1037         vn (:,:,1) = ssv_m(:,:)                             ! will be used in sbc_cpl_snd if atmosphere coupling 
    10361038         CALL iom_put( 'ssv_m', ssv_m ) 
    10371039      ENDIF 
    … …  
    17431745                     ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
    17441746                  ELSEWHERE 
    1745                      ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?) 
     1747                     ztmp3(:,:,1) = rt0 
    17461748                  END WHERE 
    17471749               CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 
    … …  
    17741776      !                                                      ! ------------------------- ! 
    17751777      IF( ssnd(jps_albice)%laction ) THEN                         ! ice  
    1776          SELECT CASE( sn_snd_alb%cldes ) 
    1777          CASE( 'ice'          )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
    1778          CASE( 'weighted ice' )   ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
    1779          CASE default             ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
     1778          SELECT CASE( sn_snd_alb%cldes ) 
     1779          CASE( 'ice' ) 
     1780             SELECT CASE( sn_snd_alb%clcat ) 
     1781             CASE( 'yes' )    
     1782                ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 
     1783             CASE( 'no' ) 
     1784                WHERE( SUM( a_i, dim=3 ) /= 0. ) 
     1785                   ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 
     1786                ELSEWHERE 
     1787                   ztmp1(:,:) = albedo_oce_mix(:,:) 
     1788                END WHERE 
     1789             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 
     1790             END SELECT 
     1791          CASE( 'weighted ice' )   ; 
     1792             SELECT CASE( sn_snd_alb%clcat ) 
     1793             CASE( 'yes' )    
     1794                ztmp3(:,:,1:jpl) =  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 
     1795             CASE( 'no' ) 
     1796                WHERE( fr_i (:,:) > 0. ) 
     1797                   ztmp1(:,:) = SUM (  alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 
     1798                ELSEWHERE 
     1799                   ztmp1(:,:) = 0. 
     1800                END WHERE 
     1801             CASE default   ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 
     1802             END SELECT 
     1803          CASE default      ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 
    17801804         END SELECT 
    1781          CALL cpl_snd( jps_albice, isec, ztmp3, info ) 
    1782       ENDIF 
     1805 
     1806         SELECT CASE( sn_snd_alb%clcat ) 
     1807            CASE( 'yes' )    
     1808               CALL cpl_snd( jps_albice, isec, ztmp3, info )      !-> MV this has never been checked in coupled mode 
     1809            CASE( 'no'  )    
     1810               CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
     1811         END SELECT 
     1812      ENDIF 
     1813 
    17831814      IF( ssnd(jps_albmix)%laction ) THEN                         ! mixed ice-ocean 
    17841815         ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r5720 r6204  
    5353   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  risfLeff               !:effective length (Leff) BG03 nn_isf==2 
    5454   REAL(wp)   , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 
    55 #if defined key_agrif 
    56    ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals 
    57    REAL(wp),    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
    58                                                                                           !: (first wet level and last level include in the tbl) 
    59 #else 
    6055   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
    61 #endif 
    6256 
    6357 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r5503 r6204  
    126126      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
    127127      ! 
    128       ! Runoff reduction only associated to the ORCA2_LIM configuration 
    129       ! when reading the NetCDF file runoff_1m_nomask.nc 
    130       IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl )   THEN 
    131          WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 
    132             sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 
    133          END WHERE 
    134       ENDIF 
    135       ! 
    136128      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    137129         ! 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r4990 r6204  
    212212      CHARACTER(len=3) ::   cdtype 
    213213      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 
    214       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
     214      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', & 
     215          &  kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
    215216   END SUBROUTINE tra_adv_eiv 
    216217#endif 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r5147 r6204  
    326326      CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav ) 
    327327      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts ) 
    328       CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs ) 
     328      CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs ) 
    329329      ! 
    330330      IF( kt == kit000 )  THEN 
    … …  
    564564      ! 
    565565                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts ) 
    566                    CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs ) 
     566                   CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs ) 
    567567                   CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 
    568568      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r5628 r6204  
    4747   USE timing          ! Timing 
    4848#if defined key_agrif 
    49    USE agrif_opa_update 
    5049   USE agrif_opa_interp 
    5150#endif 
    … …  
    111110      ! Update after tracer on domain lateral boundaries 
    112111      !  
     112#if defined key_agrif 
     113      CALL Agrif_tra                     ! AGRIF zoom boundaries 
     114#endif 
     115      ! 
    113116      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign) 
    114117      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
    … …  
    116119#if defined key_bdy  
    117120      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    118 #endif 
    119 #if defined key_agrif 
    120       CALL Agrif_tra                     ! AGRIF zoom boundaries 
    121121#endif 
    122122  
    … …  
    149149         ELSE                 ;   CALL tra_nxt_fix( kt, nit000,         'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level  
    150150         ENDIF 
    151       ENDIF  
    152       ! 
    153 #if defined key_agrif 
    154       ! Update tracer at AGRIF zoom boundaries 
    155       IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only 
    156 #endif       
    157       ! 
    158       ! trends computation 
     151      ENDIF      
     152      ! 
     153     ! trends computation 
    159154      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    160155         DO jk = 1, jpkm1 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5215 r6204  
    117117      ! 
    118118      SELECT CASE( ktrd ) 
    119          CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
    120          CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
    121          CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 
    122          CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 
    123          CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
    124          CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
    125          CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
    126          CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
    127          CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
    128          CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
     119        CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
     120        CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
     121        CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 
     122        CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 
     123        CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
     124        CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
     125        CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
     126        CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
     127        CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
     128        CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
    129129                                 !                                   ! wind stress trends 
    130                                  CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
    131                            z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
    132                            z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
    133                            zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    134                            DO jj = 2, jpj 
    135                               DO ji = 2, jpi 
    136                                  zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    137                                  &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    138                               END DO 
    139                            END DO 
    140                                  CALL iom_put( "ketrd_tau", zke2d ) 
    141                                  CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
    142          CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
     130                                CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
     131                     z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
     132                     z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
     133                     zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
     134                     DO jj = 2, jpj 
     135                         DO ji = 2, jpi 
     136                           zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
     137                            &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
     138                         END DO 
     139                     END DO 
     140                                CALL iom_put( "ketrd_tau", zke2d ) 
     141                                CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
     142        CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
    143143!!gm TO BE DONE properly 
    144144!!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 
    … …  
    162162!         ENDIF 
    163163!!gm end 
    164          CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
     164        CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
    165165!! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 
    166166!! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 
    … …  
    184184!                              CALL iom_put( "ketrd_bfri", zke2d ) 
    185185!         ENDIF 
    186          CASE( jpdyn_ken )   ;   ! kinetic energy 
    187                            ! called in dynnxt.F90 before asselin time filter 
    188                            ! with putrd=ua and pvtrd=va 
    189                            zke(:,:,:) = 0.5_wp * zke(:,:,:) 
    190                            CALL iom_put( "KE", zke ) 
    191                            ! 
    192                            CALL ken_p2k( kt , zke ) 
    193                            CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
     186        CASE( jpdyn_ken )   ;   ! kinetic energy 
     187                    ! called in dynnxt.F90 before asselin time filter 
     188                    ! with putrd=ua and pvtrd=va 
     189                    zke(:,:,:) = 0.5_wp * zke(:,:,:) 
     190                    CALL iom_put( "KE", zke ) 
     191                    ! 
     192                    CALL ken_p2k( kt , zke ) 
     193                      CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
    194194         ! 
    195195      END SELECT 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90

    r5215 r6204  
    165165 
    166166 
    167       SELECT CASE( ktrd ) 
    168       CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf 
     167      SELECT CASE( ktrd ) 
     168      CASE( jptra_npc  )               ! non-penetrative convection: regrouped with zdf 
    169169!!gm : to be completed !  
    170 !        IF( .... 
     170!         IF( .... 
    171171!!gm end 
    172       CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion 
    173          !                                   ! regroup iso-neutral diffusion in one term 
     172      CASE( jptra_zdfp )               ! iso-neutral diffusion: "pure" vertical diffusion 
     173         !                                   ! regroup iso-neutral diffusion in one term 
    174174         tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) ) 
    175175         smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) ) 
    … …  
    811811 
    812812 
    813       nkstp     = nit000 - 1              ! current time step indicator initialization 
     813      nkstp     = nit000 - 1              ! current time step indicator initialization 
    814814 
    815815 
    … …  
    851851      IF( nn_ctls == 1 ) THEN 
    852852         CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    853          READ ( inum ) nbol 
     853         READ ( inum, * ) nbol 
    854854         CLOSE( inum ) 
    855855      END IF 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r5215 r6204  
    9999                                   CALL wrk_alloc( jpi, jpj, z2d ) 
    100100                                   z2d(:,:) = wn(:,:,1) * ( & 
    101                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
    102                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
    103                                       &                  ) / fse3t(:,:,1) 
     101                                       &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
     102                                       &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
     103                                       &             ) / fse3t(:,:,1) 
    104104                                   CALL iom_put( "petrd_sad" , z2d ) 
    105105                                   CALL wrk_dealloc( jpi, jpj, z2d ) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r4990 r6204  
    4343   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts       [m2/s] 
    4444   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt [m2/s] 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en              !: now turbulent kinetic energy   [m2/s2] 
    4548  
    4649   !!---------------------------------------------------------------------- 
    … …  
    6063         &     tfrua(jpi, jpj), tfrva(jpi, jpj)              ,      & 
    6164         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      & 
    62          &     avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk)           , STAT = zdf_oce_alloc ) 
     65         &     avmv  (jpi,jpj,jpk), avt   (jpi,jpj,jpk)      ,      & 
     66         &     avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk)      ,      &  
     67         &     avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk)      ,      & 
     68         &     en    (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 
    6369         ! 
    6470      IF( zdf_oce_alloc /= 0 )   CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r5610 r6204  
    4242   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag 
    4343   ! 
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy 
    4544   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length 
    4645   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function 
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k   ! not enhanced Kz 
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avm_k   ! not enhanced Kz 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k  ! not enhanced Kz 
    50    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmv_k  ! not enhanced Kz 
    5146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points 
    5247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points 
    … …  
    120115      !!                ***  FUNCTION zdf_gls_alloc  *** 
    121116      !!---------------------------------------------------------------------- 
    122       ALLOCATE( en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     & 
    123          &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                    & 
    124          &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk),                    & 
    125          &      ustars2(jpi,jpj), ustarb2(jpi,jpj)                      , STAT= zdf_gls_alloc ) 
     117      ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) ,     & 
     118         &      ustars2(jpi,jpj) , ustarb2(jpi,jpj)   , STAT= zdf_gls_alloc ) 
    126119         ! 
    127120      IF( lk_mpp             )   CALL mpp_sum ( zdf_gls_alloc ) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r5938 r6204  
    2727 
    2828   PUBLIC   zdf_mxl       ! called by step.F90 
     29   PUBLIC   zdf_mxl_alloc ! Used in zdf_tke_init 
    2930 
    3031   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r6113 r6204  
    5353   USE timing         ! Timing 
    5454   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     55#if defined key_agrif 
     56   USE agrif_opa_interp 
     57   USE agrif_opa_update 
     58#endif 
     59 
     60 
    5561 
    5662   IMPLICIT NONE 
    … …  
    8591   REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3) 
    8692 
    87    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2] 
    8893   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    8994   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
    90    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz 
    91    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz 
    9295#if defined key_c1d 
    9396   !                                                                        !!** 1D cfg only  **   ('key_c1d') 
    … …  
    115118         &      e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) ,                          & 
    116119#endif 
    117          &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     &  
    118          &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          & 
    119          &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      ) 
     120         &      htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc      ) 
    120121         ! 
    121122      IF( lk_mpp             )   CALL mpp_sum ( zdf_tke_alloc ) 
    … …  
    189190      avmv_k(:,:,:) = avmv(:,:,:)  
    190191      ! 
     192#if defined key_agrif 
     193      ! Update child grid f => parent grid  
     194      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only 
     195#endif       
     196     !  
    191197   END SUBROUTINE zdf_tke 
    192198 
    … …  
    317323                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    318324                  !                                           ! TKE Langmuir circulation source term 
    319                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     325                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   & 
     326                     &   zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    320327               END DO 
    321328            END DO 
    … …  
    710717      !!---------------------------------------------------------------------- 
    711718      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    712       INTEGER ::   ios 
     719      INTEGER ::   ios, ierr 
    713720      !! 
    714721      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   & 
    … …  
    768775      ENDIF 
    769776       
    770       IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln  
     777      IF( nn_etau == 2  ) THEN 
     778          ierr = zdf_mxl_alloc() 
     779          nmln(:,:) = nlb10           ! Initialization of nmln 
     780      ENDIF 
    771781 
    772782      !                               !* depth of penetration of surface tke 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r5531 r6204  
    161161          ENDIF 
    162162 
     163#if defined key_agrif 
     164          CALL Agrif_Regrid() 
     165#endif 
     166 
    163167         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    164168#if defined key_agrif 
    165             CALL Agrif_Step( stp )           ! AGRIF: time stepping 
     169            CALL stp                         ! AGRIF: time stepping 
    166170#else 
    167171            CALL stp( istp )                 ! standard time stepping 
    … …  
    187191      ! 
    188192#if defined key_agrif 
    189       IF ( Agrif_Level() < Agrif_MaxLevel() ) THEN  
     193      IF( .NOT. Agrif_Root() ) THEN 
    190194         CALL Agrif_ParentGrid_To_ChildGrid() 
    191195         IF( lk_diaobs ) CALL dia_obs_wri 
    … …  
    336340         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    337341#endif 
    338       ENDIF 
     342      ENDIF          
    339343         jpk = jpkdta                                             ! third dim 
     344#if defined key_agrif 
     345         ! simple trick to use same vertical grid as parent 
     346         ! but different number of levels:  
     347         ! Save maximum number of levels in jpkdta, then define all vertical grids 
     348         ! with this number. 
     349         ! Suppress once vertical online interpolation is ok 
     350         IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta) 
     351#endif 
    340352         jpim1 = jpi-1                                            ! inner domain indices 
    341353         jpjm1 = jpj-1                                            !   "           " 
    … …  
    712724      INTEGER :: ifac, jl, inu 
    713725      INTEGER, PARAMETER :: ntest = 14 
    714       INTEGER :: ilfax(ntest) 
    715       ! 
    716       ! lfax contains the set of allowed factors. 
    717       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    718          &                            128,   64,   32,   16,    8,   4,   2  / 
    719       !!---------------------------------------------------------------------- 
     726      INTEGER, DIMENSION(ntest) :: ilfax 
     727      ! 
     728      ! ilfax contains the set of allowed factors. 
     729      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     730      !!---------------------------------------------------------------------- 
     731      ! ilfax contains the set of allowed factors. 
     732      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    720733 
    721734      ! Clear the error flag and initialise output vars 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/step.F90

    r5510 r6204  
    5050 
    5151#if defined key_agrif 
    52    SUBROUTINE stp( ) 
     52   RECURSIVE SUBROUTINE stp( ) 
    5353      INTEGER             ::   kstp   ! ocean time-step index 
    5454#else 
    … …  
    7979#if defined key_agrif 
    8080      kstp = nit000 + Agrif_Nb_Step() 
    81 !      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    82 !      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
     81      IF ( lk_agrif_debug ) THEN 
     82         IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
     83         IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 
     84      ENDIF 
     85 
    8386      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
     87 
    8488# if defined key_iomput 
    8589      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( cxios_context ) 
    … …  
    110114      ! Update stochastic parameters and random T/S fluctuations 
    111115      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    112                         CALL sto_par( kstp )          ! Stochastic parameters 
     116       IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters 
     117       IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations 
    113118 
    114119      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    152157      ! 
    153158      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
    154          IF(ln_sto_eos ) CALL sto_pts( tsn )          ! Random T/S fluctuations 
    155159                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
    156160         IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    … …  
    188192          ! Note that the computation of vertical velocity above, hence "after" sea level 
    189193          ! is necessary to compute momentum advection for the rhs of barotropic loop: 
    190             IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
    191194                            CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
    192195            IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    … …  
    200203                                  ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    201204                                  va(:,:,:) = 0.e0 
    202           IF(  ln_asmiau .AND. & 
     205          IF(  lk_asminc .AND. ln_asmiau .AND. & 
    203206             & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment 
    204207          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified) 
    … …  
    248251                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
    249252 
    250       IF(  ln_asmiau .AND. & 
     253      IF(  lk_asminc .AND. ln_asmiau .AND. & 
    251254         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
    252255                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    … …  
    270273         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    271274                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    272             IF( ln_sto_eos ) CALL sto_pts( tsn )                 ! Random T/S fluctuations 
    273275                             CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
    274276            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
    … …  
    281283      ELSE                                                  ! centered hpg  (eos then time stepping) 
    282284         IF ( .NOT. lk_dynspg_ts ) THEN                     ! eos already called in time-split case 
    283             IF( ln_sto_eos ) CALL sto_pts( tsn )    ! Random T/S fluctuations 
    284285                             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
    285286         IF( ln_zps .AND. .NOT. ln_isfcav)                                   & 
    … …  
    314315                               va(:,:,:) = 0.e0 
    315316 
    316         IF(  ln_asmiau .AND. & 
     317        IF(  lk_asminc .AND. ln_asmiau .AND. & 
    317318           & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
    318319        IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
    … …  
    335336                               CALL ssh_swp( kstp )         ! swap of sea surface height 
    336337      IF( lk_vvl           )   CALL dom_vvl_sf_swp( kstp )  ! swap of vertical scale factors 
    337  
     338      ! 
     339      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file 
     340 
     341#if defined key_agrif 
     342      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     343      ! AGRIF 
     344      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
     345                               CALL Agrif_Integrate_ChildGrids( stp )   
     346 
     347      IF ( Agrif_NbStepint().EQ.0 ) THEN 
     348                               CALL Agrif_Update_Tra()      ! Update active tracers 
     349                               CALL Agrif_Update_Dyn()      ! Update momentum 
     350      ENDIF 
     351#endif 
    338352      IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics 
    339353      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    340354 
    341355      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    342       ! Control and restarts 
     356      ! Control 
    343357      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    344358                               CALL stp_ctl( kstp, indic ) 
    … …  
    352366         IF( lwm.AND.numoni /= -1 ) CALL FLUSH    ( numoni )     ! flush output namelist ice 
    353367      ENDIF 
    354       IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file 
    355368 
    356369      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    367380      ! 
    368381      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
     382      !      
    369383      ! 
    370384   END SUBROUTINE stp 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r5501 r6204  
    112112#if defined key_agrif 
    113113   USE agrif_opa_sponge ! Momemtum and tracers sponges 
     114   USE agrif_opa_update ! Update (2-way nesting) 
    114115#endif 
    115116#if defined key_top 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r3294 r6204  
    1717   USE dom_oce         ! ocean space and time domain variables  
    1818   USE sol_oce         ! ocean space and time domain variables  
     19   USE sbc_oce         ! surface boundary conditions variables 
    1920   USE in_out_manager  ! I/O manager 
    2021   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    2223   USE dynspg_oce      ! pressure gradient schemes  
    2324   USE c1d             ! 1D vertical configuration 
     25 
    2426 
    2527   IMPLICIT NONE 
    … …  
    5254      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence 
    5355      !! 
     56      CHARACTER(len = 32) ::        clfname ! time stepping output file name 
    5457      INTEGER  ::   ji, jj, jk              ! dummy loop indices 
    5558      INTEGER  ::   ii, ij, ik              ! temporary integers 
    … …  
    6366         WRITE(numout,*) 'stp_ctl : time-stepping control' 
    6467         WRITE(numout,*) '~~~~~~~' 
    65          ! open time.step file 
    66          CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     68         ! open time.step file with special treatment for SAS 
     69         IF ( nn_components == jp_iam_sas ) THEN 
     70            clfname = 'time.step.sas' 
     71         ELSE 
     72            clfname = 'time.step' 
     73         ENDIF 
     74         CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    6775      ENDIF 
    6876 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r5510 r6204  
    521521#endif 
    522522      ! 
    523       INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 
     523      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8 
    524524      INTEGER :: jpm 
    525525      !!---------------------------------------------------------------------- 
    … …  
    545545      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
    546546      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
    547       ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  
     547      ALLOCATE( un(jpi,jpj,1)       , STAT=ierr7 ) 
     548      ALLOCATE( vn(jpi,jpj,1)       , STAT=ierr8 ) 
     549      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6  + ierr7 + ierr8 
    548550#endif 
    549551      ! 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r5215 r6204  
    599599 
    600600   !!====================================================================== 
    601 END MODULE  p2zbio 
     601END MODULE p2zbio 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    r5215 r6204  
    8484 
    8585   !!====================================================================== 
    86 END MODULE  p2zsms 
     86END MODULE p2zsms 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r5385 r6204  
    109109 
    110110   !!====================================================================== 
    111 END MODULE  p4zbio 
    112  
     111END MODULE p4zbio 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r5215 r6204  
    396396 
    397397   !!====================================================================== 
    398 END MODULE  p4zche 
     398END MODULE p4zche 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r5385 r6204  
    400400 
    401401   !!====================================================================== 
    402 END MODULE  p4zflx 
     402END MODULE p4zflx 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    r5385 r6204  
    8181 
    8282   !!====================================================================== 
    83 END MODULE  p4zint 
     83END MODULE p4zint 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r5385 r6204  
    265265 
    266266   !!====================================================================== 
    267 END MODULE  p4zlim 
     267END MODULE p4zlim 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r5385 r6204  
    152152         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r   * tmask(:,:,:) ) 
    153153      ELSE 
    154          trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 
    155          trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:) 
    156          trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:) 
     154         IF( ln_diatrc ) THEN 
     155            trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 
     156            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:) 
     157            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:) 
     158         ENDIF 
    157159      ENDIF 
    158160      ! 
    … …  
    223225#endif  
    224226   !!====================================================================== 
    225 END MODULE  p4zlys 
     227END MODULE p4zlys 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r5385 r6204  
    340340 
    341341   !!====================================================================== 
    342 END MODULE  p4zmeso 
     342END MODULE p4zmeso 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r5385 r6204  
    273273 
    274274   !!====================================================================== 
    275 END MODULE  p4zmicro 
     275END MODULE p4zmicro 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r5385 r6204  
    277277 
    278278   !!====================================================================== 
    279 END MODULE  p4zmort 
     279END MODULE p4zmort 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5385 r6204  
    439439 
    440440   !!====================================================================== 
    441 END MODULE  p4zopt 
     441END MODULE p4zopt 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r5385 r6204  
    629629 
    630630   !!====================================================================== 
    631 END MODULE  p4zprod 
     631END MODULE p4zprod 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r5507 r6204  
    519519 
    520520   !!====================================================================== 
    521 END MODULE  p4zsbc 
     521END MODULE p4zsbc 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r5385 r6204  
    436436 
    437437   !!====================================================================== 
    438 END MODULE  p4zsed 
     438END MODULE p4zsed 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r5385 r6204  
    913913 
    914914   !!====================================================================== 
    915 END MODULE  p4zsink 
     915END MODULE p4zsink 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r5385 r6204  
    102102      ENDIF 
    103103 
     104#if defined key_agrif 
     105      CALL Agrif_trc                   ! AGRIF zoom boundaries 
     106#endif 
    104107      ! Update after tracer on domain lateral boundaries 
    105108      DO jn = 1, jptra 
    … …  
    110113#if defined key_bdy 
    111114!!      CALL bdy_trc( kt )               ! BDY open boundaries 
    112 #endif 
    113 #if defined key_agrif 
    114       CALL Agrif_trc                   ! AGRIF zoom boundaries 
    115115#endif 
    116116 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r5411 r6204  
    397397   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    398398   !!====================================================================== 
    399 END MODULE  trcnam 
     399END MODULE trcnam 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r3680 r6204  
    7575 
    7676   !!====================================================================== 
    77 END MODULE  trcsms 
     77END MODULE trcsms 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5407 r6204  
    3232   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step 
    3333   REAL(wp) :: rdt_sampl 
    34    INTEGER  :: nb_rec_per_days 
     34   INTEGER  :: nb_rec_per_day 
    3535   INTEGER  :: isecfst, iseclast 
    3636   LOGICAL  :: llnew 
    … …  
    123123      !!               of diurnal cycle 
    124124      !! 
    125       !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter  
     125      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter  
    126126      !!              is greater than 1 hour ) and then, compute the  mean with  
    127127      !!              a moving average over 24 hours.  
    … …  
    134134         IF( ln_cpl )  THEN   
    135135            rdt_sampl = 86400. / ncpl_qsr_freq 
    136             nb_rec_per_days = ncpl_qsr_freq 
     136            nb_rec_per_day = ncpl_qsr_freq 
    137137         ELSE   
    138138            rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 
    139             nb_rec_per_days = INT( 86400 / rdt_sampl ) 
     139            nb_rec_per_day = INT( 86400 / rdt_sampl ) 
    140140         ENDIF 
    141141         ! 
    142142         IF( lwp ) THEN 
    143143            WRITE(numout,*)  
    144             WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days 
     144            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day 
    145145            WRITE(numout,*)  
    146146         ENDIF 
    147147         ! 
    148          ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 
    149          DO jn = 1, nb_rec_per_days 
    150             qsr_arr(:,:,jn) = qsr(:,:) 
     148         !                                            !* Restart: read in restart file 
     149         IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN  
     150            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file' 
     151            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr 
     152         ELSE                                         !* no restart: set from nit000 values 
     153            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values' 
     154            qsr_mean(:,:) = qsr(:,:) 
     155         ENDIF 
     156         ! 
     157         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 
     158         DO jn = 1, nb_rec_per_day 
     159             qsr_arr(:,:,jn) = qsr_mean(:,:) 
    151160         ENDDO 
    152          qsr_mean(:,:) = qsr(:,:) 
    153161         ! 
    154162         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
    … …  
    163171             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 
    164172          isecfst = iseclast 
    165           DO jn = 1, nb_rec_per_days - 1 
     173          DO jn = 1, nb_rec_per_day - 1 
    166174             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 
    167175          ENDDO 
    168           qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 
    169           qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 
    170       ENDIF 
    171       ! 
     176          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) 
     177          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day 
     178      ENDIF 
     179      ! 
     180      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file  
     181         IF(lwp) WRITE(numout,*) 
     182         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt 
     183         IF(lwp) WRITE(numout,*) '~~~~~~~' 
     184         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 
     185      ENDIF 
     186     ! 
    172187   END SUBROUTINE trc_mean_qsr 
    173188 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/SETTE/prepare_exe_dir.sh

    r4773 r6204  
    7070export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME} 
    7171 
    72 cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/. 
     72cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/. 
    7373cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml 
    7474cd ${EXE_DIR} 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh

    r3294 r6204  
    5757#- AGRIF conv 
    5858if [ "$AGRIFUSE" == 1 ]; then 
     59#-MPI for AGRIF 
     60if [ ! -f ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h ];then 
     61   echo '#if defined key_mpp_mpi' > ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
     62   echo '#define AGRIF_MPI'      >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
     63   echo '#endif'                 >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
     64fi 
    5965 
    6066#- CONV 
    61 #fcm build ${TOOLS_DIR}/conv.cfg || exit 1 
    62 gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB 
     67fcm build ${COMPIL_DIR}/conv.cfg || exit 1 
     68#C_COMPILER=${CC-cc} 
     69#gmake CC=${C_COMPILER} -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB 
    6370 
    6471#- AGRIF sources 
    … …  
    6774[ ! -d $2/$1/OPAFILES/AGRIF_MODELFILES ] && mkdir  $2/$1/OPAFILES/AGRIF_MODELFILES 
    6875cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/agrif_opa.in  $2/$1/OPAFILES/ 
    69 cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/ 
     76#cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/ 
     77cp -f -r $2/$1/AGRIFLIB/bin/conv  $2/$1/OPAFILES/ 
    7078 
    7179fi 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/bld.cfg

    r4990 r6204  
    4141bld::tool::fppflags::nemo      %FPPFLAGS -I$CONFIG_DIR/$NEW_CONF/OPAFILES/inc 
    4242bld::tool::fppflags::ioipsl    %FPPFLAGS 
    43 bld::tool::fppflags::agrif     %FPPFLAGS 
     43bld::tool::fppflags::agrif     %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
    4444 
    4545# Ignore the following dependencies 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg

    r4990 r6204  
    5252bld::excl_dep       use::ioipsl 
    5353bld::excl_dep       use::xios 
     54bld::excl_dep        use::agrif_grids 
    5455bld::excl_dep       use::agrif_types 
    5556bld::excl_dep       use::agrif_util 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/conv.cfg

    r3294 r6204  
    88# Build information 
    99# ------------------------------------------------------------------------------ 
    10 inc $COMPIL_DIR/arch.fcm 
     10inc $COMPIL_DIR/arch_nemo.fcm 
    1111 
     12bld::tool::cc        %CC 
     13bld::tool::cflags    %CFLAGS 
    1214bld::tool::make      %MK 
    1315 
    … …  
    1921dir::root            $NEMO_TDIR/$NEW_CONF/AGRIFLIB 
    2022 
    21 bld::tool::cflags::convsrc  -O0   
    22 bld::tool::ld::convsrc   cc 
    23 bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o  
    24 bld::pp 1 
     23#bld::tool::cflags::convsrc  -O0   
     24#bld::tool::ld::convsrc   cc 
     25#bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o  
     26#bld::pp 1 
    2527 
    2628 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/agulhas

    r2455 r6204  
    1717    removeclosedseas = true 
    1818    type_bathy_interp = 0  
     19    rn_hmin = -3  
    1920/    
    2021 
    … …  
    3940    pa1  = 245.58132232490 
    4041    N  = 31 
     42    ldbletanh   = .FALSE. 
     43    ppa2        = 0.0 
     44    ppkth2      = 0.0 
     45    ppacr2      = 0.0 
    4146/     
    4247     
    … …  
    4550    parent_bathy_meter = 'bathy_meter.nc' 
    4651    parent_batmet_name = 'Bathymetry' 
    47     e3zps_min = 25. 
    48     e3zps_rat = 0.2 
     52    e3zps_min = 20. 
     53    e3zps_rat = 0.1 
    4954/ 
    5055 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90

    r2143 r6204  
    105105    IMPLICIT NONE 
    106106    ! 
    107     REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 
     107    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 
    108108    TYPE(Coordinates) :: Grid 
    109109    INTEGER :: i,j 
    … …  
    134134       za0  = pa0 
    135135       za1  = pa1 
     136       za2  = pa2 
    136137       ! 
    137138    ELSE 
    … …  
    147148 
    148149    zacr = ppacr 
    149     zkth = ppkth  
    150  
     150    zkth = ppkth 
     151    zacr2 = ppacr2 
     152    zkth2 = ppkth2    
    151153    ! 
    152154    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    153155    ! 
    154     DO i = 1,N 
    155        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    156        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    157        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    158        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    159     END DO 
     156    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     157       za1 = pphmax / FLOAT(N-1)  
     158       DO i = 1, N 
     159          gdepw(i) = ( i - 1   ) * za1 
     160          gdept(i) = ( i - 0.5 ) * za1 
     161          e3w  (i) =  za1 
     162          e3t  (i) =  za1 
     163       END DO 
     164    ELSE                            ! Madec & Imbard 1996 function 
     165       IF( .NOT. ldbletanh ) THEN 
     166          DO i = 1,N 
     167             !  
     168             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     169             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     170             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     171             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     172             ! 
     173          END DO 
     174       ELSE 
     175          DO i = 1,N 
     176             ! Double tanh function 
     177             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     178                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     179             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     180                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     181             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     182                &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     183             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     184                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     185            END DO 
     186       ENDIF 
     187    ENDIF 
    160188    ! 
    161189    gdepw(1) = 0.0 
    162190    zmax = gdepw(N) + e3t(N) 
    163     zmin = gdepw(4) 
     191    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     192    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     193    ENDIF 
     194    zmin = gdepw(i+1) 
    164195    ! 
    165196    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) & 
    … …  
    227258    IMPLICIT NONE 
    228259    ! 
    229     REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 
     260    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 
    230261    TYPE(Coordinates) :: Grid 
    231262    INTEGER :: i,j 
    … …  
    257288       za0  = pa0 
    258289       za1  = pa1 
     290       za2  = pa2 
    259291       ! 
    260292    ELSE 
    … …  
    264296       WRITE(*,*) 'please check values of variables' 
    265297       WRITE(*,*) 'in namelist vertical_grid section' 
    266        WRITE(*,*) ' ' 
    267        STOP       
     298       WRITE(*,*) ' '  
     299       STOP      
    268300       !        
    269301    ENDIF 
    270     ! 
     302 
    271303    zacr = ppacr 
    272     zkth = ppkth  
    273  
     304    zkth = ppkth 
     305    zacr2 = ppacr2 
     306    zkth2 = ppkth2    
    274307    ! 
    275308    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    276309    ! 
    277     DO i = 1,N 
    278        !  
    279        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    280        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    281        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    282        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    283     END DO 
     310    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     311       za1 = pphmax / FLOAT(N-1)  
     312       DO i = 1, N 
     313          gdepw(i) = ( i - 1   ) * za1 
     314          gdept(i) = ( i - 0.5 ) * za1 
     315          e3w  (i) =  za1 
     316          e3t  (i) =  za1 
     317       END DO 
     318    ELSE                            ! Madec & Imbard 1996 function 
     319       IF( .NOT. ldbletanh ) THEN 
     320          DO i = 1,N 
     321             !  
     322             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     323             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     324             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     325             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     326             ! 
     327          END DO 
     328       ELSE 
     329          DO i = 1,N 
     330             ! Double tanh function 
     331             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     332                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     333             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     334                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     335             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     336                &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     337             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     338                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     339         END DO 
     340       ENDIF 
     341    ENDIF 
    284342    ! 
    285343    gdepw(1) = 0.0   
    … …  
    684742  ! for consistency with fine grid bathymetry         * 
    685743  !                        * 
    686   ! if a given coarse grid point is masked and one of the      * 
    687   ! child grid points contained in this coarse cell is not masked * 
    688   ! the corresponding coarse grid point is unmasked with gdepw(4) * 
    689   ! value                        * 
     744  ! if a given coarse grid point is masked and one of the     * 
     745  ! child grid points contained in this coarse cell is not masked * 
     746  ! the corresponding coarse grid point is unmasked with rn_hmin * 
     747  ! value                            * 
    690748  !                        * 
    691749  ! - input :                    * 
    … …  
    704762    ! 
    705763    INTEGER :: ideb,jdeb,ifin,jfin 
    706     REAL*8 :: za1,za0,zsur,zacr,zkth,zmin 
     764    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin 
    707765    INTEGER :: i,j 
    708766    INTEGER :: k1 
    … …  
    727785       za0  = pa0 
    728786       za1  = pa1 
     787       za2  = pa2 
    729788       ! 
    730789    ELSE 
    … …  
    740799 
    741800    zacr = ppacr 
    742     zkth = ppkth  
    743  
     801    zkth = ppkth 
     802    zacr2 = ppacr2 
     803    zkth2 = ppkth2    
    744804    ! 
    745805    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    746806    ! 
    747     DO i = 1,N 
    748        !  
    749        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    750        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    751        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    752        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    753     END DO 
    754     ! 
    755     zmin = gdepw(4) 
     807    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     808       za1 = pphmax / FLOAT(N-1)  
     809       DO i = 1, N 
     810          gdepw(i) = ( i - 1   ) * za1 
     811          gdept(i) = ( i - 0.5 ) * za1 
     812          e3w  (i) =  za1 
     813          e3t  (i) =  za1 
     814       END DO 
     815    ELSE                            ! Madec & Imbard 1996 function 
     816       IF( .NOT. ldbletanh ) THEN 
     817          DO i = 1,N 
     818             !  
     819             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     820             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     821             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     822             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     823             ! 
     824          END DO 
     825       ELSE 
     826          DO i = 1,N 
     827             ! Double tanh function 
     828             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     829                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     830             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     831                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     832             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     833                &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     834             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     835                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     836          END DO 
     837       ENDIF 
     838    ENDIF 
     839    ! 
     840    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     841    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     842    ENDIF 
     843    zmin = gdepw(i+1) 
    756844    !       
    757845    diff = 0 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90

    r2143 r6204  
    3636    !        
    3737    TYPE(Coordinates) :: Grid                      
    38     REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp 
     38    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp 
    3939    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt 
    4040    INTEGER, DIMENSION(1) :: k 
    … …  
    7676       za0  = pa0 
    7777       za1  = pa1 
     78       za2  = pa2 
    7879       ! 
    7980    ELSE 
    … …  
    8889    ENDIF 
    8990 
    90     zacr = ppacr 
    91     zkth = ppkth        
    92     ! 
    93     DO i = 1,N 
    94        !  
    95        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    96        gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    97        e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    98        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    99        ! 
    100     END DO 
    101     ! 
    102  
     91    zacr  = ppacr 
     92    zkth  = ppkth      
     93    zacr2 = ppacr2 
     94    zkth2 = ppkth2   
     95    ! 
     96    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     97         za1 = pphmax / FLOAT(N-1)  
     98         DO i = 1, N 
     99            gdepw(i) = ( i - 1   ) * za1 
     100            gdept(i) = ( i - 0.5 ) * za1 
     101            e3w  (i) =  za1 
     102            e3t  (i) =  za1 
     103         END DO 
     104    ELSE                            ! Madec & Imbard 1996 function 
     105       IF( .NOT. ldbletanh ) THEN 
     106          DO i = 1,N 
     107             !  
     108             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     109             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     110             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     111             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     112             ! 
     113          END DO 
     114       ELSE 
     115            DO i = 1,N 
     116               ! Double tanh function 
     117               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     118                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     119               gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
     120                  &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
     121               e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
     122                  &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
     123               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     124                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     125            END DO 
     126       ENDIF 
     127    ENDIF 
    103128    gdepw(1) = 0.0   
    104129    ! 
    … …  
    106131    ! 
    107132    zmax = gdepw(N) + e3t(N) 
    108     zmin = gdepw(4) 
     133    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     134    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     135    ENDIF 
     136    zmin = gdepw(i+1) 
    109137    ! 
    110138    ! Initialize bathy_level to the maximum ocean level available 
    … …  
    235263    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt 
    236264    REAL,DIMENSION(N) :: gdepw,e3t 
    237     REAL :: za0,za1,zsur,zacr,zkth,zmin,zmax,zdepth 
     265    REAL :: za0,za1,za2,zsur,zacr,zacr2,zkth,zkth2,zmin,zmax,zdepth 
    238266    INTEGER :: kbathy,jk,diff 
    239267    INTEGER :: bornex,borney,bornex2,borney2 
    240     !        
     268    ! 
    241269    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) & 
    242270         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN  
    243271       !     
     272       WRITE(*,*) 'psur,pa0,pa1 computed' 
    244273       za1=( ppdzmin - pphmax / (N-1) )          & 
    245274            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) & 
    … …  
    253282         pa0.NE.0 .AND. pa1.NE.0 ) THEN 
    254283       !        
     284       WRITE(*,*) 'psur,pa0,pa1 given by namelist' 
    255285       zsur = psur 
    256286       za0  = pa0 
    257287       za1  = pa1 
     288       za2  = pa2 
    258289       ! 
    259290    ELSE 
    … …  
    263294       WRITE(*,*) 'please check values of variables' 
    264295       WRITE(*,*) 'in namelist vertical_grid section' 
    265        WRITE(*,*) ' '       
    266        !        
    267     ENDIF 
    268     !        
    269     zacr = ppacr 
    270     zkth = ppkth        
    271     ! 
    272     DO i = 1,N 
    273        !  
    274        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
    275        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))        
    276     END DO 
    277     ! 
     296       WRITE(*,*) ' '   
     297       STOP     
     298       !        
     299    ENDIF 
     300 
     301    zacr  = ppacr 
     302    zkth  = ppkth      
     303    zacr2 = ppacr2 
     304    zkth2 = ppkth2   
     305    ! 
     306    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     307         za1 = pphmax / FLOAT(N-1)  
     308         DO i = 1, N 
     309            gdepw(i) = ( i - 1   ) * za1 
     310            e3t  (i) =  za1 
     311         END DO 
     312    ELSE                            ! Madec & Imbard 1996 function 
     313       IF( .NOT. ldbletanh ) THEN 
     314          DO i = 1,N 
     315             !  
     316             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     317             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     318             ! 
     319          END DO 
     320       ELSE 
     321            DO i = 1,N 
     322               ! Double tanh function 
     323               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     324                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     325               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     326                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     327            END DO 
     328       ENDIF 
     329    ENDIF 
    278330    gdepw(1) = 0.0 
    279     ! 
    280331    ! 
    281332    diff = 0       
    … …  
    344395    ! 
    345396    zmax = gdepw(N) + e3t(N) 
    346     zmin = gdepw(4)  
     397    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     398    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     399    ENDIF 
     400    zmin = gdepw(i+1) 
    347401    ! 
    348402    ! check that interpolated value stays at the same level          
    … …  
    646700    REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v 
    647701    !                                   
    648     REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp 
     702    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp 
    649703    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk 
    650704    INTEGER, DIMENSION(1) :: k 
    … …  
    660714    ALLOCATE(gdepw(jpk),e3t(jpk)) 
    661715    ALLOCATE(gdepw_ps(jpi,jpj,jpk))                   
    662     !        
     716    !   
    663717    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) & 
    664718         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN  
    … …  
    668722            / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) & 
    669723            *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      & 
    670             - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )  
    671        ! 
     724            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
     725 
    672726       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 
    673727       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  ) 
    … …  
    676730         pa0.NE.0 .AND. pa1.NE.0 ) THEN 
    677731       !        
     732       WRITE(*,*) 'psur,pa0,pa1 given by namelist' 
    678733       zsur = psur 
    679734       za0  = pa0 
    680        za1  = pa1    
    681        !        
    682     ENDIF 
    683  
    684     zacr = ppacr 
    685     zkth = ppkth        
     735       za1  = pa1 
     736       za2  = pa2 
     737       ! 
     738    ELSE 
     739       !        
     740       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...'  
     741       WRITE(*,*) ' ' 
     742       WRITE(*,*) 'please check values of variables' 
     743       WRITE(*,*) 'in namelist vertical_grid section' 
     744       WRITE(*,*) ' '   
     745       STOP     
     746       !        
     747    ENDIF 
     748 
     749    zacr  = ppacr 
     750    zkth  = ppkth      
     751    zacr2 = ppacr2 
     752    zkth2 = ppkth2   
     753    ! 
     754    IF( ppkth == 0. ) THEN            !  uniform vertical grid  
     755         za1 = pphmax / FLOAT(jpk-1)  
     756         DO i = 1, jpk 
     757            gdepw(i) = ( i - 1   ) * za1 
     758            e3t  (i) =  za1 
     759         END DO 
     760    ELSE                            ! Madec & Imbard 1996 function 
     761       IF( .NOT. ldbletanh ) THEN 
     762          DO i = 1,jpk 
     763             !  
     764             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     765             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     766             ! 
     767          END DO 
     768       ELSE 
     769            DO i = 1,jpk 
     770               ! Double tanh function 
     771               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
     772                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
     773               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
     774                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
     775            END DO 
     776       ENDIF 
     777    ENDIF          
    686778    !          
    687779    !                 
    688780    DO i = 1,jpk 
    689        !  
    690        gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    691        e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    692781       !        
    693782       fse3t(:,:,i) = e3t(i) 
    … …  
    700789    ! 
    701790    zmax = gdepw(jpk) + e3t(jpk) 
    702     zmin = gdepw(4) 
     791    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
     792    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
     793    ENDIF 
     794    zmin = gdepw(i+1) 
    703795    ! 
    704796    DO jj = 1, jpj 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90

    r2455 r6204  
    5151  INTEGER jpizoom,jpjzoom,nb_connection_pts 
    5252  !       
    53   REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat 
    54   REAL*8 psur,pa0,pa1,adatrj 
     53  REAL*8 rn_hmin 
     54  REAL*8 ppkth2, ppacr2, ppkth,ppacr,ppdzmin,pphmax,smoothing_factor,e3zps_min,e3zps_rat 
     55  REAL*8 psur,pa0,pa1,pa2,adatrj 
    5556  !        
     57  LOGICAL ldbletanh 
    5658  LOGICAL partial_steps,smoothing,bathy_update 
    5759  LOGICAL new_topo,removeclosedseas,dimg,iom_activated 
    … …  
    7072  !       
    7173  NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, & 
    72        nb_connection_pts,removeclosedseas,type_bathy_interp       
     74       nb_connection_pts,removeclosedseas,type_bathy_interp,rn_hmin       
    7375  !       
    7476  NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file       
    7577  ! 
    76   NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N 
     78  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,ppa2,ppkth2,ppacr2 
    7779  !  
    7880  NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat       
Note: See TracChangeset for help on using the changeset viewer.