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 4064 for branches/2013/dev_r3940_CNRS4_IOCRS – NEMO

Ignore:
Timestamp:
2013-10-15T19:54:10+02:00 (11 years ago)
Author:
cetlod
Message:

branch dev_r3940_CNRS4_IOCRS: some improvments+ minor bug corrections

Location:
branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM
Files:
20 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_top

    r3744 r4064  
    77!!              6 - tracer newtonian damping              (namtrc_dmp) 
    88!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    9 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    10 &namtrc     !   tracers definition 
    11 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     9!----------------------------------------------------------------------- 
     10&namtrc_run     !   run information 
     11!----------------------------------------------------------------------- 
    1212   nn_dttrc      =  1        !  time step frequency for passive sn_tracers       
    1313   nn_writetrc   =  0        !  time step frequency for sn_tracer outputs 
    14    ln_top_euler  = .true.    !  use Euler timestepping for TOP 
     14   ln_top_euler  = .true.    !  use Euler time-stepping for TOP 
    1515   ln_rsttr      = .false.   !  start from a restart file (T) or not (F) 
    1616   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value 
    … …  
    1919   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    2020   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     21/ 
     22!----------------------------------------------------------------------- 
     23&namtrc     !   tracers definition 
     24!----------------------------------------------------------------------- 
    2125   ln_trcdta     =  .false.        !  Initialisation from data input file (T) or not (F) 
    2226! 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_top

    r3855 r4064  
    88!!                       7 - tracer output                         (namtrc_wri) 
    99!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    10 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    11 &namtrc     !   tracers definition 
    12 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
    13 ! 
    14    nn_dttrc      =  1        !  time step frequency for passive sn_tracers 
     10!----------------------------------------------------------------------- 
     11&namtrc_run     !   run information 
     12!----------------------------------------------------------------------- 
     13   nn_dttrc      =  1        !  time step frequency for passive sn_tracers       
    1514   nn_writetrc   =  60       !  time step frequency for sn_tracer outputs 
    1615   ln_top_euler  = .false.   !  use Euler time-stepping for TOP 
    1716   ln_rsttr      = .false.   !  start from a restart file (T) or not (F) 
    18    nn_rsttr      =   1       !  restart control = 0 initial time step is not compared to the restart file value 
     17   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value 
    1918                           !                  = 1 do not use the value in the restart file 
    2019                           !                  = 2 calendar parameters read in the restart file 
    21    cn_trcrst_in  = "restart_trc.nc"   !  suffix of pass. sn_tracer restart name (input) 
     20   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    2221   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     22/ 
     23!----------------------------------------------------------------------- 
     24&namtrc     !   tracers definition 
     25!----------------------------------------------------------------------- 
    2326   ln_trcdta     =   .false.    !  Initialisation from data input file (T) or not (F) 
    2427! 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/iodef.xml

    r3771 r4064  
    2121    --> 
    2222     
    23     <file_definition type="multiple_file" sync_freq="1d" min_digits="4"> 
    24      
     23   <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
     24 
     25      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
    2526      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
    2627      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
    … …  
    3334      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
    3435      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->    
     36 
     37   <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 
     38     <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               /> 
     39     <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            /> 
     40     <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
     41     <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             /> 
     42     <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          /> 
     43     <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                /> 
     44     <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      /> 
     45     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
     46     <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
     47     <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
     48     <field field_ref="taum"         /> 
     49     <field field_ref="mldkz5"       /> 
     50     <field field_ref="mldr10_1"     /> 
     51   </file> 
     52    
     53   <file id="file2" name_suffix="_grid_U" description="ocean U grid variables" > 
     54     <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      /> 
     55     <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    /> 
     56     <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" /> 
     57   </file> 
     58    
     59   <file id="file3" name_suffix="_grid_V" description="ocean V grid variables" > 
     60     <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      /> 
     61     <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    /> 
     62     <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" /> 
     63   </file> 
     64    
     65   <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" > 
     66     <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         /> 
     67     <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" /> 
     68   </file> 
     69    
     70   <file id="file5" name_suffix="_icemod" description="ice variables" > 
     71     <field field_ref="ice_pres"                     /> 
     72     <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"   /> 
     73     <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
     74     <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
     75     <field field_ref="ist_ipa"      /> 
     76     <field field_ref="ioceflxb"     /> 
     77     <field field_ref="uice_ipa"     /> 
     78     <field field_ref="vice_ipa"     /> 
     79     <field field_ref="utau_ice"     /> 
     80     <field field_ref="vtau_ice"     /> 
     81     <field field_ref="qsr_io_cea"   /> 
     82     <field field_ref="qns_io_cea"   /> 
     83     <field field_ref="snowpre"      /> 
     84   </file> 
     85 
     86 
     87   <file id="file6" name_suffix="_ptrc_T" description="sms variables" > 
     88          <field field_ref="CFC11"      /> 
     89          <field field_ref="C14B" /> 
     90   </file> 
     91    
     92   <file id="file7" name_suffix="_diad_T" description="additional diagnostics" > 
     93          <field field_ref="qtrCFC11"     /> 
     94          <field field_ref="qintCFC11"     /> 
     95          <field field_ref="qtrC14b"     /> 
     96          <field field_ref="qintC14b"     /> 
     97          <field field_ref="fdecay"     /> 
     98   </file> 
     99 
    35100      </file_group> 
    36101 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_top

    r3855 r4064  
    99!!              8 - tracer output diagonstics             (namtrc_dia) 
    1010!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    11 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    12 &namtrc     !   tracers definition 
    13 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     11!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     12!----------------------------------------------------------------------- 
     13&namtrc_run     !   run information 
     14!----------------------------------------------------------------------- 
    1415   nn_dttrc      =  1        !  time step frequency for passive sn_tracers       
    15    nn_writetrc   =  5475      !  time step frequency for sn_tracer outputs 
     16   nn_writetrc   =  5475     !  time step frequency for sn_tracer outputs 
    1617   ln_top_euler  = .false.   !  use Euler time-stepping for TOP 
    1718   ln_rsttr      = .false.   !  start from a restart file (T) or not (F) 
    … …  
    2122   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    2223   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     24/ 
     25!----------------------------------------------------------------------- 
     26&namtrc     !   tracers definition 
     27!----------------------------------------------------------------------- 
    2328   ln_trcdta     =  .false. !  Initialisation from data input file (T) or not (F) 
    2429   ln_trcdmp     =  .false.  !  add a damping termn (T) or not (F) 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml

    r3905 r4064  
    2020============================================================================================================ 
    2121    --> 
    22      
    23     <file_definition type="multiple_file" sync_freq="1d" min_digits="4"> 
    24      
     22  
     23     
     24    <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
     25     
     26      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
    2527      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
    2628      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
    … …  
    3133      <file_group id="1d" output_freq="1d"  output_level="10" enabled=".TRUE."> <!-- 1d files --> 
    3234 
    33    <file id="1d_grid_T" name="auto" description="ocean T grid variables" > 
    34      <field field_ref="sst"          name="sosstsst"  /> 
    35      <field field_ref="sss"          name="sosaline"  /> 
    36      <field field_ref="ssh"          name="sossheig"  /> 
    37    </file> 
    38  
    39    <file id="1d_grid_U" name="auto" description="ocean U grid variables" > 
    40      <field field_ref="suoce"         name="vozocrtx"  /> 
    41    </file> 
    42     
    43    <file id="1d_grid_V" name="auto" description="ocean V grid variables" > 
    44      <field field_ref="svoce"         name="vomecrty"  /> 
    45    </file> 
    46     
    47       </file_group> 
     35   <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 
     36     <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
     37     <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          /> 
     38     <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                /> 
     39   </file> 
     40 
     41   <file id="file2" name_suffix="_grid_U" description="ocean U grid variables" > 
     42     <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    /> 
     43   </file> 
     44    
     45   <file id="file3" name_suffix="_grid_V" description="ocean V grid variables" > 
     46     <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    /> 
     47   </file> 
     48    
     49      </file_group> 
     50 
    4851      <file_group id="3d" output_freq="3d"  output_level="10" enabled=".TRUE."/> <!-- 3d files -->     
     52 
    4953      <file_group id="5d" output_freq="5d"  output_level="10" enabled=".TRUE.">  <!-- 5d files -->    
    5054 
    51    <file id="5d_grid_T" name="auto" description="ocean T grid variables" > 
    52      <field field_ref="toce"         name="votemper"  /> 
    53      <field field_ref="soce"         name="vosaline"  /> 
    54      <field field_ref="sst"          name="sosstsst"  /> 
    55      <field field_ref="sss"          name="sosaline"  /> 
    56      <field field_ref="ssh"          name="sossheig"  /> 
    57      <field field_ref="empmr"        name="sowaflup"  /> 
    58      <field field_ref="qsr"          name="soshfldo"  /> 
    59           <field field_ref="saltflx"      name="sosfldow"  /> 
    60           <field field_ref="fmmflx"       name="sofmflup"  /> 
    61      <field field_ref="qt"           name="sohefldo"  /> 
    62      <field field_ref="mldr10_1"     name="somxl010"  /> 
    63      <field field_ref="mldkz5"       name="somixhgt"  /> 
    64      <field field_ref="ice_cover"    name="soicecov"  /> 
    65      <field field_ref="wspd"         name="sowindsp"  /> 
    66      <field field_ref="erp"          name="sowafldp"  /> 
    67      <field field_ref="ist_ipa"      name="soicetem"  /> 
    68      <field field_ref="icealb_cea"   name="soicealb"  />    
    69    </file> 
    70     
    71    <file id="5d_grid_U" name="auto" description="ocean U grid variables" > 
    72      <field field_ref="uoce"         name="vozocrtx"  /> 
    73      <field field_ref="uoce_eiv"     name="vozoeivu"  /> 
    74      <field field_ref="utau"         name="sozotaux"  /> 
    75    </file> 
    76     
    77    <file id="5d_grid_V" name="auto" description="ocean V grid variables" > 
    78      <field field_ref="voce"         name="vomecrty"  /> 
    79      <field field_ref="voce_eiv"     name="vomeeivv"  /> 
    80      <field field_ref="vtau"         name="sometauy"  /> 
    81    </file> 
    82     
    83    <file id="5d_grid_W" name="auto" description="ocean W grid variables" > 
    84      <field field_ref="woce"         name="vovecrtz" /> 
    85      <field field_ref="avt"          name="votkeavt" /> 
    86      <field field_ref="avs"          name="voddmavs" /> 
    87      <field field_ref="aht2d_eiv"    name="soleaeiw" /> 
    88    </file> 
    89     
    90    <file id="5d_icemod" name="auto" description="ice variables" > 
     55   <file id="file4" name_suffix="_grid_T" description="ocean T grid variables" > 
     56     <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"               /> 
     57     <field field_ref="soce"         name="so"       long_name="sea_water_salinity"                            /> 
     58     <field field_ref="sst"          name="tos"      long_name="sea_surface_temperature"                       /> 
     59     <field field_ref="sst2"         name="tossq"    long_name="square_of_sea_surface_temperature"             /> 
     60     <field field_ref="sss"          name="sos"      long_name="sea_surface_salinity"                          /> 
     61     <field field_ref="ssh"          name="zos"      long_name="sea_surface_height_above_geoid"                /> 
     62     <field field_ref="ssh2"         name="zossq"    long_name="square_of_sea_surface_height_above_geoid"      /> 
     63     <field field_ref="empmr"        name="wfo"      long_name="water_flux_into_sea_water"                     /> 
     64     <field field_ref="qsr"          name="rsntds"   long_name="surface_net_downward_shortwave_flux"           /> 
     65     <field field_ref="qt"           name="tohfls"   long_name="surface_net_downward_total_heat_flux"          /> 
     66     <field field_ref="taum"         /> 
     67     <field field_ref="mldkz5"       /> 
     68     <field field_ref="mldr10_1"     /> 
     69   </file> 
     70    
     71   <file id="file5" name_suffix="_grid_U" description="ocean U grid variables" > 
     72     <field field_ref="uoce"         name="uo"      long_name="sea_water_x_velocity"      /> 
     73     <field field_ref="suoce"        name="uos"     long_name="sea_surface_x_velocity"    /> 
     74     <field field_ref="utau"         name="tauuo"   long_name="surface_downward_x_stress" /> 
     75   </file> 
     76    
     77   <file id="file6" name_suffix="_grid_V" description="ocean V grid variables" > 
     78     <field field_ref="voce"         name="vo"      long_name="sea_water_y_velocity"      /> 
     79     <field field_ref="svoce"        name="vos"     long_name="sea_surface_y_velocity"    /> 
     80     <field field_ref="vtau"         name="tauvo"   long_name="surface_downward_y_stress" /> 
     81   </file> 
     82    
     83   <file id="file7" name_suffix="_grid_W" description="ocean W grid variables" > 
     84     <field field_ref="woce"         name="wo"      long_name="ocean vertical velocity"         /> 
     85     <field field_ref="avt"          name="difvho"  long_name="ocean_vertical_heat_diffusivity" /> 
     86   </file> 
     87    
     88   <file id="file8" name_suffix="_icemod" description="ice variables" > 
    9189     <field field_ref="ice_pres"                     /> 
    92      <field field_ref="snowthic_cea" name="isnowthi" /> 
    93      <field field_ref="icethic_cea"  name="iicethic" /> 
    94      <field field_ref="iceprod_cea"  name="iiceprod" /> 
    95      <field field_ref="ist_ipa"      name="iicetemp" /> 
    96      <field field_ref="ioceflxb"     name="ioceflxb" /> 
    97      <field field_ref="uice_ipa"     name="iicevelu" /> 
    98      <field field_ref="vice_ipa"     name="iicevelv" /> 
    99      <field field_ref="utau_ice"     name="iicestru" /> 
    100      <field field_ref="vtau_ice"     name="iicestrv" /> 
    101      <field field_ref="qsr_io_cea"   name="iicesflx" /> 
    102      <field field_ref="qns_io_cea"   name="iicenflx" /> 
    103      <field field_ref="snowpre"      name="isnowpre" /> 
     90     <field field_ref="snowthic_cea" name="snd"     long_name="surface_snow_thickness"  /> 
     91     <field field_ref="icethic_cea"  name="sit"     long_name="sea_ice_thickness"        /> 
     92     <field field_ref="iceprod_cea"  name="sip"     long_name="sea_ice_thickness"        /> 
     93     <field field_ref="ist_ipa"      /> 
     94     <field field_ref="ioceflxb"     /> 
     95     <field field_ref="uice_ipa"     /> 
     96     <field field_ref="vice_ipa"     /> 
     97     <field field_ref="utau_ice"     /> 
     98     <field field_ref="vtau_ice"     /> 
     99     <field field_ref="qsr_io_cea"   /> 
     100     <field field_ref="qns_io_cea"   /> 
     101     <field field_ref="snowpre"      /> 
    104102   </file> 
    105103    
    … …  
    108106      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files --> 
    109107 
    110    <file id="1m_ptrc_T" name="auto" description="pisces sms variables" > 
     108   <file id="file9" name_suffix="_ptrc_T" description="pisces sms variables" > 
    111109          <field field_ref="DIC"      /> 
    112110          <field field_ref="Alkalini" /> 
    … …  
    120118   </file> 
    121119    
    122    <file id="1m_diad_T" name="auto" description="additional pisces diagnostics" > 
     120   <file id="file10" name_suffix="_diad_T" description="additional pisces diagnostics" > 
    123121          <field field_ref="Cflx"     /> 
    124122          <field field_ref="Dpco2"    /> 
    … …  
    126124 
    127125      </file_group> 
     126 
    128127      <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 
    129128      <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 
    … …  
    133132      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files --> 
    134133 
    135    <file id="1y_ptrc_T" name="auto" description="pisces sms variables" > 
     134   <file id="file11" name_suffix="_ptrc_T" description="pisces sms variables" > 
    136135          <field field_ref="DIC"      /> 
    137136          <field field_ref="Alkalini" /> 
    … …  
    160159   </file> 
    161160 
    162    <file id="1y_diad_T" name="auto" description="additional pisces diagnostics" > 
     161   <file id="file12" name_suffix="_diad_T" description="additional pisces diagnostics" > 
    163162          <field field_ref="PH"       /> 
    164163          <field field_ref="CO3"      /> 
    … …  
    212211 
    213212      </file_group> 
     213 
    214214      <file_group id="2y"  output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files --> 
    215215      <file_group id="5y"  output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files --> 
    … …  
    217217 
    218218   </file_definition> 
    219      
     219 
    220220    <!--  
    221221============================================================================================================ 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces

    r4029 r4064  
    201201   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2) 
    202202   concfediaz  =  1.e-10   ! Diazotrophs half-saturation Cste for Iron 
    203    hratio      =  9.e+5    ! Fe to 3He ratio assumed for vent iron supply  
     203   hratio      =  1.e+7    ! Fe to 3He ratio assumed for vent iron supply  
    204204/ 
    205205!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top

    r3855 r4064  
    99!!              8 - tracer output diagonstics             (namtrc_dia) 
    1010!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    11 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    12 &namtrc     !   tracers definition 
    13 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     11!----------------------------------------------------------------------- 
     12&namtrc_run     !   run information 
     13!----------------------------------------------------------------------- 
    1414   nn_dttrc      =  1        !  time step frequency for passive sn_tracers       
    1515   nn_writetrc   =  5475     !  time step frequency for sn_tracer outputs 
    … …  
    1717   ln_rsttr      = .false.   !  start from a restart file (T) or not (F) 
    1818   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value 
    19                              !                  = 1 do not use the value in the restart file 
    20                              !                  = 2 calendar parameters read in the restart file 
     19                           !                  = 1 do not use the value in the restart file 
     20                           !                  = 2 calendar parameters read in the restart file 
    2121   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    2222   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     23/ 
     24!----------------------------------------------------------------------- 
     25&namtrc     !   tracers definition 
     26!----------------------------------------------------------------------- 
    2327   ln_trcdta     =   .true.  !  Initialisation from data input file (T) or not (F) 
    2428   ln_trcdmp     =  .false.  !  add a damping termn (T) or not (F) 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml

    r3771 r4064  
    2020============================================================================================================ 
    2121    --> 
     22 
     23   <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 
    2224     
    23     <file_definition type="multiple_file" sync_freq="1d" min_digits="4"> 
    24      
     25      <file_group id="1ts" output_freq="1ts"  output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 
    2526      <file_group id="1h" output_freq="1h"  output_level="10" enabled=".TRUE."/> <!-- 1h files --> 
    2627      <file_group id="2h" output_freq="2h"  output_level="10" enabled=".TRUE."/> <!-- 2h files --> 
    … …  
    3536      <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."> <!-- real monthly files --> 
    3637 
    37    <file id="1m_ptrc_T" name="auto" description="pisces sms variables" > 
     38   <file id="file1" name_suffix="_ptrc_T" description="pisces sms variables" > 
    3839          <field field_ref="DIC"      /> 
    3940          <field field_ref="Alkalini" /> 
    … …  
    4748   </file> 
    4849    
    49    <file id="1m_diad_T" name="auto" description="additional pisces diagnostics" > 
     50   <file id="file2" name_suffix="_diad_T" description="additional pisces diagnostics" > 
    5051          <field field_ref="Cflx"     /> 
    5152          <field field_ref="Dpco2"    /> 
    … …  
    6061      <file_group id="1y"  output_freq="1y" output_level="10" enabled=".TRUE."> <!-- real yearly files --> 
    6162 
    62    <file id="1y_ptrc_T" name="auto" description="pisces sms variables" > 
     63   <file id="file3" name_suffix="_ptrc_T" description="pisces sms variables" > 
    6364          <field field_ref="DIC"      /> 
    6465          <field field_ref="Alkalini" /> 
    … …  
    8788   </file> 
    8889 
    89    <file id="1y_diad_T" name="auto" description="additional pisces diagnostics" > 
     90   <file id="file4" name_suffix="_ptrc_T" description="additional pisces diagnostics" > 
    9091          <field field_ref="PH"       /> 
    9192          <field field_ref="CO3"      /> 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces

    r4029 r4064  
    201201   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2) 
    202202   concfediaz  =  1.e-10   ! Diazotrophs half-saturation Cste for Iron 
    203    hratio      =  9.e+5    ! Fe to 3He ratio assumed for vent iron supply  
     203   hratio      =  1.e+7    ! Fe to 3He ratio assumed for vent iron supply  
    204204/ 
    205205!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top

    r3855 r4064  
    99!!              8 - tracer output diagonstics             (namtrc_dia) 
    1010!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    11 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    12 &namtrc     !   tracers definition 
    13 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 
     11!----------------------------------------------------------------------- 
     12&namtrc_run     !   run information 
     13!----------------------------------------------------------------------- 
    1414   nn_dttrc      =  1        !  time step frequency for passive sn_tracers       
    1515   nn_writetrc   =  1460     !  time step frequency for sn_tracer outputs 
    … …  
    2121   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input) 
    2222   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output) 
     23/ 
     24!----------------------------------------------------------------------- 
     25&namtrc     !   tracers definition 
     26!----------------------------------------------------------------------- 
    2327   ln_trcdta     =   .true. !  Initialisation from data input file (T) or not (F) 
    2428   ln_trcdmp     =  .false.  !  add a damping termn (T) or not (F) 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/CONFIG/SHARED/field_def.xml

    r3905 r4064  
    2929         <field id="mldr10_1"     long_name="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        /> 
    3030         <field id="rhop"         long_name="potential density (sigma0)"                unit="kg/m3" grid_ref="grid_T_3D"/> 
     31    <field id="eken"         long_name="kinetic energy"                            unit="m2/s2" grid_ref="grid_T_3D"/> 
     32    <field id="hdiv"         long_name="horizontal divergence"                     unit="s-1"   grid_ref="grid_T_3D"/> 
    3133         <!-- next variables available with key_diahth --> 
    3234         <field id="mlddzt"       long_name="Thermocline Depth (max dT/dz)"             unit="m"                        /> 
    … …  
    140142         <field id="uoce"         long_name="ocean current along i-axis"                  unit="m/s"  grid_ref="grid_U_3D" /> 
    141143         <field id="uocetr_eff"   long_name="Effective ocean transport along i-axis"      unit="m3/s" grid_ref="grid_U_3D" /> 
     144         <field id="uocet"        long_name="ocean transport along i-axis times temperature" unit="degC.m/s" grid_ref="grid_U_3D" /> 
     145         <field id="uoces"        long_name="ocean transport along i-axis times salinity"    unit="psu.m/s"  grid_ref="grid_U_3D" /> 
    142146         <!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv --> 
    143147         <field id="uoce_eiv"     long_name="EIV ocean current along i-axis"              unit="m/s"  grid_ref="grid_U_3D" /> 
    … …  
    159163         <field id="voce"         long_name="ocean current along j-axis"                  unit="m/s"  grid_ref="grid_V_3D" /> 
    160164         <field id="vocetr_eff"   long_name="Effective ocean transport along j-axis"      unit="m3/s" grid_ref="grid_V_3D" /> 
     165         <field id="vocet"        long_name="ocean transport along j-axis times temperature" unit="degC.m/s" grid_ref="grid_V_3D" /> 
     166         <field id="voces"        long_name="ocean transport along j-axis times salinity"    unit="psu.m/s"  grid_ref="grid_V_3D" /> 
    161167         <!-- voce_eiv: available with key_traldf_eiv and key_diaeiv --> 
    162168         <field id="voce_eiv"     long_name="EIV ocean current along j-axis"              unit="m/s"  grid_ref="grid_V_3D" /> 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90

    r4015 r4064  
    1717    
    1818   PUBLIC crs_dom_alloc  ! Called from crsini.F90 
     19   PUBLIC crs_dom_alloc2  ! Called from crsini.F90 
    1920   PUBLIC dom_grid_glo    
    2021   PUBLIC dom_grid_crs  
    … …  
    4344      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid 
    4445      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid 
     46 
    4547      INTEGER  ::  narea_full, narea_crs        !: node 
    4648      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition 
    … …  
    7476      INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset 
    7577      INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs 
     78      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs 
    7679      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box 
    7780      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain 
    … …  
    97100      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F 
    98101      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs 
    99       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3w_max_crs 
    100       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_crs, fse3u_crs, fse3v_crs, fse3f_crs, fse3w_crs 
    101       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_n_crs, fse3t_b_crs, fse3t_a_crs 
     102      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3f_max_crs, e3w_max_crs 
    102103       
    103104      ! Surface 
    … …  
    139140      REAL(wp)     ::  rfactxy  
    140141 
    141       !! Horizontal grid parameters for domhgr 
    142       !! ===================================== 
    143       INTEGER  ::   nphgr_msh_crs = 0   !: type of horizontal mesh 
    144       !                                 !  = 0 curvilinear coordinate on the sphere read in coordinate.nc 
    145       !                                 !  = 1 geographical mesh on the sphere with regular grid-spacing 
    146       !                                 !  = 2 f-plane with regular grid-spacing 
    147       !                                 !  = 3 beta-plane with regular grid-spacing 
    148       !                                 !  = 4 Mercator grid with T/U point at the equator 
    149        
    150142      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields 
    151143      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs 
    … …  
    153145      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs     
    154146      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs     
    155  
    156147      !  
    157148      ! Surface fluxes to pass to TOP 
    158       REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, emp_b_crs, fr_i_crs, wndm_crs, emp_crs 
     149      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, fr_i_crs, wndm_crs 
     150      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: emp_crs, emp_b_crs, sfx_crs 
    159151      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs 
    160152      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs 
    … …  
    185177 
    186178      ! Set up bins for coarse grid, horizontal only. 
    187       ALLOCATE( mis2_crs(jpiglo_crs) , mie2_crs(jpiglo_crs) , mjs2_crs(jpjglo_crs) , mje2_crs(jpjglo_crs),& 
    188       & mig_crs(jpi_crs), mjg_crs(jpj_crs),  STAT=ierr(1) ) 
     179     ALLOCATE( mis2_crs(jpiglo_crs), mie2_crs(jpiglo_crs),  & 
     180       &       mjs2_crs(jpjglo_crs), mje2_crs(jpjglo_crs),  & 
     181       &       mi0_crs (jpiglo_crs), mi1_crs (jpiglo_crs),  & 
     182       &       mj0_crs (jpjglo_crs), mj1_crs (jpjglo_crs),  & 
     183       &       mig_crs (jpi_crs)   , mjg_crs (jpj_crs)   ,  STAT=ierr(1) )  
     184 
    189185 
    190186      ! Set up Mask and Mesh 
    191  
    192187      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  & 
    193188         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2)) 
    194189 
    195       ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs), rnfmsk_crs(jpi_crs,jpj_crs), & 
    196       &     tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) ) 
     190      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs)   , rnfmsk_crs(jpi_crs,jpj_crs), & 
     191      &         tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) ) 
    197192 
    198193      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , &  
    … …  
    208203         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5)) 
    209204 
    210       ALLOCATE( fse3t_crs(jpi_crs,jpj_crs,jpk)  , fse3w_crs(jpi_crs,jpj_crs,jpk) , &  
    211          &      fse3u_crs(jpi_crs,jpj_crs,jpk)  , fse3v_crs(jpi_crs,jpj_crs,jpk) , &  
    212          &      e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)   , &  
    213          &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)   , & 
    214          &      e3f_crs(jpi_crs,jpj_crs,jpk)    , fse3f_crs(jpi_crs,jpj_crs,jpk) , &  
    215          &      e3t_max_crs(jpi_crs,jpj_crs,jpk), e3w_max_crs(jpi_crs,jpj_crs,jpk), &  
    216          &      e3u_max_crs(jpi_crs,jpj_crs,jpk), e3v_max_crs(jpi_crs,jpj_crs,jpk)   , & 
    217          &      fse3t_b_crs(jpi_crs,jpj_crs,jpk), fse3t_n_crs(jpi_crs,jpj_crs,jpk),& 
    218          &      fse3t_a_crs(jpi_crs,jpj_crs,jpk), e1e2w_msk(jpi_crs,jpj_crs,jpk) , & 
    219          &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk) , & 
    220          &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk) , & 
    221          &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , STAT=ierr(6)) 
    222  
    223  
    224       ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk) , facsurfu(jpi_crs,jpj_crs,jpk) , &  
    225          &      facvol_t(jpi_crs,jpj_crs,jpk) , facvol_w(jpi_crs,jpj_crs,jpk) , & 
    226          &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), & 
    227          &      bt_crs(jpi_crs,jpj_crs,jpk)   , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7)) 
    228  
    229  
    230       ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk) , crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , &  
    231          &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk) , crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8)) 
    232  
    233  
    234       ALLOCATE( mbathy_crs(jpi_crs,jpj_crs) , mbkt_crs(jpi_crs,jpj_crs) , & 
    235          &      mbku_crs(jpi_crs,jpj_crs)   , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9)) 
    236  
    237       ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk) , gdepu_crs(jpi_crs,jpj_crs,jpk) , & 
    238          &      gdepv_crs(jpi_crs,jpj_crs,jpk) , gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) ) 
     205      ALLOCATE( e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)    , &  
     206         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)    , & 
     207         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , e1e2w_msk(jpi_crs,jpj_crs,jpk)  , &  
     208         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk)  , & 
     209         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk)  , & 
     210         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , e3t_max_crs(jpi_crs,jpj_crs,jpk), & 
     211         &      e3w_max_crs(jpi_crs,jpj_crs,jpk), e3u_max_crs(jpi_crs,jpj_crs,jpk), & 
     212         &      e3v_max_crs(jpi_crs,jpj_crs,jpk), STAT=ierr(6)) 
     213 
     214 
     215      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk), facsurfu(jpi_crs,jpj_crs,jpk) , &  
     216         &      facvol_t(jpi_crs,jpj_crs,jpk), facvol_w(jpi_crs,jpj_crs,jpk) , & 
     217         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk), ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), & 
     218         &      bt_crs(jpi_crs,jpj_crs,jpk)  , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7)) 
     219 
     220 
     221      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk), crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , &  
     222         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk), crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8)) 
     223 
     224 
     225      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs), mbkt_crs(jpi_crs,jpj_crs) , & 
     226         &      mbku_crs(jpi_crs,jpj_crs)  , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9)) 
     227 
     228      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk), gdepu_crs(jpi_crs,jpj_crs,jpk) , & 
     229         &      gdepv_crs(jpi_crs,jpj_crs,jpk), gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) ) 
    239230 
    240231 
    … …  
    243234         &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11)) 
    244235 
    245      ALLOCATE( sshn_crs(jpi_crs,jpj_crs),  emp_crs(jpi_crs,jpj_crs) , emp_b_crs(jpi_crs,jpj_crs), & 
    246          &      qsr_crs(jpi_crs,jpj_crs) , wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
    247          &      vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs, jpj_crs) , & 
    248          &      fr_i_crs(jpi_crs, jpj_crs),   STAT=ierr(12)  ) 
     236     ALLOCATE( sshn_crs(jpi_crs,jpj_crs), emp_crs (jpi_crs,jpj_crs), emp_b_crs(jpi_crs,jpj_crs), & 
     237         &     qsr_crs(jpi_crs ,jpj_crs), wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , & 
     238         &     vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs ,jpj_crs), & 
     239         &     fr_i_crs(jpi_crs,jpj_crs), sfx_crs(jpi_crs ,jpj_crs),  STAT=ierr(12)  ) 
    249240 
    250241     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    & 
    … …  
    327318      !!--------------------------------------------------------------------- 
    328319 
    329   
    330320      ! 
    331321      !                        Switch to coarse grid domain 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r4015 r4064  
    5151   END INTERFACE 
    5252 
     53   REAL(wp) :: r_inf = 1e+36 
     54 
    5355   !! Substitutions 
    5456#  include "domzgr_substitute.h90" 
    … …  
    6062       
    6163      INTEGER  ::  ji, jj, jk                   ! dummy loop indices 
    62       INTEGER  ::  ijie,ijis,ijje,ijjs 
     64      INTEGER  ::  ijie,ijis,ijje,ijjs,ij,je_2 
    6365      REAL(wp) ::  zmask 
    6466       
    … …  
    6971      umask_crs(:,:,:) = 0.0 
    7072      fmask_crs(:,:,:) = 0.0 
    71        
     73   
     74             
     75      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     76         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     77            je_2 = mje_crs(2)   ;  ij = je_2 
     78         ENDIF 
     79      ELSE 
     80         je_2 = mje_crs(2)      ;  ij = mjs_crs(2)  
     81      ENDIF 
    7282      DO jk = 1, jpkm1 
    7383         DO ji = 2, nlei_crs   
    74             ijie = mie_crs(ji) 
    75             ijis = mis_crs(ji) 
    76             DO jj = nldj_crs, nlej_crs  
    77                ijje = mje_crs(jj)  
    78                ijjs = mjs_crs(jj)  
    79                                   
     84            ijis = mis_crs(ji)  ;  ijie = mie_crs(ji)     
     85            !           
     86            zmask = 0.0 
     87            zmask = SUM( tmask(ijis:ijie,ij:je_2,jk) )  
     88            IF ( zmask > 0.0 ) tmask_crs(ji,2,jk) = 1.0 
     89                
     90            zmask = 0.0 
     91            zmask = SUM( vmask(ijis:ijie,je_2     ,jk) )   
     92            IF ( zmask > 0.0 ) vmask_crs(ji,2,jk) = 1.0 
     93                
     94            zmask = 0.0 
     95            zmask = SUM(umask(ijie,ij:je_2,jk))    
     96            IF ( zmask > 0.0 ) umask_crs(ji,2,jk) = 1.0 
     97                
     98            fmask_crs(ji,je_2,jk) = fmask(ijie,2,jk) 
     99         ENDDO 
     100      ENDDO 
     101      ! 
     102      DO jk = 1, jpkm1 
     103         DO ji = 2, nlei_crs   
     104            ijis = mis_crs(ji)     ;   ijie = mie_crs(ji)        
     105            DO jj = 3, nlej_crs 
     106               ijjs = mjs_crs(jj)  ;   ijje = mje_crs(jj) 
     107                           
    80108               zmask = 0.0 
    81109               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) )  
    … …  
    91119                
    92120               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)   
    93  
    94121            ENDDO 
    95122         ENDDO 
    96123      ENDDO 
     124 
    97125      ! 
    98126      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 ) 
    … …  
    195223            ENDDO 
    196224      END SELECT 
    197  
    198       !                                             ! Fill i=1, i=jpi at j=1 
    199       p_gphi_crs(1      ,1) = p_gphi(jpi_crsm1,1) 
    200       p_glam_crs(1      ,1) = p_glam(jpi_crsm1,1) 
    201       !                                             ! Fill upper-right corner i=1, j=jpj_crs 
    202       p_gphi_crs(jpi_crs,1) = p_gphi(2        ,1) 
    203       p_glam_crs(jpi_crs,1) = p_glam(2        ,1) 
    204       !                                             
     225      ! 
    205226   END SUBROUTINE crs_dom_coordinates 
    206227 
    … …  
    233254      !! Local variables 
    234255      INTEGER :: ji, jj, jk     ! dummy loop indices 
    235       INTEGER :: ijie,ijis,ijje,ijjs,ijrs 
     256      INTEGER :: ijie,ijje,ijrs 
    236257   
    237258      !!----------------------------------------------------------------   
    … …  
    241262         DO ji = 2, nlei_crs 
    242263            ijie = mie_crs(ji) 
    243             ijis = mis_crs(ji) 
    244264            DO jj = nldj_crs, nlej_crs 
    245                ijje = mje_crs(jj)  
    246                ijjs = mjs_crs(jj)                    
    247                ijrs =  mje_crs(jj) - mjs_crs(jj) 
     265               ijje = mje_crs(jj)   ;   ijrs =  mje_crs(jj) - mjs_crs(jj) 
    248266               ! Only for a factro 3 coarsening 
    249267               SELECT CASE ( cd_type ) 
    … …  
    335353      !! Local variables 
    336354      REAL(wp)                                :: zdAm 
    337       INTEGER                                 :: ji, jj, jk       ! dummy loop indices 
    338       INTEGER                                 :: ii, ij, ijie,ijje 
    339  
    340       REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol       
     355      INTEGER                                 :: ji, jj, jk , ii, ij, je_2 
     356 
     357      REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol, zmask       
    341358      !!----------------------------------------------------------------   
    342359    
    343       CALL wrk_alloc( jpi, jpj, jpk, zvol ) 
     360      CALL wrk_alloc( jpi, jpj, jpk, zvol, zmask ) 
     361 
     362      p_fld1_crs(:,:,:) = 0.0 
     363      p_fld2_crs(:,:,:) = 0.0 
    344364 
    345365      DO jk = 1, jpk 
    … …  
    347367      ENDDO 
    348368 
     369      zmask(:,:,:) = 0.0 
     370      IF( cd_type == 'W' ) THEN 
     371         zmask(:,:,1) = p_mask(:,:,1)  
     372         DO jk = 2, jpk 
     373            zmask(:,:,jk) = p_mask(:,:,jk-1)  
     374         ENDDO 
     375      ELSE 
     376         DO jk = 1, jpk 
     377             zmask(:,:,jk) = p_mask(:,:,jk)  
     378         ENDDO 
     379      ENDIF 
     380 
     381      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     382         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     383            je_2 = mje_crs(2) 
     384            DO jk = 1, jpk            
     385               DO ji = nistr, niend, nn_factx 
     386                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     387                  p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  & 
     388                     &                 + zvol(ji,je_2-1,jk) + zvol(ji+1,je_2-1,jk) + zvol(ji+2,je_2-1,jk)  
     389                  ! 
     390                  zdAm =  zvol(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)  & 
     391                    &   + zvol(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)  & 
     392                    &   + zvol(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  
     393                  !  
     394                  p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)  
     395               ENDDO 
     396            ENDDO 
     397         ENDIF 
     398      ELSE 
     399         je_2 = mjs_crs(2) 
     400         DO jk = 1, jpk            
     401            DO ji = nistr, niend, nn_factx 
     402               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     403               p_fld1_crs(ii,2,jk) =  zvol(ji,je_2  ,jk) + zvol(ji+1,je_2  ,jk) + zvol(ji+2,je_2  ,jk)  & 
     404                   &                + zvol(ji,je_2+1,jk) + zvol(ji+1,je_2+1,jk) + zvol(ji+2,je_2+1,jk)  & 
     405                   &                + zvol(ji,je_2+2,jk) + zvol(ji+1,je_2+2,jk) + zvol(ji+2,je_2+2,jk)   
     406              ! 
     407               zdAm = zvol(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)  & 
     408                 &  + zvol(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)  & 
     409                 &  + zvol(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)  & 
     410                 &  + zvol(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)  & 
     411                 &  + zvol(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)  & 
     412                 &  + zvol(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)  & 
     413                 &  + zvol(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)  & 
     414                 &  + zvol(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)  & 
     415                 &  + zvol(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) 
     416                 !  
     417                 p_fld2_crs(ii,2,jk) = zdAm / p_fld1_crs(ii,2,jk)  
     418            ENDDO 
     419         ENDDO 
     420      ENDIF 
     421 
    349422      DO jk = 1, jpk            
    350          DO ji = nistr, niend, nn_factx 
    351             DO jj   = njstr, njend, nn_facty 
    352                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    353                ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    354                ijje = mje_crs(ij) 
    355                ijie = mie_crs(ii) 
     423         DO jj  = njstr, njend, nn_facty 
     424            DO ji = nistr, niend, nn_factx 
     425               ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     426               ij  = ( jj - njstr ) * rfacty_r + 3 
    356427               ! 
    357428               p_fld1_crs(ii,ij,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  & 
    358429                   &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  & 
    359                    &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk)   
     430                   &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk)  
     431               ! 
     432               zdAm =  zvol(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)  & 
     433                 &   + zvol(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)  & 
     434                 &   + zvol(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)  & 
     435                 &   + zvol(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)  & 
     436                 &   + zvol(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)  & 
     437                 &   + zvol(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)  & 
     438                 &   + zvol(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)  & 
     439                 &   + zvol(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)  & 
     440                 &   + zvol(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 
     441                 !  
     442                p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk)  
    360443            ENDDO 
    361444         ENDDO 
    362445      ENDDO 
    363  
    364       IF( cd_type == 'T' ) THEN 
    365          DO jk = 1, jpk            
    366             DO ji = nistr, niend, nn_factx 
    367                DO jj   = njstr, njend, nn_facty 
    368                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    369                   ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    370                   ijje = mje_crs(ij) 
    371                   ijie = mie_crs(ii) 
    372                   ! 
    373                   zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk)  & 
    374                     &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk)  & 
    375                     &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)  & 
    376                     &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk)  & 
    377                     &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk)  & 
    378                     &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk)  & 
    379                     &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk)  & 
    380                     &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk)  & 
    381                     &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
    382                     !  
    383                    IF( p_fld1_crs(ii,ij,jk) /= 0._wp ) p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk)  
    384                    !  
    385                ENDDO 
    386             ENDDO 
    387          ENDDO 
    388       ENDIF 
    389       ! 
    390       IF( cd_type == 'W' ) THEN 
    391          DO jk = 2, jpk            
    392             DO ji = nistr, niend, nn_factx 
    393                DO jj   = njstr, njend, nn_facty 
    394                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    395                   ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    396                   ijje = mje_crs(ij) 
    397                   ijie = mie_crs(ii) 
    398                   ! 
    399                   zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1)  & 
    400                     &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1)  & 
    401                     &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)  & 
    402                     &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1)  & 
    403                     &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1)  & 
    404                     &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1)  & 
    405                     &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1)  & 
    406                     &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1)  & 
    407                     &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
    408                   ! 
    409                   IF( p_fld1_crs(ii,ij,jk) /= 0._wp ) p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk)  
    410                   ! 
    411                ENDDO 
    412             ENDDO 
    413          ENDDO 
    414          DO ji = nistr, niend, nn_factx 
    415             DO jj   = njstr, njend, nn_facty 
    416                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    417                ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    418                ijje = mje_crs(ij) 
    419                ijie = mie_crs(ii) 
    420                ! 
    421                zdAm =  zvol(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1)  & 
    422                  &   + zvol(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1)  & 
    423                  &   + zvol(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)  & 
    424                  &   + zvol(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1)  & 
    425                  &   + zvol(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1)  & 
    426                  &   + zvol(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1)  & 
    427                  &   + zvol(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1)  & 
    428                  &   + zvol(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1)  & 
    429                  &   + zvol(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
    430                !  
    431                IF( p_fld1_crs(ii,ij,1) /= 0._wp ) p_fld2_crs(ii,ij,1) = zdAm / p_fld2_crs(ii,ij,1)  
    432                !  
    433             ENDDO 
    434          ENDDO 
    435       ENDIF 
    436        
    437446      !                                             !  Retroactively add back the boundary halo cells. 
    438447      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 )  
    439448      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 )  
    440449      ! 
    441       CALL wrk_dealloc( jpi, jpj, jpk, zvol ) 
     450      CALL wrk_dealloc( jpi, jpj, jpk, zvol, zmask ) 
    442451      ! 
    443452   END SUBROUTINE crs_dom_facvol 
    444453 
    445454 
    446    SUBROUTINE crs_dom_ope_3d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs ) 
     455   SUBROUTINE crs_dom_ope_3d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs, psgn ) 
    447456      !!---------------------------------------------------------------- 
    448457      !!               *** SUBROUTINE crsfun_UV *** 
    … …  
    476485      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v) 
    477486      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    478       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask 
     487      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V maska 
     488      REAL(wp),                                 INTENT(in)           :: psgn    ! sign  
     489 
    479490 
    480491      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    481492 
    482493      !! Local variables 
    483       INTEGER  :: ji, jj, jk                 ! dummy loop indices 
    484       INTEGER  :: ijie, ijje, ii, ij 
     494      INTEGER  :: ji, jj, jk  
     495      INTEGER  :: ii, ij, ijie, ijje, je_2 
    485496      REAL(wp) :: zflcrs, zsfcrs    
    486       REAL(wp) :: zeps = 1.e20     
    487       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf    
    488  
     497      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk, zmask   
    489498      !!----------------------------------------------------------------   
    490499    
     500      p_fld_crs(:,:,:) = 0.0 
    491501 
    492502      SELECT CASE ( cd_op ) 
    … …  
    494504         CASE ( 'VOL' ) 
    495505       
    496             CALL wrk_alloc( jpi, jpj, jpk, zsurf ) 
    497             DO jk = 1, jpk 
    498               zsurf(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) 
    499             ENDDO 
     506            CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    500507          
    501508            SELECT CASE ( cd_type ) 
    502509             
    503                CASE( 'T' ) 
     510               CASE( 'T', 'W' ) 
     511                  IF( cd_type == 'T' ) THEN 
     512                     DO jk = 1, jpk 
     513                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) *  p_mask(:,:,jk)  
     514                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk)  
     515                    ENDDO 
     516                  ELSE 
     517                     zsurf   (:,:,1) =  p_e12(:,:) * p_e3(:,:,1) 
     518                     zsurfmsk(:,:,1) =  zsurf(:,:,1) *  p_mask(:,:,1)  
     519                     DO jk = 2, jpk 
     520                        zsurf   (:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) 
     521                        zsurfmsk(:,:,jk) =  zsurf(:,:,jk) * p_mask(:,:,jk-1)  
     522                     ENDDO 
     523                  ENDIF 
    504524          
    505                   DO jk = 1, jpk 
    506                      
    507                      DO ji = nistr, niend, nn_factx 
    508                         DO jj = njstr, njend, nn_facty 
    509                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    510                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    511                            ijje = mje_crs(ij) 
    512                            ijie = mie_crs(ii)                   
     525                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     526                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     527                        je_2 = mje_crs(2) 
     528                        DO jk = 1, jpk            
     529                           DO ji = nistr, niend, nn_factx 
     530                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
     531                              zflcrs =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk)   & 
     532                                &     + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk)   & 
     533                                &     + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk)  
    513534  
    514                            zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) & 
    515                              &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) & 
    516                              &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) & 
    517                              &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) & 
    518                              &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) & 
    519                              &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) & 
    520                              &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) & 
    521                              &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) & 
    522                              &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)  
    523   
    524                            zsfcrs =  zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) & 
    525                              &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) & 
    526                              &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) & 
    527                              &     + zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) & 
    528                              &     + zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) & 
    529                              &     + zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) & 
    530                              &     + zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) & 
    531                              &     + zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) & 
    532                              &     + zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)  
    533                            ! 
     535                              zsfcrs =  zsurf(ji,je_2,jk) + zsurf(ji+1,je_2,jk) + zsurf(ji+2,je_2,jk)  
     536                              ! 
     537                              p_fld_crs(ii,2,jk) = zflcrs 
     538                              IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     539                           ENDDO 
     540                        ENDDO 
     541                     ENDIF 
     542                  ELSE 
     543                     je_2 = mjs_crs(2) 
     544                     DO jk = 1, jpk            
     545                        DO ji = nistr, niend, nn_factx 
     546                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     547                           zflcrs =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk) & 
     548                             &     + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk) & 
     549                             &     + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk) & 
     550                             &     + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk) & 
     551                             &     + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk) & 
     552                             &     + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk) & 
     553                             &     + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk) & 
     554                             &     + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk) & 
     555                             &     + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)  
     556 
     557                           zsfcrs =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) & 
     558                             &     + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk) & 
     559                             &     + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)  
     560                            ! 
     561                            p_fld_crs(ii,2,jk) = zflcrs 
     562                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2,jk) = zflcrs / zsfcrs 
     563                        ENDDO 
     564                     ENDDO 
     565                  ENDIF 
     566                  ! 
     567                  DO jk = 1, jpk            
     568                     DO jj  = njstr, njend, nn_facty 
     569                        DO ji = nistr, niend, nn_factx 
     570                           ii = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     571                           ij = ( jj - njstr ) * rfacty_r + 3 
     572                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk) & 
     573                             &     + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk) & 
     574                             &     + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk) & 
     575                             &     + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk) & 
     576                             &     + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk) & 
     577                             &     + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk) & 
     578                             &     + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk) & 
     579                             &     + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk) & 
     580                             &     + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)  
     581 
     582                           zsfcrs =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk) & 
     583                             &     + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk) & 
     584                             &     + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)  
     585                            ! 
    534586                           p_fld_crs(ii,ij,jk) = zflcrs 
    535587                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
    536  
     588                        ENDDO       
     589                     ENDDO 
     590                  ENDDO   
     591               CASE DEFAULT 
     592                    STOP 
     593               END SELECT 
     594 
     595              CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
     596 
     597         CASE ( 'SUM' ) 
     598          
     599            CALL wrk_alloc( jpi, jpj, jpk, zsurfmsk ) 
     600 
     601            SELECT CASE ( cd_type ) 
     602              CASE( 'W' ) 
     603                  IF( PRESENT( p_e3 ) ) THEN 
     604                    zsurfmsk(:,:,1) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)  
     605                    DO jk = 2, jpk 
     606                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk-1)  
     607                    ENDDO 
     608                 ELSE 
     609                    zsurfmsk(:,:,1) =  p_e12(:,:) * p_mask(:,:,1)  
     610                    DO jk = 2, jpk 
     611                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk-1)  
     612                    ENDDO 
     613                 ENDIF 
     614              CASE DEFAULT 
     615                 IF( PRESENT( p_e3 ) ) THEN 
     616                    DO jk = 1, jpk 
     617                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) * p_mask(:,:,jk)  
     618                    ENDDO 
     619                 ELSE 
     620                    DO jk = 1, jpk 
     621                      zsurfmsk(:,:,jk) =  p_e12(:,:) * p_mask(:,:,jk)  
     622                    ENDDO 
     623                 ENDIF 
     624              END SELECT 
     625 
     626            SELECT CASE ( cd_type ) 
     627             
     628               CASE( 'T', 'W' ) 
     629          
     630                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     631                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     632                        je_2 = mje_crs(2) 
     633                        DO jk = 1, jpk            
     634                           DO ji = nistr, niend, nn_factx 
     635                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2           
     636                              zflcrs  =  p_fld(ji  ,je_2,jk) * zsurfmsk(ji  ,je_2,jk) & 
     637                                &      + p_fld(ji+1,je_2,jk) * zsurfmsk(ji+1,je_2,jk) & 
     638                                &      + p_fld(ji+2,je_2,jk) * zsurfmsk(ji+2,je_2,jk)  
     639                               ! 
     640                              p_fld_crs(ii,2,jk) = zflcrs 
     641                           ENDDO 
     642                        ENDDO 
     643                      ENDIF 
     644                  ELSE 
     645                     je_2 = mjs_crs(2) 
     646                     DO jk = 1, jpk            
     647                        DO ji = nistr, niend, nn_factx 
     648                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     649                           zflcrs  =  p_fld(ji  ,je_2  ,jk) * zsurfmsk(ji  ,je_2  ,jk)  & 
     650                             &      + p_fld(ji+1,je_2  ,jk) * zsurfmsk(ji+1,je_2  ,jk)  & 
     651                             &      + p_fld(ji+2,je_2  ,jk) * zsurfmsk(ji+2,je_2  ,jk)  & 
     652                             &      + p_fld(ji  ,je_2+1,jk) * zsurfmsk(ji  ,je_2+1,jk)  & 
     653                             &      + p_fld(ji+1,je_2+1,jk) * zsurfmsk(ji+1,je_2+1,jk)  & 
     654                             &      + p_fld(ji+2,je_2+1,jk) * zsurfmsk(ji+2,je_2+1,jk)  & 
     655                             &      + p_fld(ji  ,je_2+2,jk) * zsurfmsk(ji  ,je_2+2,jk)  & 
     656                             &      + p_fld(ji+1,je_2+2,jk) * zsurfmsk(ji+1,je_2+2,jk)  & 
     657                             &      + p_fld(ji+2,je_2+2,jk) * zsurfmsk(ji+2,je_2+2,jk)   
     658                            ! 
     659                            p_fld_crs(ii,2,jk) = zflcrs 
     660                        ENDDO 
     661                     ENDDO 
     662                  ENDIF 
     663                  ! 
     664                  DO jk = 1, jpk            
     665                     DO jj  = njstr, njend, nn_facty 
     666                        DO ji = nistr, niend, nn_factx 
     667                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     668                           ij  = ( jj - njstr ) * rfacty_r + 3 
     669                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurfmsk(ji  ,jj  ,jk)  & 
     670                             &      + p_fld(ji+1,jj  ,jk) * zsurfmsk(ji+1,jj  ,jk)  & 
     671                             &      + p_fld(ji+2,jj  ,jk) * zsurfmsk(ji+2,jj  ,jk)  & 
     672                             &      + p_fld(ji  ,jj+1,jk) * zsurfmsk(ji  ,jj+1,jk)  & 
     673                             &      + p_fld(ji+1,jj+1,jk) * zsurfmsk(ji+1,jj+1,jk)  & 
     674                             &      + p_fld(ji+2,jj+1,jk) * zsurfmsk(ji+2,jj+1,jk)  & 
     675                             &      + p_fld(ji  ,jj+2,jk) * zsurfmsk(ji  ,jj+2,jk)  & 
     676                             &      + p_fld(ji+1,jj+2,jk) * zsurfmsk(ji+1,jj+2,jk)  & 
     677                             &      + p_fld(ji+2,jj+2,jk) * zsurfmsk(ji+2,jj+2,jk)   
     678                            ! 
     679                            p_fld_crs(ii,ij,jk) = zflcrs 
     680                            !  
    537681                        ENDDO       
    538682                     ENDDO 
    539683                  ENDDO    
    540684             
    541                CASE( 'W' ) 
    542           
    543                   DO jk = 2, jpk 
    544                      
     685               CASE( 'V' ) 
     686 
     687                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     688                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     689                        ijje = mje_crs(2) 
     690                     ENDIF 
     691                  ELSE 
     692                     ijje = mjs_crs(2) 
     693                  ENDIF 
     694                  ! 
     695                  DO jk = 1, jpk            
    545696                     DO ji = nistr, niend, nn_factx 
    546                         DO jj = njstr, njend, nn_facty 
    547                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    548                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
     697                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     698                        zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
     699                          &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
     700                          &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)  
     701                          ! 
     702                        p_fld_crs(ii,2,jk) = zflcrs 
     703                     ENDDO 
     704                  ENDDO 
     705                  ! 
     706                  DO jk = 1, jpk            
     707                     DO jj  = njstr, njend, nn_facty 
     708                        DO ji = nistr, niend, nn_factx 
     709                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     710                           ij   = ( jj - njstr ) * rfacty_r + 3 
    549711                           ijje = mje_crs(ij) 
    550                            ijie = mie_crs(ii)                   
    551   
    552                            zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) & 
    553                              &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) & 
    554                              &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) & 
    555                              &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) & 
    556                              &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) & 
    557                              &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) & 
    558                              &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) & 
    559                              &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) & 
    560                              &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1)  
    561   
    562                            zsfcrs =  zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) & 
    563                              &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) & 
    564                              &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) & 
    565                              &     + zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) & 
    566                              &     + zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) & 
    567                              &     + zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) & 
    568                              &     + zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) & 
    569                              &     + zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) & 
    570                              &     + zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1)  
    571                            ! 
     712                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurfmsk(ji  ,ijje,jk) & 
     713                             &      + p_fld(ji+1,ijje,jk) * zsurfmsk(ji+1,ijje,jk) & 
     714                             &      + p_fld(ji+2,ijje,jk) * zsurfmsk(ji+2,ijje,jk)  
     715                             ! 
    572716                           p_fld_crs(ii,ij,jk) = zflcrs 
    573                            IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs 
    574  
     717                           !  
    575718                        ENDDO       
    576719                     ENDDO 
    577720                  ENDDO    
    578  
    579                   DO ji = nistr, niend, nn_factx 
    580                      DO jj = njstr, njend, nn_facty 
    581                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    582                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    583                         ijje = mje_crs(ij) 
    584                         ijie = mie_crs(ii)                   
    585  
    586                           zflcrs =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) & 
    587                              &     + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) & 
    588                              &     + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) & 
    589                              &     + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) & 
    590                              &     + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) & 
    591                              &     + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) & 
    592                              &     + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) & 
    593                              &     + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) & 
    594                              &     + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  
    595   
    596                            zsfcrs =  zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) & 
    597                              &     + zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) & 
    598                              &     + zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) & 
    599                              &     + zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) & 
    600                              &     + zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) & 
    601                              &     + zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) & 
    602                              &     + zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) & 
    603                              &     + zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) & 
    604                              &     + zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  
    605                           
    606                         p_fld_crs(ii,ij,1) = zflcrs 
    607                         IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,1) = zflcrs / zsfcrs 
    608  
    609                      ENDDO       
     721             
     722               CASE( 'U' ) 
     723 
     724                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     725                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     726                        je_2 = mje_crs(2) 
     727                        DO jk = 1, jpk            
     728                           DO ji = nistr, niend, nn_factx 
     729                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
     730                              ijie = mie_crs(ii) 
     731                              zflcrs  =  p_fld(ijie,je_2,jk) * zsurfmsk(ijie,je_2,jk)   
     732                              p_fld_crs(ii,2,jk) = zflcrs 
     733                           ENDDO 
     734                        ENDDO 
     735                      ENDIF 
     736                  ELSE 
     737                     je_2 = mjs_crs(2) 
     738                     DO jk = 1, jpk            
     739                        DO ji = nistr, niend, nn_factx 
     740                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     741                           ijie = mie_crs(ii) 
     742                           zflcrs =  p_fld(ijie,je_2  ,jk) * zsurfmsk(ijie,je_2  ,jk)  & 
     743                             &     + p_fld(ijie,je_2+1,jk) * zsurfmsk(ijie,je_2+1,jk)  & 
     744                             &     + p_fld(ijie,je_2+2,jk) * zsurfmsk(ijie,je_2+2,jk)  
     745 
     746                           p_fld_crs(ii,2,jk) = zflcrs 
     747                        ENDDO 
     748                     ENDDO 
     749                  ENDIF 
     750                  ! 
     751                  DO jk = 1, jpk            
     752                     DO jj  = njstr, njend, nn_facty 
     753                        DO ji = nistr, niend, nn_factx 
     754                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     755                           ij   = ( jj - njstr ) * rfacty_r + 3 
     756                           ijie = mie_crs(ii) 
     757                           zflcrs =  p_fld(ijie,jj  ,jk) * zsurfmsk(ijie,jj  ,jk)  & 
     758                              &    + p_fld(ijie,jj+1,jk) * zsurfmsk(ijie,jj+1,jk)  & 
     759                              &    + p_fld(ijie,jj+2,jk) * zsurfmsk(ijie,jj+2,jk)  
     760                             ! 
     761                           p_fld_crs(ii,ij,jk) = zflcrs 
     762                           !  
     763                        ENDDO       
     764                     ENDDO 
     765                  ENDDO    
     766 
     767              END SELECT 
     768 
     769              IF( PRESENT( p_surf_crs ) ) THEN 
     770                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:,:) = p_fld_crs(:,:,:) / p_surf_crs(:,:,:) 
     771              ENDIF 
     772 
     773              CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk ) 
     774 
     775         CASE ( 'MAX' )    !  search the max of unmasked grid cells 
     776 
     777            CALL wrk_alloc( jpi, jpj, jpk, zmask ) 
     778 
     779            SELECT CASE ( cd_type ) 
     780              CASE( 'W' ) 
     781                  zmask(:,:,1) = p_mask(:,:,1)  
     782                  DO jk = 2, jpk 
     783                     zmask(:,:,jk) = p_mask(:,:,jk-1)  
    610784                  ENDDO 
    611  
    612               END SELECT 
    613  
    614               CALL wrk_dealloc( jpi, jpj, jpk, zsurf ) 
    615  
    616          CASE ( 'SUM' ) 
    617           
    618             CALL wrk_alloc( jpi, jpj, jpk, zsurf ) 
    619  
    620             IF( PRESENT( p_e3 ) ) THEN 
    621                DO jk = 1, jpk 
    622                  zsurf(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk) 
    623                ENDDO 
    624             ELSE 
    625                DO jk = 1, jpk 
    626                  zsurf(:,:,jk) =  p_e12(:,:)  
    627                ENDDO 
    628             ENDIF 
     785              CASE ( 'T' ) 
     786                  DO jk = 1, jpk 
     787                     zmask(:,:,jk) = p_mask(:,:,jk)  
     788                  ENDDO 
     789            END SELECT 
    629790 
    630791            SELECT CASE ( cd_type ) 
    631792             
    632                CASE( 'T' ) 
     793               CASE( 'T', 'W' ) 
    633794          
    634                   DO jk = 1, jpk 
    635                      DO ji = nistr, niend, nn_factx 
    636                         DO jj = njstr, njend, nn_facty 
    637                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    638                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    639                            ijje = mje_crs(ij) 
    640                            ijie = mie_crs(ii)                   
    641   
    642                            zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) & 
    643                              &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) & 
    644                              &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) & 
    645                              &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) & 
    646                              &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) & 
    647                              &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) & 
    648                              &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) & 
    649                              &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) & 
    650                              &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)  
     795                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     796                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     797                        je_2 = mje_crs(2) 
     798                        DO jk = 1, jpk            
     799                           DO ji = nistr, niend, nn_factx 
     800                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2         
     801                              zflcrs =  & 
     802                                & MAX( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) - ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  & 
     803                                &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) - ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  & 
     804                                &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) - ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  ) 
     805                              ! 
     806                              p_fld_crs(ii,2,jk) = zflcrs 
     807                           ENDDO 
     808                        ENDDO 
     809                      ENDIF 
     810                  ELSE 
     811                     je_2 = mjs_crs(2) 
     812                     DO jk = 1, jpk            
     813                        DO ji = nistr, niend, nn_factx 
     814                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     815                           zflcrs =  & 
     816                             & MAX( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) - ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  & 
     817                             &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) - ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  & 
     818                             &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) - ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  & 
     819                             &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) - ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  & 
     820                             &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) - ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  & 
     821                             &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) - ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  & 
     822                             &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) - ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  & 
     823                             &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) - ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  & 
     824                             &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) - ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   ) 
     825                           ! 
     826                           p_fld_crs(ii,2,jk) = zflcrs 
     827                        ENDDO 
     828                     ENDDO 
     829                  ENDIF 
     830                  ! 
     831                  DO jk = 1, jpk            
     832                     DO jj  = njstr, njend, nn_facty 
     833                        DO ji = nistr, niend, nn_factx 
     834                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     835                           ij  = ( jj - njstr ) * rfacty_r + 3 
     836                           zflcrs =  & 
     837                             & MAX( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) - ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  & 
     838                             &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) - ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  & 
     839                             &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) - ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  & 
     840                             &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) - ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  & 
     841                             &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) - ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  & 
     842                             &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) - ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  & 
     843                             &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) - ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  & 
     844                             &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) - ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  & 
     845                             &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) - ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   ) 
    651846                           ! 
    652847                           p_fld_crs(ii,ij,jk) = zflcrs 
    … …  
    656851                  ENDDO    
    657852             
    658                CASE( 'W' ) 
    659           
    660                   DO jk = 2, jpk 
     853               CASE( 'V' ) 
     854 
     855                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     856                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     857                        ijje = mje_crs(2) 
     858                      ENDIF 
     859                  ELSE 
     860                     ijje = mjs_crs(2) 
     861                  ENDIF 
     862 
     863                  DO jk = 1, jpk 
    661864                     DO ji = nistr, niend, nn_factx 
    662                         DO jj = njstr, njend, nn_facty 
    663                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    664                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
     865                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     866                        zflcrs = & 
     867                          & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     868                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     869                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
     870                          ! 
     871                        p_fld_crs(ii,2,jk) = zflcrs 
     872                     ENDDO 
     873                  ENDDO 
     874                  ! 
     875                  DO jk = 1, jpk            
     876                     DO jj  = njstr, njend, nn_facty 
     877                        DO ji = nistr, niend, nn_factx 
     878                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     879                           ij  = ( jj - njstr ) * rfacty_r + 3 
    665880                           ijje = mje_crs(ij) 
    666                            ijie = mie_crs(ii) 
    667881                           !                   
    668                            zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) & 
    669                              &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) & 
    670                              &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) & 
    671                              &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) & 
    672                              &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) & 
    673                              &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) & 
    674                              &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) & 
    675                              &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) & 
    676                              &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1)  
     882                           zflcrs = & 
     883                             & MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     884                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     885                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) - ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    677886                           ! 
    678887                           p_fld_crs(ii,ij,jk) = zflcrs 
    … …  
    682891                  ENDDO    
    683892 
    684                   DO ji = nistr, niend, nn_factx 
    685                      DO jj = njstr, njend, nn_facty 
    686                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    687                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    688                         ijje = mje_crs(ij) 
    689                         ijie = mie_crs(ii)                   
    690                         ! 
    691                         zflcrs  =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) & 
    692                            &      + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) & 
    693                            &      + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) & 
    694                            &      + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) & 
    695                            &      + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) & 
    696                            &      + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) & 
    697                            &      + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) & 
    698                            &      + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) & 
    699                            &      + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  
    700                         ! 
    701                         p_fld_crs(ii,ij,1) = zflcrs 
    702                         ! 
    703                      ENDDO       
    704                   ENDDO 
    705             
    706                CASE( 'V' ) 
    707           
    708                   DO jk = 1, jpk 
    709                      DO ji = nistr, niend, nn_factx 
    710                         DO jj = njstr, njend, nn_facty 
    711                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    712                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    713                            ijje = mje_crs(ij) 
    714                            ijie = mie_crs(ii) 
    715                            !                   
    716                            zflcrs  =  p_fld(ji  ,ijje,jk) * zsurf(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) & 
    717                              &      + p_fld(ji+1,ijje,jk) * zsurf(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) & 
    718                              &      + p_fld(ji+2,ijje,jk) * zsurf(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk)  
    719                            ! 
    720                            p_fld_crs(ii,ij,jk) = zflcrs 
    721                            ! 
    722                          ENDDO       
    723                      ENDDO 
    724                   ENDDO    
    725  
    726893             
    727894               CASE( 'U' ) 
    728           
    729                   DO jk = 1, jpk 
    730                      DO ji = nistr, niend, nn_factx 
    731                         DO jj = njstr, njend, nn_facty 
     895 
     896                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     897                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     898                        je_2 = mje_crs(2) 
     899                        DO jk = 1, jpk            
     900                           DO ji = nistr, niend, nn_factx 
     901                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
     902                              ijie = mie_crs(ii) 
     903                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
     904                              ! 
     905                              p_fld_crs(ii,2,jk) = zflcrs 
     906                            ENDDO 
     907                        ENDDO 
     908                      ENDIF 
     909                  ELSE 
     910                     je_2 = mjs_crs(2) 
     911                     DO jk = 1, jpk            
     912                        DO ji = nistr, niend, nn_factx 
     913                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     914                           ijie = mie_crs(ii) 
     915                           zflcrs = & 
     916                             & MAX( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     917                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     918                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) - ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
     919                            ! 
     920                           p_fld_crs(ii,2,jk) = zflcrs 
     921                        ENDDO 
     922                     ENDDO 
     923                  ENDIF 
     924                  ! 
     925                  DO jk = 1, jpk            
     926                     DO jj  = njstr, njend, nn_facty 
     927                        DO ji = nistr, niend, nn_factx 
    732928                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    733                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    734                            ijje = mje_crs(ij) 
     929                           ij   = ( jj - njstr ) * rfacty_r + 3 
    735930                           ijie = mie_crs(ii) 
    736                            !                   
    737                            zflcrs =  p_fld(ijie,jj  ,jk) * zsurf(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) & 
    738                              &     + p_fld(ijie,jj+1,jk) * zsurf(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) & 
    739                              &     + p_fld(ijie,jj+2,jk) * zsurf(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) 
    740                            ! 
     931                           zflcrs =  & 
     932                             & MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 
     933                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf , & 
     934                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) - ( 1.- p_mask(ijie,jj,jk) ) * r_inf  ) 
     935                           !  
    741936                           p_fld_crs(ii,ij,jk) = zflcrs 
    742                            ! 
     937                           !  
    743938                        ENDDO       
    744939                     ENDDO 
    … …  
    747942              END SELECT 
    748943 
    749               IF( PRESENT( p_surf_crs ) ) THEN 
    750                  WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:,:) = p_fld_crs(:,:,:) / p_surf_crs(:,:,:) 
    751               ENDIF 
    752  
    753               CALL wrk_dealloc( jpi, jpj, jpk, zsurf ) 
    754  
    755          CASE ( 'MAX' ) 
     944              CALL wrk_dealloc( jpi, jpj, jpk, zmask ) 
     945 
     946         CASE ( 'MIN' )      !   Search the min of unmasked grid cells 
     947 
     948            CALL wrk_alloc( jpi, jpj, jpk, zmask ) 
     949 
     950            SELECT CASE ( cd_type ) 
     951              CASE( 'W' ) 
     952                  zmask(:,:,1) = p_mask(:,:,1)  
     953                  DO jk = 2, jpk 
     954                     zmask(:,:,jk) = p_mask(:,:,jk-1)  
     955                  ENDDO 
     956              CASE ( 'T' ) 
     957                  DO jk = 1, jpk 
     958                     zmask(:,:,jk) = p_mask(:,:,jk)  
     959                  ENDDO 
     960            END SELECT 
     961 
     962            SELECT CASE ( cd_type ) 
     963 
     964               CASE( 'T', 'W' ) 
    756965          
    757             SELECT CASE ( cd_type ) 
    758              
    759                CASE( 'T' ) 
    760           
    761                   DO jk = 1, jpk 
    762                      DO ji = nistr, niend, nn_factx 
    763                         DO jj = njstr, njend, nn_facty 
    764                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    765                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    766                            ijje = mje_crs(ij) 
    767                            ijie = mie_crs(ii)                   
    768   
    769                            zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
    770                              &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
    771                              &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
    772                              &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  & 
    773                              &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  & 
    774                              &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
    775                              &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
    776                              &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
    777                              &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)   ) 
     966                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     967                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     968                        je_2 = mje_crs(2) 
     969                        DO jk = 1, jpk            
     970                           DO ji = nistr, niend, nn_factx 
     971                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2         
     972                              zflcrs =  & 
     973                                & MIN( p_fld(ji  ,je_2,jk) * zmask(ji  ,je_2,jk) + ( 1.- zmask(ji  ,je_2,jk) ) * r_inf ,  & 
     974                                &      p_fld(ji+1,je_2,jk) * zmask(ji+1,je_2,jk) + ( 1.- zmask(ji+1,je_2,jk) ) * r_inf ,  & 
     975                                &      p_fld(ji+2,je_2,jk) * zmask(ji+2,je_2,jk) + ( 1.- zmask(ji+2,je_2,jk) ) * r_inf  ) 
     976                              ! 
     977                              p_fld_crs(ii,2,jk) = zflcrs 
     978                           ENDDO 
     979                        ENDDO 
     980                      ENDIF 
     981                  ELSE 
     982                     je_2 = mjs_crs(2) 
     983                     DO jk = 1, jpk            
     984                        DO ji = nistr, niend, nn_factx 
     985                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     986                           zflcrs =  & 
     987                             & MIN( p_fld(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk) + ( 1.- zmask(ji  ,je_2  ,jk) ) * r_inf ,  & 
     988                             &      p_fld(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk) + ( 1.- zmask(ji+1,je_2  ,jk) ) * r_inf ,  & 
     989                             &      p_fld(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk) + ( 1.- zmask(ji+2,je_2  ,jk) ) * r_inf ,  & 
     990                             &      p_fld(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk) + ( 1.- zmask(ji  ,je_2+1,jk) ) * r_inf ,  & 
     991                             &      p_fld(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk) + ( 1.- zmask(ji+1,je_2+1,jk) ) * r_inf ,  & 
     992                             &      p_fld(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk) + ( 1.- zmask(ji+2,je_2+1,jk) ) * r_inf ,  & 
     993                             &      p_fld(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk) + ( 1.- zmask(ji  ,je_2+2,jk) ) * r_inf ,  & 
     994                             &      p_fld(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk) + ( 1.- zmask(ji+1,je_2+2,jk) ) * r_inf ,  & 
     995                             &      p_fld(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) + ( 1.- zmask(ji+2,je_2+2,jk) ) * r_inf   ) 
     996                           ! 
     997                           p_fld_crs(ii,2,jk) = zflcrs 
     998                        ENDDO 
     999                     ENDDO 
     1000                  ENDIF 
     1001                  ! 
     1002                  DO jk = 1, jpk            
     1003                     DO jj  = njstr, njend, nn_facty 
     1004                        DO ji = nistr, niend, nn_factx 
     1005                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1006                           ij  = ( jj - njstr ) * rfacty_r + 3 
     1007                           zflcrs =  & 
     1008                             & MIN( p_fld(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk) + ( 1.- zmask(ji  ,jj  ,jk) ) * r_inf ,  & 
     1009                             &      p_fld(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk) + ( 1.- zmask(ji+1,jj  ,jk) ) * r_inf ,  & 
     1010                             &      p_fld(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk) + ( 1.- zmask(ji+2,jj  ,jk) ) * r_inf ,  & 
     1011                             &      p_fld(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk) + ( 1.- zmask(ji  ,jj+1,jk) ) * r_inf ,  & 
     1012                             &      p_fld(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk) + ( 1.- zmask(ji+1,jj+1,jk) ) * r_inf ,  & 
     1013                             &      p_fld(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk) + ( 1.- zmask(ji+2,jj+1,jk) ) * r_inf ,  & 
     1014                             &      p_fld(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk) + ( 1.- zmask(ji  ,jj+2,jk) ) * r_inf ,  & 
     1015                             &      p_fld(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk) + ( 1.- zmask(ji+1,jj+2,jk) ) * r_inf ,  & 
     1016                             &      p_fld(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) + ( 1.- zmask(ji+2,jj+2,jk) ) * r_inf   ) 
    7781017                           ! 
    7791018                           p_fld_crs(ii,ij,jk) = zflcrs 
    … …  
    7831022                  ENDDO    
    7841023             
    785                CASE( 'W' ) 
    786           
    787                   DO jk = 2, jpk 
     1024               CASE( 'V' ) 
     1025 
     1026                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1027                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1028                        ijje = mje_crs(2) 
     1029                      ENDIF 
     1030                  ELSE 
     1031                     ijje = mjs_crs(2) 
     1032                  ENDIF 
     1033 
     1034                  DO jk = 1, jpk 
    7881035                     DO ji = nistr, niend, nn_factx 
    789                         DO jj = njstr, njend, nn_facty 
    790                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    791                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
     1036                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1037                        zflcrs = & 
     1038                          & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1039                          &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1040                          &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
     1041                          ! 
     1042                        p_fld_crs(ii,2,jk) = zflcrs 
     1043                     ENDDO 
     1044                  ENDDO 
     1045                  ! 
     1046                  DO jk = 1, jpk            
     1047                     DO jj  = njstr, njend, nn_facty 
     1048                        DO ji = nistr, niend, nn_factx 
     1049                           ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1050                           ij  = ( jj - njstr ) * rfacty_r + 3 
    7921051                           ijje = mje_crs(ij) 
    793                            ijie = mie_crs(ii) 
    794                            !                   
    795                            zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
    796                              &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
    797                              &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  & 
    798                              &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  & 
    799                              &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  & 
    800                              &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  & 
    801                              &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  & 
    802                              &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  & 
    803                              &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 
     1052                           zflcrs = & 
     1053                             & MIN( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1054                             &      p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ,  & 
     1055                             &      p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) + ( 1.- p_mask(ji,ijje,jk) ) * r_inf ) 
    8041056                           ! 
    8051057                           p_fld_crs(ii,ij,jk) = zflcrs 
    … …  
    8091061                  ENDDO    
    8101062 
    811                   DO ji = nistr, niend, nn_factx 
    812                      DO jj = njstr, njend, nn_facty 
    813                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    814                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    815                         ijje = mje_crs(ij) 
    816                         ijie = mie_crs(ii)                   
    817                         ! 
    818                         zflcrs = MAX( p_fld(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
    819                            &          p_fld(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
    820                            &          p_fld(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  & 
    821                            &          p_fld(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  & 
    822                            &          p_fld(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  & 
    823                            &          p_fld(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  & 
    824                            &          p_fld(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  & 
    825                            &          p_fld(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  & 
    826                            &          p_fld(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  )  
    827                          ! 
    828                          p_fld_crs(ii,ij,1) = zflcrs 
    829                          ! 
    830                      ENDDO       
    831                   ENDDO 
    832             
    833                CASE( 'V' ) 
    834           
    835                   DO jk = 1, jpk 
    836                      DO ji = nistr, niend, nn_factx 
    837                         DO jj = njstr, njend, nn_facty 
     1063             
     1064               CASE( 'U' ) 
     1065 
     1066                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1067                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1068                        je_2 = mje_crs(2) 
     1069                        DO jk = 1, jpk            
     1070                           DO ji = nistr, niend, nn_factx 
     1071                              ii   = ( ji - mis_crs(2) ) * rfactx_r + 2   
     1072                              ijie = mie_crs(ii) 
     1073                              zflcrs = p_fld(ijie,je_2,jk) * p_mask(ijie,je_2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  
     1074                              ! 
     1075                              p_fld_crs(ii,2,jk) = zflcrs 
     1076                            ENDDO 
     1077                        ENDDO 
     1078                      ENDIF 
     1079                  ELSE 
     1080                     je_2 = mjs_crs(2) 
     1081                     DO jk = 1, jpk            
     1082                        DO ji = nistr, niend, nn_factx 
     1083                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     1084                           ijie = mie_crs(ii) 
     1085                           zflcrs = & 
     1086                             & MIN( p_fld(ijie,je_2  ,jk) * p_mask(ijie,je_2  ,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     1087                             &      p_fld(ijie,je_2+1,jk) * p_mask(ijie,je_2+1,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf ,  & 
     1088                             &      p_fld(ijie,je_2+2,jk) * p_mask(ijie,je_2+2,jk) + ( 1.- p_mask(ijie,je_2,jk) ) * r_inf  ) 
     1089                            ! 
     1090                           p_fld_crs(ii,2,jk) = zflcrs 
     1091                        ENDDO 
     1092                     ENDDO 
     1093                  ENDIF 
     1094                  ! 
     1095                  DO jk = 1, jpk            
     1096                     DO jj  = njstr, njend, nn_facty 
     1097                        DO ji = nistr, niend, nn_factx 
    8381098                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    839                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    840                            ijje = mje_crs(ij) 
     1099                           ij   = ( jj - njstr ) * rfacty_r + 3 
    8411100                           ijie = mie_crs(ii) 
    842                            !                   
    843                            zflcrs = MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk),  & 
    844                              &           p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk),  & 
    845                              &           p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) ) 
    846                            ! 
     1101                           zflcrs = & 
     1102                             & MIN( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
     1103                             &      p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ,  & 
     1104                             &      p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) + ( 1.- p_mask(ijie,jj,jk) ) * r_inf ) 
     1105                           !  
    8471106                           p_fld_crs(ii,ij,jk) = zflcrs 
    848                            ! 
     1107                           !  
    8491108                        ENDDO       
    8501109                     ENDDO 
    8511110                  ENDDO    
    852  
    853              
    854                CASE( 'U' ) 
    855           
    856                   DO jk = 1, jpk 
    857                      DO ji = nistr, niend, nn_factx 
    858                         DO jj = njstr, njend, nn_facty 
    859                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    860                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    861                            ijje = mje_crs(ij) 
    862                            ijie = mie_crs(ii) 
    863                            !                   
    864                            Zflcrs = MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk),  & 
    865                              &           p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk),  & 
    866                              &           p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) ) 
    867                            ! 
    868                            p_fld_crs(ii,ij,jk) = zflcrs 
    869                            ! 
    870                         ENDDO       
    871                      ENDDO 
    872                   ENDDO    
    873  
    874               END SELECT 
    875  
    876          CASE ( 'MIN' ) 
    877             !   Search the min of masked grid cells 
    878             SELECT CASE ( cd_type ) 
    879              
    880                CASE( 'T' ) 
    881           
    882                   DO jk = 1, jpk 
    883                      DO ji = nistr, niend, nn_factx 
    884                         DO jj = njstr, njend, nn_facty 
    885                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    886                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    887                            ijje = mje_crs(ij) 
    888                            ijie = mie_crs(ii)                   
    889                             
    890                            zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  & 
    891                              &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk) ) * zeps ),  & 
    892                              &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk) ) * zeps ),  & 
    893                              &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  & 
    894                              &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  & 
    895                              &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps ),  & 
    896                              &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  & 
    897                              &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  & 
    898                              &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps )   ) 
    899                            ! 
    900                            p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk) 
    901                            ! 
    902                         ENDDO       
    903                      ENDDO 
    904                   ENDDO    
    905             
    906                CASE( 'W' ) 
    907           
    908                   DO jk = 2, jpk 
    909                      DO ji = nistr, niend, nn_factx 
    910                         DO jj = njstr, njend, nn_facty 
    911                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    912                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    913                            ijje = mje_crs(ij) 
    914                            ijie = mie_crs(ii)                   
    915                             
    916                            zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  & 
    917                              &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk-1) ) * zeps ),  & 
    918                              &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk-1) ) * zeps ),  & 
    919                              &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  & 
    920                              &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  & 
    921                              &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps ),  & 
    922                              &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  & 
    923                              &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  & 
    924                              &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps )   ) 
    925                            ! 
    926                            p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk) 
    927                            ! 
    928                         ENDDO       
    929                      ENDDO 
    930                   ENDDO   
    931   
    932                   DO ji = nistr, niend, nn_factx 
    933                      DO jj = njstr, njend, nn_facty 
    934                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    935                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    936                         ijje = mje_crs(ij) 
    937                         ijie = mie_crs(ii)                   
    938                          
    939                         zflcrs =  MIN( p_fld(ji  ,jj  ,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  & 
    940                           &            p_fld(ji+1,jj  ,1) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  & 
    941                           &            p_fld(ji+2,jj  ,1) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  & 
    942                           &            p_fld(ji  ,jj+1,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  & 
    943                           &            p_fld(ji+1,jj+1,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  & 
    944                           &            p_fld(ji+2,jj+1,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  & 
    945                           &            p_fld(ji  ,jj+2,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  & 
    946                           &            p_fld(ji+1,jj+2,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  & 
    947                           &            p_fld(ji+2,jj+2,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   ) 
    948                         ! 
    949                         p_fld_crs(ii,ij,1) = zflcrs * p_mask_crs(ii,ij,1) 
    950                         ! 
    951                      ENDDO       
    952                   ENDDO 
    953  
    954                CASE( 'V' ) 
    955           
    956                   DO jk = 1, jpk 
    957                      DO ji = nistr, niend, nn_factx 
    958                         DO jj = njstr, njend, nn_facty 
    959                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    960                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    961                            ijje = mje_crs(ij) 
    962                            ijie = mie_crs(ii)                   
    963                             
    964                            zflcrs =  MIN( p_fld(ji  ,ijje,jk) * ( 1. + ( 1. - p_mask(ji  ,ijje,jk) ) * zeps ),  & 
    965                              &            p_fld(ji+1,ijje,jk) * ( 1. + ( 1. - p_mask(ji+1,ijje,jk) ) * zeps ),  & 
    966                              &            p_fld(ji+2,ijje,jk) * ( 1. + ( 1. - p_mask(ji+2,ijje,jk) ) * zeps )   ) 
    967                            ! 
    968                            p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk) 
    969                            ! 
    970                         ENDDO       
    971                      ENDDO 
    972                   ENDDO   
    973  
    974  
    975                CASE( 'U' ) 
    976           
    977                   DO jk = 1, jpk 
    978                      DO ji = nistr, niend, nn_factx 
    979                         DO jj = njstr, njend, nn_facty 
    980                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    981                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    982                            ijje = mje_crs(ij) 
    983                            ijie = mie_crs(ii)                   
    984                             
    985                            zflcrs =  MIN( p_fld(ijie,jj  ,jk) * ( 1. + ( 1. - p_mask(ijie,jj  ,jk) ) * zeps ),  & 
    986                              &            p_fld(ijie,jj+1,jk) * ( 1. + ( 1. - p_mask(ijie,jj+1,jk) ) * zeps ),  & 
    987                              &            p_fld(ijie,jj+2,jk) * ( 1. + ( 1. - p_mask(ijie,jj+2,jk) ) * zeps )   ) 
    988                            ! 
    989                            p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk) 
    990                            ! 
    991                         ENDDO       
    992                      ENDDO 
    993                   ENDDO   
     1111           
    9941112            END SELECT 
     1113            ! 
     1114            CALL wrk_dealloc( jpi, jpj, jpk, zmask ) 
    9951115            ! 
    9961116         END SELECT 
    9971117         ! 
    998          CALL crs_lbc_lnk( p_fld_crs, cd_type, 1.0 ) 
     1118         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn ) 
    9991119         ! 
    10001120    END SUBROUTINE crs_dom_ope_3d 
    10011121 
    1002     SUBROUTINE crs_dom_ope_2d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs ) 
     1122    SUBROUTINE crs_dom_ope_2d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs, psgn ) 
    10031123      !!---------------------------------------------------------------- 
    10041124      !!               *** SUBROUTINE crsfun_UV *** 
    … …  
    10331153      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator     
    10341154      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask 
     1155      REAL(wp),                                 INTENT(in)           :: psgn    
    10351156 
    10361157      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity  
    … …  
    10381159      !! Local variables 
    10391160      INTEGER  :: ji, jj, jk                 ! dummy loop indices 
    1040       INTEGER  :: ijie, ijje, ii, ij 
     1161      INTEGER  :: ijie, ijje, ii, ij, je_2 
    10411162      REAL(wp) :: zflcrs, zsfcrs    
    1042       REAL(wp) :: zeps = 1.e20     
    1043       REAL(wp), DIMENSION(:,:), POINTER :: zsurf    
     1163      REAL(wp), DIMENSION(:,:), POINTER :: zsurfmsk    
    10441164 
    10451165      !!----------------------------------------------------------------   
    10461166    
     1167      p_fld_crs(:,:) = 0.0 
    10471168 
    10481169      SELECT CASE ( cd_op ) 
    10491170       
    1050          CASE ( 'VOL' ) 
     1171        CASE ( 'VOL' ) 
    10511172       
    1052            CALL wrk_alloc( jpi, jpj, zsurf ) 
    1053            zsurf(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
    1054                      
    1055            DO ji = nistr, niend, nn_factx 
    1056               DO jj = njstr, njend, nn_facty 
    1057                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1058                  ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1059                  ijje = mje_crs(ij) 
    1060                  ijie = mie_crs(ii)                   
    1061   
    1062                  zflcrs =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  & 
    1063                    &     + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  & 
    1064                    &     + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  & 
    1065                    &     + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  & 
    1066                    &     + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  & 
    1067                    &     + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  & 
    1068                    &     + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  & 
    1069                    &     + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  & 
    1070                    &     + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)   
    1071  
    1072                  zsfcrs =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  & 
    1073                    &     + zsurf(ji,jj+1) + zsurf(ji+1,jj+1) + zsurf(ji+2,jj+1)  & 
    1074                    &     + zsurf(ji,jj+2) + zsurf(ji+1,jj+2) + zsurf(ji+2,jj+2)   
    1075                  ! 
    1076                  p_fld_crs(ii,ij) = zflcrs 
    1077                  IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs 
    1078  
    1079               ENDDO       
    1080            ENDDO 
    1081              
    1082            CALL wrk_dealloc( jpi, jpj, zsurf ) 
     1173            CALL wrk_alloc( jpi, jpj, zsurfmsk ) 
     1174            zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
     1175 
     1176            IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1177               IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1178                  je_2 = mje_crs(2) 
     1179                  DO ji = nistr, niend, nn_factx 
     1180                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2        
     1181                     zflcrs =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2)   & 
     1182                       &     + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2)   & 
     1183                       &     + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2)  
     1184 
     1185                     zsfcrs =  zsurfmsk(ji,je_2) + zsurfmsk(ji+1,je_2) + zsurfmsk(ji+2,je_2)  
     1186                     ! 
     1187                     p_fld_crs(ii,2) = zflcrs 
     1188                     IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs 
     1189                  ENDDO 
     1190               ENDIF 
     1191            ELSE 
     1192               je_2 = mjs_crs(2) 
     1193               DO ji = nistr, niend, nn_factx 
     1194                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2    
     1195                  zflcrs =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  ) & 
     1196                    &     + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  ) & 
     1197                    &     + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  ) & 
     1198                    &     + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1) & 
     1199                    &     + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1) & 
     1200                    &     + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1) & 
     1201                    &     + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2) & 
     1202                    &     + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2) & 
     1203                    &     + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2)  
     1204 
     1205                   zsfcrs =  zsurfmsk(ji,je_2  ) + zsurfmsk(ji+1,je_2  ) + zsurfmsk(ji+2,je_2  ) & 
     1206                     &     + zsurfmsk(ji,je_2+1) + zsurfmsk(ji+1,je_2+1) + zsurfmsk(ji+2,je_2+1) & 
     1207                     &     + zsurfmsk(ji,je_2+2) + zsurfmsk(ji+1,je_2+2) + zsurfmsk(ji+2,je_2+2)  
     1208                    ! 
     1209                    p_fld_crs(ii,2) = zflcrs 
     1210                    IF( zsfcrs /= 0.0 )  p_fld_crs(ii,2) = zflcrs / zsfcrs 
     1211                ENDDO 
     1212            ENDIF 
     1213                  ! 
     1214            DO jj  = njstr, njend, nn_facty 
     1215               DO ji = nistr, niend, nn_factx 
     1216                  ii  = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
     1217                  ij  = ( jj - njstr ) * rfacty_r + 3 
     1218                  zflcrs =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  ) & 
     1219                    &     + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  ) & 
     1220                    &     + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  ) & 
     1221                    &     + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1) & 
     1222                    &     + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1) & 
     1223                    &     + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1) & 
     1224                    &     + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2) & 
     1225                    &     + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2) & 
     1226                    &     + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)  
     1227   
     1228                  zsfcrs =  zsurfmsk(ji,jj  ) + zsurfmsk(ji+1,jj  ) + zsurfmsk(ji+2,jj  ) & 
     1229                    &     + zsurfmsk(ji,jj+1) + zsurfmsk(ji+1,jj+1) + zsurfmsk(ji+2,jj+1) & 
     1230                    &     + zsurfmsk(ji,jj+2) + zsurfmsk(ji+1,jj+2) + zsurfmsk(ji+2,jj+2)  
     1231                   ! 
     1232                  p_fld_crs(ii,ij) = zflcrs 
     1233                  IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs 
     1234               ENDDO       
     1235            ENDDO 
     1236 
     1237            CALL wrk_dealloc( jpi, jpj, zsurfmsk ) 
    10831238 
    10841239         CASE ( 'SUM' ) 
    10851240          
    1086             CALL wrk_alloc( jpi, jpj, zsurf ) 
     1241            CALL wrk_alloc( jpi, jpj, zsurfmsk ) 
    10871242            IF( PRESENT( p_e3 ) ) THEN 
    1088                zsurf(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
     1243               zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
    10891244            ELSE 
    1090                zsurf(:,:) =  p_e12(:,:) * p_mask(:,:,1) 
     1245               zsurfmsk(:,:) =  p_e12(:,:) * p_mask(:,:,1) 
    10911246            ENDIF 
     1247 
     1248            SELECT CASE ( cd_type ) 
     1249 
     1250               CASE( 'T', 'W' ) 
     1251 
     1252                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1253                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1254                         je_2 = mje_crs(2) 
     1255                         DO ji = nistr, niend, nn_factx 
     1256                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1257                            zflcrs  =  p_fld(ji  ,je_2) * zsurfmsk(ji  ,je_2) & 
     1258                              &      + p_fld(ji+1,je_2) * zsurfmsk(ji+1,je_2) & 
     1259                              &      + p_fld(ji+2,je_2) * zsurfmsk(ji+2,je_2)  
     1260                              ! 
     1261                             p_fld_crs(ii,2) = zflcrs 
     1262                         ENDDO 
     1263                      ENDIF 
     1264                   ELSE 
     1265                      je_2 = mjs_crs(2) 
     1266                      DO ji = nistr, niend, nn_factx 
     1267                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1268                         zflcrs  =  p_fld(ji  ,je_2  ) * zsurfmsk(ji  ,je_2  )  & 
     1269                           &      + p_fld(ji+1,je_2  ) * zsurfmsk(ji+1,je_2  )  & 
     1270                           &      + p_fld(ji+2,je_2  ) * zsurfmsk(ji+2,je_2  )  & 
     1271                           &      + p_fld(ji  ,je_2+1) * zsurfmsk(ji  ,je_2+1)  & 
     1272                           &      + p_fld(ji+1,je_2+1) * zsurfmsk(ji+1,je_2+1)  & 
     1273                           &      + p_fld(ji+2,je_2+1) * zsurfmsk(ji+2,je_2+1)  & 
     1274                           &      + p_fld(ji  ,je_2+2) * zsurfmsk(ji  ,je_2+2)  & 
     1275                           &      + p_fld(ji+1,je_2+2) * zsurfmsk(ji+1,je_2+2)  & 
     1276                           &      + p_fld(ji+2,je_2+2) * zsurfmsk(ji+2,je_2+2)   
     1277                            ! 
     1278                            p_fld_crs(ii,2) = zflcrs 
     1279                      ENDDO 
     1280                   ENDIF 
     1281                     ! 
     1282                   DO jj = njstr, njend, nn_facty 
     1283                      DO ji = nistr, niend, nn_factx 
     1284                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1285                         ij   = ( jj - njstr ) * rfacty_r + 3 
     1286                         zflcrs  =  p_fld(ji  ,jj  ) * zsurfmsk(ji  ,jj  )  & 
     1287                           &      + p_fld(ji+1,jj  ) * zsurfmsk(ji+1,jj  )  & 
     1288                           &      + p_fld(ji+2,jj  ) * zsurfmsk(ji+2,jj  )  & 
     1289                           &      + p_fld(ji  ,jj+1) * zsurfmsk(ji  ,jj+1)  & 
     1290                           &      + p_fld(ji+1,jj+1) * zsurfmsk(ji+1,jj+1)  & 
     1291                           &      + p_fld(ji+2,jj+1) * zsurfmsk(ji+2,jj+1)  & 
     1292                           &      + p_fld(ji  ,jj+2) * zsurfmsk(ji  ,jj+2)  & 
     1293                           &      + p_fld(ji+1,jj+2) * zsurfmsk(ji+1,jj+2)  & 
     1294                           &      + p_fld(ji+2,jj+2) * zsurfmsk(ji+2,jj+2)   
     1295                           ! 
     1296                          p_fld_crs(ii,ij) = zflcrs 
     1297                          !  
     1298                      ENDDO       
     1299                   ENDDO 
     1300             
     1301               CASE( 'V' ) 
     1302 
     1303                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1304                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1305                        ijje = mje_crs(2) 
     1306                      ENDIF 
     1307                  ELSE 
     1308                     ijje = mjs_crs(2) 
     1309                  ENDIF 
     1310 
     1311                  DO ji = nistr, niend, nn_factx 
     1312                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1313                     zflcrs  =  p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje) & 
     1314                       &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 
     1315                       &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje)  
     1316                            ! 
     1317                     p_fld_crs(ii,2) = zflcrs 
     1318                  ENDDO 
     1319 
     1320                  DO jj = njstr, njend, nn_facty 
     1321                     DO ji = nistr, niend, nn_factx 
     1322                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1323                        ij   = ( jj - njstr ) * rfacty_r + 3 
     1324                        ijje = mje_crs(ij) 
     1325                        zflcrs  =  p_fld(ji  ,ijje) * zsurfmsk(ji  ,ijje) & 
     1326                          &      + p_fld(ji+1,ijje) * zsurfmsk(ji+1,ijje) & 
     1327                          &      + p_fld(ji+2,ijje) * zsurfmsk(ji+2,ijje)  
     1328                          ! 
     1329                        p_fld_crs(ii,ij) = zflcrs 
     1330                        !  
     1331                     ENDDO       
     1332                  ENDDO 
     1333             
     1334               CASE( 'U' ) 
     1335 
     1336                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1337                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1338                        je_2 = mje_crs(2) 
     1339                        DO ji = nistr, niend, nn_factx 
     1340                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1341                           ijie = mie_crs(ii) 
     1342                           zflcrs  =  p_fld(ijie,je_2) * zsurfmsk(ijie,je_2)   
     1343                           p_fld_crs(ii,2) = zflcrs 
     1344                        ENDDO 
     1345                     ENDIF 
     1346                  ELSE 
     1347                     je_2 = mjs_crs(2) 
     1348                     DO ji = nistr, niend, nn_factx 
     1349                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1350                        ijie = mie_crs(ii) 
     1351                        zflcrs =  p_fld(ijie,je_2  ) * zsurfmsk(ijie,je_2  )  & 
     1352                          &     + p_fld(ijie,je_2+1) * zsurfmsk(ijie,je_2+1)  & 
     1353                          &     + p_fld(ijie,je_2+2) * zsurfmsk(ijie,je_2+2)  
     1354    
     1355                        p_fld_crs(ii,2) = zflcrs 
     1356                     ENDDO 
     1357                 ENDIF 
     1358 
     1359                 DO jj = njstr, njend, nn_facty 
     1360                    DO ji = nistr, niend, nn_factx 
     1361                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1362                       ij   = ( jj - njstr ) * rfacty_r + 3 
     1363                       ijie = mie_crs(ii) 
     1364                       zflcrs =  p_fld(ijie,jj  ) * zsurfmsk(ijie,jj  )  & 
     1365                          &    + p_fld(ijie,jj+1) * zsurfmsk(ijie,jj+1)  & 
     1366                          &    + p_fld(ijie,jj+2) * zsurfmsk(ijie,jj+2)  
     1367                         ! 
     1368                       p_fld_crs(ii,ij) = zflcrs 
     1369                       !  
     1370                    ENDDO       
     1371                 ENDDO 
     1372 
     1373              END SELECT 
     1374 
     1375              IF( PRESENT( p_surf_crs ) ) THEN 
     1376                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:) = p_fld_crs(:,:) / p_surf_crs(:,:) 
     1377              ENDIF 
     1378 
     1379              CALL wrk_dealloc( jpi, jpj, zsurfmsk ) 
     1380 
     1381         CASE ( 'MAX' ) 
    10921382 
    10931383            SELECT CASE ( cd_type ) 
    10941384             
    10951385               CASE( 'T', 'W' ) 
    1096           
    1097                   DO ji = nistr, niend, nn_factx 
    1098                      DO jj = njstr, njend, nn_facty 
    1099                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1100                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1101                         ijje = mje_crs(ij) 
    1102                         ijie = mie_crs(ii)                   
    1103  
    1104                         zflcrs  =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  & 
    1105                           &      + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  & 
    1106                           &      + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  & 
    1107                           &      + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  & 
    1108                           &      + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  & 
    1109                           &      + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  & 
    1110                           &      + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  & 
    1111                           &      + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  & 
    1112                           &      + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)   
    1113                         ! 
    1114                         p_fld_crs(ii,ij) = zflcrs 
    1115                         ! 
    1116                      ENDDO       
    1117                   ENDDO 
     1386   
     1387                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1388                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1389                         je_2 = mje_crs(2) 
     1390                         DO ji = nistr, niend, nn_factx 
     1391                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1392                            zflcrs =  & 
     1393                              & MAX( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) - ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  & 
     1394                             &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) - ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  & 
     1395                             &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) - ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  ) 
     1396                            ! 
     1397                            p_fld_crs(ii,2) = zflcrs 
     1398                         ENDDO 
     1399                      ENDIF 
     1400                   ELSE 
     1401                      je_2 = mjs_crs(2)  
     1402                      zflcrs =  & 
     1403                        &  MAX( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) - ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  & 
     1404                        &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) - ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  & 
     1405                        &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) - ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  & 
     1406                        &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) - ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  & 
     1407                        &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) - ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  & 
     1408                        &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) - ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  & 
     1409                        &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) - ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  & 
     1410                        &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) - ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  & 
     1411                        &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) - ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   ) 
     1412                      ! 
     1413                      p_fld_crs(ii,2) = zflcrs 
     1414                   ENDIF 
     1415 
     1416                   DO jj = njstr, njend, nn_facty 
     1417                      DO ji = nistr, niend, nn_factx 
     1418                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1419                         ij   = ( jj - njstr ) * rfacty_r + 3 
     1420                         zflcrs = & 
     1421                          &  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) - ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  & 
     1422                          &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) - ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  & 
     1423                          &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) - ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  & 
     1424                          &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) - ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  & 
     1425                          &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) - ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  & 
     1426                          &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) - ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  & 
     1427                          &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) - ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  & 
     1428                          &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) - ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  & 
     1429                          &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) - ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   ) 
     1430                         ! 
     1431                         p_fld_crs(ii,ij) = zflcrs 
     1432                         ! 
     1433                      ENDDO       
     1434                   ENDDO 
    11181435             
    11191436               CASE( 'V' ) 
    1120           
    1121                   DO jk = 1, jpk 
     1437 
     1438                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1439                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1440                        ijje = mje_crs(2) 
     1441                      ENDIF 
     1442                  ELSE 
     1443                     ijje = mjs_crs(2) 
     1444                  ENDIF 
     1445 
     1446                  DO ji = nistr, niend, nn_factx 
     1447                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1448                     zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1449                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1450                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
     1451                       ! 
     1452                     p_fld_crs(ii,2) = zflcrs 
     1453                  ENDDO       
     1454                  DO jj = njstr, njend, nn_facty 
    11221455                     DO ji = nistr, niend, nn_factx 
    1123                         DO jj = njstr, njend, nn_facty 
    1124                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1125                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1126                            ijje = mje_crs(ij) 
    1127                            ijie = mie_crs(ii) 
    1128                            !                   
    1129                            zflcrs  =  p_fld(ji  ,ijje) * zsurf(ji  ,ijje)  & 
    1130                              &      + p_fld(ji+1,ijje) * zsurf(ji+1,ijje)  & 
    1131                              &      + p_fld(ji+2,ijje) * zsurf(ji+2,ijje)   
    1132                            ! 
    1133                            p_fld_crs(ii,ij) = zflcrs 
    1134                            ! 
    1135                          ENDDO       
    1136                      ENDDO 
    1137                   ENDDO    
    1138  
    1139              
    1140                CASE( 'U' ) 
    1141           
    1142                   DO jk = 1, jpk 
    1143                      DO ji = nistr, niend, nn_factx 
    1144                         DO jj = njstr, njend, nn_facty 
    1145                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1146                            ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1147                            ijje = mje_crs(ij) 
    1148                            ijie = mie_crs(ii) 
    1149                            !                   
    1150                            zflcrs =  p_fld(ijie,jj  ) * zsurf(ijie,jj  )  & 
    1151                              &     + p_fld(ijie,jj+1) * zsurf(ijie,jj+1)  & 
    1152                              &     + p_fld(ijie,jj+2) * zsurf(ijie,jj+2)  
    1153                            ! 
    1154                            p_fld_crs(ii,ij) = zflcrs 
    1155                            ! 
    1156                         ENDDO       
    1157                      ENDDO 
    1158                   ENDDO    
    1159  
    1160               END SELECT 
    1161  
    1162               IF( PRESENT( p_surf_crs ) ) THEN 
    1163                  WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:) = p_fld_crs(:,:) / p_surf_crs(:,:) 
    1164               ENDIF 
    1165  
    1166               CALL wrk_dealloc( jpi, jpj, zsurf ) 
    1167  
    1168          CASE ( 'MAX' ) 
    1169           
    1170             SELECT CASE ( cd_type ) 
    1171              
    1172                CASE( 'T', 'W' ) 
    1173           
    1174                   DO ji = nistr, niend, nn_factx 
    1175                      DO jj = njstr, njend, nn_facty 
    1176                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1177                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1178                         ijje = mje_crs(ij) 
    1179                         ijie = mie_crs(ii)                   
    1180  
    1181                         zflcrs =  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1),  & 
    1182                           &            p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1),  & 
    1183                           &            p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1),  & 
    1184                           &            p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1),  & 
    1185                           &            p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1),  & 
    1186                           &            p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1),  & 
    1187                           &            p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1),  & 
    1188                           &            p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1),  & 
    1189                           &            p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1)   ) 
    1190                         ! 
    1191                         p_fld_crs(ii,ij) = zflcrs 
    1192                         ! 
    1193                      ENDDO       
    1194                   ENDDO 
    1195              
    1196                CASE( 'V' ) 
    1197           
    1198                   DO ji = nistr, niend, nn_factx 
    1199                      DO jj = njstr, njend, nn_facty 
    1200                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1201                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1202                         ijje = mje_crs(ij) 
    1203                         ijie = mie_crs(ii) 
     1456                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1457                        ij   = ( jj - njstr ) * rfacty_r + 3                
     1458                        ijje = mje_crs(ij)  
    12041459                        !                   
    1205                         zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1),  & 
    1206                           &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1),  & 
    1207                           &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) ) 
     1460                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1461                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1462                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) - ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    12081463                        ! 
    12091464                        p_fld_crs(ii,ij) = zflcrs 
    … …  
    12131468             
    12141469               CASE( 'U' ) 
    1215           
     1470 
     1471                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1472                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1473                        je_2 = mje_crs(2) 
     1474                        DO ji = nistr, niend, nn_factx 
     1475                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1476                           ijie = mie_crs(ii) 
     1477                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
     1478                           p_fld_crs(ii,2) = zflcrs 
     1479                        ENDDO 
     1480                     ENDIF 
     1481                 ELSE 
     1482                     je_2 = mjs_crs(2) 
     1483                     DO ji = nistr, niend, nn_factx 
     1484                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1485                        ijie = mie_crs(ii) 
     1486                        zflcrs =  & 
     1487                          &  MAX( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1488                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1489                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) - ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
     1490                        p_fld_crs(ii,2) = zflcrs 
     1491                     ENDDO 
     1492                 ENDIF 
     1493                 DO jj = njstr, njend, nn_facty 
     1494                    DO ji = nistr, niend, nn_factx 
     1495                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1496                       ij   = ( jj - njstr ) * rfacty_r + 3 
     1497                       ijie = mie_crs(ii) 
     1498                       zflcrs =  & 
     1499                         &  MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1500                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1501                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) - ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
     1502                        p_fld_crs(ii,ij) = zflcrs 
     1503                        !  
     1504                     ENDDO       
     1505                  ENDDO 
     1506 
     1507              END SELECT 
     1508 
     1509         CASE ( 'MIN' )      !   Search the min of unmasked grid cells 
     1510 
     1511           SELECT CASE ( cd_type ) 
     1512 
     1513              CASE( 'T', 'W' ) 
     1514   
     1515                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1516                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1517                         je_2 = mje_crs(2) 
     1518                         DO ji = nistr, niend, nn_factx 
     1519                            ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1520                            zflcrs =  & 
     1521                              & MIN( p_fld(ji  ,je_2) * p_mask(ji  ,je_2,1) + ( 1.- p_mask(ji  ,je_2,1) ) * r_inf ,  & 
     1522                             &       p_fld(ji+1,je_2) * p_mask(ji+1,je_2,1) + ( 1.- p_mask(ji+1,je_2,1) ) * r_inf ,  & 
     1523                             &       p_fld(ji+2,je_2) * p_mask(ji+2,je_2,1) + ( 1.- p_mask(ji+2,je_2,1) ) * r_inf  ) 
     1524                            ! 
     1525                            p_fld_crs(ii,2) = zflcrs 
     1526                         ENDDO 
     1527                      ENDIF 
     1528                   ELSE 
     1529                      je_2 = mjs_crs(2)  
     1530                      zflcrs =  & 
     1531                        &  MIN( p_fld(ji  ,je_2  ) * p_mask(ji  ,je_2  ,1) + ( 1.- p_mask(ji  ,je_2  ,1) ) * r_inf ,  & 
     1532                        &       p_fld(ji+1,je_2  ) * p_mask(ji+1,je_2  ,1) + ( 1.- p_mask(ji+1,je_2  ,1) ) * r_inf ,  & 
     1533                        &       p_fld(ji+2,je_2  ) * p_mask(ji+2,je_2  ,1) + ( 1.- p_mask(ji+2,je_2  ,1) ) * r_inf ,  & 
     1534                        &       p_fld(ji  ,je_2+1) * p_mask(ji  ,je_2+1,1) + ( 1.- p_mask(ji  ,je_2+1,1) ) * r_inf ,  & 
     1535                        &       p_fld(ji+1,je_2+1) * p_mask(ji+1,je_2+1,1) + ( 1.- p_mask(ji+1,je_2+1,1) ) * r_inf ,  & 
     1536                        &       p_fld(ji+2,je_2+1) * p_mask(ji+2,je_2+1,1) + ( 1.- p_mask(ji+2,je_2+1,1) ) * r_inf ,  & 
     1537                        &       p_fld(ji  ,je_2+2) * p_mask(ji  ,je_2+2,1) + ( 1.- p_mask(ji  ,je_2+2,1) ) * r_inf ,  & 
     1538                        &       p_fld(ji+1,je_2+2) * p_mask(ji+1,je_2+2,1) + ( 1.- p_mask(ji+1,je_2+2,1) ) * r_inf ,  & 
     1539                        &       p_fld(ji+2,je_2+2) * p_mask(ji+2,je_2+2,1) + ( 1.- p_mask(ji+2,je_2+2,1) ) * r_inf   ) 
     1540                      ! 
     1541                      p_fld_crs(ii,2) = zflcrs 
     1542                   ENDIF 
     1543 
     1544                   DO jj = njstr, njend, nn_facty 
     1545                      DO ji = nistr, niend, nn_factx 
     1546                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1547                         ij   = ( jj - njstr ) * rfacty_r + 3 
     1548                         zflcrs = & 
     1549                          &  MIN( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1) + ( 1.- p_mask(ji  ,jj  ,1) ) * r_inf ,  & 
     1550                          &       p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1) + ( 1.- p_mask(ji+1,jj  ,1) ) * r_inf ,  & 
     1551                          &       p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1) + ( 1.- p_mask(ji+2,jj  ,1) ) * r_inf ,  & 
     1552                          &       p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1) + ( 1.- p_mask(ji  ,jj+1,1) ) * r_inf ,  & 
     1553                          &       p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1) + ( 1.- p_mask(ji+1,jj+1,1) ) * r_inf ,  & 
     1554                          &       p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1) + ( 1.- p_mask(ji+2,jj+1,1) ) * r_inf ,  & 
     1555                          &       p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1) + ( 1.- p_mask(ji  ,jj+2,1) ) * r_inf ,  & 
     1556                          &       p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1) + ( 1.- p_mask(ji+1,jj+2,1) ) * r_inf ,  & 
     1557                          &       p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1) + ( 1.- p_mask(ji+2,jj+2,1) ) * r_inf   ) 
     1558                         ! 
     1559                         p_fld_crs(ii,ij) = zflcrs 
     1560                         ! 
     1561                      ENDDO       
     1562                   ENDDO 
     1563             
     1564               CASE( 'V' ) 
     1565 
     1566                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1567                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1568                        ijje = mje_crs(2) 
     1569                      ENDIF 
     1570                  ELSE 
     1571                     ijje = mjs_crs(2) 
     1572                  ENDIF 
     1573 
    12161574                  DO ji = nistr, niend, nn_factx 
    1217                      DO jj = njstr, njend, nn_facty 
    1218                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1219                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1220                         ijje = mje_crs(ij) 
    1221                         ijie = mie_crs(ii) 
     1575                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1576                     zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1577                       &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1578                       &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
     1579                       ! 
     1580                     p_fld_crs(ii,2) = zflcrs 
     1581                  ENDDO       
     1582                  DO jj = njstr, njend, nn_facty 
     1583                     DO ji = nistr, niend, nn_factx 
     1584                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1585                        ij   = ( jj - njstr ) * rfacty_r + 3                
     1586                        ijje = mje_crs(ij)  
    12221587                        !                   
    1223                         zflcrs = MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1),  & 
    1224                           &           p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1),  & 
    1225                           &           p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) ) 
     1588                        zflcrs = MIN( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1589                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ,  & 
     1590                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) + ( 1.- p_mask(ji,ijje,1) ) * r_inf ) 
    12261591                        ! 
    12271592                        p_fld_crs(ii,ij) = zflcrs 
    … …  
    12291594                     ENDDO       
    12301595                  ENDDO 
    1231  
    1232               END SELECT 
    1233  
    1234          CASE ( 'MIN' ) 
    1235             !   Search the min of masked grid cells 
    1236             SELECT CASE ( cd_type ) 
    12371596             
    1238                CASE( 'T', 'W' ) 
    1239           
    1240                   DO ji = nistr, niend, nn_factx 
    1241                      DO jj = njstr, njend, nn_facty 
    1242                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1243                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1244                         ijje = mje_crs(ij) 
    1245                         ijie = mie_crs(ii)                   
    1246                          
    1247                         zflcrs =  MIN( p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  & 
    1248                           &            p_fld(ji+1,jj  ) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  & 
    1249                           &            p_fld(ji+2,jj  ) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  & 
    1250                           &            p_fld(ji  ,jj+1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  & 
    1251                           &            p_fld(ji+1,jj+1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  & 
    1252                           &            p_fld(ji+2,jj+1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  & 
    1253                           &            p_fld(ji  ,jj+2) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  & 
    1254                           &            p_fld(ji+1,jj+2) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  & 
    1255                           &            p_fld(ji+2,jj+2) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   ) 
    1256                         ! 
    1257                         p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1) 
    1258                         ! 
     1597               CASE( 'U' ) 
     1598 
     1599                 IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1600                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1601                        je_2 = mje_crs(2) 
     1602                        DO ji = nistr, niend, nn_factx 
     1603                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1604                           ijie = mie_crs(ii) 
     1605                           zflcrs  =  p_fld(ijie,je_2) * p_mask(ijie,je_2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  
     1606  
     1607                           p_fld_crs(ii,2) = zflcrs 
     1608                        ENDDO 
     1609                     ENDIF 
     1610                 ELSE 
     1611                     je_2 = mjs_crs(2) 
     1612                     DO ji = nistr, niend, nn_factx 
     1613                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
     1614                        ijie = mie_crs(ii) 
     1615                        zflcrs =  & 
     1616                          &  MIN( p_fld(ijie,je_2  ) * p_mask(ijie,je_2  ,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1617                          &       p_fld(ijie,je_2+1) * p_mask(ijie,je_2+1,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf ,  & 
     1618                          &       p_fld(ijie,je_2+2) * p_mask(ijie,je_2+2,1) + ( 1.- p_mask(ijie,je_2,1) ) * r_inf  ) 
     1619                        p_fld_crs(ii,2) = zflcrs 
     1620                     ENDDO 
     1621                 ENDIF 
     1622                 DO jj = njstr, njend, nn_facty 
     1623                    DO ji = nistr, niend, nn_factx 
     1624                       ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1625                       ij   = ( jj - njstr ) * rfacty_r + 3 
     1626                       ijie = mie_crs(ii) 
     1627                       zflcrs =  & 
     1628                         &  MIN( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1629                         &       p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf ,  & 
     1630                          &      p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) + ( 1.- p_mask(ijie,jj,1) ) * r_inf  ) 
     1631                        p_fld_crs(ii,ij) = zflcrs 
     1632                        !  
    12591633                     ENDDO       
    12601634                  ENDDO 
    1261   
    1262                CASE( 'V' ) 
    1263           
    1264                   DO ji = nistr, niend, nn_factx 
    1265                      DO jj = njstr, njend, nn_facty 
    1266                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1267                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1268                         ijje = mje_crs(ij) 
    1269                         ijie = mie_crs(ii)                   
    1270                          
    1271                         zflcrs =  MIN( p_fld(ji  ,ijje) * ( 1. + ( 1. - p_mask(ji  ,ijje,1) ) * zeps ),  & 
    1272                           &            p_fld(ji+1,ijje) * ( 1. + ( 1. - p_mask(ji+1,ijje,1) ) * zeps ),  & 
    1273                           &            p_fld(ji+2,ijje) * ( 1. + ( 1. - p_mask(ji+2,ijje,1) ) * zeps )   ) 
    1274                         ! 
    1275                         p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1) 
    1276                         ! 
    1277                      ENDDO       
    1278                   ENDDO 
    1279  
    1280                CASE( 'U' ) 
    1281           
    1282                   DO ji = nistr, niend, nn_factx 
    1283                      DO jj = njstr, njend, nn_facty 
    1284                         ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1285                         ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1286                         ijje = mje_crs(ij) 
    1287                         ijie = mie_crs(ii)                   
    1288                          
    1289                         zflcrs =  MIN( p_fld(ijie,jj  ) * ( 1. + ( 1. - p_mask(ijie,jj  ,1) ) * zeps ),  & 
    1290                           &            p_fld(ijie,jj+1) * ( 1. + ( 1. - p_mask(ijie,jj+1,1) ) * zeps ),  & 
    1291                           &            p_fld(ijie,jj+2) * ( 1. + ( 1. - p_mask(ijie,jj+2,1) ) * zeps )   ) 
    1292                         ! 
    1293                         p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1) 
    1294                         ! 
    1295                      ENDDO       
    1296                   ENDDO 
    1297             END SELECT 
    1298             ! 
     1635 
     1636              END SELECT 
     1637             ! 
    12991638         END SELECT 
    13001639         ! 
    1301          CALL crs_lbc_lnk( p_fld_crs, cd_type, 1.0 ) 
     1640         CALL crs_lbc_lnk( p_fld_crs, cd_type, psgn ) 
    13021641         ! 
    13031642   END SUBROUTINE crs_dom_ope_2d 
    … …  
    13161655      !! Local variables 
    13171656      INTEGER ::  ji, jj, jk                   ! dummy loop indices 
    1318       INTEGER ::  ijie, ijje, ii, ij 
     1657      INTEGER ::  ijie, ijje, ii, ij, je_2 
    13191658      REAL(wp) :: ze3crs   
     1659      REAL(wp), DIMENSION(:,:,:), POINTER :: zmask, zsurf    
    13201660 
    13211661      !!----------------------------------------------------------------   
     1662 
     1663       p_e3_crs    (:,:,:) = 0. 
     1664       p_e3_max_crs(:,:,:) = 1. 
    13221665    
    1323       SELECT CASE ( cd_type ) 
    1324        
    1325          CASE ('T', 'U', 'V') 
    1326           
    1327             DO jk = 1 , jpk 
    1328                DO ji = nistr, niend, nn_factx 
    1329                   DO jj = njstr, njend, nn_facty 
    1330                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1331                      ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1332                      ijje = mje_crs(ij) 
    1333                      ijie = mie_crs(ii) 
    1334                      !  
    1335                      ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  & 
    1336                         &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  & 
    1337                         &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  & 
    1338                         &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  & 
    1339                         &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  & 
    1340                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  & 
    1341                         &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  & 
    1342                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  & 
    1343                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk) 
    1344   
    1345                      p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
    1346                      ! 
    1347                      ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  & 
    1348                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  & 
    1349                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  & 
    1350                         &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  & 
    1351                         &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  & 
    1352                         &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  & 
    1353                         &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  & 
    1354                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  & 
    1355                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) ) 
    1356                      
    1357                      p_e3_max_crs(ii,ij,jk) = ze3crs 
    1358                   ENDDO 
    1359                ENDDO 
    1360             ENDDO 
    1361   
    1362          CASE ('W') 
    1363           
    1364             DO jk = 2 , jpk 
    1365                DO ji = nistr, niend, nn_factx 
    1366                   DO jj = njstr, njend, nn_facty 
    1367                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1368                      ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1369                      ijje = mje_crs(ij) 
    1370                      ijie = mie_crs(ii) 
    1371                      !   
    1372                      ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  & 
    1373                         &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  & 
    1374                         &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  & 
    1375                         &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  & 
    1376                         &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  & 
    1377                         &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  & 
    1378                         &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  & 
    1379                         &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  & 
    1380                         &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 
    1381                          
    1382                      p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
    1383                      ! 
    1384                      ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  & 
    1385                         &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  & 
    1386                         &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  & 
    1387                         &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  & 
    1388                         &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  & 
    1389                         &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  & 
    1390                         &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  & 
    1391                         &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  & 
    1392                         &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) ) 
    1393                      
    1394                      p_e3_max_crs(ii,ij,jk) = ze3crs 
    1395                   ENDDO 
    1396                ENDDO 
    1397             ENDDO 
    1398               
    1399             DO ji = nistr, niend, nn_factx 
    1400                DO jj = njstr, njend, nn_facty 
    1401                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1402                   ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1403                   ijje = mje_crs(ij) 
    1404                   ijie = mie_crs(ii) 
    1405                   !   
    1406                    ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  & 
    1407                         &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  & 
    1408                         &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  & 
    1409                         &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  & 
    1410                         &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  & 
    1411                         &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  & 
    1412                         &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  & 
    1413                         &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  & 
    1414                         &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 
    1415                          
    1416                   p_e3_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1) 
    1417                   ! 
    1418                   ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  & 
    1419                      &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  & 
    1420                      &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  & 
    1421                      &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  & 
    1422                      &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  & 
    1423                      &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  & 
    1424                      &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  & 
    1425                      &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  & 
    1426                      &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) ) 
    1427                   
    1428                   p_e3_max_crs(ii,ij,1) = ze3crs 
    1429                ENDDO 
    1430             ENDDO 
    1431              
    1432          END SELECT  
    1433          !               
    1434          CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )   
    1435          CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )   
    1436          !               
     1666 
     1667       CALL wrk_alloc( jpi, jpj, jpk, zmask, zsurf ) 
     1668 
     1669       SELECT CASE ( cd_type ) 
     1670          CASE( 'W' ) 
     1671              zmask(:,:,1) = p_mask(:,:,1)  
     1672              DO jk = 2, jpk 
     1673                 zmask(:,:,jk) = p_mask(:,:,jk-1)  
     1674              ENDDO 
     1675           CASE DEFAULT 
     1676              DO jk = 1, jpk 
     1677                 zmask(:,:,jk) = p_mask(:,:,jk)  
     1678              ENDDO 
     1679       END SELECT 
     1680 
     1681       DO jk = 1, jpk 
     1682          zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk)  
     1683       ENDDO 
     1684 
     1685       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1686          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1687             je_2 = mje_crs(2) 
     1688             DO jk = 1 , jpk 
     1689                DO ji = nistr, niend, nn_factx 
     1690                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1691                   ze3crs =   zsurf(ji  ,je_2,jk) * zmask(ji  ,je_2,jk)   & 
     1692                        &   + zsurf(ji+1,je_2,jk) * zmask(ji+1,je_2,jk)   & 
     1693                        &   + zsurf(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  
     1694 
     1695                   p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1696                   ! 
     1697                   ze3crs = MAX( p_e3(ji  ,je_2,jk) * zmask(ji  ,je_2,jk),  & 
     1698                      &          p_e3(ji+1,je_2,jk) * zmask(ji+1,je_2,jk),  & 
     1699                      &          p_e3(ji+2,je_2,jk) * zmask(ji+2,je_2,jk)  ) 
     1700                   ! 
     1701                   p_e3_max_crs(ii,2,jk) = ze3crs 
     1702                ENDDO 
     1703             ENDDO 
     1704          ENDIF 
     1705       ELSE 
     1706          je_2 = mjs_crs(2) 
     1707          DO jk = 1 , jpk 
     1708             DO ji = nistr, niend, nn_factx 
     1709                ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
     1710                ze3crs =  zsurf(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk)   & 
     1711                   &    + zsurf(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk)   & 
     1712                   &    + zsurf(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk)   & 
     1713                   &    + zsurf(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk)   & 
     1714                   &    + zsurf(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk)   & 
     1715                   &    + zsurf(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk)   & 
     1716                   &    + zsurf(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk)   & 
     1717                   &    + zsurf(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk)   & 
     1718                   &    + zsurf(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) 
     1719 
     1720                p_e3_crs(ii,2,jk) = ze3crs / p_sfc_crs(ii,2,jk) 
     1721                ! 
     1722                ze3crs = MAX( p_e3(ji  ,je_2  ,jk) * zmask(ji  ,je_2  ,jk),  & 
     1723                   &          p_e3(ji+1,je_2  ,jk) * zmask(ji+1,je_2  ,jk),  & 
     1724                   &          p_e3(ji+2,je_2  ,jk) * zmask(ji+2,je_2  ,jk),  & 
     1725                   &          p_e3(ji  ,je_2+1,jk) * zmask(ji  ,je_2+1,jk),  & 
     1726                   &          p_e3(ji+1,je_2+1,jk) * zmask(ji+1,je_2+1,jk),  & 
     1727                   &          p_e3(ji+2,je_2+1,jk) * zmask(ji+2,je_2+1,jk),  & 
     1728                   &          p_e3(ji  ,je_2+2,jk) * zmask(ji  ,je_2+2,jk),  & 
     1729                   &          p_e3(ji+1,je_2+2,jk) * zmask(ji+1,je_2+2,jk),  & 
     1730                   &          p_e3(ji+2,je_2+2,jk) * zmask(ji+2,je_2+2,jk) ) 
     1731                
     1732                p_e3_max_crs(ii,2,jk) = ze3crs 
     1733                ENDDO 
     1734             ENDDO 
     1735          ENDIF 
     1736          DO jk = 1 , jpk 
     1737             DO jj = njstr, njend, nn_facty 
     1738                DO ji = nistr, niend, nn_factx 
     1739                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2           
     1740                   ij   = ( jj - njstr ) * rfacty_r + 3 
     1741                   ze3crs =   zsurf(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk)   & 
     1742                   &        + zsurf(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk)   & 
     1743                   &        + zsurf(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk)   & 
     1744                   &        + zsurf(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk)   & 
     1745                   &        + zsurf(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk)   & 
     1746                   &        + zsurf(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk)   & 
     1747                   &        + zsurf(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk)   & 
     1748                   &        + zsurf(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk)   & 
     1749                   &        + zsurf(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) 
     1750 
     1751                p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk) 
     1752                ! 
     1753                ze3crs = MAX( p_e3(ji  ,jj  ,jk) * zmask(ji  ,jj  ,jk),  & 
     1754                   &          p_e3(ji+1,jj  ,jk) * zmask(ji+1,jj  ,jk),  & 
     1755                   &          p_e3(ji+2,jj  ,jk) * zmask(ji+2,jj  ,jk),  & 
     1756                   &          p_e3(ji  ,jj+1,jk) * zmask(ji  ,jj+1,jk),  & 
     1757                   &          p_e3(ji+1,jj+1,jk) * zmask(ji+1,jj+1,jk),  & 
     1758                   &          p_e3(ji+2,jj+1,jk) * zmask(ji+2,jj+1,jk),  & 
     1759                   &          p_e3(ji  ,jj+2,jk) * zmask(ji  ,jj+2,jk),  & 
     1760                   &          p_e3(ji+1,jj+2,jk) * zmask(ji+1,jj+2,jk),  & 
     1761                   &          p_e3(ji+2,jj+2,jk) * zmask(ji+2,jj+2,jk) ) 
     1762                
     1763                p_e3_max_crs(ii,ij,jk) = ze3crs 
     1764             ENDDO 
     1765          ENDDO 
     1766       ENDDO 
     1767                   
     1768       CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )   
     1769       CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )   
     1770       !               
     1771       CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zmask ) 
     1772       ! 
    14371773   END SUBROUTINE crs_dom_e3 
    14381774 
    … …  
    14401776 
    14411777      !!  Arguments 
    1442       CHARACTER(len=1),                 INTENT(in) :: cd_type      ! grid type T, W ( U, V, F) 
    1443       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask       ! Parent grid T mask 
    1444       REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in), OPTIONAL :: p_e1, p_e2         ! 3D tracer T or W on parent grid 
    1445       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3         ! 3D tracer T or W on parent grid 
    1446       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out):: p_surf_crs ! Coarse grid box east or north face quantity  
    1447       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out):: p_surf_crs_msk ! Coarse grid box east or north face quantity  
     1778      CHARACTER(len=1),                         INTENT(in)          :: cd_type      ! grid type T, W ( U, V, F) 
     1779      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)          :: p_mask       ! Parent grid T mask 
     1780      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in), OPTIONAL :: p_e1, p_e2         ! 3D tracer T or W on parent grid 
     1781      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in), OPTIONAL :: p_e3         ! 3D tracer T or W on parent grid 
     1782      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_surf_crs ! Coarse grid box east or north face quantity  
     1783      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_surf_crs_msk ! Coarse grid box east or north face quantity  
    14481784 
    14491785      !! Local variables 
    14501786      INTEGER  :: ji, jj, jk                   ! dummy loop indices 
    1451       INTEGER  :: ijie, ijje, ii, ij 
    1452       REAL(wp), DIMENSION(:,:)  , POINTER :: zsurf    
    1453       REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf3d    
    1454       REAL(wp) :: zsfcrs, zsfcrs_msk 
     1787      INTEGER  :: ii, ij, je_2 
     1788      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf, zsurfmsk    
    14551789      !!----------------------------------------------------------------   
    14561790      ! Initialize 
    14571791 
    14581792 
     1793      CALL wrk_alloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    14591794      ! 
    14601795      SELECT CASE ( cd_type ) 
    14611796       
    1462          CASE ('W') 
    1463        
    1464            CALL wrk_alloc( jpi, jpj, zsurf ) 
    1465            zsurf(:,:) =  p_e1(:,:) * p_e2(:,:) 
    1466          
    1467             DO ji = nistr, niend, nn_factx 
    1468                DO jj   = njstr, njend, nn_facty 
    1469                   ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1470                   ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1471                   ijje = mje_crs(ij) 
    1472                   ijie = mie_crs(ii) 
     1797         CASE ('W')     
     1798            DO jk = 1, jpk 
     1799               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:)  
     1800            ENDDO 
     1801            zsurfmsk(:,:,1) = zsurf(:,:,1) * p_mask(:,:,1)  
     1802            DO jk = 2, jpk 
     1803               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk-1)  
     1804            ENDDO 
     1805 
     1806         CASE ('V')      
     1807            DO jk = 1, jpk 
     1808               zsurf(:,:,jk) = p_e1(:,:) * p_e3(:,:,jk)  
     1809            ENDDO 
     1810            DO jk = 1, jpk 
     1811               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
     1812            ENDDO 
     1813 
     1814         CASE ('U')      
     1815            DO jk = 1, jpk 
     1816               zsurf(:,:,jk) = p_e2(:,:) * p_e3(:,:,jk)  
     1817            ENDDO 
     1818            DO jk = 1, jpk 
     1819               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
     1820            ENDDO 
     1821 
     1822         CASE DEFAULT 
     1823            DO jk = 1, jpk 
     1824               zsurf(:,:,jk) = p_e1(:,:) * p_e2(:,:)  
     1825            ENDDO 
     1826            DO jk = 1, jpk 
     1827               zsurfmsk(:,:,jk) = zsurf(:,:,jk) * p_mask(:,:,jk)  
     1828            ENDDO 
     1829      END SELECT 
     1830 
     1831      IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1832         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
     1833            je_2 = mje_crs(2) 
     1834            DO jk = 1, jpk 
     1835               DO ji = nistr, niend, nn_factx 
     1836                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
     1837                  !     
     1838                  p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk) & 
     1839                    &                      + zsurf(ji,je_2-1,jk) + zsurf(ji+1,je_2-1,jk) + zsurf(ji+2,je_2-1,jk)  ! Why ????? 
    14731840                  ! 
    1474                   zsfcrs     =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  & 
    1475                     &         + zsurf(ji,jj+1) + zsurf(ji+1,jj+1) + zsurf(ji+2,jj+1)  & 
    1476                     &         + zsurf(ji,jj+2) + zsurf(ji+1,jj+2) + zsurf(ji+2,jj+2)   
    1477                   ! 
    1478                   zsfcrs_msk =  zsurf(ji  ,jj  ) * p_mask(ji  ,jj  ,1)  & 
    1479                     &         + zsurf(ji+1,jj  ) * p_mask(ji+1,jj  ,1)  & 
    1480                     &         + zsurf(ji+2,jj  ) * p_mask(ji+2,jj  ,1)  & 
    1481                     &         + zsurf(ji  ,jj+1) * p_mask(ji  ,jj+1,1)  & 
    1482                     &         + zsurf(ji+1,jj+1) * p_mask(ji+1,jj+1,1)  & 
    1483                     &         + zsurf(ji+2,jj+1) * p_mask(ji+2,jj+1,1)  & 
    1484                     &         + zsurf(ji  ,jj+2) * p_mask(ji  ,jj+2,1)  & 
    1485                     &         + zsurf(ji+1,jj+2) * p_mask(ji+1,jj+2,1)  & 
    1486                     &         + zsurf(ji+2,jj+2) * p_mask(ji+2,jj+2,1) 
    1487                   ! 
    1488                   p_surf_crs    (ii,ij,1) = zsfcrs 
    1489                   p_surf_crs_msk(ii,ij,1) = zsfcrs_msk 
     1841                  p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2,jk) + zsurfmsk(ji+1,je_2,jk) + zsurfmsk(ji+2,je_2,jk)  
    14901842                  ! 
    14911843               ENDDO 
    14921844            ENDDO 
    1493             DO jk = 2, jpk 
     1845         ENDIF 
     1846      ELSE 
     1847         je_2 = mjs_crs(2) 
     1848         DO jk = 1, jpk 
     1849            DO ji = nistr, niend, nn_factx 
     1850               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2  
     1851               !   
     1852               p_surf_crs    (ii,2,jk) =  zsurf(ji,je_2  ,jk) + zsurf(ji+1,je_2  ,jk) + zsurf(ji+2,je_2  ,jk)  & 
     1853                    &                   + zsurf(ji,je_2+1,jk) + zsurf(ji+1,je_2+1,jk) + zsurf(ji+2,je_2+1,jk)  & 
     1854                    &                   + zsurf(ji,je_2+2,jk) + zsurf(ji+1,je_2+2,jk) + zsurf(ji+2,je_2+2,jk)   
     1855 
     1856               p_surf_crs_msk(ii,2,jk) =  zsurfmsk(ji,je_2  ,jk) + zsurfmsk(ji+1,je_2  ,jk) + zsurfmsk(ji+2,je_2  ,jk)  & 
     1857                    &                   + zsurfmsk(ji,je_2+1,jk) + zsurfmsk(ji+1,je_2+1,jk) + zsurfmsk(ji+2,je_2+1,jk)  & 
     1858                    &                   + zsurfmsk(ji,je_2+2,jk) + zsurfmsk(ji+1,je_2+2,jk) + zsurfmsk(ji+2,je_2+2,jk)   
     1859                ENDDO 
     1860            ENDDO 
     1861      ENDIF 
     1862          
     1863      DO jk = 1, jpk 
     1864         DO jj = njstr, njend, nn_facty 
     1865            DO ji = nistr, niend, nn_factx 
     1866               ii = ( ji - mis_crs(2) ) * rfactx_r + 2   
     1867               ij = ( jj - njstr ) * rfacty_r + 3 
    14941868               ! 
    1495                p_surf_crs(:,:,jk) = p_surf_crs(:,:,1) 
    1496                ! 
    1497                DO ji = nistr, niend, nn_factx 
    1498                   DO jj   = njstr, njend, nn_facty 
    1499                      ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid 
    1500                      ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1501                      ijje = mje_crs(ij) 
    1502                      ijie = mie_crs(ii) 
    1503                      ! 
    1504                      zsfcrs_msk =  zsurf(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1)  & 
    1505                        &         + zsurf(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1)  & 
    1506                        &         + zsurf(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1)  & 
    1507                        &         + zsurf(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1)  & 
    1508                        &         + zsurf(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1)  & 
    1509                        &         + zsurf(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1)  & 
    1510                        &         + zsurf(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1)  & 
    1511                        &         + zsurf(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1)  & 
    1512                        &         + zsurf(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1) 
    1513                        ! 
    1514                        p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk 
    1515                        ! 
    1516                    ENDDO 
    1517                 ENDDO 
    1518             ENDDO 
    1519                          
    1520             CALL wrk_dealloc( jpi, jpj, zsurf ) 
    1521            
    1522          CASE( 'V' ) 
    1523             
    1524            CALL wrk_alloc( jpi, jpj, jpk, zsurf3d ) 
    1525            DO jk = 1, jpk 
    1526               zsurf3d(:,:,jk) =  p_e1(:,:) * p_e3(:,:,jk) 
    1527            ENDDO 
    1528           
    1529            DO jk = 1, jpk 
    1530               DO ji = nistr, niend, nn_factx 
    1531                  DO jj = njstr, njend, nn_facty 
    1532                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1533                     ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1534                     ijje = mje_crs(ij) 
    1535                     ijie = mie_crs(ii) 
    1536                     !                   
    1537                     zsfcrs      =  zsurf3d(ji,ijje,jk) + zsurf3d(ji+1,ijje,jk) + zsurf3d(ji+2,ijje,jk) 
    1538                     ! 
    1539                     zsfcrs_msk  =  zsurf3d(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) & 
    1540                       &          + zsurf3d(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) & 
    1541                       &          + zsurf3d(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk)  
    1542                     ! 
    1543                     p_surf_crs    (ii,ij,jk) = zsfcrs 
    1544                     p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk 
    1545                     ! 
    1546                   ENDDO       
    1547               ENDDO 
    1548            ENDDO    
    1549  
    1550            CALL wrk_dealloc( jpi, jpj, jpk, zsurf3d ) 
    1551              
    1552          CASE( 'U' ) 
    1553           
    1554            CALL wrk_alloc( jpi, jpj, jpk, zsurf3d ) 
    1555            DO jk = 1, jpk 
    1556               zsurf3d(:,:,jk) =  p_e2(:,:) * p_e3(:,:,jk) 
    1557            ENDDO 
    1558           
    1559            DO jk = 1, jpk 
    1560               DO ji = nistr, niend, nn_factx 
    1561                  DO jj = njstr, njend, nn_facty 
    1562                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2      
    1563                     ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2 
    1564                     ijje = mje_crs(ij) 
    1565                     ijie = mie_crs(ii) 
    1566                     !                   
    1567                     zsfcrs      =  zsurf3d(ijie,jj,jk) + zsurf3d(ijie,jj+1,jk) + zsurf3d(ijie,jj+2,jk) 
    1568                     ! 
    1569                     zsfcrs_msk  =  zsurf3d(ijie  ,jj,jk) * p_mask(ijie,jj  ,jk) & 
    1570                       &          + zsurf3d(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) & 
    1571                       &          + zsurf3d(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk)  
    1572                     ! 
    1573                     p_surf_crs    (ii,ij,jk) = zsfcrs 
    1574                     p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk 
    1575                     ! 
    1576                   ENDDO       
    1577               ENDDO 
    1578            ENDDO   
    1579   
    1580            CALL wrk_dealloc( jpi, jpj, jpk, zsurf3d ) 
    1581  
    1582       END SELECT 
    1583        
     1869               p_surf_crs    (ii,ij,jk) =  zsurf(ji,jj  ,jk) + zsurf(ji+1,jj  ,jk) + zsurf(ji+2,jj  ,jk)  & 
     1870                    &                    + zsurf(ji,jj+1,jk) + zsurf(ji+1,jj+1,jk) + zsurf(ji+2,jj+1,jk)  & 
     1871                    &                    + zsurf(ji,jj+2,jk) + zsurf(ji+1,jj+2,jk) + zsurf(ji+2,jj+2,jk)   
     1872 
     1873               p_surf_crs_msk(ii,ij,jk) =  zsurfmsk(ji,jj  ,jk) + zsurfmsk(ji+1,jj  ,jk) + zsurfmsk(ji+2,jj  ,jk)  & 
     1874                    &                    + zsurfmsk(ji,jj+1,jk) + zsurfmsk(ji+1,jj+1,jk) + zsurfmsk(ji+2,jj+1,jk)  & 
     1875                    &                    + zsurfmsk(ji,jj+2,jk) + zsurfmsk(ji+1,jj+2,jk) + zsurfmsk(ji+2,jj+2,jk)   
     1876            ENDDO       
     1877         ENDDO 
     1878      ENDDO    
     1879 
    15841880      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 ) 
    15851881      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 
    15861882 
     1883      CALL wrk_dealloc( jpi, jpj, jpk, zsurf, zsurfmsk ) 
    15871884 
    15881885   END SUBROUTINE crs_dom_sfc 
    … …  
    16011898      INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices 
    16021899      INTEGER  :: ierr                                ! allocation error status 
    1603     
    1604      ! 1.a. Define global domain indices 
     1900  
     1901   
     1902     ! 1.a. Define global domain indices  : take into account the interior domain only ( removes i/j=1 , i/j=jpiglo/jpjglo ) then add 2/3 grid points  
    16051903      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2 
    1606       jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj 
     1904  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj 
     1905  !    jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 3 
     1906      jpjglo_crs   = INT( (jpjglo - MOD(jpjglo, nn_facty)) / nn_facty ) + 3 
    16071907      jpiglo_crsm1 = jpiglo_crs - 1 
    16081908      jpjglo_crsm1 = jpjglo_crs - 1   
    16091909 
    1610      ! 1.b. Define local domain indices 
    1611       jpi_crs = ( jpiglo_crs-2 * jpreci + (jpni-1) ) / jpni + 2*jpreci 
    1612       jpj_crs = ( jpjglo_crs-2 * jprecj + (jpnj-1) ) / jpnj + 2*jprecj 
     1910      jpi_crs = ( jpiglo_crs   - 2 * jpreci + (jpni-1) ) / jpni + 2 * jpreci 
     1911      jpj_crs = ( jpjglo_crsm1 - 2 * jprecj + (jpnj-1) ) / jpnj + 2 * jprecj    
     1912               
     1913      IF( noso < 0 ) jpj_crs = jpj_crs + 1    ! add a local band on southern processors   
    16131914        
    16141915      jpi_crsm1   = jpi_crs - 1 
    … …  
    16181919       
    16191920      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays 
    1620      ! 2.a Define processor domain 
     1921 
     1922      ! 2.a Define processor domain 
    16211923      IF( .NOT. lk_mpp ) THEN 
    16221924         nimpp_crs  = 1 
    … …  
    16281930         nlei_crs   = jpi_crs 
    16291931         nlej_crs   = jpj_crs 
    1630  
    16311932      ELSE 
    16321933         ! Initialisation of most local variables - 
    … …  
    16421943        ! Calculs suivant une découpage en j 
    16431944        DO jn = 1, jpnij, jpni 
    1644            IF( jn < (jpnij-jpni + 1)) THEN 
     1945           IF( jn < ( jpnij - jpni + 1 ) ) THEN 
    16451946              nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) & 
    16461947                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 
    … …  
    16481949              nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1             
    16491950           ENDIF 
    1650             
     1951           IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1              
    16511952           SELECT CASE( ibonjt(jn) ) 
    16521953              CASE ( -1 ) 
    1653                 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )    nlejt_crs(jn) = nlejt_crs(jn) + 1 
     1954                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    16541955                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
    16551956                nldjt_crs(jn) = nldjt(jn) 
    … …  
    16571958              CASE ( 0 ) 
    16581959               
     1960                nldjt_crs(jn) = nldjt(jn) 
     1961                IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    16591962                nlejt_crs(jn) = nlejt_crs(jn) + jprecj 
    16601963                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj 
    1661                 nldjt_crs(jn) = nldjt(jn) 
    16621964                 
    16631965              CASE ( 1, 2 ) 
    … …  
    16701972                 STOP 
    16711973           END SELECT 
    1672           
    1673            njmppt_crs(jn) = ANINT(REAL((njmppt(jn) + 1 + MOD( jpjglo - njmppt(jn) + 1, nn_facty )) / nn_facty, wp ) ) 
     1974           IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
     1975 
     1976           IF(nldjt_crs(jn) == 1 ) THEN 
     1977              njmppt_crs(jn) = 1 
     1978           ELSE 
     1979              njmppt_crs(jn) = 2 + ANINT(REAL((njmppt(jn) + 1 - MOD( jpjglo , nn_facty )) / nn_facty, wp ) ) 
     1980           ENDIF            
    16741981            
    16751982           DO jj = jn + 1, jn + jpni - 1 
    … …  
    16851992        njmpp_crs = njmppt_crs(nproc + 1) 
    16861993 
    1687          !!!! Calcul suivant un decoupage en i 
    1688            DO jn = 1, jpni 
    1689               IF( jn < jpni ) THEN 
    1690           
    1691                  nleit_crs(jn) = AINT( REAL( ( jpiglo - (nimppt(jn  ) - 1) ) / nn_factx, wp ) ) & 
    1692                          &     - AINT( REAL( ( jpiglo - (nimppt(jn+1) - 1) ) / nn_factx, wp ) ) 
    1693               ELSE 
    1694                  nleit_crs(jn) = AINT( REAL( ( jpiglo - (nimppt(jn  ) - 1) ) / nn_factx, wp ) ) 
    1695               ENDIF 
    1696               SELECT CASE( ibonit(jn) ) 
    1697             
    1698                  CASE ( -1 ) 
    1699                    nleit_crs(jn) = nleit_crs(jn) + jpreci            
    1700                    nlcit_crs(jn) = nleit_crs(jn) + jpreci 
    1701                    nldit_crs(jn) = nldit(jn)  
     1994        ! Calcul suivant un decoupage en i 
     1995        DO jn = 1, jpni 
     1996           IF( jn == 1 ) THEN           
     1997              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) 
     1998           ELSE 
     1999              nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) & 
     2000                 &          - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) )  / nn_factx, wp) ) 
     2001           ENDIF 
     2002 
     2003           SELECT CASE( ibonit(jn) ) 
     2004              CASE ( -1 ) 
     2005                 nleit_crs(jn) = nleit_crs(jn) + jpreci            
     2006                 nlcit_crs(jn) = nleit_crs(jn) + jpreci 
     2007                 nldit_crs(jn) = nldit(jn)  
    17022008               
    1703                  CASE ( 0 ) 
    1704                    nleit_crs(jn) = nleit_crs(jn) + jpreci 
    1705                    nlcit_crs(jn) = nleit_crs(jn) + jpreci 
    1706                    nldit_crs(jn) = nldit(jn)  
     2009              CASE ( 0 ) 
     2010                 nleit_crs(jn) = nleit_crs(jn) + jpreci 
     2011                 nlcit_crs(jn) = nleit_crs(jn) + jpreci 
     2012                 nldit_crs(jn) = nldit(jn)  
    17072013                 
    1708                  CASE ( 1, 2 ) 
    1709                    IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )    nleit_crs(jn) = nleit_crs(jn) + 1 
    1710                    nleit_crs(jn) = nleit_crs(jn) + jpreci 
    1711                    nlcit_crs(jn) = nleit_crs(jn) 
    1712                    nldit_crs(jn) = nldit(jn)  
    1713                  
    1714                  CASE DEFAULT 
    1715                     STOP 
    1716               END SELECT 
    1717  
    1718               nimppt_crs(jn) =ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
    1719               DO jj = jn+jpni , jpnij, jpni 
    1720                  nleit_crs(jj) = nleit_crs(jn)  
    1721                  nlcit_crs(jj) = nlcit_crs(jn) 
    1722                  nldit_crs(jj) = nldit_crs(jn) 
    1723                  nimppt_crs(jj)= nimppt_crs(jn) 
    1724               ENDDO 
    1725            ENDDO  
     2014              CASE ( 1, 2 ) 
     2015                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1 
     2016                 nleit_crs(jn) = nleit_crs(jn) + jpreci 
     2017                 nlcit_crs(jn) = nleit_crs(jn) 
     2018                 nldit_crs(jn) = nldit(jn)  
     2019 
     2020              CASE DEFAULT 
     2021                 STOP 
     2022           END SELECT 
     2023 
     2024           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
     2025           DO jj = jn + jpni , jpnij, jpni 
     2026              nleit_crs(jj) = nleit_crs(jn)  
     2027              nlcit_crs(jj) = nlcit_crs(jn) 
     2028              nldit_crs(jj) = nldit_crs(jn) 
     2029              nimppt_crs(jj)= nimppt_crs(jn) 
     2030           ENDDO 
     2031         ENDDO  
    17262032         
    17272033         nlei_crs  = nleit_crs(nproc + 1)  
    … …  
    17302036         nimpp_crs = nimppt_crs(nproc + 1) 
    17312037 
    1732          ! rajouter la condition stop 
     2038         ! No coarsening with zoom 
    17332039         IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP  
     2040 
    17342041         DO ji = 1, jpi_crs 
    17352042            mig_crs(ji) = ji + nimpp_crs - 1 
    … …  
    17372044         DO jj = 1, jpj_crs 
    17382045            mjg_crs(jj) = jj + njmpp_crs - 1! 
     2046         ENDDO 
     2047        
     2048         DO ji = 1, jpiglo_crs 
     2049            mi0_crs(ji) = MAX( 1, MIN( ji - nimpp_crs + 1 , jpi_crs + 1 ) ) 
     2050            mi1_crs(ji) = MAX( 0, MIN( ji - nimpp_crs + 1 , jpi_crs     ) ) 
     2051         ENDDO 
     2052          
     2053         DO jj = 1, jpjglo_crs 
     2054            mj0_crs(jj) = MAX( 1, MIN( jj - njmpp_crs + 1 , jpj_crs + 1 ) ) 
     2055            mj1_crs(jj) = MAX( 0, MIN( jj - njmpp_crs + 1 , jpj_crs     ) ) 
    17392056         ENDDO 
    17402057 
    … …  
    17732090      
    17742091 
    1775       IF (lwp) THEN 
     2092      IF(lwp) THEN 
    17762093         WRITE(numout,*) 
    17772094         WRITE(numout,*) 'crs_init : coarse grid dimensions' 
    … …  
    17932110         WRITE(numout,*) ' njmpp  = '     , njmpp 
    17942111         WRITE(numout,*) ' njmpp_full  = ', njmpp_full 
    1795          WRITE(numout,*) ' nreci'         , nreci  
    1796    !      WRITE(numout,*) ' nlejt'         , nlejt 
    1797    !      WRITE(numout,*) ' nldjt'         , nldjt 
    1798    !      WRITE(numout,*) ' nlcjt'         , nlcjt 
    1799    !      WRITE(numout,*) ' njmppt'        , njmppt 
    1800    !      WRITE(numout,*) ' nleit'         , nleit 
    1801    !      WRITE(numout,*) ' nldit'         , nldit 
    1802    !      WRITE(numout,*) ' nlcit'         , nlcit          
    1803    !      WRITE(numout,*) ' nimppt'        , nimppt 
    1804    !      WRITE(numout,*) ' nleit_full'    , nleit_full 
    18052112         WRITE(numout,*) 
    18062113      ENDIF 
    18072114       
    1808  
    18092115      CALL dom_grid_glo 
    18102116       
    … …  
    18472153         
    18482154            DO ji = 2, jpiglo_crsm1 
    1849                ijie = (ji*nn_factx)-nn_factx   !cc 
    1850                ijis = ijie-nn_factx+1 
     2155               ijie = ( ji * nn_factx ) - nn_factx   !cc 
     2156               ijis = ijie - nn_factx + 1 
    18512157               mis2_crs(ji) = ijis 
    18522158               mie2_crs(ji) = ijie 
    18532159            ENDDO 
    1854             IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1)  = jpiglo-2   
     2160            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1) = jpiglo - 2   
    18552161 
    18562162            ! Handle first the northernmost bin 
    … …  
    18592165            ENDIF 
    18602166 
    1861             DO jj = 2, jpjglo_crsm1 
    1862                 ijje = ijjgloT-nn_facty*(jj-2) 
    1863                 ijjs = ijje-nn_facty+1                    
    1864                 mjs2_crs(jpjglo_crs-jj+1) = ijjs 
    1865                 mje2_crs(jpjglo_crs-jj+1) = ijje 
     2167            DO jj = 2, jpjglo_crs 
     2168                ijje = ijjgloT - nn_facty * ( jj - 3 ) 
     2169                ijjs = ijje - nn_facty + 1                    
     2170                mjs2_crs(jpjglo_crs-jj+2) = ijjs 
     2171                mje2_crs(jpjglo_crs-jj+2) = ijje 
    18662172            ENDDO 
    18672173 
    … …  
    18722178 
    18732179            DO ji = 2, jpiglo_crsm1 
    1874                ijie = (ji*nn_factx)-nn_factx  
    1875                ijis = ijie-nn_factx+1 
     2180               ijie = ( ji * nn_factx ) - nn_factx  
     2181               ijis = ijie - nn_factx + 1 
    18762182               mis2_crs(ji) = ijis 
    18772183               mie2_crs(ji) = ijie 
    18782184            ENDDO 
    1879             IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo-2  
     2185            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo - 2  
    18802186 
    18812187            ! Treat the northernmost bin separately. 
    18822188            jj = 2 
    1883             ijje = jpj-nn_facty*(jj-2) 
     2189            ijje = jpj - nn_facty * ( jj - 2 ) 
    18842190            IF ( nn_facty == 3 ) THEN   ;  ijjs = ijje - 1  
    18852191            ELSE                        ;  ijjs = ijje - nn_facty + 1 
    … …  
    18902196            ! Now bin the rest, any remainder at the south is lumped in the southern bin 
    18912197            DO jj = 3, jpjglo_crsm1 
    1892                 ijje = jpjglo-nn_facty*(jj-2) 
    1893                 ijjs = ijje-nn_facty+1                   
    1894                 IF ( ijjs <= nn_facty )   ijjs = 2 
    1895                 mjs2_crs(jpj_crs-jj+1) = ijjs 
    1896                 mje2_crs(jpj_crs-jj+1) = ijje 
     2198                ijje = jpjglo - nn_facty * ( jj - 2 ) 
     2199                ijjs = ijje - nn_facty + 1                   
     2200                IF ( ijjs <= nn_facty )  ijjs = 2 
     2201                mjs2_crs(jpj_crs-jj+1)   = ijjs 
     2202                mje2_crs(jpj_crs-jj+1)   = ijje 
    18972203            ENDDO 
    18982204 
    … …  
    19082214 
    19092215     ! Pad the boundaries, do not know if it is necessary 
    1910       mis2_crs(1) = 1             ; mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1    
    1911       mie2_crs(1) = nn_factx      ; mie2_crs(jpiglo_crs) = jpiglo                          
    1912       mje2_crs(1) = mjs2_crs(2)-1 ; mje2_crs(jpjglo_crs) = jpjglo 
    1913       mjs2_crs(1) = 1             ; mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1  
     2216      mis2_crs(2) = 1             ;  mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1    
     2217      mie2_crs(2) = nn_factx      ;  mie2_crs(jpiglo_crs) = jpiglo                          
     2218      ! 
     2219      mjs2_crs(1) = 1 
     2220      mje2_crs(1) = 1 
     2221      ! 
     2222      mje2_crs(2) = mjs2_crs(3)-1 ;  mje2_crs(jpjglo_crs) = jpjglo 
     2223      mjs2_crs(2) = 1             ;  mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1  
    19142224  
    19152225      IF( .NOT. lk_mpp ) THEN      
    … …  
    19282238        ENDDO 
    19292239      ENDIF 
    1930       njstr = mjs_crs(2)  ;   njend = mjs_crs(nlcj_crs - 1) 
     2240      ! 
    19312241      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 
     2242      njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1) 
    19322243      ! 
    19332244   END SUBROUTINE crs_dom_def 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90

    r4015 r4064  
    211211            DO jj = 1,jpj_crs    
    212212               DO ji = 1,jpi_crs 
    213                   ze3tp(ji,jj) = fse3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 
    214                   ze3wp(ji,jj) = fse3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 
     213                  ze3tp(ji,jj) = e3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 
     214                  ze3wp(ji,jj) = e3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1) 
    215215               END DO 
    216216            END DO 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90

    r4029 r4064  
    9090         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity 
    9191         wn_crs   (:,:,:  ) = 0._wp    ! w 
    92          avt_crs  (:,:,:  ) = 0._wp    ! avt 
     92         avs_crs  (:,:,:  ) = 0._wp    ! avt 
    9393         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv 
    9494         rke_crs  (:,:,:  ) = 0._wp    ! rke 
    … …  
    111111      !  Temperature 
    112112      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp 
    113       CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t ) 
     113      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
    114114      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) 
    115115 
    … …  
    120120      !  Salinity 
    121121      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp 
    122       CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t ) 
     122      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
    123123      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) 
    124124 
    … …  
    127127 
    128128      !  U-velocity 
    129       CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk ) 
     129      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    130130      ! 
    131131      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    138138         END DO 
    139139      END DO 
    140       CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk ) 
    141       CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk ) 
     140      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
     141      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 
    142142 
    143143      CALL iom_put( "uoce"  , un_crs )   ! i-current  
    … …  
    146146 
    147147      !  V-velocity 
    148       CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk ) 
     148      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    149149      !                                                                                  
    150150      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp 
    … …  
    157157         END DO 
    158158      END DO 
    159       CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk ) 
    160       CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk ) 
     159      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
     160      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 
    161161  
    162162      CALL iom_put( "voce"  , vn_crs )   ! i-current  
    … …  
    166166      
    167167      !  Kinetic energy 
    168       CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t ) 
     168      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t, psgn=1.0 ) 
    169169      CALL iom_put( "eken", rke_crs ) 
    170170 
    … …  
    184184         ENDDO 
    185185      ENDDO 
    186       CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0  ) 
     186      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0 ) 
    187187      ! 
    188188      CALL iom_put( "hdiv", hdivn_crs )   
    … …  
    191191      !  W-velocity 
    192192      IF( ln_crs_wn ) THEN 
    193          CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk ) 
     193         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 
    194194       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w ) 
    195195      ELSE 
    … …  
    202202      !  free memory 
    203203 
    204       !  avt 
     204      !  avt, avs 
    205205      SELECT CASE ( nn_crs_kz ) 
    206206         CASE ( 0 ) 
    207             CALL crs_dom_ope( avt, 'VOL', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w ) 
     207            CALL crs_dom_ope( fsavs(:,:,:), 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
    208208         CASE ( 1 ) 
    209             CALL crs_dom_ope( avt, 'MAX', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w ) 
     209            CALL crs_dom_ope( fsavs(:,:,:), 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
    210210         CASE ( 2 ) 
    211             CALL crs_dom_ope( avt, 'MIN', 'W', tmask, avt_crs, p_e12=e1e2t, p_e3=zfse3w ) 
     211            CALL crs_dom_ope( fsavs(:,:,:), 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w, psgn=1.0 ) 
    212212      END SELECT 
    213213      ! 
    214       CALL iom_put( "avt", avt_crs )   !  Kz 
     214      CALL iom_put( "avs", avs_crs )   !  Kz 
    215215       
    216216      !  sbc fields   
    217       CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t          )   
    218       CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs   ) 
    219       CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs   ) 
    220       CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs ) 
    221       CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                      ) 
    222       CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs ) 
    223       CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs ) 
    224       CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs ) 
    225       CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs ) 
     217      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t         , psgn=1.0 )   
     218      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs  , psgn=1.0 ) 
     219      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs  , psgn=1.0 ) 
     220      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     221      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                     , psgn=1.0 ) 
     222      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     223      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     224      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     225      CALL crs_dom_ope( sfx  , 'SUM', 'T', tmask, sfx_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
     226      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs, psgn=1.0 ) 
    226227 
    227228      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output  
    … …  
    232233      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output  
    233234      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output  
     235      CALL iom_put( "saltflx"  , sfx_crs  )   ! salt flux output  
    234236      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output  
    235237 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r4015 r4064  
    212212 
    213213     !    3.d.3   Vertical depth (meters) 
    214      CALL crs_dom_ope( gdept, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t )  
    215      CALL crs_dom_ope( gdepw, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w ) 
     214     CALL crs_dom_ope( gdept, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t, psgn=1.0 )  
     215     CALL crs_dom_ope( gdepw, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w, psgn=1.0 ) 
    216216 
    217217 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r3557 r4064  
    4040   REAL(wp), PUBLIC  :: diazolight  = 50._wp     !: Nitrogen fixation sensitivty to light  
    4141   REAL(wp), PUBLIC  :: concfediaz  = 1.E-10_wp  !: Fe half-saturation Cste for diazotrophs  
    42    REAL(wp)          :: hratio      = 9.E-5_wp   !: Fe:3He ratio assumed for vent iron supply 
     42   REAL(wp)          :: hratio      = 1.e+7_wp   !: Fe:3He ratio assumed for vent iron supply 
    4343 
    4444   LOGICAL , PUBLIC  :: ll_sbc 
    … …  
    488488         CALL iom_get  ( numhydro, jpdom_data, TRIM( sn_hydrofe%clvar ), hydrofe(:,:,:), 1 ) 
    489489         CALL iom_close( numhydro ) 
    490          ! 
    491          hydrofe(:,:,:) = ( hydrofe(:,:,:) * hratio ) / ( cvol(:,:,:) * ryyss + rtrn ) / fse3t(:,:,:) 
     490         !                                                        ! factor 1000 to convert from mol/m3 to mol/L 
     491         hydrofe(:,:,:) = ( hydrofe(:,:,:) * hratio ) / ( cvol(:,:,:) * ryyss + rtrn ) / 1000._wp  
    492492         ! 
    493493      ENDIF 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r3680 r4064  
    7575         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    7676 
    77       CALL trc_nam                  ! read passive tracers namelists 
    78       ! 
    79       IF(lwp) WRITE(numout,*) 
    80       IF( ln_rsttr ) THEN 
    81         ! 
    82         IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    83         CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
    84         ! 
    85       ELSE 
    86         IF( lk_offline )  THEN 
    87            neuler = 0                  ! Set time-step indicator at nit000 (euler) 
    88            CALL day_init               ! set calendar 
    89         ENDIF 
    90         ! 
    91       ENDIF 
     77      CALL trc_nam      ! read passive tracers namelists 
     78      ! 
     79      IF(lwp) WRITE(numout,*) 
     80      ! 
     81      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
     82      ! 
    9283      IF(lwp) WRITE(numout,*) 
    9384                                                              ! masked grid volume 
    … …  
    10798      IF( lwp ) THEN 
    10899         ! 
    109          CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     100         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
    110101         ! 
    111102      ENDIF 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r3882 r4064  
    3232   PRIVATE  
    3333 
     34   PUBLIC trc_nam_run  ! called in trcini 
    3435   PUBLIC trc_nam      ! called in trcini 
    3536 
    … …  
    4445CONTAINS 
    4546 
     47 
    4648   SUBROUTINE trc_nam 
    4749      !!--------------------------------------------------------------------- 
    … …  
    5456      !!                ( (PISCES, CFC, MY_TRC ) 
    5557      !!--------------------------------------------------------------------- 
    56       INTEGER ::  jn, ierr 
    57       ! Definition of a tracer as a structure 
    58       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    59       !! 
    60       NAMELIST/namtrc/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, & 
    61          &             cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, & 
    62          &             ln_trcdmp, ln_trcdmp_clo, ln_top_euler 
    63 #if defined key_trdmld_trc  || defined key_trdtrc 
    64       NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    65          &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, & 
    66          &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    67 #endif 
    68       NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    69  
    70       !!--------------------------------------------------------------------- 
    71  
    72       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    73       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    74  
    75       CALL ctl_opn( numnat, 'namelist_top', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
    76  
    77       ! Namelist nattrc (files) 
    78       ! ---------------------------------------------- 
    79       nn_dttrc      = 1                 ! default values 
    80       nn_writetrc   = 10  
    81       ln_top_euler  = .FALSE. 
    82       ln_rsttr      = .FALSE. 
    83       nn_rsttr      =  0 
    84       cn_trcrst_in  = 'restart_trc' 
    85       cn_trcrst_out = 'restart_trc' 
    86       ! 
    87       DO jn = 1, jptra 
    88          WRITE( sn_tracer(jn)%clsname,'("TR_",I1)'           ) jn 
    89          WRITE( sn_tracer(jn)%cllname,'("TRACER NUMBER ",I1)') jn 
    90          sn_tracer(jn)%clunit  = 'mmole/m3' 
    91          sn_tracer(jn)%llinit  = .FALSE. 
    92          sn_tracer(jn)%llsave  = .TRUE. 
    93       END DO 
    94       ln_trcdta     = .FALSE. 
    95       ln_trcdmp     = .FALSE. 
    96       ln_trcdmp_clo = .FALSE. 
    97  
    98  
    99       REWIND( numnat )               ! read nattrc 
    100       READ  ( numnat, namtrc ) 
    101  
    102       DO jn = 1, jptra 
    103          ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname ) 
    104          ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname ) 
    105          ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    106          ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
    107          ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    108       END DO 
    109  
    110       !!KPE  computes the first time step of tracer model 
    111       nittrc000 = nit000 + nn_dttrc - 1 
    112   
     58      INTEGER ::  jn 
     59 
     60      !                                        !   Parameters of the run  
     61      IF( .NOT. lk_offline ) CALL trc_nam_run 
     62       
     63      !                                        !  passive tracer informations 
     64      CALL trc_nam_trc 
     65       
     66      !                                        !   Parameters of additional diagnostics 
     67      CALL trc_nam_dia 
     68 
     69      !                                        !   namelist of transport 
     70      CALL trc_nam_trp 
     71 
     72 
     73      IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
     74      ! 
     75      IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
     76      ! 
     77      IF( .NOT.ln_trcdta ) THEN 
     78         ln_trc_ini(:) = .FALSE. 
     79      ENDIF 
     80 
    11381 
    11482      IF(lwp) THEN                   ! control print 
    11583         WRITE(numout,*) 
    11684         WRITE(numout,*) ' Namelist : namtrc' 
    117          WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
    118          WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
    119          WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
    120          WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000 
    121          WRITE(numout,*) '   frequency of outputs for passive tracers     nn_writetrc   = ', nn_writetrc   
    12285         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
    12386         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
    12487         WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    125          WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    12688         WRITE(numout,*) ' ' 
    12789         DO jn = 1, jptra 
    … …  
    13193      ENDIF 
    13294 
     95      IF(lwp) THEN                   ! control print 
     96         IF( ln_rsttr ) THEN 
     97            WRITE(numout,*) 
     98            WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
     99            WRITE(numout,*) 
     100         ENDIF 
     101         IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN 
     102            WRITE(numout,*) 
     103            WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies ' 
     104            WRITE(numout,*) 
     105         ENDIF 
     106         IF( .NOT.ln_trcdta ) THEN 
     107            WRITE(numout,*) 
     108            WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
     109            WRITE(numout,*) 
     110         ENDIF 
     111      ENDIF 
     112 
     113       
    133114      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
    134115   
    … …  
    137118        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    138119        WRITE(numout,*)  
    139       ENDIF 
    140  
    141       ln_diatrc = .FALSE. 
    142       ln_diabio = .FALSE. 
    143       nn_writedia = 10 
    144       nn_writebio = 10 
    145  
    146       REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic 
    147       READ  ( numnat, namtrc_dia ) 
    148  
    149       IF(lwp) THEN 
    150          WRITE(numout,*) 
    151          WRITE(numout,*) 
    152          WRITE(numout,*) ' Namelist : namtrc_dia' 
    153          WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc 
    154          WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio 
    155          WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia 
    156          WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
    157          WRITE(numout,*) ' ' 
    158       ENDIF 
    159  
    160       IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
    161          ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    162            &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
    163            &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr )  
    164          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' ) 
    165          ! 
    166          trc2d(:,:,:  ) = 0._wp  ;   ctrc2d(:) = ' '   ;   ctrc2l(:) = ' '    ;    ctrc2u(:) = ' '  
    167          trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    168          ! 
    169       ENDIF 
    170  
    171       IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
    172          ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 
    173            &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr )  
    174          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' ) 
    175          ! 
    176          trbio(:,:,:,:) = 0._wp  ;   ctrbio(:) = ' '   ;   ctrbil(:) = ' '    ;    ctrbiu(:) = ' '  
    177          ! 
    178       ENDIF 
    179  
    180       ! namelist of transport 
    181       ! --------------------- 
    182       CALL trc_nam_trp 
    183  
    184  
    185       IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
    186       ! 
    187       IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
    188       ! 
    189       IF( .NOT.ln_trcdta ) THEN 
    190          ln_trc_ini(:) = .FALSE. 
    191       ENDIF 
    192  
    193       IF(lwp) THEN                   ! control print 
    194          IF( ln_rsttr ) THEN 
    195             WRITE(numout,*) 
    196             WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
    197             WRITE(numout,*) 
    198          ENDIF 
    199          IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN 
    200             WRITE(numout,*) 
    201             WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies ' 
    202             WRITE(numout,*) 
    203          ENDIF 
    204          IF( .NOT.ln_trcdta ) THEN 
    205             WRITE(numout,*) 
    206             WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
    207             WRITE(numout,*) 
    208          ENDIF 
    209120      ENDIF 
    210121 
    … …  
    260171   END SUBROUTINE trc_nam 
    261172 
     173   SUBROUTINE trc_nam_run 
     174      !!--------------------------------------------------------------------- 
     175      !!                     ***  ROUTINE trc_nam  *** 
     176      !! 
     177      !! ** Purpose :   read options for the passive tracer run (namelist)  
     178      !! 
     179      !!--------------------------------------------------------------------- 
     180      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
     181        &                  cn_trcrst_in, cn_trcrst_out 
     182 
     183      !!--------------------------------------------------------------------- 
     184 
     185      IF(lwp) WRITE(numout,*)  
     186      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 
     187      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     188 
     189      CALL ctl_opn( numnat, 'namelist_top', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     190 
     191      ! Namelist nattrc (files) 
     192      ! ---------------------------------------------- 
     193      nn_dttrc      = 1                 ! default values 
     194      nn_writetrc   = 10  
     195      ln_top_euler  = .FALSE. 
     196      ln_rsttr      = .FALSE. 
     197      nn_rsttr      =  0 
     198      cn_trcrst_in  = 'restart_trc' 
     199      cn_trcrst_out = 'restart_trc' 
     200      ! 
     201      REWIND( numnat )               ! read nattrc 
     202      READ  ( numnat, namtrc_run ) 
     203 
     204      !  computes the first time step of tracer model 
     205      nittrc000 = nit000 + nn_dttrc - 1 
     206 
     207      IF(lwp) THEN                   ! control print 
     208         WRITE(numout,*) 
     209         WRITE(numout,*) ' Namelist : namtrc' 
     210         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
     211         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
     212         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
     213         WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000 
     214         WRITE(numout,*) '   frequency of outputs for passive tracers     nn_writetrc   = ', nn_writetrc   
     215         WRITE(numout,*) ' ' 
     216      ENDIF 
     217      ! 
     218    END SUBROUTINE trc_nam_run 
     219 
     220 
     221   SUBROUTINE trc_nam_trc 
     222      !!--------------------------------------------------------------------- 
     223      !!                     ***  ROUTINE trc_nam  *** 
     224      !! 
     225      !! ** Purpose :   read options for the passive tracer run (namelist)  
     226      !! 
     227      !!--------------------------------------------------------------------- 
     228      INTEGER ::  jn 
     229      ! Definition of a tracer as a structure 
     230      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     231      !! 
     232      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
     233 
     234      !!--------------------------------------------------------------------- 
     235 
     236      IF(lwp) WRITE(numout,*)  
     237      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     238      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     239 
     240      ! 
     241      DO jn = 1, jptra 
     242         WRITE( sn_tracer(jn)%clsname,'("TR_",I1)'           ) jn 
     243         WRITE( sn_tracer(jn)%cllname,'("TRACER NUMBER ",I1)') jn 
     244         sn_tracer(jn)%clunit  = 'mmole/m3' 
     245         sn_tracer(jn)%llinit  = .FALSE. 
     246         sn_tracer(jn)%llsave  = .TRUE. 
     247      END DO 
     248      ln_trcdta     = .FALSE. 
     249      ln_trcdmp     = .FALSE. 
     250      ln_trcdmp_clo = .FALSE. 
     251 
     252      REWIND( numnat )               ! read nattrc 
     253      READ  ( numnat, namtrc ) 
     254 
     255      DO jn = 1, jptra 
     256         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname ) 
     257         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname ) 
     258         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
     259         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     260         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
     261      END DO 
     262       
     263    END SUBROUTINE trc_nam_trc 
     264 
     265 
     266   SUBROUTINE trc_nam_dia 
     267      !!--------------------------------------------------------------------- 
     268      !!                     ***  ROUTINE trc_nam_dia  *** 
     269      !! 
     270      !! ** Purpose :   read options for the passive tracer diagnostics 
     271      !! 
     272      !! ** Method  : - read passive tracer namelist  
     273      !!              - read namelist of each defined SMS model 
     274      !!                ( (PISCES, CFC, MY_TRC ) 
     275      !!--------------------------------------------------------------------- 
     276      INTEGER ::  ierr 
     277#if defined key_trdmld_trc  || defined key_trdtrc 
     278      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     279         &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, & 
     280         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     281#endif 
     282      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
     283 
     284      !!--------------------------------------------------------------------- 
     285 
     286      IF(lwp) WRITE(numout,*)  
     287      IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 
     288      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     289 
     290      ln_diatrc = .FALSE. 
     291      ln_diabio = .FALSE. 
     292      nn_writedia = 10 
     293      nn_writebio = 10 
     294 
     295      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic 
     296      READ  ( numnat, namtrc_dia ) 
     297 
     298      IF(lwp) THEN 
     299         WRITE(numout,*) 
     300         WRITE(numout,*) 
     301         WRITE(numout,*) ' Namelist : namtrc_dia' 
     302         WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc 
     303         WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio 
     304         WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia 
     305         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
     306         WRITE(numout,*) ' ' 
     307      ENDIF 
     308 
     309      IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     310         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
     311           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
     312           &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr )  
     313         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' ) 
     314         ! 
     315         trc2d(:,:,:  ) = 0._wp  ;   ctrc2d(:) = ' '   ;   ctrc2l(:) = ' '    ;    ctrc2u(:) = ' '  
     316         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
     317         ! 
     318      ENDIF 
     319 
     320      IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     321         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 
     322           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr )  
     323         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' ) 
     324         ! 
     325         trbio(:,:,:,:) = 0._wp  ;   ctrbio(:) = ' '   ;   ctrbil(:) = ' '    ;    ctrbiu(:) = ' '  
     326         ! 
     327      ENDIF 
     328      ! 
     329   END SUBROUTINE trc_nam_dia 
     330 
    262331#else 
    263332   !!---------------------------------------------------------------------- 
    … …  
    267336   SUBROUTINE trc_nam                      ! Empty routine    
    268337   END SUBROUTINE trc_nam 
     338   SUBROUTINE trc_nam_run                      ! Empty routine    
     339   END SUBROUTINE trc_nam_run 
    269340#endif 
    270341 

  • branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r3680 r4064  
    197197 
    198198         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
     199 
    199200         IF(lwp) THEN 
    200201            WRITE(numout,*) ' *** Info read in restart : ' 
    … …  
    216217            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN 
    217218               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 ) 
    218                IF( zrdttrc1 /= rdttrc(1) )   neuler = 0 
     219               IF( zrdttrc1 /= rdt * nn_dttrc )   neuler = 0 
    219220            ENDIF 
    220221            !                          ! define ndastp and adatrj 
    221             IF ( nn_rsttr == 2 ) THEN 
     222            IF( nn_rsttr == 2 ) THEN 
    222223               CALL iom_get( numrtr, 'ndastp', zndastp )  
    223224               ndastp = NINT( zndastp ) 
Note: See TracChangeset for help on using the changeset viewer.