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

Changeset 6204


Ignore:
Timestamp:
2016-01-04T14:47:06+01:00 (9 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