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

Changeset 4785


Ignore:
Timestamp:
2014-09-24T14:03:02+02:00 (10 years ago)
Author:
rblod
Message:

dev_r4765_CNRS_agrif: First update of AGRIF for dynamic only (_flt and _ts), see ticket #1380 and associated wiki page

Location:
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM
Files:
31 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml

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

    r4698 r4785  
    3131   nn_leapy    =       0   !  Leap year calendar (1) or not (0) 
    3232   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T) 
     33   nn_euler    =       1   !  = 0 : start with forward time step if ln_rstart=.true. 
    3334   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T 
    3435                           !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist 
     
    119120                           ! 
    120121   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0) 
    121    nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts") 
    122122   rn_atfp     =    0.1    !  asselin time filter parameter 
    123123   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k) 
     
    150150   ppkth2      =       48.029893720000 ! 
    151151   ppacr2      =       13.000000000000 ! 
     152/ 
     153!----------------------------------------------------------------------- 
     154&namsplit      !   time splitting parameters                            ("key_dynspg_ts") 
     155!----------------------------------------------------------------------- 
     156   ln_bt_fw      =    .TRUE.           !  Forward integration of barotropic equations 
     157   ln_bt_av      =    .TRUE.           !  Time filtering of barotropic variables 
     158   ln_bt_nn_auto =    .TRUE.           !  Set nn_baro automatically to be just below 
     159                                       !  a user defined maximum courant number (rn_bt_cmax) 
     160   nn_baro       =    30               !  Number of iterations of barotropic mode 
     161                                       !  during rn_rdt seconds. Only used if ln_bt_nn_auto=F 
     162   rn_bt_cmax    =    0.8              !  Maximum courant number allowed if ln_bt_nn_auto=T 
     163   nn_bt_flt     =    1                !  Time filter choice 
     164                                       !  = 0 None 
     165                                       !  = 1 Boxcar over   nn_baro barotropic steps 
     166                                       !  = 2 Boxcar over 2*nn_baro     "        " 
    152167/ 
    153168!----------------------------------------------------------------------- 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex

    r4779 r4785  
    33 
    44all: main.c fortran.c 
    5 YACC = bison  
    65 
    76main.c : convert.tab.c convert.yy.c 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c

    r4779 r4785  
    120120         strcat(ligne,parcours->var->v_nomvar); 
    121121         didvariableadded = 1; 
    122             } 
     122      } 
    123123      parcours = parcours -> suiv; 
    124124   } 
     
    131131         strcat(ligne,parcours->var->v_nomvar); 
    132132         didvariableadded = 1; 
    133             } 
     133      } 
    134134      parcours = parcours -> suiv; 
    135135   } 
     
    249249         strcat(ligne,parcours->var->v_nomvar); 
    250250         didvariableadded = 1; 
    251             } 
     251      } 
    252252      parcours = parcours -> suiv; 
    253253   } 
     
    331331 
    332332      AddUseAgrifUtilBeforeCall_0(fortran_out); 
     333      WriteArgumentDeclaration_beforecall(); 
    333334      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); 
    334335      if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) 
     
    378379      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n"); 
    379380      WriteLocalParamDeclaration(fortran_out); 
     381      WriteArgumentDeclaration_beforecall(); 
    380382      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); 
    381383/*      WriteSubroutineDeclaration(0);*/ 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c

    r4779 r4785  
    554554      } 
    555555      tmpvar -> suiv = newvar; 
    556    } 
     556      } 
    557557      else 
    558558      { 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c

    r4779 r4785  
    4949    if ( VariableIsParameter ) 
    5050        List_GlobalParameter_Var =  AddListvarToListvar(listin, List_GlobalParameter_Var, 1); 
    51    } 
    5251} 
    5352 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c

    r4779 r4785  
    299299            } 
    300300        } 
    301      } 
    302301        newmodule = newmodule ->suiv; 
    303302    } 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c

    r4779 r4785  
    615615            { 
    616616                Merge_Variables(parcours->var,parcours1->var); 
     617            } 
    617618            else 
    618619            { 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h

    r4779 r4785  
    251251 int PrivateDeclare;       /* Variable has been declared as PRIVATE */ 
    252252 int ExternalDeclare;      /* Variable has been declared as EXTERNAL */ 
    253  char InitialValueGiven[LONG_C];   
     253 int InitialValueGiven;    /* An initial value has been given */ 
    254254 int Allocatabledeclare; 
    255255 int Targetdeclare; 
     
    333333 FILE *subloop; 
    334334 FILE *module_declar; 
    335  FILE *module_declar_type; 
    336335 FILE *allocationagrif; 
    337336 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c

    r4779 r4785  
    12061206       0,     0,     0,   275,   276,     0,     0,     0,     0,   331, 
    12071207       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1208        0,     0,     0,     0,     0,     0,     0,     0,   339,   340, 
    1209        0,   347,   350,   349,   342,   343,   344,   341,     0,   403, 
    1210      250,   247,     0,   279,   316,   318,   315,   281,   314,   280, 
    1211      351,   249,     0,     0,   356,   357,   429,     0,    69,   101, 
    1212        0,   355,   427,     0,   150,     0,   148,     0,   428,     0, 
    1213      415,   414,   393,   538,     0,   540,     0,   417,   408,    35, 
    1214      384,     0,   470,   468,     0,   456,     0,     0,     0,     0, 
    1215      162,     0,     0,   138,     0,    53,   172,   173,   158,   143, 
    1216      144,   170,   169,   234,   235,   108,    72,    52,    30,    15, 
    1217       25,     0,     0,    11,    39,    22,    12,     0,     0,    55, 
    1218      166,   127,   164,     0,   125,     0,   236,   120,   125,   165, 
    1219      137,     0,   165,     0,     0,     0,   236,   154,   159,     0, 
    1220        0,     0,   112,    50,     0,   177,   174,   209,   210,     0, 
    1221        0,     0,   179,     0,     0,   178,     0,    16,   236,   368, 
    1222      363,    37,   382,   381,   383,   164,   409,   407,     0,     0, 
    1223        0,   421,     0,   442,   439,   444,   430,     0,   452,   506, 
    1224      507,   485,     0,     0,     0,     0,   338,     0,   505,   492, 
    1225      493,   453,   458,   462,     0,   484,     0,   454,   390,     0, 
    1226        0,   432,   386,     0,   284,   277,     0,     0,     0,     0, 
    12271208       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    12281209       0,     0,   334,   329,   330,     0,   337,   340,   339,   333, 
     
    17731754     155,   156,   157,   158,   159,     0,   160,     0,     0,     0, 
    17741755       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1775      177,     0,   531,     0,     0,     0,     0,     0,     0,   149, 
    1776        0,   178,   179,     0,     0,     0,     0,   180,   150,   151, 
    1777      532,     0,     0,     0,     0,     0,     0,   181,   182,     0, 
    1778        0,   183,   184,   185,   186,     0,   152,   153,    91,     0, 
    1779        0,   154,   155,   156,   157,   187,     0,     0,   188,     0, 
    1780        0,     0,     0,   158,   159,   160,   161,   162,   163,   164, 
    1781        0,   165,   166,   167,     0,     0,   168,   169,   170,     0, 
    1782      171,   172,   173,   174,   175,     0,   176,     0,     0,     0, 
    17831756       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    17841757       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
     
    17931766       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    17941767       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1795        0,     0,     0,     0,     0,     0,     0,     0,   177,     0, 
    1796      650,     0,     0,     0,     0,     0,     0,   149,     0,   178, 
    1797      179,     0,     0,     0,     0,   180,   150,   151,     0,   651, 
    1798        0,     0,     0,     0,     0,   181,   182,     0,     0,   183, 
    1799      184,   185,   186,     0,   152,   153,    91,     0,     0,   154, 
    1800      155,   156,   157,   187,     0,     0,   188,     0,     0,     0, 
    1801        0,   158,   159,   160,   161,   162,   163,   164,     0,   165, 
    1802      166,   167,     0,     0,   168,   169,   170,     0,   171,   172, 
    1803      173,   174,   175,     0,   176,     0,     0,     0,     0,     0, 
    18041768       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    18051769       0,     0,   472,     0,     0,     0,     0,     0,   132,     0, 
     
    18341798     159,     0,   160,     0,     0,     0,     0,     0,     0,     0, 
    18351799       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1836        0,     0,     0,     0,   177,     0,   633,     0,     0,     0, 
    1837        0,     0,     0,   149,     0,   178,   179,     0,     0,     0, 
    1838        0,   180,   150,   151,     0,     0,     0,     0,     0,     0, 
    1839        0,   181,   182,     0,     0,   183,   184,   185,   186,     0, 
    1840      152,   153,    91,     0,     0,   154,   155,   156,   157,   187, 
    1841        0,     0,   188,     0,     0,     0,     0,   158,   159,   160, 
    1842      161,   162,   163,   164,     0,   165,   166,   167,     0,     0, 
    1843      168,   169,   170,     0,   171,   172,   173,   174,   175,     0, 
    1844      176,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    18451800       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    18461801       0,     0,     0,     0,     0,     0,     0,     0,     0,   615, 
     
    18651820     160,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    18661821       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1867        0,     0,   177,     0,   655,     0,     0,     0,     0,     0, 
    1868        0,   149,     0,   178,   179,     0,     0,     0,     0,   180, 
    1869      150,   151,     0,     0,     0,     0,     0,     0,     0,   181, 
    1870      182,     0,     0,   183,   184,   185,   186,     0,   152,   153, 
    1871       91,     0,     0,   154,   155,   156,   157,   187,     0,     0, 
    1872      188,     0,     0,     0,     0,   158,   159,   160,   161,   162, 
    1873      163,   164,     0,   165,   166,   167,     0,     0,   168,   169, 
    1874      170,     0,   171,   172,   173,   174,   175,     0,   176,     0, 
    18751822       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    18761823       0,     0,     0,     0,     0,     0,     0,   639,     0,     0, 
     
    19201867       0,   160,     0,     0,     0,     0,     0,     0,     0,     0, 
    19211868       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1922        0,     0,     0,     0,     0,     0,   177,     0,     0,     0, 
    1923        0,     0,     0,     0,     0,   149,     0,   178,   179,     0, 
    1924        0,     0,     0,   180,   150,   151,   532,     0,     0,     0, 
    1925        0,     0,     0,   181,   182,     0,     0,   183,   184,   185, 
    1926      186,     0,   152,   153,    91,     0,     0,   154,   155,   156, 
    1927      157,   187,     0,     0,   748,     0,     0,     0,     0,   158, 
    1928      159,   160,   161,   162,   163,   164,     0,   165,   166,   167, 
    1929        0,     0,   168,   169,   170,     0,   171,   172,   173,   174, 
    1930      175,     0,   176,     0,     0,     0,     0,     0,     0,     0, 
    19311869       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    19321870       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
     
    19411879       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    19421880       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1943        0,     0,     0,     0,   177,     0,     0,     0,     0,     0, 
    1944        0,     0,     0,   149,     0,   178,   179,     0,     0,     0, 
    1945        0,   180,   150,   151,   557,     0,     0,     0,     0,     0, 
    1946        0,   181,   182,     0,     0,   183,   184,   185,   186,     0, 
    1947      152,   153,   538,     0,     0,   154,   155,   156,   157,   187, 
    1948        0,     0,   188,     0,     0,     0,     0,   158,   159,   160, 
    1949      161,   162,   163,   164,     0,   165,   166,   167,     0,     0, 
    1950      168,   169,   170,     0,   171,   172,   173,   174,   175,     0, 
    1951      176,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    19521881       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    19531882       0,     0,     0,   132,     0,     0,     0,     0,   161,     0, 
     
    19611890       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    19621891       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    1963        0,     0,   177,     0,     0,     0,     0,     0,     0,     0, 
    1964        0,   149,     0,   178,   179,     0,     0,     0,     0,   180, 
    1965      150,   151,   532,     0,     0,     0,     0,     0,     0,   181, 
    1966      182,     0,     0,   183,   184,   185,   186,     0,   152,   153, 
    1967       91,     0,     0,   154,   155,   156,   157,   187,     0,     0, 
    1968      188,     0,     0,     0,     0,   158,   159,   160,   161,   162, 
    1969      163,   164,     0,   165,   166,   167,     0,     0,   168,   169, 
    1970      170,     0,   171,   172,   173,   174,   175,     0,   176,     0, 
    19711892       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    19721893       0,     0,   132,     0,     0,     0,     0,   161,     0,     0, 
     
    20241945     156,   157,   158,   159,     0,   160,     0,     0,     0,     0, 
    20251946       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    2026        0,     0,     0,     0,   177,     0,     0,     0,     0,     0, 
    2027        0,     0,     0,   149,     0,   178,   179,     0,     0,     0, 
    2028        0,   180,   150,   151,     0,     0,     0,     0,     0,     0, 
    2029        0,   181,   182,     0,     0,   183,   184,   185,   186,     0, 
    2030      152,   153,    91,     0,     0,   154,   155,   156,   157,   187, 
    2031        0,     0,   188,     0,     0,     0,     0,   158,   159,   160, 
    2032      161,   162,   163,   164,     0,   165,   166,   167,     0,     0, 
    2033      168,   169,   170,     0,   171,   172,   173,   174,   175,     0, 
    2034      176,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    20351947       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    20361948       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
     
    20451957       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    20461958       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    2047        0,     0,   177,     0,     0,     0,     0,     0,     0,     0, 
    2048        0,   149,     0,   178,   179,     0,     0,     0,     0,   180, 
    2049      150,   151,     0,     0,     0,     0,     0,     0,     0,   181, 
    2050      182,     0,     0,   183,   184,   185,   186,     0,   152,   153, 
    2051       91,     0,     0,   154,   155,   156,   157,   187,     0,     0, 
    2052      188,     0,     0,     0,     0,   158,   159,   160,   161,   162, 
    2053      163,   164,     0,   165,   166,   167,     0,     0,   168,   169, 
    2054      170,     0,   171,   172,   173,   174,   175,     0,   176,     0, 
    20551959       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    20561960       0,     0,     0,     0,     0,     0,     0,   132,     0,     0, 
     
    20741978     159,     0,   160,     0,     0,     0,     0,     0,     0,     0, 
    20751979       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    2076      177,     0,     0,     0,     0,     0,     0,     0,     0,   149, 
    2077        0,   178,   179,     0,     0,     0,     0,   180,   150,   151, 
    2078        0,     0,     0,     0,     0,     0,     0,   181,   182,     0, 
    2079        0,   183,   184,   185,   186,     0,   152,   153,    91,     0, 
    2080        0,   154,   155,   156,   157,   187,     0,     0,   381,     0, 
    2081        0,     0,     0,   158,   159,   160,   161,   162,   163,   164, 
    2082        0,   165,   166,   167,     0,     0,   168,   169,   170,     0, 
    2083      171,   172,   173,   174,   175,     0,   176,     0,     0,     0, 
    20841980       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    20851981       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
     
    20941990       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    20951991       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    2096        0,     0,     0,     0,     0,     0,     0,     0,   177,     0, 
    2097        0,     0,     0,     0,     0,     0,     0,   149,     0,   178, 
    2098      179,     0,     0,     0,     0,   180,   150,   151,     0,     0, 
    2099        0,     0,     0,     0,     0,   181,   182,     0,     0,   183, 
    2100      184,   185,   186,     0,   152,   153,    91,     0,     0,   154, 
    2101      155,   156,   157,   444,     0,     0,   188,     0,     0,     0, 
    2102        0,   158,   159,   160,   161,   162,   163,   164,     0,   165, 
    2103      166,   167,     0,     0,   168,   169,   170,     0,   171,   172, 
    2104      173,   174,   175,     0,   176,     0,     0,     0,     0,     0, 
    21051992       0,     0,     0,     0,     0,     0,     0,     0,     0,     0, 
    21061993       0,     0,     0,     0,   132,     0,     0,     0,     0,   161, 
     
    24482335      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1, 
    24492336      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1, 
    2450       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1, 
    2451       -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1, 
    2452       -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61, 
    2453       62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71, 
    2454      185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131, 
    2455       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1, 
    2456      142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1, 
    2457       -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1, 
    2458      162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1, 
    2459       44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1, 
    2460       -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1, 
    2461       64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73, 
    2462       74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1, 
    2463       -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1, 
    24642337      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1, 
    24652338      -1,    -1,    -1,   163,   164,   165,     5,     6,     7,     8, 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y

    r4779 r4785  
    275275%type <na> opt_signe 
    276276%type <na> filename 
    277 %type <nac> attribute 
     277%type <na> attribute 
    278278%type <na> complex_const 
    279279%type <na> begin_array 
     
    751751 
    752752save :  before_save varsave 
    753       | before_save  comblock varsave 
     753      | before_save comblock varsave 
    754754      | save opt_comma comblock opt_comma varsave 
    755755      | save ',' varsave 
     
    13251325            InitialValueGiven = 2; 
    13261326        } 
    1327       | before_initial TOK_POINT_TO expr 
    1328                     { 
    1329                        if ( couldaddvariable == 1 ) 
    1330                        { 
    1331                           strcpy(InitValue,$3); 
    1332                           strcpy(InitialValueGiven,"=>"); 
    1333                        } 
    1334                     } 
    13351327      ; 
    13361328complex_const : 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c

    r4779 r4785  
    1 /* A Bison parser, made by GNU Bison 2.7.12-4996.  */ 
    2  
    3 /* Bison implementation for Yacc-like parsers in C 
    4     
    5       Copyright (C) 1984, 1989-1990, 2000-2013 Free Software Foundation, Inc. 
    6     
    7    This program is free software: you can redistribute it and/or modify 
     1/* A Bison parser, made by GNU Bison 2.3.  */ 
     2 
     3/* Skeleton implementation for Bison's Yacc-like parsers in C 
     4 
     5   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 
     6   Free Software Foundation, Inc. 
     7 
     8   This program is free software; you can redistribute it and/or modify 
    89   it under the terms of the GNU General Public License as published by 
    9    the Free Software Foundation, either version 3 of the License, or 
    10    (at your option) any later version. 
    11     
     10   the Free Software Foundation; either version 2, or (at your option) 
     11   any later version. 
     12 
    1213   This program is distributed in the hope that it will be useful, 
    1314   but WITHOUT ANY WARRANTY; without even the implied warranty of 
    1415   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
    1516   GNU General Public License for more details. 
    16     
     17 
    1718   You should have received a copy of the GNU General Public License 
    18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */ 
     19   along with this program; if not, write to the Free Software 
     20   Foundation, Inc., 51 Franklin Street, Fifth Floor, 
     21   Boston, MA 02110-1301, USA.  */ 
    1922 
    2023/* As a special exception, you may create a larger work that contains 
     
    2730   Bison output files to be licensed under the GNU General Public 
    2831   License without this special exception. 
    29     
     32 
    3033   This special exception was added by the Free Software Foundation in 
    3134   version 2.2 of Bison.  */ 
     
    4548 
    4649/* Bison version.  */ 
    47 #define YYBISON_VERSION "2.7.12-4996" 
     50#define YYBISON_VERSION "2.3" 
    4851 
    4952/* Skeleton name.  */ 
     
    5356#define YYPURE 0 
    5457 
    55 /* Push parsers.  */ 
    56 #define YYPUSH 0 
     58/* Using locations.  */ 
     59#define YYLSP_NEEDED 0 
    5760 
    5861/* Substitute the variable and function names.  */ 
     
    97100 
    98101 
     102 
     103 
    99104/* Copy the first part of user declarations.  */ 
    100 /* Line 371 of yacc.c  */ 
    101105#line 35 "convert.y" 
    102106 
     
    130134#endif 
    131135 
    132  
    133 /* Enabling traces.  */ 
    134 #ifndef YYDEBUG 
    135 # define YYDEBUG 0 
    136 #endif 
    137 #if YYDEBUG 
    138 extern int yydebug; 
    139 #endif 
    140  
    141 /* Tokens.  */ 
    142 #ifndef YYTOKENTYPE 
    143 # define YYTOKENTYPE 
    144    /* Put the tokens into the symbol table, so that GDB and other debuggers 
    145       know about them.  */ 
    146    enum yytokentype { 
    147      TOK_SEP = 258, 
    148      TOK_USE = 259, 
    149      TOK_MODULEMAIN = 260, 
    150      TOK_NOTGRIDDEP = 261, 
    151      TOK_USEITEM = 262, 
    152      TOK_NAME = 263, 
    153      TOK_PROBTYPE = 264 
    154    }; 
    155 #endif 
    156  
     136/* Enabling the token table.  */ 
     137#ifndef YYTOKEN_TABLE 
     138# define YYTOKEN_TABLE 0 
     139#endif 
    157140 
    158141#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED 
    159142typedef union YYSTYPE 
    160143#line 52 "convert.y" 
    161  
     144{ 
    162145    char na[LONG_M]; 
    163146} 
     
    167150# define yystype YYSTYPE /* obsolescent; will be withdrawn */ 
    168151# define YYSTYPE_IS_DECLARED 1 
    169 #endif 
    170  
    171 extern YYSTYPE yylval; 
    172  
    173 #ifdef YYPARSE_PARAM 
    174 #if defined __STDC__ || defined __cplusplus 
    175 int yyparse (void *YYPARSE_PARAM); 
    176 #else 
    177 int yyparse (); 
    178 #endif 
    179 #else /* ! YYPARSE_PARAM */ 
    180 #if defined __STDC__ || defined __cplusplus 
    181 int yyparse (void); 
    182 #else 
    183 int yyparse (); 
    184 #endif 
    185 #endif /* ! YYPARSE_PARAM */ 
     152# define YYSTYPE_IS_TRIVIAL 1 
     153#endif 
    186154 
    187155 
     
    189157/* Copy the second part of user declarations.  */ 
    190158 
    191 /* Line 390 of yacc.c  */ 
    192 #line 159 "convert.tab.c" 
    193159 
    194160/* Line 216 of yacc.c.  */ 
     
    246212#  if ENABLE_NLS 
    247213#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */ 
    248 #   define YY_(Msgid) dgettext ("bison-runtime", Msgid) 
     214#   define YY_(msgid) dgettext ("bison-runtime", msgid) 
    249215#  endif 
    250216# endif 
    251217# ifndef YY_ 
    252 #  define YY_(Msgid) Msgid 
    253 # endif 
    254 #endif 
    255  
    256 #ifndef __attribute__ 
    257 /* This feature is available in gcc versions 2.5 and later.  */ 
    258 # if (! defined __GNUC__ || __GNUC__ < 2 \ 
    259       || (__GNUC__ == 2 && __GNUC_MINOR__ < 5)) 
    260 #  define __attribute__(Spec) /* empty */ 
     218#  define YY_(msgid) msgid 
    261219# endif 
    262220#endif 
     
    264222/* Suppress unused-variable warnings by "using" E.  */ 
    265223#if ! defined lint || defined __GNUC__ 
    266 # define YYUSE(E) ((void) (E)) 
     224# define YYUSE(e) ((void) (e)) 
    267225#else 
    268 # define YYUSE(E) /* empty */ 
    269 #endif 
    270  
     226# define YYUSE(e) /* empty */ 
     227#endif 
    271228 
    272229/* Identity function, used to suppress warnings about constant conditions.  */ 
    273230#ifndef lint 
    274 # define YYID(N) (N) 
     231# define YYID(n) (n) 
    275232#else 
    276233#if (defined __STDC__ || defined __C99__FUNC__ \ 
    277234     || defined __cplusplus || defined _MSC_VER) 
    278235static int 
    279 YYID (int yyi) 
     236YYID (int i) 
    280237#else 
    281238static int 
    282 YYID (yyi) 
    283     int yyi; 
    284 #endif 
    285 { 
    286   return yyi; 
     239YYID (i) 
     240    int i; 
     241#endif 
     242{ 
     243  return i; 
    287244} 
    288245#endif 
     
    305262#   else 
    306263#    define YYSTACK_ALLOC alloca 
    307 #    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ 
     264#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ 
    308265     || defined __cplusplus || defined _MSC_VER) 
    309266#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */ 
    310       /* Use EXIT_SUCCESS as a witness for stdlib.h.  */ 
    311 #     ifndef EXIT_SUCCESS 
    312 #      define EXIT_SUCCESS 0 
     267#     ifndef _STDLIB_H 
     268#      define _STDLIB_H 1 
    313269#     endif 
    314270#    endif 
     
    333289#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM 
    334290#  endif 
    335 #  if (defined __cplusplus && ! defined EXIT_SUCCESS \ 
     291#  if (defined __cplusplus && ! defined _STDLIB_H \ 
    336292       && ! ((defined YYMALLOC || defined malloc) \ 
    337293        && (defined YYFREE || defined free))) 
    338294#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */ 
    339 #   ifndef EXIT_SUCCESS 
    340 #    define EXIT_SUCCESS 0 
     295#   ifndef _STDLIB_H 
     296#    define _STDLIB_H 1 
    341297#   endif 
    342298#  endif 
    343299#  ifndef YYMALLOC 
    344300#   define YYMALLOC malloc 
    345 #   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ 
     301#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ 
    346302     || defined __cplusplus || defined _MSC_VER) 
    347303void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ 
     
    350306#  ifndef YYFREE 
    351307#   define YYFREE free 
    352 #   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ 
     308#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ 
    353309     || defined __cplusplus || defined _MSC_VER) 
    354310void free (void *); /* INFRINGES ON USER NAME SPACE */ 
     
    366322union yyalloc 
    367323{ 
    368   yytype_int16 yyss_alloc; 
    369   YYSTYPE yyvs_alloc; 
    370 }; 
     324  yytype_int16 yyss; 
     325  YYSTYPE yyvs; 
     326  }; 
    371327 
    372328/* The size of the maximum gap between one aligned stack and the next.  */ 
     
    379335      + YYSTACK_GAP_MAXIMUM) 
    380336 
    381 # define YYCOPY_NEEDED 1 
     337/* Copy COUNT objects from FROM to TO.  The source and destination do 
     338   not overlap.  */ 
     339# ifndef YYCOPY 
     340#  if defined __GNUC__ && 1 < __GNUC__ 
     341#   define YYCOPY(To, From, Count) \ 
     342      __builtin_memcpy (To, From, (Count) * sizeof (*(From))) 
     343#  else 
     344#   define YYCOPY(To, From, Count)     \ 
     345      do             \ 
     346   {              \ 
     347     YYSIZE_T yyi;            \ 
     348     for (yyi = 0; yyi < (Count); yyi++)  \ 
     349       (To)[yyi] = (From)[yyi];     \ 
     350   }              \ 
     351      while (YYID (0)) 
     352#  endif 
     353# endif 
    382354 
    383355/* Relocate STACK from its old location to the new one.  The 
     
    386358   stack.  Advance YYPTR to a properly aligned location for the next 
    387359   stack.  */ 
    388 # define YYSTACK_RELOCATE(Stack_alloc, Stack)            \ 
     360# define YYSTACK_RELOCATE(Stack)             \ 
    389361    do                           \ 
    390362      {                          \ 
    391363   YYSIZE_T yynewbytes;                \ 
    392    YYCOPY (&yyptr->Stack_alloc, Stack, yysize);       \ 
    393    Stack = &yyptr->Stack_alloc;              \ 
     364   YYCOPY (&yyptr->Stack, Stack, yysize);          \ 
     365   Stack = &yyptr->Stack               \ 
    394366   yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ 
    395367   yyptr += yynewbytes / sizeof (*yyptr);          \ 
     
    398370 
    399371#endif 
    400  
    401 #if defined YYCOPY_NEEDED && YYCOPY_NEEDED 
    402 /* Copy COUNT objects from SRC to DST.  The source and destination do 
    403    not overlap.  */ 
    404 # ifndef YYCOPY 
    405 #  if defined __GNUC__ && 1 < __GNUC__ 
    406 #   define YYCOPY(Dst, Src, Count) \ 
    407       __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) 
    408 #  else 
    409 #   define YYCOPY(Dst, Src, Count)              \ 
    410       do                                        \ 
    411         {                                       \ 
    412           YYSIZE_T yyi;                         \ 
    413           for (yyi = 0; yyi < (Count); yyi++)   \ 
    414             (Dst)[yyi] = (Src)[yyi];            \ 
    415         }                                       \ 
    416       while (YYID (0)) 
    417 #  endif 
    418 # endif 
    419 #endif /* !YYCOPY_NEEDED */ 
    420372 
    421373/* YYFINAL -- State number of the termination state.  */ 
     
    499451#endif 
    500452 
    501 #if YYDEBUG || YYERROR_VERBOSE || 0 
     453#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE 
    502454/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. 
    503455   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */ 
     
    507459  "TOK_USE", "TOK_MODULEMAIN", "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME", 
    508460  "TOK_CSTINT", "TOK_PROBTYPE", "','", "';'", "'\\n'", "$accept", "input", 
    509   "line", YY_NULL 
     461  "line", 0 
    510462}; 
    511463#endif 
     
    535487}; 
    536488 
    537 /* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM. 
    538    Performed when YYTABLE doesn't specify something else to do.  Zero 
     489/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state 
     490   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero 
    539491   means the default is an error.  */ 
    540492static const yytype_uint8 yydefact[] = 
     
    569521/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If 
    570522   positive, shift that token.  If negative, reduce the rule which 
    571    number is the opposite.  If YYTABLE_NINF, syntax error.  */ 
     523   number is the opposite.  If zero, do what YYDEFACT says. 
     524   If YYTABLE_NINF, syntax error.  */ 
    572525#define YYTABLE_NINF -1 
    573526static const yytype_uint8 yytable[] = 
     
    578531}; 
    579532 
    580 #define yypact_value_is_default(Yystate) \ 
    581   (!!((Yystate) == (-10))) 
    582  
    583 #define yytable_value_is_error(Yytable_value) \ 
    584   YYID (0) 
    585  
    586533static const yytype_int8 yycheck[] = 
    587534{ 
     
    612559/* Like YYERROR except do call yyerror.  This remains here temporarily 
    613560   to ease the transition to the new meaning of YYERROR, for GCC. 
    614    Once GCC version 2 has supplanted version 1, this can go.  However, 
    615    YYFAIL appears to be in use.  Nevertheless, it is formally deprecated 
    616    in Bison 2.4.2's NEWS entry, where a plan to phase it out is 
    617    discussed.  */ 
     561   Once GCC version 2 has supplanted version 1, this can go.  */ 
    618562 
    619563#define YYFAIL    goto yyerrlab 
    620 #if defined YYFAIL 
    621   /* This is here to suppress warnings from the GCC cpp's 
    622      -Wunused-macros.  Normally we don't worry about that warning, but 
    623      some users do, and we want to make it easy for users to remove 
    624      YYFAIL uses, which will produce warnings from Bison 2.5.  */ 
    625 #endif 
    626564 
    627565#define YYRECOVERING()  (!!yyerrstatus) 
    628566 
    629 #define YYBACKUP(Token, Value)                                  \ 
    630 do                                                              \ 
    631   if (yychar == YYEMPTY)                                        \ 
    632     {                                                           \ 
    633       yychar = (Token);                                         \ 
    634       yylval = (Value);                                         \ 
    635       YYPOPSTACK (yylen);                                       \ 
    636       yystate = *yyssp;                                         \ 
    637       goto yybackup;                                            \ 
    638     }                                                           \ 
    639   else                                                          \ 
    640     {                                                           \ 
     567#define YYBACKUP(Token, Value)               \ 
     568do                      \ 
     569  if (yychar == YYEMPTY && yylen == 1)          \ 
     570    {                      \ 
     571      yychar = (Token);                \ 
     572      yylval = (Value);                \ 
     573      yytoken = YYTRANSLATE (yychar);           \ 
     574      YYPOPSTACK (1);                  \ 
     575      goto yybackup;                \ 
     576    }                      \ 
     577  else                        \ 
     578    {                      \ 
    641579      yyerror (YY_("syntax error: cannot back up")); \ 
    642580      YYERROR;                   \ 
     
    644582while (YYID (0)) 
    645583 
    646 /* Error token number */ 
     584 
    647585#define YYTERROR  1 
    648586#define YYERRCODE 256 
    649587 
    650588 
    651 /* This macro is provided for backward compatibility. */ 
     589/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. 
     590   If N is 0, then set CURRENT to the empty location which ends 
     591   the previous symbol: RHS[0] (always defined).  */ 
     592 
     593#define YYRHSLOC(Rhs, K) ((Rhs)[K]) 
     594#ifndef YYLLOC_DEFAULT 
     595# define YYLLOC_DEFAULT(Current, Rhs, N)           \ 
     596    do                           \ 
     597      if (YYID (N))                                                    \ 
     598   {                       \ 
     599     (Current).first_line   = YYRHSLOC (Rhs, 1).first_line; \ 
     600     (Current).first_column = YYRHSLOC (Rhs, 1).first_column;  \ 
     601     (Current).last_line    = YYRHSLOC (Rhs, N).last_line;     \ 
     602     (Current).last_column  = YYRHSLOC (Rhs, N).last_column;   \ 
     603   }                       \ 
     604      else                       \ 
     605   {                       \ 
     606     (Current).first_line   = (Current).last_line   =    \ 
     607       YYRHSLOC (Rhs, 0).last_line;          \ 
     608     (Current).first_column = (Current).last_column =    \ 
     609       YYRHSLOC (Rhs, 0).last_column;           \ 
     610   }                       \ 
     611    while (YYID (0)) 
     612#endif 
     613 
     614 
     615/* YY_LOCATION_PRINT -- Print the location on the stream. 
     616   This macro was not mandated originally: define only if we know 
     617   we won't break user code: when these are the locations we know.  */ 
     618 
    652619#ifndef YY_LOCATION_PRINT 
    653 # define YY_LOCATION_PRINT(File, Loc) ((void) 0) 
     620# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL 
     621#  define YY_LOCATION_PRINT(File, Loc)       \ 
     622     fprintf (File, "%d.%d-%d.%d",        \ 
     623         (Loc).first_line, (Loc).first_column,  \ 
     624         (Loc).last_line,  (Loc).last_column) 
     625# else 
     626#  define YY_LOCATION_PRINT(File, Loc) ((void) 0) 
     627# endif 
    654628#endif 
    655629 
    656630 
    657631/* YYLEX -- calling `yylex' with the right arguments.  */ 
     632 
    658633#ifdef YYLEX_PARAM 
    659634# define YYLEX yylex (YYLEX_PARAM) 
     
    705680#endif 
    706681{ 
    707   FILE *yyo = yyoutput; 
    708   YYUSE (yyo); 
    709682  if (!yyvaluep) 
    710683    return; 
     
    715688  YYUSE (yyoutput); 
    716689# endif 
    717   YYUSE (yytype); 
     690  switch (yytype) 
     691    { 
     692      default: 
     693   break; 
     694    } 
    718695} 
    719696 
     
    752729     || defined __cplusplus || defined _MSC_VER) 
    753730static void 
    754 yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) 
     731yy_stack_print (yytype_int16 *bottom, yytype_int16 *top) 
    755732#else 
    756733static void 
    757 yy_stack_print (yybottom, yytop) 
    758     yytype_int16 *yybottom; 
    759     yytype_int16 *yytop; 
     734yy_stack_print (bottom, top) 
     735    yytype_int16 *bottom; 
     736    yytype_int16 *top; 
    760737#endif 
    761738{ 
    762739  YYFPRINTF (stderr, "Stack now"); 
    763   for (; yybottom <= yytop; yybottom++) 
    764     { 
    765       int yybot = *yybottom; 
    766       YYFPRINTF (stderr, " %d", yybot); 
    767     } 
     740  for (; bottom <= top; ++bottom) 
     741    YYFPRINTF (stderr, " %d", *bottom); 
    768742  YYFPRINTF (stderr, "\n"); 
    769743} 
     
    799773  for (yyi = 0; yyi < yynrhs; yyi++) 
    800774    { 
    801       YYFPRINTF (stderr, "   $%d = ", yyi + 1); 
     775      fprintf (stderr, "   $%d = ", yyi + 1); 
    802776      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], 
    803777             &(yyvsp[(yyi + 1) - (yynrhs)]) 
    804778                         ); 
    805       YYFPRINTF (stderr, "\n"); 
     779      fprintf (stderr, "\n"); 
    806780    } 
    807781} 
     
    839813# define YYMAXDEPTH 10000 
    840814#endif 
     815 
     816 
    841817 
    842818 
     
    942918# endif 
    943919 
    944 /* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message 
    945    about the unexpected token YYTOKEN for the state stack whose top is 
    946    YYSSP. 
    947  
    948    Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is 
    949    not large enough to hold the message.  In that case, also set 
    950    *YYMSG_ALLOC to the required number of bytes.  Return 2 if the 
    951    required number of bytes is too large to store.  */ 
    952 static int 
    953 yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, 
    954                 yytype_int16 *yyssp, int yytoken) 
    955 { 
    956   YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]); 
    957   YYSIZE_T yysize = yysize0; 
    958   enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; 
    959   /* Internationalized format string. */ 
    960   const char *yyformat = YY_NULL; 
    961   /* Arguments of yyformat. */ 
    962   char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; 
    963   /* Number of reported tokens (one for the "unexpected", one per 
    964      "expected"). */ 
    965   int yycount = 0; 
    966  
    967   /* There are many possibilities here to consider: 
    968      - Assume YYFAIL is not used.  It's too flawed to consider.  See 
    969        <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html> 
    970        for details.  YYERROR is fine as it does not invoke this 
    971        function. 
    972      - If this state is a consistent state with a default action, then 
    973        the only way this function was invoked is if the default action 
    974        is an error action.  In that case, don't check for expected 
    975        tokens because there are none. 
    976      - The only way there can be no lookahead present (in yychar) is if 
    977        this state is a consistent state with a default action.  Thus, 
    978        detecting the absence of a lookahead is sufficient to determine 
    979        that there is no unexpected or expected token to report.  In that 
    980        case, just report a simple "syntax error". 
    981      - Don't assume there isn't a lookahead just because this state is a 
    982        consistent state with a default action.  There might have been a 
    983        previous inconsistent state, consistent state with a non-default 
    984        action, or user semantic action that manipulated yychar. 
    985      - Of course, the expected token list depends on states to have 
    986        correct lookahead information, and it depends on the parser not 
    987        to perform extra reductions after fetching a lookahead from the 
    988        scanner and before detecting a syntax error.  Thus, state merging 
    989        (from LALR or IELR) and default reductions corrupt the expected 
    990        token list.  However, the list is correct for canonical LR with 
    991        one exception: it will still contain any token that will not be 
    992        accepted due to an error action in a later state. 
    993   */ 
    994   if (yytoken != YYEMPTY) 
     920/* Copy into YYRESULT an error message about the unexpected token 
     921   YYCHAR while in state YYSTATE.  Return the number of bytes copied, 
     922   including the terminating null byte.  If YYRESULT is null, do not 
     923   copy anything; just return the number of bytes that would be 
     924   copied.  As a special case, return 0 if an ordinary "syntax error" 
     925   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during 
     926   size calculation.  */ 
     927static YYSIZE_T 
     928yysyntax_error (char *yyresult, int yystate, int yychar) 
     929{ 
     930  int yyn = yypact[yystate]; 
     931 
     932  if (! (YYPACT_NINF < yyn && yyn <= YYLAST)) 
     933    return 0; 
     934  else 
    995935    { 
    996       int yyn = yypact[*yyssp]; 
    997       yyarg[yycount++] = yytname[yytoken]; 
    998       if (!yypact_value_is_default (yyn)) 
    999         { 
    1000           /* Start YYX at -YYN if negative to avoid negative indexes in 
    1001              YYCHECK.  In other words, skip the first -YYN actions for 
    1002              this state because they are default actions.  */ 
    1003           int yyxbegin = yyn < 0 ? -yyn : 0; 
    1004           /* Stay within bounds of both yycheck and yytname.  */ 
    1005           int yychecklim = YYLAST - yyn + 1; 
    1006           int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; 
    1007           int yyx; 
    1008  
    1009           for (yyx = yyxbegin; yyx < yyxend; ++yyx) 
    1010             if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR 
    1011                 && !yytable_value_is_error (yytable[yyx + yyn])) 
    1012               { 
    1013                 if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) 
    1014                   { 
    1015                     yycount = 1; 
    1016                     yysize = yysize0; 
    1017                     break; 
    1018                   } 
    1019                 yyarg[yycount++] = yytname[yyx]; 
    1020                 { 
    1021                   YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]); 
    1022                   if (! (yysize <= yysize1 
    1023                          && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) 
    1024                     return 2; 
    1025                   yysize = yysize1; 
    1026                 } 
    1027               } 
    1028         } 
     936      int yytype = YYTRANSLATE (yychar); 
     937      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]); 
     938      YYSIZE_T yysize = yysize0; 
     939      YYSIZE_T yysize1; 
     940      int yysize_overflow = 0; 
     941      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; 
     942      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; 
     943      int yyx; 
     944 
     945# if 0 
     946      /* This is so xgettext sees the translatable formats that are 
     947    constructed on the fly.  */ 
     948      YY_("syntax error, unexpected %s"); 
     949      YY_("syntax error, unexpected %s, expecting %s"); 
     950      YY_("syntax error, unexpected %s, expecting %s or %s"); 
     951      YY_("syntax error, unexpected %s, expecting %s or %s or %s"); 
     952      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"); 
     953# endif 
     954      char *yyfmt; 
     955      char const *yyf; 
     956      static char const yyunexpected[] = "syntax error, unexpected %s"; 
     957      static char const yyexpecting[] = ", expecting %s"; 
     958      static char const yyor[] = " or %s"; 
     959      char yyformat[sizeof yyunexpected 
     960          + sizeof yyexpecting - 1 
     961          + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2) 
     962             * (sizeof yyor - 1))]; 
     963      char const *yyprefix = yyexpecting; 
     964 
     965      /* Start YYX at -YYN if negative to avoid negative indexes in 
     966    YYCHECK.  */ 
     967      int yyxbegin = yyn < 0 ? -yyn : 0; 
     968 
     969      /* Stay within bounds of both yycheck and yytname.  */ 
     970      int yychecklim = YYLAST - yyn + 1; 
     971      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; 
     972      int yycount = 1; 
     973 
     974      yyarg[0] = yytname[yytype]; 
     975      yyfmt = yystpcpy (yyformat, yyunexpected); 
     976 
     977      for (yyx = yyxbegin; yyx < yyxend; ++yyx) 
     978   if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) 
     979     { 
     980       if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) 
     981         { 
     982      yycount = 1; 
     983      yysize = yysize0; 
     984      yyformat[sizeof yyunexpected - 1] = '\0'; 
     985      break; 
     986         } 
     987       yyarg[yycount++] = yytname[yyx]; 
     988       yysize1 = yysize + yytnamerr (0, yytname[yyx]); 
     989       yysize_overflow |= (yysize1 < yysize); 
     990       yysize = yysize1; 
     991       yyfmt = yystpcpy (yyfmt, yyprefix); 
     992       yyprefix = yyor; 
     993     } 
     994 
     995      yyf = YY_(yyformat); 
     996      yysize1 = yysize + yystrlen (yyf); 
     997      yysize_overflow |= (yysize1 < yysize); 
     998      yysize = yysize1; 
     999 
     1000      if (yysize_overflow) 
     1001   return YYSIZE_MAXIMUM; 
     1002 
     1003      if (yyresult) 
     1004   { 
     1005     /* Avoid sprintf, as that infringes on the user's name space. 
     1006        Don't have undefined behavior even if the translation 
     1007        produced a string with the wrong number of "%s"s.  */ 
     1008     char *yyp = yyresult; 
     1009     int yyi = 0; 
     1010     while ((*yyp = *yyf) != '\0') 
     1011       { 
     1012         if (*yyp == '%' && yyf[1] == 's' && yyi < yycount) 
     1013      { 
     1014        yyp += yytnamerr (yyp, yyarg[yyi++]); 
     1015        yyf += 2; 
     1016      } 
     1017         else 
     1018      { 
     1019        yyp++; 
     1020        yyf++; 
     1021      } 
     1022       } 
     1023   } 
     1024      return yysize; 
    10291025    } 
    1030  
    1031   switch (yycount) 
    1032     { 
    1033 # define YYCASE_(N, S)                      \ 
    1034       case N:                               \ 
    1035         yyformat = S;                       \ 
    1036       break 
    1037       YYCASE_(0, YY_("syntax error")); 
    1038       YYCASE_(1, YY_("syntax error, unexpected %s")); 
    1039       YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); 
    1040       YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); 
    1041       YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); 
    1042       YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); 
    1043 # undef YYCASE_ 
    1044     } 
    1045  
    1046   { 
    1047     YYSIZE_T yysize1 = yysize + yystrlen (yyformat); 
    1048     if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) 
    1049       return 2; 
    1050     yysize = yysize1; 
    1051   } 
    1052  
    1053   if (*yymsg_alloc < yysize) 
    1054     { 
    1055       *yymsg_alloc = 2 * yysize; 
    1056       if (! (yysize <= *yymsg_alloc 
    1057              && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) 
    1058         *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; 
    1059       return 1; 
    1060     } 
    1061  
    1062   /* Avoid sprintf, as that infringes on the user's name space. 
    1063      Don't have undefined behavior even if the translation 
    1064      produced a string with the wrong number of "%s"s.  */ 
    1065   { 
    1066     char *yyp = *yymsg; 
    1067     int yyi = 0; 
    1068     while ((*yyp = *yyformat) != '\0') 
    1069       if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) 
    1070         { 
    1071           yyp += yytnamerr (yyp, yyarg[yyi++]); 
    1072           yyformat += 2; 
    1073         } 
    1074       else 
    1075         { 
    1076           yyp++; 
    1077           yyformat++; 
    1078         } 
    1079   } 
    1080   return 0; 
    10811026} 
    10821027#endif /* YYERROR_VERBOSE */ 
     1028 
     1029 
    10831030 
    10841031/*-----------------------------------------------. 
     
    11051052  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); 
    11061053 
    1107   YYUSE (yytype); 
    1108 } 
    1109  
    1110  
    1111  
    1112  
    1113 /* The lookahead symbol.  */ 
     1054  switch (yytype) 
     1055    { 
     1056 
     1057      default: 
     1058   break; 
     1059    } 
     1060} 
     1061 
     1062 
     1063 
     1064/* Prevent warnings from -Wmissing-prototypes.  */ 
     1065 
     1066#ifdef YYPARSE_PARAM 
     1067#if defined __STDC__ || defined __cplusplus 
     1068int yyparse (void *YYPARSE_PARAM); 
     1069#else 
     1070int yyparse (); 
     1071#endif 
     1072#else /* ! YYPARSE_PARAM */ 
     1073#if defined __STDC__ || defined __cplusplus 
     1074int yyparse (void); 
     1075#else 
     1076int yyparse (); 
     1077#endif 
     1078#endif /* ! YYPARSE_PARAM */ 
     1079 
     1080 
     1081 
     1082/* The look-ahead symbol.  */ 
    11141083int yychar; 
    11151084 
    1116  
    1117 #ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN 
    1118 # define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN 
    1119 # define YY_IGNORE_MAYBE_UNINITIALIZED_END 
    1120 #endif 
    1121 #ifndef YY_INITIAL_VALUE 
    1122 # define YY_INITIAL_VALUE(Value) /* Nothing. */ 
    1123 #endif 
    1124  
    1125 /* The semantic value of the lookahead symbol.  */ 
    1126 YYSTYPE yylval YY_INITIAL_VALUE(yyval_default); 
     1085/* The semantic value of the look-ahead symbol.  */ 
     1086YYSTYPE yylval; 
    11271087 
    11281088/* Number of syntax errors so far.  */ 
    11291089int yynerrs; 
     1090 
    11301091 
    11311092 
     
    11561117#endif 
    11571118{ 
    1158     int yystate; 
    1159     /* Number of tokens to shift before error messages enabled.  */ 
    1160     int yyerrstatus; 
    1161  
    1162     /* The stacks and their tools: 
    1163        `yyss': related to states. 
    1164        `yyvs': related to semantic values. 
    1165  
    1166        Refer to the stacks through separate pointers, to allow yyoverflow 
    1167        to reallocate them elsewhere.  */ 
    1168  
    1169     /* The state stack.  */ 
    1170     yytype_int16 yyssa[YYINITDEPTH]; 
    1171     yytype_int16 *yyss; 
    1172     yytype_int16 *yyssp; 
    1173  
    1174     /* The semantic value stack.  */ 
    1175     YYSTYPE yyvsa[YYINITDEPTH]; 
    1176     YYSTYPE *yyvs; 
    1177     YYSTYPE *yyvsp; 
    1178  
    1179     YYSIZE_T yystacksize; 
    1180  
     1119   
     1120  int yystate; 
    11811121  int yyn; 
    11821122  int yyresult; 
    1183   /* Lookahead token as an internal (translated) token number.  */ 
     1123  /* Number of tokens to shift before error messages enabled.  */ 
     1124  int yyerrstatus; 
     1125  /* Look-ahead token as an internal (translated) token number.  */ 
    11841126  int yytoken = 0; 
    1185   /* The variables used to return semantic value and location from the 
    1186      action routines.  */ 
    1187   YYSTYPE yyval; 
    1188  
    11891127#if YYERROR_VERBOSE 
    11901128  /* Buffer for error messages, and its allocated size.  */ 
     
    11941132#endif 
    11951133 
     1134  /* Three stacks and their tools: 
     1135     `yyss': related to states, 
     1136     `yyvs': related to semantic values, 
     1137     `yyls': related to locations. 
     1138 
     1139     Refer to the stacks thru separate pointers, to allow yyoverflow 
     1140     to reallocate them elsewhere.  */ 
     1141 
     1142  /* The state stack.  */ 
     1143  yytype_int16 yyssa[YYINITDEPTH]; 
     1144  yytype_int16 *yyss = yyssa; 
     1145  yytype_int16 *yyssp; 
     1146 
     1147  /* The semantic value stack.  */ 
     1148  YYSTYPE yyvsa[YYINITDEPTH]; 
     1149  YYSTYPE *yyvs = yyvsa; 
     1150  YYSTYPE *yyvsp; 
     1151 
     1152 
     1153 
    11961154#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N)) 
     1155 
     1156  YYSIZE_T yystacksize = YYINITDEPTH; 
     1157 
     1158  /* The variables used to return semantic value and location from the 
     1159     action routines.  */ 
     1160  YYSTYPE yyval; 
     1161 
    11971162 
    11981163  /* The number of symbols on the RHS of the reduced rule. 
     
    12001165  int yylen = 0; 
    12011166 
    1202   yyssp = yyss = yyssa; 
    1203   yyvsp = yyvs = yyvsa; 
    1204   yystacksize = YYINITDEPTH; 
    1205  
    12061167  YYDPRINTF ((stderr, "Starting parse\n")); 
    12071168 
     
    12091170  yyerrstatus = 0; 
    12101171  yynerrs = 0; 
    1211   yychar = YYEMPTY; /* Cause a token to be read.  */ 
     1172  yychar = YYEMPTY;     /* Cause a token to be read.  */ 
     1173 
     1174  /* Initialize stack pointers. 
     1175     Waste one element of value and location stack 
     1176     so that they stay on the same level as the state stack. 
     1177     The wasted elements are never initialized.  */ 
     1178 
     1179  yyssp = yyss; 
     1180  yyvsp = yyvs; 
     1181 
    12121182  goto yysetstate; 
    12131183 
     
    12361206   yytype_int16 *yyss1 = yyss; 
    12371207 
     1208 
    12381209   /* Each stack pointer address is followed by the size of the 
    12391210      data in use in that stack, in bytes.  This used to be a 
     
    12431214          &yyss1, yysize * sizeof (*yyssp), 
    12441215          &yyvs1, yysize * sizeof (*yyvsp), 
     1216 
    12451217          &yystacksize); 
    12461218 
     
    12651237   if (! yyptr) 
    12661238     goto yyexhaustedlab; 
    1267    YYSTACK_RELOCATE (yyss_alloc, yyss); 
    1268    YYSTACK_RELOCATE (yyvs_alloc, yyvs); 
     1239   YYSTACK_RELOCATE (yyss); 
     1240   YYSTACK_RELOCATE (yyvs); 
     1241 
    12691242#  undef YYSTACK_RELOCATE 
    12701243   if (yyss1 != yyssa) 
     
    12771250      yyvsp = yyvs + yysize - 1; 
    12781251 
     1252 
    12791253      YYDPRINTF ((stderr, "Stack size increased to %lu\n", 
    12801254        (unsigned long int) yystacksize)); 
     
    12851259 
    12861260  YYDPRINTF ((stderr, "Entering state %d\n", yystate)); 
    1287  
    1288   if (yystate == YYFINAL) 
    1289     YYACCEPT; 
    12901261 
    12911262  goto yybackup; 
     
    12971268 
    12981269  /* Do appropriate processing given the current state.  Read a 
    1299      lookahead token if we need one and don't already have one.  */ 
    1300  
    1301   /* First try to decide what to do without reference to lookahead token.  */ 
     1270     look-ahead token if we need one and don't already have one.  */ 
     1271 
     1272  /* First try to decide what to do without reference to look-ahead token.  */ 
    13021273  yyn = yypact[yystate]; 
    1303   if (yypact_value_is_default (yyn)) 
     1274  if (yyn == YYPACT_NINF) 
    13041275    goto yydefault; 
    13051276 
    1306   /* Not known => get a lookahead token if don't already have one.  */ 
    1307  
    1308   /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */ 
     1277  /* Not known => get a look-ahead token if don't already have one.  */ 
     1278 
     1279  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */ 
    13091280  if (yychar == YYEMPTY) 
    13101281    { 
     
    13321303  if (yyn <= 0) 
    13331304    { 
    1334       if (yytable_value_is_error (yyn)) 
    1335         goto yyerrlab; 
     1305      if (yyn == 0 || yyn == YYTABLE_NINF) 
     1306   goto yyerrlab; 
    13361307      yyn = -yyn; 
    13371308      goto yyreduce; 
    13381309    } 
     1310 
     1311  if (yyn == YYFINAL) 
     1312    YYACCEPT; 
    13391313 
    13401314  /* Count tokens shifted since error; after three, turn off error 
     
    13431317    yyerrstatus--; 
    13441318 
    1345   /* Shift the lookahead token.  */ 
     1319  /* Shift the look-ahead token.  */ 
    13461320  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); 
    13471321 
    1348   /* Discard the shifted token.  */ 
    1349   yychar = YYEMPTY; 
     1322  /* Discard the shifted token unless it is eof.  */ 
     1323  if (yychar != YYEOF) 
     1324    yychar = YYEMPTY; 
    13501325 
    13511326  yystate = yyn; 
    1352   YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN 
    13531327  *++yyvsp = yylval; 
    1354   YY_IGNORE_MAYBE_UNINITIALIZED_END 
    13551328 
    13561329  goto yynewstate; 
     
    14501423      default: break; 
    14511424    } 
    1452   /* User semantic actions sometimes alter yychar, and that requires 
    1453      that yytoken be updated with the new translation.  We take the 
    1454      approach of translating immediately before every use of yytoken. 
    1455      One alternative is translating here after every semantic action, 
    1456      but that translation would be missed if the semantic action invokes 
    1457      YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or 
    1458      if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an 
    1459      incorrect destructor might then be invoked immediately.  In the 
    1460      case of YYERROR or YYBACKUP, subsequent parser actions might lead 
    1461      to an incorrect destructor call or verbose syntax error message 
    1462      before the lookahead is translated.  */ 
    14631425  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); 
    14641426 
     
    14681430 
    14691431  *++yyvsp = yyval; 
     1432 
    14701433 
    14711434  /* Now `shift' the result of the reduction.  Determine what state 
     
    14881451`------------------------------------*/ 
    14891452yyerrlab: 
    1490   /* Make sure we have latest lookahead translation.  See comments at 
    1491      user semantic actions for why this is necessary.  */ 
    1492   yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); 
    1493  
    14941453  /* If not already recovering from an error, report this error.  */ 
    14951454  if (!yyerrstatus) 
     
    14991458      yyerror (YY_("syntax error")); 
    15001459#else 
    1501 # define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ 
    1502                                         yyssp, yytoken) 
    15031460      { 
    1504         char const *yymsgp = YY_("syntax error"); 
    1505         int yysyntax_error_status; 
    1506         yysyntax_error_status = YYSYNTAX_ERROR; 
    1507         if (yysyntax_error_status == 0) 
    1508           yymsgp = yymsg; 
    1509         else if (yysyntax_error_status == 1) 
    1510           { 
    1511             if (yymsg != yymsgbuf) 
    1512               YYSTACK_FREE (yymsg); 
    1513             yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); 
    1514             if (!yymsg) 
    1515               { 
    1516                 yymsg = yymsgbuf; 
    1517                 yymsg_alloc = sizeof yymsgbuf; 
    1518                 yysyntax_error_status = 2; 
    1519               } 
    1520             else 
    1521               { 
    1522                 yysyntax_error_status = YYSYNTAX_ERROR; 
    1523                 yymsgp = yymsg; 
    1524               } 
    1525           } 
    1526         yyerror (yymsgp); 
    1527         if (yysyntax_error_status == 2) 
    1528           goto yyexhaustedlab; 
     1461   YYSIZE_T yysize = yysyntax_error (0, yystate, yychar); 
     1462   if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM) 
     1463     { 
     1464       YYSIZE_T yyalloc = 2 * yysize; 
     1465       if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM)) 
     1466         yyalloc = YYSTACK_ALLOC_MAXIMUM; 
     1467       if (yymsg != yymsgbuf) 
     1468         YYSTACK_FREE (yymsg); 
     1469       yymsg = (char *) YYSTACK_ALLOC (yyalloc); 
     1470       if (yymsg) 
     1471         yymsg_alloc = yyalloc; 
     1472       else 
     1473         { 
     1474      yymsg = yymsgbuf; 
     1475      yymsg_alloc = sizeof yymsgbuf; 
     1476         } 
     1477     } 
     1478 
     1479   if (0 < yysize && yysize <= yymsg_alloc) 
     1480     { 
     1481       (void) yysyntax_error (yymsg, yystate, yychar); 
     1482       yyerror (yymsg); 
     1483     } 
     1484   else 
     1485     { 
     1486       yyerror (YY_("syntax error")); 
     1487       if (yysize != 0) 
     1488         goto yyexhaustedlab; 
     1489     } 
    15291490      } 
    1530 # undef YYSYNTAX_ERROR 
    15311491#endif 
    15321492    } 
     
    15361496  if (yyerrstatus == 3) 
    15371497    { 
    1538       /* If just tried and failed to reuse lookahead token after an 
     1498      /* If just tried and failed to reuse look-ahead token after an 
    15391499    error, discard it.  */ 
    15401500 
     
    15531513    } 
    15541514 
    1555   /* Else will try to reuse lookahead token after shifting the error 
     1515  /* Else will try to reuse look-ahead token after shifting the error 
    15561516     token.  */ 
    15571517  goto yyerrlab1; 
     
    15871547    { 
    15881548      yyn = yypact[yystate]; 
    1589       if (!yypact_value_is_default (yyn)) 
     1549      if (yyn != YYPACT_NINF) 
    15901550   { 
    15911551     yyn += YYTERROR; 
     
    16101570    } 
    16111571 
    1612   YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN 
     1572  if (yyn == YYFINAL) 
     1573    YYACCEPT; 
     1574 
    16131575  *++yyvsp = yylval; 
    1614   YY_IGNORE_MAYBE_UNINITIALIZED_END 
    16151576 
    16161577 
     
    16361597  goto yyreturn; 
    16371598 
    1638 #if !defined yyoverflow || YYERROR_VERBOSE 
     1599#ifndef yyoverflow 
    16391600/*-------------------------------------------------. 
    16401601| yyexhaustedlab -- memory exhaustion comes here.  | 
     
    16471608 
    16481609yyreturn: 
    1649   if (yychar != YYEMPTY) 
    1650     { 
    1651       /* Make sure we have latest lookahead translation.  See comments at 
    1652          user semantic actions for why this is necessary.  */ 
    1653       yytoken = YYTRANSLATE (yychar); 
    1654       yydestruct ("Cleanup: discarding lookahead", 
    1655                   yytoken, &yylval); 
    1656     } 
     1610  if (yychar != YYEOF && yychar != YYEMPTY) 
     1611     yydestruct ("Cleanup: discarding lookahead", 
     1612       yytoken, &yylval); 
    16571613  /* Do not reclaim the symbols of the rule which action triggered 
    16581614     this YYABORT or YYACCEPT.  */ 
     
    20331989    return 0; 
    20341990} 
     1991 
    20351992#line 2 "convert.yy.c" 
    20361993 
     
    20632020#define YY_FLEX_MAJOR_VERSION 2 
    20642021#define YY_FLEX_MINOR_VERSION 5 
    2065 #define YY_FLEX_SUBMINOR_VERSION 37 
     2022#define YY_FLEX_SUBMINOR_VERSION 35 
    20662023#if YY_FLEX_SUBMINOR_VERSION > 0 
    20672024#define FLEX_BETA 
     
    21092066typedef unsigned short int flex_uint16_t; 
    21102067typedef unsigned int flex_uint32_t; 
     2068#endif /* ! C99 */ 
    21112069 
    21122070/* Limits of integral types. */ 
     
    21382096#define UINT32_MAX             (4294967295U) 
    21392097#endif 
    2140  
    2141 #endif /* ! C99 */ 
    21422098 
    21432099#endif /* ! FLEXINT_H */ 
     
    27282684      { \ 
    27292685      int c = '*'; \ 
    2730       size_t n; \ 
     2686      yy_size_t n; \ 
    27312687      for ( n = 0; n < max_size && \ 
    27322688              (c = getc( convert_in )) != EOF && c != '\n'; ++n ) \ 
     
    31653121 
    31663122         /* just a shorter name for the current buffer */ 
    3167          YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; 
     3123         YY_BUFFER_STATE b = YY_CURRENT_BUFFER; 
    31683124 
    31693125         int yy_c_buf_p_offset = 
     
    32983254   yy_is_jam = (yy_current_state == 83); 
    32993255 
    3300       return yy_is_jam ? 0 : yy_current_state; 
     3256   return yy_is_jam ? 0 : yy_current_state; 
    33013257} 
    33023258 
     
    33863342               { 
    33873343               if ( convert_wrap( ) ) 
    3388                   return EOF; 
     3344                  return 0; 
    33893345 
    33903346               if ( ! (yy_did_buffer_switch_on_eof) ) 
     
    35223478} 
    35233479 
     3480#ifndef __cplusplus 
     3481extern int isatty (int ); 
     3482#endif /* __cplusplus */ 
     3483     
    35243484/* Initializes or reinitializes a buffer. 
    35253485 * This function is sometimes called more than once on the same buffer, 
     
    37263686/** Setup the input buffer state to scan the given bytes. The next call to convert_lex() will 
    37273687 * scan from a @e copy of @a bytes. 
    3728  * @param yybytes the byte buffer to scan 
    3729  * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. 
     3688 * @param bytes the byte buffer to scan 
     3689 * @param len the number of bytes in the buffer pointed to by @a bytes. 
    37303690 *  
    37313691 * @return the newly allocated buffer state object. 
     
    37353695   YY_BUFFER_STATE b; 
    37363696   char *buf; 
    3737    yy_size_t n; 
    3738    int i; 
     3697   yy_size_t n, i; 
    37393698     
    37403699   /* Get memory for full buffer, including space for trailing EOB's. */ 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif2model.F90

    r3680 r4785  
    1515      !!   *** ROUTINE Agrif_Set_numberofcells *** 
    1616      !!---------------------------------------------  
    17       USE Agrif_Types 
     17      USE Agrif_Grids 
    1818      IMPLICIT NONE 
    1919 
     
    3030      !!   *** ROUTINE Agrif_Get_numberofcells *** 
    3131      !!---------------------------------------------  
    32       USE Agrif_Types 
     32      USE Agrif_Grids 
    3333      IMPLICIT NONE 
    3434 
    3535      Type(Agrif_Grid), Pointer :: Agrif_Gr 
    3636 
     37    if ( associated(Agrif_Curgrid) ) then 
    3738#include "GetNumberofcells.h" 
     39    endif 
    3840 
    3941   END SUBROUTINE Agrif_Get_numberofcells 
     
    4345      !!   *** ROUTINE Agrif_Allocationscalls *** 
    4446      !!---------------------------------------------  
    45       USE Agrif_Types  
     47      USE Agrif_Grids  
    4648#include "include_use_Alloc_agrif.h" 
    4749      IMPLICIT NONE 
     
    7274      !!   *** ROUTINE Agrif_clustering_def *** 
    7375      !!---------------------------------------------  
    74       Use Agrif_Types 
    7576      IMPLICIT NONE 
    7677 
     
    7980   END 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 
    95 #endif 
    96       Return 
    97  
    98    END SUBROUTINE Agrif_comm_def 
    9982#else 
    10083   SUBROUTINE Agrif2Model 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90

    r3680 r4785  
    99   !!            3.4   !  09-2012  (R. Benshila, C. Herbaut) update and EVP 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_agrif && defined key_lim2 
     11#undef toto 
     12#if defined key_agrif && defined key_lim2  
    1213   !!---------------------------------------------------------------------- 
    1314   !!   'key_lim2'  :                                 LIM 2.0 sea-ice model 
     
    6566      u_ice_nst(:,:) = 0. 
    6667      v_ice_nst(:,:) = 0. 
     68#undef toto 
     69#ifdef toto 
    6770      CALL Agrif_Bc_variable( u_ice_nst, u_ice_id ,procname=interp_u_ice, calledweight=1. ) 
    6871      CALL Agrif_Bc_variable( v_ice_nst, v_ice_id ,procname=interp_v_ice, calledweight=1. ) 
     72#endif 
    6973      Agrif_SpecialValue=0. 
    7074      Agrif_UseSpecialValue = .FALSE. 
     
    157161         zuice = 0. 
    158162         zvice = 0. 
     163#undef toto 
     164#ifdef toto 
    159165         CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.) 
    160166         CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.) 
     167#endif 
    161168         Agrif_SpecialValue=0. 
    162169         Agrif_UseSpecialValue = .FALSE. 
     
    348355         Agrif_SpecialValue=-9999. 
    349356         Agrif_UseSpecialValue = .TRUE. 
     357#undef toto 
     358#ifdef toto 
    350359         CALL Agrif_Bc_variable( ztab, adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 
     360#endif 
    351361         Agrif_SpecialValue=0. 
    352362         Agrif_UseSpecialValue = .FALSE. 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90

    r3680 r4785  
    6060      Agrif_UseSpecialValueInUpdate = .TRUE. 
    6161      Agrif_SpecialValueFineGrid = 0. 
    62  
    63 # if defined TWO_WAY 
     62#undef toto 
     63# if defined TWO_WAY && defined toto 
    6464      IF( MOD(nbcline,nbclineupdate) == 0) THEN 
    6565         CALL Agrif_Update_Variable( zadv , adv_ice_id , procname = update_adv_ice  ) 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r4491 r4785  
    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   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers 
     24   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics 
    2525 
    2626   !                                              !!! OLD namelist names 
     
    3434   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step 
    3535 
     36   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone 
     37   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u 
     38   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v 
    3639   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ??? 
    3740   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 
     41# if defined key_dynspg_ts 
     42   ! Barotropic arrays used to store open boundary data during 
     43   ! time-splitting loop: 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w 
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n 
     47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s 
     48# endif   
     49  
     50   INTEGER :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
     51   INTEGER :: un_interp_id, vn_interp_id                              ! AGRIF profiles for interpolations 
     52   INTEGER :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates 
     53   INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers 
     54   INTEGER :: trn_id 
     55   INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id 
     56   INTEGER :: ub2b_update_id, vb2b_update_id 
     57   INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 
     58   INTEGER :: scales_t_id 
    4459 
    4560   !!---------------------------------------------------------------------- 
     
    5469      !!                ***  FUNCTION agrif_oce_alloc  *** 
    5570      !!---------------------------------------------------------------------- 
    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 )  
     71      INTEGER, DIMENSION(2) :: ierr 
     72      !!---------------------------------------------------------------------- 
     73      ierr(:) = 0 
     74      ! 
     75      ALLOCATE( spe1ur         (jpi,jpj), spe2vr         (jpi,jpj),   & 
     76         &      spbtr2         (jpi,jpj), spe1ur2        (jpi,jpj),   & 
     77         &      spe2vr2        (jpi,jpj), spbtr3         (jpi,jpj),   & 
     78         &      tabspongedone  (jpi,jpj), tabspongedone_u(jpi,jpj),   & 
     79         &      tabspongedone_v(jpi,jpj), STAT = ierr(1) ) 
     80 
     81# if defined key_dynspg_ts 
     82      ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj),   & 
     83         &      ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj),   &  
     84         &      ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi),   &  
     85         &      ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) ) 
     86# endif 
     87      agrif_oce_alloc = MAXVAL(ierr) 
     88      ! 
    5889   END FUNCTION agrif_oce_alloc 
    5990 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r4486 r4785  
    3333   PRIVATE 
    3434 
    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      
     35   INTEGER :: bdy_tinterp = 0 
     36        
    4237   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    43    PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn 
     38   PUBLIC   interpun, interpvn, interpun2d, interpvn2d  
     39   PUBLIC   interptsn,  interpsshn 
     40   PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
    4441 
    4542#  include "domzgr_substitute.h90"   
     
    5552   SUBROUTINE Agrif_tra 
    5653      !!---------------------------------------------------------------------- 
    57       !!                  ***  ROUTINE Agrif_Tra  *** 
     54      !!                  ***  ROUTINE Agrif_tra  *** 
    5855      !!---------------------------------------------------------------------- 
    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 
    64       !!---------------------------------------------------------------------- 
    6556      ! 
    6657      IF( Agrif_Root() )   RETURN 
    67  
    68       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa )  
    6958 
    7059      Agrif_SpecialValue    = 0.e0 
    7160      Agrif_UseSpecialValue = .TRUE. 
    72       ztsa(:,:,:,:) = 0.e0 
    73  
    74       CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 
     61 
     62      CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 
    7563      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 )  
    16664      ! 
    16765   END SUBROUTINE Agrif_tra 
     
    17573      INTEGER, INTENT(in) ::   kt 
    17674      !! 
    177       INTEGER :: ji,jj,jk 
     75      INTEGER :: ji,jj,jk, j1,j2, i1,i2 
    17876      REAL(wp) :: timeref 
    17977      REAL(wp) :: z2dt, znugdt 
    18078      REAL(wp) :: zrhox, zrhoy 
    181       REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 
    182       REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d 
     79      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 
    18380      !!----------------------------------------------------------------------   
    18481 
    18582      IF( Agrif_Root() )   RETURN 
    18683 
    187       CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 
    188       CALL wrk_alloc( jpi, jpj, jpk, zua, zva ) 
     84      CALL wrk_alloc( jpi, jpj, spgv1, spgu1 ) 
     85 
     86      Agrif_SpecialValue=0. 
     87      Agrif_UseSpecialValue = ln_spc_dyn 
     88 
     89      CALL Agrif_Bc_variable(un_interp_id,procname=interpun) 
     90      CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 
     91 
     92#if defined key_dynspg_flt 
     93      CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d) 
     94      CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d) 
     95#endif 
     96 
     97      Agrif_UseSpecialValue = .FALSE. 
    18998 
    19099      zrhox = Agrif_Rhox() 
     
    192101 
    193102      timeref = 1. 
    194  
    195103      ! time step: leap-frog 
    196104      z2dt = 2. * rdt 
     
    200108      znugdt =  grav * z2dt     
    201109 
    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  
     110      ! prevent smoothing in ghost cells 
     111      i1=1 
     112      i2=jpi 
     113      j1=1 
     114      j2=jpj 
     115      IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3 
     116      IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2 
     117      IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3 
     118      IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2 
     119 
     120 
     121      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    212122#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 
     123         DO jk=1,jpkm1 
     124            DO jj=j1,j2 
     125               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 
     126            END DO 
     127         END DO 
     128 
     129         spgu(2,:)=0. 
    228130 
    229131         DO jk=1,jpkm1 
    230132            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) 
     133               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
    248134            END DO 
    249135         END DO 
     
    251137         DO jj=1,jpj 
    252138            IF (umask(2,jj,1).NE.0.) THEN 
    253                spgu(2,jj)=spgu(2,jj)*hur_a(2,jj) 
     139               spgu(2,jj)=spgu(2,jj)/hu(2,jj) 
    254140            ENDIF 
    255141         END DO 
     
    259145 
    260146         DO jk=1,jpkm1 
    261             DO jj=1,jpj 
     147            DO jj=j1,j2 
    262148               ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk)) 
    263149               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 
     
    269155         DO jk=1,jpkm1 
    270156            DO jj=1,jpj 
    271                spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 
     157               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
    272158            END DO 
    273159         END DO 
     
    275161         DO jj=1,jpj 
    276162            IF (umask(2,jj,1).NE.0.) THEN 
    277                spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj) 
     163               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 
    278164            ENDIF 
    279165         END DO 
    280166 
    281167         DO jk=1,jpkm1 
    282             DO jj=1,jpj 
     168            DO jj=j1,j2 
    283169               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) 
    291170            END DO 
    292171         END DO 
     
    300179            END DO 
    301180         END DO 
    302  
    303181         DO jj=1,jpj 
    304182            spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 
    305183         END DO 
    306  
    307184         DO jk=1,jpkm1 
    308185            DO jj=1,jpj 
     
    316193      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    317194#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  
    323          DO jk=1,jpkm1 
    324             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 
     195         DO jk=1,jpkm1 
     196            DO jj=j1,j2 
    333197               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 
    334198            END DO 
    335199         END DO 
    336  
    337  
    338200         spgu(nlci-2,:)=0. 
    339  
    340201         do jk=1,jpkm1 
    341202            do jj=1,jpj 
    342                spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
     203               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
    343204            enddo 
    344205         enddo 
    345  
    346206         DO jj=1,jpj 
    347207            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    348                spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj) 
     208               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 
    349209            ENDIF 
    350210         END DO 
     
    352212         spgu(nlci-2,:) = ua_b(nlci-2,:) 
    353213#endif 
    354  
     214         DO jk=1,jpkm1 
     215            DO jj=j1,j2 
     216               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 
     217 
     218               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 
     219 
     220            END DO 
     221         END DO 
     222         spgu1(nlci-2,:)=0. 
    355223         DO jk=1,jpkm1 
    356224            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  
     225               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
     226            END DO 
     227         END DO 
    372228         DO jj=1,jpj 
    373229            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    374                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj) 
     230               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 
    375231            ENDIF 
    376232         END DO 
    377  
    378          DO jk=1,jpkm1 
    379             DO jj=1,jpj 
     233         DO jk=1,jpkm1 
     234            DO jj=j1,j2 
    380235               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) 
    388236            END DO 
    389237         END DO 
     
    414262 
    415263#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 
    429264         DO jk=1,jpkm1 
    430265            DO ji=1,jpi 
     
    437272         DO jk=1,jpkm1 
    438273            DO ji=1,jpi 
    439                spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk) 
     274               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 
    440275            END DO 
    441276         END DO 
     
    443278         DO ji=1,jpi 
    444279            IF (vmask(ji,2,1).NE.0.) THEN 
    445                spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2) 
     280               spgv(ji,2)=spgv(ji,2)/hv(ji,2) 
    446281            ENDIF 
    447282         END DO 
     
    451286 
    452287         DO jk=1,jpkm1 
    453             DO ji=1,jpi 
     288            DO ji=i1,i2 
    454289               va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 
    455290               va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) 
     
    461296         DO jk=1,jpkm1 
    462297            DO ji=1,jpi 
    463                spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
     298               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
    464299            END DO 
    465300         END DO 
     
    467302         DO ji=1,jpi 
    468303            IF (vmask(ji,2,1).NE.0.) THEN 
    469                spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2) 
     304               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 
    470305            ENDIF 
    471306         END DO 
     
    474309            DO ji=1,jpi 
    475310               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) 
    483311            END DO 
    484312         END DO 
     
    508336 
    509337#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 
    523338         DO jk=1,jpkm1 
    524339            DO ji=1,jpi 
     
    527342         END DO 
    528343 
     344 
    529345         spgv(:,nlcj-2)=0. 
    530346 
    531347         DO jk=1,jpkm1 
    532348            DO ji=1,jpi 
    533                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     349               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    534350            END DO 
    535351         END DO 
     
    537353         DO ji=1,jpi 
    538354            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    539                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2) 
     355               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 
    540356            ENDIF 
    541357         END DO 
     358 
    542359#else 
    543360         spgv(:,nlcj-2)=va_b(:,nlcj-2) 
     
    545362 
    546363         DO jk=1,jpkm1 
    547             DO ji=1,jpi 
     364            DO ji=i1,i2 
    548365               va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 
    549366               va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 
     
    555372         DO jk=1,jpkm1 
    556373            DO ji=1,jpi 
    557                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     374               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    558375            END DO 
    559376         END DO 
     
    561378         DO ji=1,jpi 
    562379            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    563                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2) 
     380               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 
    564381            ENDIF 
    565382         END DO 
     
    568385            DO ji=1,jpi 
    569386               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) 
    577387            END DO 
    578388         END DO 
     
    600410      ENDIF 
    601411      ! 
    602       CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 
    603       CALL wrk_dealloc( jpi, jpj, jpk, zua, zva ) 
     412      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 
    604413      ! 
    605414   END SUBROUTINE Agrif_dyn 
     
    672481      INTEGER :: ji, jj 
    673482      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 
     483      REAL(wp) :: zrhot, zt 
    679484      !!----------------------------------------------------------------------   
    680485 
     
    684489                             ! the forward case only 
    685490 
    686       zrhox = Agrif_Rhox() 
    687       zrhoy = Agrif_Rhoy() 
    688491      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 ) 
    698492 
    699493      ! "Central" time index for interpolation: 
     
    707501      Agrif_SpecialValue    = 0.e0 
    708502      Agrif_UseSpecialValue = .TRUE. 
    709       CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn ) 
     503      CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn ) 
    710504      Agrif_UseSpecialValue = .FALSE. 
    711505 
     
    715509 
    716510      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           
     511         ! orders matters here !!!!!! 
     512         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated 
     513         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b) 
     514         bdy_tinterp = 1 
     515         CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After 
     516         CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb) 
     517         bdy_tinterp = 2 
     518         CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before 
     519         CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb)          
     520      ELSE ! Linear interpolation 
     521         bdy_tinterp = 0 
     522         ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0  
     523         ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0  
     524         ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0  
     525         ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0  
     526         CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb) 
     527         CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb) 
     528      ENDIF 
     529      Agrif_UseSpecialValue = .FALSE. 
     530      !  
     531   END SUBROUTINE Agrif_dta_ts 
     532 
     533   SUBROUTINE Agrif_ssh( kt ) 
     534      !!---------------------------------------------------------------------- 
     535      !!                  ***  ROUTINE Agrif_DYN  *** 
     536      !!----------------------------------------------------------------------   
     537      INTEGER, INTENT(in) ::   kt 
     538      !! 
     539      !!----------------------------------------------------------------------   
     540 
     541      IF( Agrif_Root() )   RETURN 
     542 
     543      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     544         ssha(2,:)=ssha(3,:) 
     545         sshn(2,:)=sshn(3,:) 
     546      ENDIF 
     547 
     548      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     549         ssha(nlci-1,:)=ssha(nlci-2,:) 
     550         sshn(nlci-1,:)=sshn(nlci-2,:) 
     551      ENDIF 
     552 
     553      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     554         ssha(:,2)=ssha(:,3) 
     555         sshn(:,2)=sshn(:,3) 
     556      ENDIF 
     557 
     558      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     559         ssha(:,nlcj-1)=ssha(:,nlcj-2) 
     560         sshn(:,nlcj-1)=sshn(:,nlcj-2) 
     561      ENDIF 
     562 
     563   END SUBROUTINE Agrif_ssh 
     564 
     565   SUBROUTINE Agrif_ssh_ts( jn ) 
     566      !!---------------------------------------------------------------------- 
     567      !!                  ***  ROUTINE Agrif_ssh_ts  *** 
     568      !!----------------------------------------------------------------------   
     569      INTEGER, INTENT(in) ::   jn 
     570      !! 
     571      INTEGER :: ji,jj 
     572      !!----------------------------------------------------------------------   
     573 
     574      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     575         DO jj=1,jpj 
     576            ssha_e(2,jj) = hbdy_w(jj) 
     577         END DO 
     578      ENDIF 
     579 
     580      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     581         DO jj=1,jpj 
     582            ssha_e(nlci-1,jj) = hbdy_e(jj) 
     583         END DO 
     584      ENDIF 
     585 
     586      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     587         DO ji=1,jpi 
     588            ssha_e(ji,2) = hbdy_s(ji) 
     589         END DO 
     590      ENDIF 
     591 
     592      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     593         DO ji=1,jpi 
     594            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
     595         END DO 
     596      ENDIF 
     597 
     598   END SUBROUTINE Agrif_ssh_ts 
     599 
     600   SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 
     601      !!--------------------------------------------- 
     602      !!   *** ROUTINE interptsn *** 
     603      !!--------------------------------------------- 
     604      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
     605      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     606      LOGICAL, INTENT(in) :: before 
     607      INTEGER, INTENT(in) :: nb , ndir 
     608      ! 
     609      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     610      INTEGER :: imin, imax, jmin, jmax 
     611      REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
     612      REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
     613      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     614        
     615      IF (before) THEN          
     616         ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     617      ELSE 
     618         ! 
     619         western_side  = (nb == 1).AND.(ndir == 1) 
     620         eastern_side  = (nb == 1).AND.(ndir == 2) 
     621         southern_side = (nb == 2).AND.(ndir == 1) 
     622         northern_side = (nb == 2).AND.(ndir == 2) 
     623         ! 
     624         zrhox = Agrif_Rhox() 
     625         !  
     626         zalpha1 = ( zrhox - 1. ) * 0.5 
     627         zalpha2 = 1. - zalpha1 
     628         !  
     629         zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 
     630         zalpha4 = 1. - zalpha3 
     631         !  
     632         zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 
     633         zalpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. ) 
     634         zalpha5 = 1. - zalpha6 - zalpha7 
     635         ! 
     636         imin = i1 
     637         imax = i2 
     638         jmin = j1 
     639         jmax = j2 
     640         !  
     641         ! Remove CORNERS 
     642         IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 
     643         IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 
     644         IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 
     645         IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2         
     646         ! 
     647         IF( eastern_side) THEN 
     648            DO jn = 1, jpts 
     649               tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 
     650               DO jk = 1, jpkm1 
     651                  DO jj = jmin,jmax 
     652                     IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     653                        tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     654                     ELSE 
     655                        tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     656                        IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     657                           tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) &  
     658                                                + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     659                        ENDIF 
     660                     ENDIF 
     661                  END DO 
     662               END DO 
     663            ENDDO 
     664         ENDIF 
     665         !  
     666         IF( northern_side ) THEN             
     667            DO jn = 1, jpts 
     668               tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 
     669               DO jk = 1, jpkm1 
     670                  DO ji = imin,imax 
     671                     IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     672                        tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     673                     ELSE 
     674                        tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     675                        IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     676                           tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn)  & 
     677                                                + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     678                        ENDIF 
     679                     ENDIF 
     680                  END DO 
     681               END DO 
     682            ENDDO  
     683         ENDIF 
     684         ! 
     685         IF( western_side) THEN             
     686            DO jn = 1, jpts 
     687               tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 
     688               DO jk = 1, jpkm1 
     689                  DO jj = jmin,jmax 
     690                     IF( umask(2,jj,jk) == 0.e0 ) THEN 
     691                        tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     692                     ELSE 
     693                        tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     694                        IF( un(2,jj,jk) < 0.e0 ) THEN 
     695                           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) 
     696                        ENDIF 
     697                     ENDIF 
     698                  END DO 
     699               END DO 
     700            END DO 
     701         ENDIF 
     702         ! 
     703         IF( southern_side ) THEN            
     704            DO jn = 1, jpts 
     705               tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 
     706               DO jk=1,jpk       
     707                  DO ji=imin,imax 
     708                     IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     709                        tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     710                     ELSE 
     711                        tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     712                        IF( vn(ji,2,jk) < 0.e0 ) THEN 
     713                           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) 
     714                        ENDIF 
     715                     ENDIF 
     716                  END DO 
     717               END DO 
     718            ENDDO 
     719         ENDIF 
     720         ! 
     721         ! Treatment of corners 
     722         !  
     723         ! East south 
     724         IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     725           tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 
     726         ENDIF 
     727         ! East north 
     728         IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     729           tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 
     730         ENDIF          
     731         ! West south 
     732         IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 
     733           tsa(2,2,:,:) = ptab(2,2,:,:) 
     734         ENDIF 
     735         ! West north 
     736         IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 
     737           tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 
     738         ENDIF 
     739         ! 
     740      ENDIF 
     741      ! 
     742   END SUBROUTINE interptsn 
     743 
     744   SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir) 
     745      !!---------------------------------------------------------------------- 
     746      !!                  ***  ROUTINE interpsshn  *** 
     747      !!----------------------------------------------------------------------   
     748      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     749      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     750      LOGICAL, INTENT(in) :: before 
     751      INTEGER, INTENT(in) :: nb , ndir 
     752      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     753      !!----------------------------------------------------------------------   
     754      ! 
     755      IF( before) THEN 
     756         ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 
     757      ELSE 
     758         western_side  = (nb == 1).AND.(ndir == 1) 
     759         eastern_side  = (nb == 1).AND.(ndir == 2) 
     760         southern_side = (nb == 2).AND.(ndir == 1) 
     761         northern_side = (nb == 2).AND.(ndir == 2) 
     762         IF(western_side)  hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
     763         IF(eastern_side)  hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 
     764         IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
     765         IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 
     766      ENDIF 
     767      ! 
     768   END SUBROUTINE interpsshn 
     769 
     770   SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before) 
     771      !!--------------------------------------------- 
     772      !!   *** ROUTINE interpun *** 
     773      !!---------------------------------------------     
     774      !! 
     775      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     776      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     777      LOGICAL, INTENT(in) :: before 
     778      !! 
     779      INTEGER :: ji,jj,jk 
     780      REAL(wp) :: zrhoy  
     781      !!---------------------------------------------     
     782      ! 
     783      IF (before) THEN  
     784         DO jk=1,jpk 
     785            DO jj=j1,j2 
     786               DO ji=i1,i2 
     787                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
     788                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk) 
     789               END DO 
     790            END DO 
     791         END DO 
     792      ELSE 
     793         zrhoy = Agrif_Rhoy() 
     794         DO jk=1,jpkm1 
     795            DO jj=j1,j2 
     796               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 
     797               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk) 
     798            END DO 
     799         END DO 
     800      ENDIF 
     801      !  
     802   END SUBROUTINE interpun 
     803 
     804 
     805   SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before) 
     806      !!--------------------------------------------- 
     807      !!   *** ROUTINE interpun *** 
     808      !!---------------------------------------------     
     809      ! 
     810      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     811      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     812      LOGICAL, INTENT(in) :: before 
     813      ! 
     814      INTEGER :: ji,jj 
     815      REAL(wp) :: ztref 
     816      REAL(wp) :: zrhoy  
     817      !!---------------------------------------------     
     818      ! 
     819      ztref = 1. 
     820       
     821      IF (before) THEN  
     822         DO jj=j1,j2 
     823            DO ji=i1,min(i2,nlci-1) 
     824               ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj))  
     825            END DO 
     826         END DO 
     827      ELSE 
     828         zrhoy = Agrif_Rhoy() 
     829         DO jj=j1,j2 
     830            laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1) 
     831         END DO 
     832      ENDIF 
     833      !  
     834   END SUBROUTINE interpun2d 
     835 
     836 
     837   SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 
     838      !!--------------------------------------------- 
     839      !!   *** ROUTINE interpvn *** 
     840      !!---------------------------------------------     
     841      ! 
     842      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
     843      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     844      LOGICAL, INTENT(in) :: before 
     845      ! 
     846      INTEGER :: ji,jj,jk 
     847      REAL(wp) :: zrhox  
     848      !!---------------------------------------------     
     849      !       
     850      IF (before) THEN           
     851         !interpv entre 1 et k2 et interpv2d en jpkp1 
     852         DO jk=k1,jpk 
     853            DO jj=j1,j2 
     854               DO ji=i1,i2 
     855                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
     856                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 
     857               END DO    
     858            END DO 
     859         END DO 
     860      ELSE           
     861         zrhox= Agrif_Rhox() 
     862         DO jk=1,jpkm1 
     863            DO jj=j1,j2 
     864               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 
     865               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk) 
     866            END DO 
     867         END DO 
     868       ENDIF 
     869       !         
     870   END SUBROUTINE interpvn 
     871    
     872   SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before) 
     873      !!--------------------------------------------- 
     874      !!   *** ROUTINE interpvn *** 
     875      !!---------------------------------------------     
     876      ! 
     877      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     878      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     879      LOGICAL, INTENT(in) :: before 
     880      ! 
     881      INTEGER :: ji,jj 
     882      REAL(wp) :: zrhox  
     883      REAL(wp) :: ztref 
     884      !!---------------------------------------------     
     885      !  
     886      ztref = 1.     
     887      IF (before) THEN  
     888         !interpv entre 1 et k2 et interpv2d en jpkp1 
     889         DO jj=j1,min(j2,nlcj-1) 
     890            DO ji=i1,i2 
     891               ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1) 
     892            END DO 
     893         END DO 
     894       ELSE            
     895          zrhox = Agrif_Rhox() 
     896          DO ji=i1,i2 
     897             laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2))) 
     898           END DO 
     899         ENDIF 
     900         !       
     901   END SUBROUTINE interpvn2d 
     902 
     903   SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     904      !!---------------------------------------------------------------------- 
     905      !!                  ***  ROUTINE interpunb  *** 
     906      !!----------------------------------------------------------------------   
     907      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     908      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     909      LOGICAL, INTENT(in) :: before 
     910      INTEGER, INTENT(in) :: nb , ndir 
     911      !! 
     912      INTEGER :: ji,jj 
     913      REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 
     914      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     915      !!----------------------------------------------------------------------   
     916      ! 
     917      IF (before) THEN  
     918         DO jj=j1,j2 
     919            DO ji=i1,i2 
     920               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
     921            END DO 
     922         END DO 
     923      ELSE 
     924         western_side  = (nb == 1).AND.(ndir == 1) 
     925         eastern_side  = (nb == 1).AND.(ndir == 2) 
     926         southern_side = (nb == 2).AND.(ndir == 1) 
     927         northern_side = (nb == 2).AND.(ndir == 2) 
     928         zrhoy = Agrif_Rhoy() 
     929         zrhot = Agrif_rhot() 
     930         ! Time indexes bounds for integration 
     931         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     932         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
     933         ! Polynomial interpolation coefficients: 
     934         IF( bdy_tinterp == 1 ) THEN 
     935            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     936                        &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     937         ELSEIF( bdy_tinterp == 2 ) THEN 
     938            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     939                        &      - zt0        * (       zt0 - 1._wp)**2._wp )  
     940                      
     941         ELSE 
     942            ztcoeff = 1 
     943         ENDIF 
     944         !    
     945         IF(western_side) THEN 
     946            ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     947         ENDIF    
     948         IF(eastern_side) THEN 
     949            ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     950         ENDIF    
     951         IF(southern_side) THEN 
     952            ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
     953         ENDIF    
     954         IF(northern_side) THEN 
     955            ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
     956         ENDIF 
     957         !             
     958         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
     959           IF(western_side) THEN 
     960              ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
     961              &                                  * umask(i1,j1:j2,1) 
     962           ENDIF    
     963           IF(eastern_side) THEN 
     964              ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2))   & 
     965              &                                  * umask(i1,j1:j2,1) 
     966           ENDIF 
     967           IF(southern_side) THEN 
     968              ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
     969              &                                  * umask(i1:i2,j1,1) 
     970           ENDIF   
     971           IF(northern_side) THEN 
     972              ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1))   & 
     973              &                                  * umask(i1:i2,j1,1) 
     974           ENDIF  
     975        ENDIF     
     976      ENDIF    
     977      !  
     978   END SUBROUTINE interpunb 
     979 
     980   SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir) 
     981      !!---------------------------------------------------------------------- 
     982      !!                  ***  ROUTINE interpvnb  *** 
     983      !!----------------------------------------------------------------------   
     984      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     985      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     986      LOGICAL, INTENT(in) :: before 
     987      INTEGER, INTENT(in) :: nb , ndir 
     988      !! 
     989      INTEGER :: ji,jj 
     990      REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff    
     991      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     992      !!----------------------------------------------------------------------   
     993      !  
     994      IF (before) THEN  
     995         DO jj=j1,j2 
     996            DO ji=i1,i2 
     997               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)  
     998            END DO 
     999         END DO 
     1000      ELSE 
     1001         western_side  = (nb == 1).AND.(ndir == 1) 
     1002         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1003         southern_side = (nb == 2).AND.(ndir == 1) 
     1004         northern_side = (nb == 2).AND.(ndir == 2) 
     1005         zrhox = Agrif_Rhox() 
     1006         zrhot = Agrif_rhot() 
     1007         ! Time indexes bounds for integration 
     1008         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     1009         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
     1010         IF( bdy_tinterp == 1 ) THEN 
     1011            ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     1012                        &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     1013         ELSEIF( bdy_tinterp == 2 ) THEN 
     1014            ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     1015                        &      - zt0        * (       zt0 - 1._wp)**2._wp )  
     1016                      
     1017         ELSE 
     1018            ztcoeff = 1 
     1019         ENDIF 
     1020         ! 
     1021         IF(western_side) THEN 
     1022            vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     1023         ENDIF    
     1024         IF(eastern_side) THEN 
     1025            vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)   
     1026         ENDIF    
     1027         IF(southern_side) THEN 
     1028            vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 
     1029         ENDIF    
     1030         IF(northern_side) THEN 
     1031            vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)  
     1032         ENDIF 
     1033         !             
     1034         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
     1035           IF(western_side) THEN 
     1036              vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
     1037              &                                  * vmask(i1,j1:j2,1) 
     1038           ENDIF    
     1039           IF(eastern_side) THEN 
     1040              vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
     1041              &                                  * vmask(i1,j1:j2,1) 
     1042           ENDIF 
     1043           IF(southern_side) THEN 
     1044              vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
     1045              &                                  * vmask(i1:i2,j1,1) 
     1046           ENDIF   
     1047           IF(northern_side) THEN 
     1048              vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
     1049              &                                  * vmask(i1:i2,j1,1) 
     1050           ENDIF  
     1051        ENDIF     
     1052     ENDIF    
     1053     ! 
     1054   END SUBROUTINE interpvnb 
     1055 
     1056   SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
     1057      !!---------------------------------------------------------------------- 
     1058      !!                  ***  ROUTINE interpub2b  *** 
     1059      !!----------------------------------------------------------------------   
     1060      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1061      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1062      LOGICAL, INTENT(in) :: before 
     1063      INTEGER, INTENT(in) :: nb , ndir 
     1064      !! 
     1065      INTEGER :: ji,jj 
     1066      REAL(wp) :: zrhot, zt0, zt1,zat 
     1067      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1068      !!----------------------------------------------------------------------   
     1069      IF( before ) THEN 
     1070         DO jj=j1,j2 
     1071            DO ji=i1,i2 
     1072               ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 
     1073            END DO 
     1074         END DO 
     1075      ELSE 
     1076         western_side  = (nb == 1).AND.(ndir == 1) 
     1077         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1078         southern_side = (nb == 2).AND.(ndir == 1) 
     1079         northern_side = (nb == 2).AND.(ndir == 2) 
     1080         zrhot = Agrif_rhot() 
    7281081         ! Time indexes bounds for integration 
    7291082         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    7301083         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
    731  
    7321084         ! 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 ) 
    7371085         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
    7381086                 &      - 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 ) 
     1087         !  
     1088         IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1089         IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1090         IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1091         IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1092      ENDIF    
     1093      !  
     1094   END SUBROUTINE interpub2b 
     1095 
     1096   SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir) 
    8121097      !!---------------------------------------------------------------------- 
    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 
     1098      !!                  ***  ROUTINE interpvb2b  *** 
     1099      !!----------------------------------------------------------------------   
     1100      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1101      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1102      LOGICAL, INTENT(in) :: before 
     1103      INTEGER, INTENT(in) :: nb , ndir 
    8491104      !! 
    8501105      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) 
     1106      REAL(wp) :: zrhot, zt0, zt1,zat 
     1107      LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     1108      !!----------------------------------------------------------------------   
     1109      ! 
     1110      IF( before ) THEN 
     1111         DO jj=j1,j2 
     1112            DO ji=i1,i2 
     1113               ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 
     1114            END DO 
     1115         END DO 
     1116      ELSE       
     1117         western_side  = (nb == 1).AND.(ndir == 1) 
     1118         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1119         southern_side = (nb == 2).AND.(ndir == 1) 
     1120         northern_side = (nb == 2).AND.(ndir == 2) 
     1121         zrhot = Agrif_rhot() 
     1122         ! Time indexes bounds for integration 
     1123         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     1124         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
     1125         ! Polynomial interpolation coefficients: 
     1126         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
     1127                 &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
     1128         ! 
     1129         IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1130         IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1131         IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1132         IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1133      ENDIF 
     1134      !       
     1135   END SUBROUTINE interpvb2b 
     1136 
     1137   SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 
    8801138      !!---------------------------------------------------------------------- 
    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       !!----------------------------------------------------------------------   
     1139      !!                  ***  ROUTINE interpv  *** 
     1140      !!----------------------------------------------------------------------   
     1141      !  
    8971142      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  
     1143      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     1144      LOGICAL :: before 
     1145      INTEGER, INTENT(in) :: nb , ndir 
     1146      ! 
     1147      INTEGER :: ji, jj, jk 
     1148      INTEGER :: icnt 
     1149      logical :: western_side, eastern_side,northern_side,southern_side       
     1150      !!----------------------------------------------------------------------   
     1151      !     
     1152      IF (before) THEN 
    9031153      DO jk=k1,k2 
    9041154         DO jj=j1,j2 
    9051155            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) 
     1156               ptab(ji,jj,jk) = tmask(ji,jj,jk) * fse3t(ji,jj,jk) 
    9081157            END DO 
    9091158         END DO 
    9101159      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       !!----------------------------------------------------------------------   
    938       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    939       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    940       !! 
    941       INTEGER :: ji, jj, jk 
    942       !!----------------------------------------------------------------------   
    943  
     1160      ELSE 
     1161         western_side  = (nb == 1).AND.(ndir == 1) 
     1162         eastern_side  = (nb == 1).AND.(ndir == 2) 
     1163         southern_side = (nb == 2).AND.(ndir == 1) 
     1164         northern_side = (nb == 2).AND.(ndir == 2) 
     1165          
     1166      icnt = 0 
    9441167      DO jk=k1,k2 
    9451168         DO jj=j1,j2 
    9461169            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) 
     1170               IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * fse3t(ji,jj,jk)) > 1.D-2) THEN 
     1171                  IF (western_side) THEN 
     1172                  WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji,jj,jk 
     1173                  ELSEIF (eastern_side) THEN 
     1174                  WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji,jj,jk 
     1175                  ELSEIF (southern_side) THEN 
     1176                  WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji,jj,jk 
     1177                  ELSEIF (northern_side) THEN 
     1178                  WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji,jj,jk 
     1179                  ENDIF 
     1180                  WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), fse3t(ji,jj,jk) 
     1181                  icnt = icnt + 1 
     1182               ENDIF 
    9491183            END DO 
    9501184         END DO 
    9511185      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 
     1186      IF(icnt /= 0) THEN  
     1187         CALL ctl_stop('ERROR in bathymetry merge between parent and child grids...') 
     1188      ELSE 
     1189         IF(lwp) WRITE(numout,*) 'interp e3t ok...' 
     1190      END IF 
     1191      ENDIF 
     1192      !  
     1193   END SUBROUTINE interpe3t 
    10461194 
    10471195#else 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r4153 r4785  
    1313   PRIVATE 
    1414 
    15    PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
     15   PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn 
     16   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 
    1617 
    1718  !! * Substitutions 
     
    3839 
    3940#if defined SPONGE 
    40       CALL wrk_alloc( jpi, jpj, ztu, ztv ) 
    41       CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  ) 
    42  
    4341      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    44  
     42       
     43      CALL Agrif_Sponge 
    4544      Agrif_SpecialValue=0. 
    4645      Agrif_UseSpecialValue = .TRUE. 
    47       ztab = 0.e0 
    48       CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 
     46      tabspongedone = .FALSE. 
     47 
     48      CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 
     49 
    4950      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  ) 
    8351#endif 
    8452 
     
    9058      !!--------------------------------------------- 
    9159      !! 
    92       INTEGER :: ji,jj,jk 
    9360      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 
    9861 
    9962#if defined SPONGE 
    100       CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff ) 
    101  
    10263      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    10364 
    104       Agrif_SpecialValue=0. 
    105       Agrif_UseSpecialValue = ln_spc_dyn 
    106       ztab = 0.e0 
    107       CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun) 
    108       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 ) 
     65         Agrif_SpecialValue=0. 
     66         Agrif_UseSpecialValue = ln_spc_dyn 
     67 
     68         tabspongedone_u = .FALSE. 
     69         tabspongedone_v = .FALSE.          
     70         CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 
     71 
     72         tabspongedone_u = .FALSE. 
     73         tabspongedone_v = .FALSE. 
     74         CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 
     75 
     76         Agrif_UseSpecialValue = .FALSE. 
    17777#endif 
    17878 
     
    18585      INTEGER  :: ji,jj,jk 
    18686      INTEGER  :: ispongearea, ilci, ilcj 
    187       LOGICAL  :: ll_spdone 
    188       REAL(wp) :: z1spongearea, zramp 
    189       REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 
     87      REAL(wp) :: z1spongearea 
     88      REAL(wp), POINTER, DIMENSION(:,:) :: zlocalviscsponge 
    19089 
    19190#if defined SPONGE || defined SPONGE_TOP 
    192       ll_spdone=.TRUE. 
    193       IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 
    194          ! Define ramp from boundaries towards domain interior 
    195          ! at T-points 
    196          ! Store it in ztabramp 
    197          ll_spdone=.FALSE. 
    198  
    199          CALL wrk_alloc( jpi, jpj, ztabramp ) 
    200  
    201          ispongearea  = 2 + 2 * Agrif_irhox() 
    202          ilci = nlci - ispongearea 
    203          ilcj = nlcj - ispongearea  
    204          z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
    205          spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    206  
    207          ztabramp(:,:) = 0. 
    208  
    209          IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 
    210             DO jj = 1, jpj 
    211                IF ( umask(2,jj,1) == 1._wp ) THEN 
    212                  DO ji = 2, ispongearea                   
    213                     ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 
    214                  END DO 
    215                ENDIF 
    216             ENDDO 
    217          ENDIF 
    218  
    219          IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 
    220             DO jj = 1, jpj 
    221                IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 
    222                   DO ji = ilci+1,nlci-1 
    223                      zramp = (ji - (ilci+1) ) * z1spongearea 
    224                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    225                   ENDDO 
    226                ENDIF 
    227             ENDDO 
    228          ENDIF 
    229  
    230          IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 
    231             DO ji = 1, jpi 
    232                IF ( vmask(ji,2,1) == 1._wp ) THEN 
    233                   DO jj = 2, ispongearea 
    234                      zramp = ( ispongearea-jj ) * z1spongearea 
    235                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    236                   END DO 
    237                ENDIF 
    238             ENDDO 
    239          ENDIF 
    240  
    241          IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
    242             DO ji = 1, jpi 
    243                IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 
    244                   DO jj = ilcj+1,nlcj-1 
    245                      zramp = (jj - (ilcj+1) ) * z1spongearea 
    246                      ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 
    247                   END DO 
    248                ENDIF 
    249             ENDDO 
    250          ENDIF 
    251  
    252       ENDIF 
     91 
     92      CALL wrk_alloc( jpi, jpj, zlocalviscsponge ) 
     93 
     94      ispongearea  = 2 + 2 * Agrif_irhox() 
     95      ilci = nlci - ispongearea 
     96      ilcj = nlcj - ispongearea  
     97      z1spongearea = 1._wp / REAL( ispongearea - 2 ) 
     98      spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 
    25399 
    254100      ! Tracers 
    255101      IF( .NOT. spongedoneT ) THEN 
     102         zlocalviscsponge(:,:) = 0. 
    256103         spe1ur(:,:) = 0. 
    257104         spe2vr(:,:) = 0. 
    258105 
    259106         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) 
     107            DO ji = 2, ispongearea 
     108               zlocalviscsponge(ji,:) = visc_tra * ( ispongearea-ji ) * z1spongearea 
     109            ENDDO 
     110            spe1ur(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      )   & 
     111               &                         +            zlocalviscsponge(3:ispongearea  ,:      ) ) & 
     112               &                         * e2u(2:ispongearea-1,:      ) / e1u(2:ispongearea-1,:      ) 
     113            spe2vr(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1)   & 
     114               &                         +            zlocalviscsponge(2:ispongearea,2  :jpj  ) ) & 
     115               &                         * e1v(2:ispongearea  ,1:jpjm1) / e2v(2:ispongearea  ,1:jpjm1) 
    269116         ENDIF 
    270117 
    271118         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) 
     119            DO ji = ilci+1,nlci-1 
     120               zlocalviscsponge(ji,:) = visc_tra * (ji - (ilci+1) ) * z1spongearea 
     121            ENDDO 
     122   
     123            spe1ur(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:)    &  
     124               &                          +          zlocalviscsponge(ilci+2:nlci-1,:) )  & 
     125               &                          * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 
     126 
     127            spe2vr(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1)    &  
     128               &                            +        zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  ) &  
     129               &                                   * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 
    281130         ENDIF 
    282131 
    283132         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  ) ) & 
     133            DO jj = 2, ispongearea 
     134               zlocalviscsponge(:,jj) = visc_tra * ( ispongearea-jj ) * z1spongearea 
     135            ENDDO 
     136            spe1ur(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea  ) &  
     137               &                            +         zlocalviscsponge(2:jpi  ,2:ispongearea) ) & 
    287138               &                            * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 
    288139    
    289             spe2vr(:      ,2:ispongearea-1) = visc_tra                                     & 
    290                &                            * 0.5 * (  ztabramp(:      ,2:ispongearea-1)   & 
    291                &                                     + ztabramp(:      ,3:ispongearea  ) ) & 
     140            spe2vr(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)       & 
     141               &                            +         zlocalviscsponge(:,3:ispongearea  )     ) & 
    292142               &                            * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 
    293143         ENDIF 
    294144 
    295145         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) ) & 
     146            DO jj = ilcj+1,nlcj-1 
     147               zlocalviscsponge(:,jj) = visc_tra * (jj - (ilcj+1) ) * z1spongearea 
     148            ENDDO 
     149            spe1ur(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1)   & 
     150               &                          +         zlocalviscsponge(2:jpi  ,ilcj+1:nlcj-1) ) & 
    299151               &                                * 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) ) & 
     152            spe2vr(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      )   & 
     153               &                          +         zlocalviscsponge(:,ilcj+2:nlcj-1)     )   & 
    304154               &                                * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 
    305155         ENDIF 
     
    309159      ! Dynamics 
    310160      IF( .NOT. spongedoneU ) THEN 
     161         zlocalviscsponge(:,:) = 0. 
    311162         spe1ur2(:,:) = 0. 
    312163         spe2vr2(:,:) = 0. 
    313164 
    314165         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  ) )  
     166            DO ji = 2, ispongearea 
     167               zlocalviscsponge(ji,:) = visc_dyn * ( ispongearea-ji ) * z1spongearea 
     168            ENDDO 
     169            spe1ur2(2:ispongearea-1,:      ) = 0.5 * ( zlocalviscsponge(2:ispongearea-1,:      ) & 
     170                                             &     +   zlocalviscsponge(3:ispongearea,:    ) ) 
     171            spe2vr2(2:ispongearea  ,1:jpjm1) = 0.5 * ( zlocalviscsponge(2:ispongearea  ,1:jpjm1) & 
     172                                             &     +   zlocalviscsponge(2:ispongearea,2:jpj) )  
    321173         ENDIF 
    322174 
    323175         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    ) )  
     176            DO ji = ilci+1,nlci-1 
     177               zlocalviscsponge(ji,:) = visc_dyn * (ji - (ilci+1) ) * z1spongearea 
     178            ENDDO 
     179            spe1ur2(ilci+1:nlci-2,:      ) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-2,:) & 
     180                                           &        + zlocalviscsponge(ilci+2:nlci-1,:) )   
     181            spe2vr2(ilci+1:nlci-1,1:jpjm1) = 0.5 * (  zlocalviscsponge(ilci+1:nlci-1,1:jpjm1) & 
     182                                           &        + zlocalviscsponge(ilci+1:nlci-1,2:jpj  )  )  
    330183         ENDIF 
    331184 
    332185         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  ) ) 
     186            DO jj = 2, ispongearea 
     187               zlocalviscsponge(:,jj) = visc_dyn * ( ispongearea-jj ) * z1spongearea 
     188            ENDDO 
     189            spe1ur2(1:jpim1,2:ispongearea  ) = 0.5 * ( zlocalviscsponge(1:jpim1,2:ispongearea) & 
     190                                             &      + zlocalviscsponge(2:jpi,2:ispongearea) )  
     191            spe2vr2(:      ,2:ispongearea-1) = 0.5 * ( zlocalviscsponge(:,2:ispongearea-1)     & 
     192                                             &      + zlocalviscsponge(:,3:ispongearea)     ) 
    339193         ENDIF 
    340194 
    341195         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  ) ) 
     196            DO jj = ilcj+1,nlcj-1 
     197               zlocalviscsponge(:,jj) = visc_dyn * (jj - (ilcj+1) ) * z1spongearea 
     198            ENDDO 
     199            spe1ur2(1:jpim1,ilcj+1:nlcj-1) = 0.5 * ( zlocalviscsponge(1:jpim1,ilcj+1:nlcj-1) & 
     200                                           &         + zlocalviscsponge(2:jpi,ilcj+1:nlcj-1) )  
     201            spe2vr2(:      ,ilcj+1:nlcj-2) = 0.5 * ( zlocalviscsponge(:,ilcj+1:nlcj-2      ) & 
     202                                           &         + zlocalviscsponge(:,ilcj+2:nlcj-1)     ) 
    348203         ENDIF 
    349204         spongedoneU = .TRUE. 
     
    351206      ENDIF 
    352207      ! 
    353       IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp ) 
     208      CALL wrk_dealloc( jpi, jpj, zlocalviscsponge ) 
    354209      ! 
    355210#endif 
     
    357212   END SUBROUTINE Agrif_Sponge 
    358213 
    359    SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
    360       !!--------------------------------------------- 
    361       !!   *** ROUTINE interptsn *** 
     214   SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 
     215      !!--------------------------------------------- 
     216      !!   *** ROUTINE interptsn_sponge *** 
    362217      !!--------------------------------------------- 
    363218      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    364219      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       !!--------------------------------------------- 
     220      LOGICAL, INTENT(in) :: before 
     221        
     222      
     223      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     224 
     225      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
     226      REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 
     227      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 
     228      ! 
     229          
     230          
     231         IF (before) THEN 
     232            tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     233         ELSE       
     234 
     235            tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)       
     236            DO jn = 1, jpts 
     237               DO jk = 1, jpkm1 
     238                  
     239                  DO jj = j1,j2-1 
     240                     DO ji = i1,i2-1 
     241                        zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
     242                        zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
     243                        ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     244                        ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     245                     ENDDO 
     246                  ENDDO 
     247                   
     248                  DO jj = j1+1,j2-1 
     249                     DO ji = i1+1,i2-1 
     250                         
     251                        if (.not. tabspongedone(ji,jj)) then  
     252                           zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     253            ! horizontal diffusive trends 
     254                           ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
     255            ! add it to the general tracer trends 
     256                           tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
     257                         endif  
     258  
     259                       ENDDO 
     260                    ENDDO 
     261                     
     262                ENDDO 
     263             ENDDO 
     264              
     265             tabspongedone(i1+1:i2-1,j1+1:j2-1) = .TRUE. 
     266                          
     267    ENDIF 
     268                 
     269   END SUBROUTINE interptsn_sponge 
     270 
     271   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 
     272      !!--------------------------------------------- 
     273      !!   *** ROUTINE interpun_sponge *** 
     274      !!---------------------------------------------     
    374275      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    375276      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       !!--------------------------------------------- 
     277      LOGICAL, INTENT(in) :: before 
     278 
     279      INTEGER :: ji,jj,jk 
     280 
     281   ! sponge parameters  
     282      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
     283      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 
     284      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
     285      INTEGER :: jmax 
     286   ! 
     287       
     288 
     289      IF (before) THEN 
     290           
     291          tabres = un(i1:i2,j1:j2,:) 
     292 
     293      ELSE 
     294          
     295         ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 
     296          
     297         DO jk=1,jpkm1 
     298            ubdiff(i1:i2,j1:j2,jk) = ubdiff(i1:i2,j1:j2,jk) * spe1ur2(i1:i2,j1:j2) 
     299         ENDDO 
     300 
     301         DO jk = 1, jpkm1                                 ! Horizontal slab 
     302!                                             ! =============== 
     303 
     304!                                             ! -------- 
     305! Horizontal divergence                       !   div 
     306!                                             ! -------- 
     307            DO jj = j1,j2 
     308               DO ji = i1+1,i2   ! vector opt. 
     309                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     310                  hdivdiff(ji,jj,jk) = (e2u(ji,jj)*fse3u(ji,jj,jk) * ubdiff(ji,jj,jk) - e2u(ji-1,jj)* fse3u(ji-1,jj  ,jk)  & 
     311                                       * ubdiff(ji-1,jj  ,jk) ) * zbtr 
     312               END DO 
     313            END DO 
     314 
     315            DO jj = j1,j2-1 
     316               DO ji = i1,i2   ! vector opt. 
     317                  zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 
     318                  rotdiff(ji,jj,jk) = (- e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) & 
     319                                      * fmask(ji,jj,jk) * zbtr  
     320               END DO 
     321            END DO 
     322         ENDDO 
     323 
     324! 
     325 
     326 
     327 
     328            DO jj = j1+1, j2-1 
     329               DO ji = i1+1, i2-1   ! vector opt. 
     330                   
     331                  if (.not. tabspongedone_u(ji,jj)) then 
     332                     DO jk = 1, jpkm1                                 ! Horizontal slab 
     333                        ze2u = rotdiff (ji,jj,jk) 
     334                        ze1v = hdivdiff(ji,jj,jk) 
     335! horizontal diffusive trends 
     336                        zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     337                        + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj) 
     338 
     339! add it to the general momentum trends 
     340                        ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     341 
     342                     END DO                   
     343                  endif  
     344 
     345               END DO             
     346            END DO 
     347                   
     348            tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .true. 
     349  
     350         jmax = j2-1 
     351         If ((nbondj == 1).OR.(nbondj == 2)) jmax = min(jmax,nlcj-3) 
     352                                 
     353            DO jj = j1+1, jmax 
     354               DO ji = i1+1, i2   ! vector opt. 
     355                   
     356                  if (.not. tabspongedone_v(ji,jj)) then 
     357                     DO jk = 1, jpkm1                                 ! Horizontal slab 
     358                        ze2u = rotdiff (ji,jj,jk) 
     359                        ze1v = hdivdiff(ji,jj,jk) 
     360                         
     361! horizontal diffusive trends 
     362                        zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     363                        + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj) 
     364 
     365! add it to the general momentum trends 
     366                        va(ji,jj,jk) = va(ji,jj,jk) + zva 
     367                     END DO                   
     368                  endif  
     369 
     370               END DO             
     371            END DO 
     372 
     373             
     374            tabspongedone_v(i1+1:i2,j1+1:jmax) = .true. 
     375             
     376      ENDIF 
     377          
     378           
     379   END SUBROUTINE interpun_sponge 
     380  
     381    
     382   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir) 
     383     !!--------------------------------------------- 
     384      !!   *** ROUTINE interpvn_sponge *** 
     385      !!---------------------------------------------  
    385386      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    386387      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 
     388      LOGICAL, INTENT(in) :: before 
     389      INTEGER, INTENT(in) :: nb , ndir 
     390 
     391      INTEGER :: ji,jj,jk 
     392 
     393      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 
     394       
     395      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 
     396      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 
     397      INTEGER :: imax 
     398   ! 
     399      
     400      IF (before) THEN  
     401        tabres = vn(i1:i2,j1:j2,:) 
     402      ELSE 
     403 
     404         vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 
     405             
     406         DO jk=1,jpkm1 
     407            vbdiff(i1:i2,j1:j2,jk) = vbdiff(i1:i2,j1:j2,jk) * spe2vr2(i1:i2,j1:j2) 
     408         ENDDO 
     409 
     410         DO jk = 1, jpkm1                                 ! Horizontal slab 
     411!                                             ! =============== 
     412 
     413!                                             ! -------- 
     414! Horizontal divergence                       !   div 
     415!                                             ! -------- 
     416            DO jj = j1+1,j2 
     417               DO ji = i1,i2   ! vector opt. 
     418                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     419                  hdivdiff(ji,jj,jk) = (e1v(ji,jj) * fse3v(ji,jj,jk) * vbdiff(ji,jj,jk) - e1v(ji  ,jj-1) & 
     420                                       * fse3v(ji  ,jj-1,jk)  * vbdiff(ji  ,jj-1,jk)  ) * zbtr 
     421               END DO 
     422            END DO 
     423 
     424            DO jj = j1,j2 
     425               DO ji = i1,i2-1   ! vector opt. 
     426                  zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk) 
     427                  rotdiff(ji,jj,jk) = (e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)) & 
     428                                      * fmask(ji,jj,jk) * zbtr 
     429               END DO 
     430            END DO 
     431 
     432         ENDDO 
     433 
     434!                                                ! =============== 
     435!                                                 
     436          
     437         imax = i2-1 
     438         If ((nbondi == 1).OR.(nbondi == 2)) imax = min(imax,nlci-3) 
     439                             
     440            DO jj = j1+1, j2 
     441               DO ji = i1+1, imax   ! vector opt. 
     442                  if (.not. tabspongedone_u(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                        zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
     448                        / e1u(ji,jj) 
     449 
     450 
     451! add it to the general momentum trends 
     452                       ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     453                     END DO 
     454 
     455                   endif 
     456            END DO             
     457         END DO   
     458   
     459         tabspongedone_u(i1+1:imax,j1+1:j2) = .true. 
     460          
     461            DO jj = j1+1, j2-1 
     462               DO ji = i1+1, i2-1   ! vector opt. 
     463                  if (.not. tabspongedone_v(ji,jj)) then 
     464                     DO jk = 1, jpkm1                                 ! Horizontal slab 
     465                        ze2u = rotdiff (ji,jj,jk) 
     466                        ze1v = hdivdiff(ji,jj,jk) 
     467! horizontal diffusive trends 
     468 
     469                        zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
     470                        / e2v(ji,jj) 
     471 
     472! add it to the general momentum trends 
     473                       va(ji,jj,jk) = va(ji,jj,jk) + zva 
     474                     END DO 
     475 
     476                   endif 
     477            END DO             
     478         END DO           
     479          
     480         tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .true. 
     481          
     482      ENDIF 
     483      
     484   END SUBROUTINE interpvn_sponge 
    391485 
    392486#else 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r4491 r4785  
    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 
     
    1516   PRIVATE 
    1617 
    17    PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 
    18  
    19    INTEGER, PUBLIC :: nbcline = 0 
     18   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 
    2019 
    2120   !!---------------------------------------------------------------------- 
     
    3130      !!   *** ROUTINE Agrif_Update_Tra *** 
    3231      !!--------------------------------------------- 
    33       !! 
    3432      INTEGER, INTENT(in) :: kt 
    35       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    36  
    37  
     33      !!--------------------------------------------- 
     34      !  
    3835      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 ) 
    41  
     36#if defined TWO_WAY    
    4237      Agrif_UseSpecialValueInUpdate = .TRUE. 
    4338      Agrif_SpecialValueFineGrid = 0. 
    44  
     39      !  
    4540      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  
     41# if ! defined DECAL_FEEDBACK 
     42         CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 
     43# else 
     44         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 
     45# endif 
     46      ELSE 
     47# if ! defined DECAL_FEEDBACK 
     48         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 
     49# else 
     50         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 
     51# endif 
     52      ENDIF 
     53      ! 
    5154      Agrif_UseSpecialValueInUpdate = .FALSE. 
    52  
    53       CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 
    5455#endif 
    55  
     56      ! 
    5657   END SUBROUTINE Agrif_Update_Tra 
    5758 
     
    6061      !!   *** ROUTINE Agrif_Update_Dyn *** 
    6162      !!--------------------------------------------- 
    62       !! 
    6363      INTEGER, INTENT(in) :: kt 
    64       REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 
    65       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
    66  
    67  
     64      !!--------------------------------------------- 
     65      !  
    6866      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return 
    6967#if defined TWO_WAY 
    70       CALL wrk_alloc( jpi, jpj,      ztab2d ) 
    71       CALL wrk_alloc( jpi, jpj, jpk, ztab   ) 
    72  
     68      Agrif_UseSpecialValueInUpdate = .FALSE. 
     69      Agrif_SpecialValueFineGrid = 0. 
     70      !      
    7371      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 
     72# if ! defined DECAL_FEEDBACK 
     73         CALL Agrif_Update_Variable(un_update_id,procname = updateU) 
     74         CALL Agrif_Update_Variable(vn_update_id,procname = updateV) 
     75# else 
     76         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU) 
     77         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV) 
     78# endif 
     79      ELSE 
     80# if ! defined DECAL_FEEDBACK 
     81         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU) 
     82         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)          
     83# else 
     84         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU) 
     85         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV) 
     86# endif 
     87      ENDIF 
     88 
     89# if ! defined DECAL_FEEDBACK 
     90      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d) 
     91      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)   
     92# else 
     93      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d) 
     94      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d)   
     95# endif 
     96 
     97# if defined key_dynspg_ts 
    8598      IF (ln_bt_fw) THEN 
    8699         ! Update time integrated transports 
    87100         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) 
     101#  if ! defined DECAL_FEEDBACK 
     102            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 
     103            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 
     104#  else 
     105            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b) 
     106            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b) 
     107#  endif 
    90108         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) 
     109#  if ! defined DECAL_FEEDBACK 
     110            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b) 
     111            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b) 
    93112         ENDIF 
     113#  else 
     114         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b) 
     115         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b) 
     116#  endif 
    94117      END IF  
     118# endif 
     119      ! 
     120      nbcline = nbcline + 1 
     121      ! 
     122      Agrif_UseSpecialValueInUpdate = .TRUE. 
     123      Agrif_SpecialValueFineGrid = 0. 
     124# if ! defined DECAL_FEEDBACK 
     125      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 
     126# else 
     127      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH) 
     128# endif 
     129      Agrif_UseSpecialValueInUpdate = .FALSE. 
     130      !  
    95131#endif 
    96  
    97       nbcline = nbcline + 1 
    98  
    99       Agrif_UseSpecialValueInUpdate = .TRUE.  
    100       Agrif_SpecialValueFineGrid = 0. 
    101       CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH) 
    102       Agrif_UseSpecialValueInUpdate = .FALSE. 
    103  
    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  
    114132   END SUBROUTINE Agrif_Update_Dyn 
    115133 
    116    SUBROUTINE recompute_diags( kt ) 
    117       !!--------------------------------------------- 
    118       !!   *** ROUTINE recompute_diags *** 
    119       !!--------------------------------------------- 
    120       INTEGER, INTENT(in) :: kt 
    121  
    122    END SUBROUTINE recompute_diags 
    123134 
    124135   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     
    127138      !!--------------------------------------------- 
    128139#  include "domzgr_substitute.h90" 
    129  
    130140      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    131141      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    132       LOGICAL, iNTENT(in) :: before 
    133  
     142      LOGICAL, INTENT(in) :: before 
     143      !! 
    134144      INTEGER :: ji,jj,jk,jn 
    135  
     145      !!--------------------------------------------- 
     146      ! 
    136147      IF (before) THEN 
    137148         DO jn = n1,n2 
     
    146157      ELSE 
    147158         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    148          ! Add asselin part 
     159            ! Add asselin part 
    149160            DO jn = n1,n2 
    150161               DO jk=k1,k2 
     
    161172            ENDDO 
    162173         ENDIF 
    163  
    164174         DO jn = n1,n2 
    165175            DO jk=k1,k2 
     
    174184         END DO 
    175185      ENDIF 
    176  
     186      !  
    177187   END SUBROUTINE updateTS 
    178188 
     
    182192      !!--------------------------------------------- 
    183193#  include "domzgr_substitute.h90" 
    184  
     194      !! 
    185195      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    186196      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    187197      LOGICAL, INTENT(in) :: before 
    188  
     198      !!  
    189199      INTEGER :: ji, jj, jk 
    190200      REAL(wp) :: zrhoy 
    191  
     201      !!--------------------------------------------- 
     202      !  
    192203      IF (before) THEN 
    193204         zrhoy = Agrif_Rhoy() 
     
    217228         END DO 
    218229      ENDIF 
    219  
     230      !  
    220231   END SUBROUTINE updateu 
    221232 
     
    225236      !!--------------------------------------------- 
    226237#  include "domzgr_substitute.h90" 
    227  
     238      !! 
    228239      INTEGER :: i1,i2,j1,j2,k1,k2 
    229240      INTEGER :: ji,jj,jk 
    230241      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 
    231242      LOGICAL :: before 
    232  
     243      !! 
    233244      REAL(wp) :: zrhox 
    234  
     245      !!---------------------------------------------       
     246      ! 
    235247      IF (before) THEN 
    236248         zrhox = Agrif_Rhox() 
     
    260272         END DO 
    261273      ENDIF 
    262  
     274      !  
    263275   END SUBROUTINE updatev 
    264276 
     
    268280      !!--------------------------------------------- 
    269281#  include "domzgr_substitute.h90" 
    270  
     282      !! 
    271283      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    272284      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    273285      LOGICAL, INTENT(in) :: before 
    274  
     286      !!  
    275287      INTEGER :: ji, jj, jk 
    276288      REAL(wp) :: zrhoy 
    277289      REAL(wp) :: zcorr 
    278  
     290      !!--------------------------------------------- 
     291      ! 
    279292      IF (before) THEN 
    280293         zrhoy = Agrif_Rhoy() 
     
    326339         END DO 
    327340      ENDIF 
    328  
     341      ! 
    329342   END SUBROUTINE updateu2d 
    330343 
     
    333346      !!          *** ROUTINE updatev2d *** 
    334347      !!--------------------------------------------- 
    335  
    336348      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    337349      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    338350      LOGICAL, INTENT(in) :: before 
    339  
     351      !!  
    340352      INTEGER :: ji, jj, jk 
    341353      REAL(wp) :: zrhox 
    342354      REAL(wp) :: zcorr 
    343  
     355      !!--------------------------------------------- 
     356      ! 
    344357      IF (before) THEN 
    345358         zrhox = Agrif_Rhox() 
     
    391404         END DO 
    392405      ENDIF 
    393  
     406      !  
    394407   END SUBROUTINE updatev2d 
     408       
    395409 
    396410   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 
     
    398412      !!          *** ROUTINE updateSSH *** 
    399413      !!--------------------------------------------- 
    400 #  include "domzgr_substitute.h90" 
    401  
    402414      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    403415      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    404416      LOGICAL, INTENT(in) :: before 
    405  
     417      !! 
    406418      INTEGER :: ji, jj 
    407  
     419      !!--------------------------------------------- 
     420      !  
    408421      IF (before) THEN 
    409422         DO jj=j1,j2 
     
    413426         END DO 
    414427      ELSE 
    415  
    416428#if ! defined key_dynspg_ts 
    417429         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     
    430442         END DO 
    431443      ENDIF 
    432  
     444      ! 
    433445   END SUBROUTINE updateSSH 
    434446 
     
    437449      !!          *** ROUTINE updateub2b *** 
    438450      !!--------------------------------------------- 
    439  
    440451      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    441452      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    442453      LOGICAL, INTENT(in) :: before 
    443  
     454      !! 
    444455      INTEGER :: ji, jj 
    445456      REAL(wp) :: zrhoy 
    446  
     457      !!--------------------------------------------- 
     458      ! 
    447459      IF (before) THEN 
    448460         zrhoy = Agrif_Rhoy() 
     
    460472         END DO 
    461473      ENDIF 
    462  
     474      ! 
    463475   END SUBROUTINE updateub2b 
    464476 
     
    467479      !!          *** ROUTINE updatevb2b *** 
    468480      !!--------------------------------------------- 
    469  
    470481      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    471482      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    472483      LOGICAL, INTENT(in) :: before 
    473  
     484      !! 
    474485      INTEGER :: ji, jj 
    475486      REAL(wp) :: zrhox 
    476  
     487      !!--------------------------------------------- 
     488      ! 
    477489      IF (before) THEN 
    478490         zrhox = Agrif_Rhox() 
     
    490502         END DO 
    491503      ENDIF 
    492  
     504      ! 
    493505   END SUBROUTINE updatevb2b 
     506 
     507 
     508   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 
     509   ! currently not used 
     510      !!--------------------------------------------- 
     511      !!           *** ROUTINE updateT *** 
     512      !!--------------------------------------------- 
     513#  include "domzgr_substitute.h90" 
     514 
     515      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     516      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     517      LOGICAL, iNTENT(in) :: before 
     518 
     519      INTEGER :: ji,jj,jk 
     520      REAL(wp) :: ztemp 
     521 
     522      IF (before) THEN 
     523            DO jk=k1,k2 
     524               DO jj=j1,j2 
     525                  DO ji=i1,i2 
     526                     tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 
     527                     tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk) 
     528                     tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk) 
     529                  END DO 
     530               END DO 
     531            END DO 
     532            tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy() 
     533            tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox() 
     534            tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy() 
     535      ELSE 
     536            DO jk=k1,k2 
     537               DO jj=j1,j2 
     538                  DO ji=i1,i2 
     539                     IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN  
     540                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 
     541                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk) 
     542                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk) 
     543                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3))) 
     544                     print *,'CORR = ',ztemp-1. 
     545                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, & 
     546                     tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp 
     547                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp 
     548                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp 
     549                     END IF 
     550                  END DO 
     551               END DO 
     552            END DO 
     553      ENDIF 
     554 
     555   END SUBROUTINE update_scales 
    494556 
    495557#else 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r4624 r4785  
    125125   !!---------------------------------------------------------------------- 
    126126   USE agrif_util 
    127    USE par_oce       !   ONLY : jpts 
     127   USE par_oce        
    128128   USE oce 
    129129   IMPLICIT NONE 
     
    132132   ! 1. Declaration of the type of variable which have to be interpolated 
    133133   !--------------------------------------------------------------------- 
    134    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    135    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    136  
     134   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     135   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    137136 
    138137   ! 2. Type of interpolation 
     
    167166   USE nemogcm 
    168167   USE sol_oce 
     168   USE lib_mpp 
    169169   USE in_out_manager 
    170170   USE agrif_opa_update 
     
    174174   IMPLICIT NONE 
    175175   ! 
    176    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
    177    REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    178    REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d 
    179176   LOGICAL :: check_namelist 
    180    !!---------------------------------------------------------------------- 
    181  
    182    ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
    183    ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
    184    ALLOCATE( tab2d(jpi, jpj)                ) 
    185  
     177   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 
     178   !!---------------------------------------------------------------------- 
    186179 
    187180   ! 1. Declaration of the type of variable which have to be interpolated 
     
    193186   Agrif_SpecialValue=0. 
    194187   Agrif_UseSpecialValue = .TRUE. 
    195    Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
    196    Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
    197  
    198    Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
    199    Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
    200    Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
    201    Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    202  
    203    Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb) 
    204    Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb) 
    205    Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn) 
    206    Agrif_UseSpecialValue = .FALSE. 
     188   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     189   CALL Agrif_Sponge 
     190   tabspongedone = .FALSE. 
     191   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
     192   ! reset tsa to zero 
     193   tsa(:,:,:,:) = 0. 
     194 
     195   Agrif_UseSpecialValue = ln_spc_dyn 
     196   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
     197   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     198   tabspongedone_u = .FALSE. 
     199   tabspongedone_v = .FALSE. 
     200   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
     201   tabspongedone_u = .FALSE. 
     202   tabspongedone_v = .FALSE. 
     203   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     204 
     205#if defined key_dynspg_ts 
     206   CALL Agrif_Bc_variable(sshn_id,calledweight=1.,procname=interpsshn) 
     207   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
     208   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     209   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
     210   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     211   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
     212   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
     213   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
     214   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
     215#endif 
     216 
     217   Agrif_UseSpecialValue = .FALSE.  
     218   ! reset velocities to zero 
     219   ua(:,:,:) = 0. 
     220   va(:,:,:) = 0. 
    207221 
    208222   ! 3. Some controls 
     
    210224   check_namelist = .true. 
    211225 
    212    IF( check_namelist ) THEN 
     226   IF( check_namelist ) THEN  
    213227 
    214228      ! Check time steps            
    215       IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    216          WRITE(*,*) 'incompatible time step between grids' 
    217          WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    218          WRITE(*,*) 'child  grid value : ',nint(rdt) 
    219          WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    220          STOP 
     229      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
     230         write(cl_check1,*)  nint(Agrif_Parent(rdt)) 
     231         write(cl_check2,*)  nint(rdt) 
     232         write(cl_check3,*)  nint(Agrif_Parent(rdt)/Agrif_Rhot()) 
     233         CALL ctl_warn( 'incompatible time step between grids',   & 
     234         &               'parent grid value : '//cl_check1    ,   &  
     235         &               'child  grid value : '//cl_check2    ,   &  
     236         &               'value on child grid will be changed to : '//cl_check3 ) 
     237         rdt=Agrif_Parent(rdt)/Agrif_Rhot() 
    221238      ENDIF 
    222239 
     
    224241      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    225242           Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    226          WRITE(*,*) 'incompatible run length between grids' 
    227          WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    228               Agrif_Parent(nit000)+1),' time step' 
    229          WRITE(*,*) 'child  grid value : ', & 
    230               (nitend-nit000+1),' time step' 
    231          WRITE(*,*) 'value on child grid should be : ', & 
    232               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    233               Agrif_Parent(nit000)+1) 
    234          STOP 
     243         write(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     244         write(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     245         CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     246         &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
     247         &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     248         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     249         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    235250      ENDIF 
    236251 
     
    254269      ENDIF 
    255270   ENDIF 
    256  
     271   !  
    257272   CALL Agrif_Update_tra(0) 
    258273   CALL Agrif_Update_dyn(0) 
    259  
     274   ! 
     275   Agrif_UseSpecialValueInUpdate = .FALSE. 
    260276   nbcline = 0 
    261    ! 
    262    DEALLOCATE(tabtstemp) 
    263    DEALLOCATE(tabuvtemp) 
    264    DEALLOCATE(tab2d) 
    265277   ! 
    266278END SUBROUTINE Agrif_InitValues_cont 
     
    281293   ! 1. Declaration of the type of variable which have to be interpolated 
    282294   !--------------------------------------------------------------------- 
    283    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    284    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
    285    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
    286  
    287    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    288    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    289    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
    290    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
    291  
    292    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
    293    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
    294    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    295    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
    296    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id) 
    297    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id) 
     295   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     296   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     297 
     298   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
     299   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
     300   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
     301   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
     302   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
     303   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
     304 
     305   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     306  
     307   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
     308 
     309   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     310   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     311   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     312   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     313   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     314   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     315 
     316   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     317 
    298318 
    299319   ! 2. Type of interpolation 
    300320   !------------------------- 
    301321   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    302    CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    303  
    304    Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    305    Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    306  
    307    Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    308    Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     322  
     323   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     324   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     325  
     326   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    309327 
    310328   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    311    Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    312    Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    313    Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    314    Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     329   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     330   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     331   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     332   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     333 
     334 
     335   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     336   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     337  
     338   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     339  
    315340 
    316341   ! 3. Location of interpolation 
    317342   !----------------------------- 
    318    Call Agrif_Set_bc(un_id,(/0,1/)) 
    319    Call Agrif_Set_bc(vn_id,(/0,1/)) 
    320  
    321    Call Agrif_Set_bc(sshn_id,(/0,1/)) 
    322    Call Agrif_Set_bc(unb_id,(/0,1/)) 
    323    Call Agrif_Set_bc(vnb_id,(/0,1/)) 
    324    Call Agrif_Set_bc(ub2b_id,(/0,1/)) 
    325    Call Agrif_Set_bc(vb2b_id,(/0,1/)) 
    326  
    327    Call Agrif_Set_bc(tsn_id,(/0,1/)) 
    328    Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    329  
    330    Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    331    Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     343   CALL Agrif_Set_bc(tsn_id,(/0,1/)) 
     344   CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 
     345   CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 
     346 
     347   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 
     348   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
     349   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
     350 
     351   CALL Agrif_Set_bc(sshn_id,(/0,0/)) 
     352   CALL Agrif_Set_bc(unb_id ,(/0,0/)) 
     353   CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 
     354   Call Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 
     355   Call Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 
     356 
     357   CALL Agrif_Set_bc(e3t_id,(/-3*Agrif_irhox(),0/))   ! if west and rhox=3: column 2 to 11 
    332358 
    333359   ! 5. Update type 
    334360   !---------------  
    335    Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    336    Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    337  
    338    Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    339    Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
    340  
    341    Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    342    Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    343  
    344    Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    345    Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    346  
     361   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     362 
     363   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     364   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     365   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     366 
     367   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     368 
     369   Call Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     370   Call Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     371 
     372   ! 
    347373END SUBROUTINE agrif_declare_var 
    348374# endif 
     
    462488   USE nemogcm 
    463489   USE par_trc 
     490   USE lib_mpp 
    464491   USE trc 
    465492   USE in_out_manager 
     
    471498   ! 
    472499   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     500   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    473501   LOGICAL :: check_namelist 
    474502   !!---------------------------------------------------------------------- 
     
    494522 
    495523   IF( check_namelist ) THEN 
    496 #  if defined offline      
     524# if defined key_offline 
    497525      ! Check time steps 
    498526      IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    499          WRITE(*,*) 'incompatible time step between grids' 
    500          WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    501          WRITE(*,*) 'child  grid value : ',nint(rdt) 
    502          WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    503          STOP 
     527         write(cl_check1,*)  Agrif_Parent(rdt) 
     528         write(cl_check2,*)  rdt 
     529         write(cl_check3,*)  rdt*Agrif_Rhot() 
     530         CALL ctl_warn( 'incompatible time step between grids',   & 
     531         &               'parent grid value : '//cl_check1    ,   &  
     532         &               'child  grid value : '//cl_check2    ,   &  
     533         &               'value on child grid will be changed to  & 
     534         &               :'//cl_check3  ) 
     535         rdt=rdt*Agrif_Rhot() 
    504536      ENDIF 
    505537 
     
    515547              Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    516548              Agrif_Parent(nit000)+1) 
    517          STOP 
     549         CALL ctl_warn( 'incompatible run length between grids',   & 
     550         &              'value on child grid will be change to '  & 
     551         &             ) 
     552 
     553 
    518554      ENDIF 
    519555 
     
    664700   SELECT CASE( i ) 
    665701   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    666    CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
    667    CASE(3)   ;   indglob = indloc 
    668    CASE(4)   ;   indglob = indloc 
     702   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
     703   CASE DEFAULT 
     704                 indglob = indloc 
    669705   END SELECT 
    670706   ! 
    671707END SUBROUTINE Agrif_InvLoc 
     708 
     709SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
     710   !!---------------------------------------------------------------------- 
     711   !!                 *** ROUTINE Agrif_get_proc_info *** 
     712   !!---------------------------------------------------------------------- 
     713   USE par_oce 
     714   IMPLICIT NONE 
     715   ! 
     716   INTEGER, INTENT(out) :: imin, imax 
     717   INTEGER, INTENT(out) :: jmin, jmax 
     718   !!---------------------------------------------------------------------- 
     719   ! 
     720   imin = nimppt(Agrif_Procrank+1)  ! ????? 
     721   jmin = njmppt(Agrif_Procrank+1)  ! ????? 
     722   imax = imin + jpi - 1 
     723   jmax = jmin + jpj - 1 
     724   !  
     725END SUBROUTINE Agrif_get_proc_info 
     726 
     727SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
     728   !!---------------------------------------------------------------------- 
     729   !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
     730   !!---------------------------------------------------------------------- 
     731   USE par_oce 
     732   IMPLICIT NONE 
     733   ! 
     734   INTEGER,  INTENT(in)  :: imin, imax 
     735   INTEGER,  INTENT(in)  :: jmin, jmax 
     736   INTEGER,  INTENT(in)  :: nbprocs 
     737   REAL(wp), INTENT(out) :: grid_cost 
     738   !!---------------------------------------------------------------------- 
     739   ! 
     740   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
     741   ! 
     742END SUBROUTINE Agrif_estimate_parallel_cost 
     743 
    672744 
    673745# endif 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r4366 r4785  
    533533         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    534534            IF( .NOT. Agrif_Root() ) THEN 
    535               zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
     535              zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m)   &  
     536                    &           / (ra * rad) 
    536537            ENDIF 
    537538         ENDIF 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4691 r4785  
    11061106      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    11071107      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset 
    1108       IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    1109       IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
     1108      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       & 
     1109    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
     1110      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  & 
     1111    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    11101112      CALL xios_solve_inheritance() 
    11111113   END SUBROUTINE iom_set_field_attr 
     
    14831485      ENDIF 
    14841486       
     1487!$AGRIF_DO_NOT_TREAT       
     1488! Should be fixed in the conv 
    14851489      IF( llfull ) THEN  
    14861490         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 
     
    14931497         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run 
    14941498      ENDIF 
     1499!$AGRIF_END_DO_NOT_TREAT       
    14951500 
    14961501   END FUNCTION iom_sdate 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4765 r4785  
    289289      ENDIF 
    290290 
     291#if defined key_agrif 
     292      IF (Agrif_Root()) THEN 
     293         CALL Agrif_MPI_Init(mpi_comm_opa) 
     294      ELSE 
     295         CALL Agrif_MPI_set_grid_comm(mpi_comm_opa) 
     296      ENDIF 
     297#endif 
     298 
    291299      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    292300      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r4328 r4785  
    107107      ! Update after tracer on domain lateral boundaries 
    108108      !  
     109#if defined key_agrif 
     110      CALL Agrif_tra                     ! AGRIF zoom boundaries 
     111#endif 
     112      ! 
    109113      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign) 
    110114      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
     
    112116#if defined key_bdy  
    113117      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries 
    114 #endif 
    115 #if defined key_agrif 
    116       CALL Agrif_tra                     ! AGRIF zoom boundaries 
    117118#endif 
    118119  
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r3632 r4785  
    203203      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity  
    204204      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    205       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   & 
    206          &                                                               ktrd, ktra, ctype, kt 
     205      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', & 
     206         &     ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),                      & 
     207         &     ktrd, ktra, ctype, kt 
    207208   END SUBROUTINE trd_tra 
    208209#   endif 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4624 r4785  
    341341         END DO 
    342342      END DO 
     343      ! 
     344      IF( .NOT. AGRIF_Root() ) THEN 
     345         DO jk = 1, jpkm1 
     346            IF ((nbondi ==  1).OR.(nbondi == 2)) avmu(nlci-1 , :     ,jk) = avmu(nlci-2 , :     ,jk)     !   east 
     347            IF ((nbondi == -1).OR.(nbondi == 2)) avmu(1      , :     ,jk) = avmu(2      , :     ,jk)     !   west 
     348            IF ((nbondj ==  1).OR.(nbondj == 2)) avmv(:      ,nlcj-1 ,jk) = avmv(:      ,nlcj-2 ,jk)     !   north 
     349            IF ((nbondj == -1).OR.(nbondj == 2)) avmv(:      ,1      ,jk) = avmv(:      ,2      ,jk)     !   south 
     350         END DO 
     351      ENDIF 
    343352      ! 
    344353      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4723 r4785  
    165165          ENDIF 
    166166 
     167#if defined key_agrif 
     168          CALL Agrif_Regrid() 
     169#endif 
     170 
    167171         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    168172 
    169173#if defined key_agrif 
    170             CALL Agrif_Step( stp )           ! AGRIF: time stepping 
     174            CALL stp                         ! AGRIF: time stepping 
    171175#else 
    172176            CALL stp( istp )                 ! standard time stepping 
     
    193197      ! 
    194198#if defined key_agrif 
    195       CALL Agrif_ParentGrid_To_ChildGrid() 
    196       IF( lk_diaobs ) CALL dia_obs_wri 
    197       IF( nn_timing == 1 )   CALL timing_finalize 
    198       CALL Agrif_ChildGrid_To_ParentGrid() 
     199      IF( .NOT. Agrif_Root() ) THEN 
     200         CALL Agrif_ParentGrid_To_ChildGrid() 
     201         IF( lk_diaobs ) CALL dia_obs_wri 
     202         IF( nn_timing == 1 )   CALL timing_finalize 
     203         CALL Agrif_ChildGrid_To_ParentGrid() 
     204      ENDIF 
    199205#endif 
    200206      IF( nn_timing == 1 )   CALL timing_finalize 
     
    713719      INTEGER :: ifac, jl, inu 
    714720      INTEGER, PARAMETER :: ntest = 14 
    715       INTEGER :: ilfax(ntest) 
    716  
     721      INTEGER, DIMENSION(ntest) :: ilfax 
     722      !!---------------------------------------------------------------------- 
    717723      ! lfax contains the set of allowed factors. 
    718       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    719          &                            128,   64,   32,   16,    8,   4,   2  / 
    720       !!---------------------------------------------------------------------- 
     724      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
    721725 
    722726      ! Clear the error flag and initialise output vars 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4760 r4785  
    4848 
    4949#if defined key_agrif 
    50    SUBROUTINE stp( ) 
     50   RECURSIVE SUBROUTINE stp( ) 
    5151      INTEGER             ::   kstp   ! ocean time-step index 
    5252#else 
     
    7777#if defined key_agrif 
    7878      kstp = nit000 + Agrif_Nb_Step() 
    79 !      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    80 !      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
     79      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
     80      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
    8181      IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 
    8282# if defined key_iomput 
     
    176176                                  ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    177177                                  va(:,:,:) = 0.e0 
    178           IF(  ln_asmiau .AND. & 
     178          IF(  lk_asminc .AND. ln_asmiau .AND. & 
    179179             & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment 
    180180          IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified) 
     
    225225                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
    226226 
    227       IF(  ln_asmiau .AND. & 
     227      IF(  lk_asminc .AND. ln_asmiau .AND. & 
    228228         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
    229229                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
     
    277277                               va(:,:,:) = 0.e0 
    278278 
    279         IF(  ln_asmiau .AND. & 
     279        IF(  lk_asminc .AND. ln_asmiau .AND. & 
    280280           & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
    281281        IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
     
    341341      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
    342342      ! 
     343#if defined key_agrif 
     344      CALL Agrif_Integrate_ChildGrids( stp )    
     345#endif       
     346      ! 
    343347   END SUBROUTINE stp 
    344348 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh

    r3294 r4785  
    5757#- AGRIF conv 
    5858if [ "$AGRIFUSE" == 1 ]; then 
     59#-MPI for AGRIF 
     60if [ ! -f ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h ];then 
     61   echo '#if defined key_mpp_mpi' > ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
     62   echo '#define AGRIF_MPI'      >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
     63   echo '#endif'                 >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
     64fi 
    5965 
    60 #- CONV 
    61 #fcm build ${TOOLS_DIR}/conv.cfg || exit 1 
    62 gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB 
     66 #- CONV 
     67 #fcm build ${TOOLS_DIR}/conv.cfg || exit 1 
     68COMPILER=${CC-cc} 
     69gmake CC=${COMPILER} -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB 
    6370 
    6471#- AGRIF sources 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/COMPILE/bld.cfg

    r3695 r4785  
    3939bld::tool::fppflags::nemo      %FPPFLAGS -I$CONFIG_DIR/$NEW_CONF/OPAFILES/inc 
    4040bld::tool::fppflags::ioipsl    %FPPFLAGS 
    41 bld::tool::fppflags::agrif     %FPPFLAGS 
     41bld::tool::fppflags::agrif     %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 
    4242 
    4343# Ignore the following dependencies 
  • branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg

    r3850 r4785  
    5656bld::excl_dep       use::ioipsl 
    5757bld::excl_dep       use::xios 
     58bld::excl_dep        use::agrif_grids 
    5859bld::excl_dep       use::agrif_types 
    5960bld::excl_dep       use::agrif_util 
Note: See TracChangeset for help on using the changeset viewer.