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 7277 for branches/2016/dev_CNRS_2016 – NEMO

Ignore:
Timestamp:
2016-11-21T09:55:07+01:00 (7 years ago)
Author:
flavoni
Message:

update 2016 branch with simplif-2

Location:
branches/2016/dev_CNRS_2016/NEMOGCM
Files:
8 deleted
127 edited
6 copied

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg

    r6140 r7277  
    2020&namcfg        !   parameters of the configuration 
    2121!----------------------------------------------------------------------- 
    22    cp_cfg      =  "amm"                !  name of the configuration 
    23    jp_cfg      =     011               !  resolution of the configuration 
    24    jpidta      =     198               !  1st lateral dimension ( >= jpi ) 
    25    jpjdta      =     224               !  2nd    "         "    ( >= jpj ) 
    26    jpkdta      =      51               !  number of levels      ( >= jpk ) 
    27    jpiglo      =     198               !  1st dimension of global domain --> i =jpidta 
    28    jpjglo      =     224               !  2nd    -                  -    --> j  =jpjdta 
    29    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    30    jpjzoom     =       1               !  in data domain indices 
    31    jperio      =       0               !  lateral cond. type (between 0 and 6) 
    32 / 
    33 !----------------------------------------------------------------------- 
    34 &namzgr        !   vertical coordinate 
    35 !----------------------------------------------------------------------- 
    36    ln_sco      = .true.    !  s- or hybrid z-s-coordinate 
    37 / 
    38 !----------------------------------------------------------------------- 
    39 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate 
    40 !----------------------------------------------------------------------- 
    41    ln_s_sh94   = .false.   !  Song & Haidvogel 1994 hybrid S-sigma   (T)| 
    42    ln_s_sf12   = .true.    !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied 
    43    ln_sigcrit  = .true.    !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch 
    44                            !  stretching coefficients for all functions 
    45    rn_hc       =   50.0    !  critical depth for transition to stretched coordinates 
    46 / 
     22   ln_read_cfg = .true.   !  (=T) read the domain configuration file 
     23      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     24      cn_domcfg = "AMM_R12_sco_domcfg"     ! domain configuration filename 
     25/ 
     26 
    4727!----------------------------------------------------------------------- 
    4828&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    4929!----------------------------------------------------------------------- 
    5030   rn_rdt      =   600.    !  time step for the dynamics (and tracer if nn_acc=0) 
    51    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    52    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    53    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    54    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    55    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    56    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    57    ppsur       =  999999.0             !  ORCA r4, r2 and r05 coefficients 
    58    ppa0        =  999999.0             ! (default coefficients) 
    59    ppa1        =  999999.0             ! 
    60    ppkth       =      23.563           ! 
    61    ppacr       =       9.0             ! 
    62    ppdzmin     =       6.0             !  Minimum vertical spacing 
    63    pphmax      =    5720.              !  Maximum depth 
    64    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    65    ppa2        =  999999.              !  Double tanh function parameters 
    66    ppkth2      =  999999.              ! 
    67    ppacr2      =  999999. 
    6831/ 
    6932!----------------------------------------------------------------------- 
    7033&namcrs        !   Grid coarsening for dynamics output and/or 
    71                !   passive tracer coarsened online simulations 
     34!              !   passive tracer coarsened online simulations 
    7235!----------------------------------------------------------------------- 
    7336/ 
    … …  
    8346   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    8447                           !     (also = the frequency of sea-ice model call) 
    85    ln_flx      = .true.    !  flux formulation       (T => fill namsbc_flx ) 
     48   ln_flx      = .true.    !  flux formulation                          (T => fill namsbc_flx ) 
    8649   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
    8750   nn_ice      = 0         !  =0 no ice boundary condition   , 
    … …  
    9154   ln_traqsr   = .false.   !  Light penetration (T) or not (F) 
    9255 
    93 / 
    94 !----------------------------------------------------------------------- 
    95 &namsbc_ana    !   analytical surface boundary condition 
    96 !----------------------------------------------------------------------- 
    9756/ 
    9857!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm

    r6140 r7277  
    1  bld::tool::fppkeys  key_bdy key_tide key_zdfgls key_diainstant key_mpp_mpi key_iomput 
     1 bld::tool::fppkeys  key_bdy key_tide key_zdfgls key_diainstant key_mpp_mpi key_iomput key_mpp_rep 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg

    r6140 r7277  
    1818   cp_cfg      =  "papa"                 !  name of the configuration 
    1919   jp_cfg      =       1                 !  resolution of the configuration 
    20    jpidta      =       3                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2 
    21    jpjdta      =       3                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2  
    22    jpkdta      =      75                 !  number of levels      ( >= jpk ) 
    23    jpiglo      =       3                 !  1st dimension of global domain --> i  = jpidta 
    24    jpjglo      =       3                 !  2nd    -                  -    --> j  = jpjdta 
    25    jpizoom     =       1                 !  left bottom (i,j) indices of the zoom 
    26    jpjzoom     =       1                 !  in data domain indices 
     20!   jpidta      =       3                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2 
     21!   jpjdta      =       3                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2  
     22!   jpkdta      =      75                 !  number of levels      ( >= jpk ) 
     23!   jpiglo      =       3                 !  1st dimension of global domain --> i  = jpidta 
     24!   jpjglo      =       3                 !  2nd    -                  -    --> j  = jpjdta 
    2725   jperio      =       0                 !  lateral cond. type (between 0 and 6) 
    2826/ 
    … …  
    4341   nn_msh      =    0      !  create (=1) a mesh file or not (=0) 
    4442   rn_rdt      =  360.     !  time step for the dynamics  
    45    jphgr_msh   =       1                 !  type of horizontal mesh 
    4643   ppglam0     =    -150.0               !  longitude of first raw and column T-point (jphgr_msh = 1) 
    4744   ppgphi0     =      50.0               ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    … …  
    9592/ 
    9693!----------------------------------------------------------------------- 
    97 &namsbc_ana    !   analytical surface boundary condition 
    98 !----------------------------------------------------------------------- 
    99 / 
    100 !----------------------------------------------------------------------- 
    10194&namsbc_flx    !   surface boundary condition : flux formulation 
    10295!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg

    r6140 r7277  
    33!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    44!----------------------------------------------------------------------- 
     5&namusr_def    !   GYRE user defined namelist   
     6!----------------------------------------------------------------------- 
     7   nn_GYRE     =     1     !  GYRE resolution [1/degrees] 
     8   ln_bench    = .false.   !  ! =T benchmark with gyre: the gridsize is kept constant 
     9   jpkglo      =    31     !  number of model levels 
     10/ 
     11 
     12!----------------------------------------------------------------------- 
    513&namrun        !   parameters of the run 
    614!----------------------------------------------------------------------- 
    715   cn_exp      =  "GYRE"   !  experience name 
    816   nn_it000    =       1   !  first time step 
    9    nn_itend    =    4320   !  last  time step 
     17   nn_itend    =    4320   !!gm 4320   !  last  time step 
    1018   nn_leapy    =      30   !  Leap year calendar (1) or not (0) 
    1119   nn_stock    =    4320   !  frequency of creation of a restart file (modulo referenced to 1) 
    … …  
    1321 
    1422   ln_clobber  = .true.    !  clobber (overwrite) an existing file 
    15  
    1623/ 
    1724!----------------------------------------------------------------------- 
    1825&namcfg     !   parameters of the configuration    
    1926!----------------------------------------------------------------------- 
    20    cp_cfg      =  "gyre"                 !  name of the configuration 
    21    jp_cfg      =       1                 !  resolution of the configuration 
    22    jpidta      =      32                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2 
    23    jpjdta      =      22                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2  
    24    jpkdta      =      31                 !  number of levels      ( >= jpk ) 
    25    jpiglo      =      32                 !  1st dimension of global domain --> i  = jpidta 
    26    jpjglo      =      22                 !  2nd    -                  -    --> j  = jpjdta 
    27    jpizoom     =       1                 !  left bottom (i,j) indices of the zoom 
    28    jpjzoom     =       1                 !  in data domain indices 
    29    jperio      =       0                 !  lateral cond. type (between 0 and 6) 
    30 / 
    31 !----------------------------------------------------------------------- 
    32 &namzgr        !   vertical coordinate 
    33 !----------------------------------------------------------------------- 
    34    ln_zco      = .true.    !  z-coordinate - full    steps 
    35    ln_linssh   = .true.    !  linear free surface 
    36 / 
    37 !----------------------------------------------------------------------- 
    38 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate 
    39 !----------------------------------------------------------------------- 
     27   ln_read_cfg = .false.   !  (=T) read the domain configuration file 
     28      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     29   ln_write_cfg= .false.   !  (=T) create the domain configuration file 
     30   ! 
    4031/ 
    4132!----------------------------------------------------------------------- 
    4233&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    4334!----------------------------------------------------------------------- 
    44    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file 
    45    rn_rdt      = 7200.     !  time step for the dynamics  
    46    jphgr_msh   =       5                 !  type of horizontal mesh 
    47    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1) 
    48    ppgphi0     =      29.0               ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    49    ppe1_deg    =  999999.0               !  zonal      grid-spacing (degrees) 
    50    ppe2_deg    =  999999.0               !  meridional grid-spacing (degrees) 
    51    ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees) 
    52    ppe2_m      =  999999.0               !  meridional grid-spacing (degrees) 
    53    ppsur       =   -2033.194295283385    !  ORCA r4, r2 and r05 coefficients 
    54    ppa0        =     155.8325369664153   ! (default coefficients) 
    55    ppa1        =     146.3615918601890   ! 
    56    ppkth       =      17.28520372419791  ! 
    57    ppacr       =       5.0               ! 
    58    ppdzmin     =  999999.0               !  Minimum vertical spacing 
    59    pphmax      =  999999.0               !  Maximum depth 
    60    ldbletanh   =  .FALSE.                !  Use/do not use double tanf function for vertical coordinates 
    61    ppa2        =  999999.0               !  Double tanh function parameters 
    62    ppkth2      =  999999.0               ! 
    63    ppacr2      =  999999.0               ! 
     35   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
     36   ! 
     37   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     38   ! 
     39   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0) 
    6440/ 
    6541!----------------------------------------------------------------------- 
    6642&namcrs        !   Grid coarsening for dynamics output and/or 
    67                !   passive tracer coarsened online simulations 
     43!              !   passive tracer coarsened online simulations 
    6844!----------------------------------------------------------------------- 
    6945/ 
    … …  
    8056   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    8157   !                       !     (also = the frequency of sea-ice model call) 
    82    ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    83    ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
     58   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc) 
    8459   nn_ice      = 0         !  =0 no ice boundary condition   , 
    8560   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm

    r5930 r7277  
    1  bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_zdftke key_iomput key_mpp_mpi key_nosignedzero key_mpp_rep 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg

    r6140 r7277  
    2222&namcfg     !   parameters of the configuration    
    2323!----------------------------------------------------------------------- 
    24    cp_cfg      =  "gyre"                 !  name of the configuration 
    25    jp_cfg      =       1                 !  resolution of the configuration 
    26    jpidta      =      32                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2 
    27    jpjdta      =      22                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2  
    28    jpkdta      =      31                 !  number of levels      ( >= jpk ) 
    29    jpiglo      =      32                 !  1st dimension of global domain --> i  = jpidta 
    30    jpjglo      =      22                 !  2nd    -                  -    --> j  = jpjdta 
    31    jpizoom     =       1                 !  left bottom (i,j) indices of the zoom 
    32    jpjzoom     =       1                 !  in data domain indices 
    33    jperio      =       0                 !  lateral cond. type (between 0 and 6) 
    34 / 
    35 &namzgr        !   vertical coordinate 
    36 !----------------------------------------------------------------------- 
    37    ln_zco      = .true.    !  z-coordinate - full    steps 
    38    ln_linssh   = .true.   !  linear free surface 
    39 / 
    40 !----------------------------------------------------------------------- 
    41 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate 
    42 !----------------------------------------------------------------------- 
     24   ln_read_cfg = .false.   !  (=T) read the domain configuration file 
     25      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     26   ln_write_cfg= .false.   !  (=T) create the domain configuration file 
    4327/ 
    4428!----------------------------------------------------------------------- 
    4529&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    4630!----------------------------------------------------------------------- 
    47    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file 
    48    rn_rdt      = 7200.     !  time step for the dynamics  
    49    jphgr_msh   =       5                 !  type of horizontal mesh 
    50    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1) 
    51    ppgphi0     =      29.0               ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    52    ppe1_deg    =  999999.0               !  zonal      grid-spacing (degrees) 
    53    ppe2_deg    =  999999.0               !  meridional grid-spacing (degrees) 
    54    ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees) 
    55    ppe2_m      =  999999.0               !  meridional grid-spacing (degrees) 
    56    ppsur       =   -2033.194295283385    !  ORCA r4, r2 and r05 coefficients 
    57    ppa0        =     155.8325369664153   ! (default coefficients) 
    58    ppa1        =     146.3615918601890   ! 
    59    ppkth       =      17.28520372419791  ! 
    60    ppacr       =       5.0               ! 
    61    ppdzmin     =  999999.0               !  Minimum vertical spacing 
    62    pphmax      =  999999.0               !  Maximum depth 
    63    ldbletanh   =  .FALSE.                !  Use/do not use double tanf function for vertical coordinates 
    64    ppa2        =  999999.0               !  Double tanh function parameters 
    65    ppkth2      =  999999.0               ! 
    66    ppacr2      =  999999.0               ! 
     31   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
     32   ! 
     33   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     34   ! 
     35   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0) 
    6736/ 
    6837!----------------------------------------------------------------------- 
    … …  
    8554   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    8655                           !     (also = the frequency of sea-ice model call) 
    87    ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    88    ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
     56   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc) 
    8957   nn_ice      = 0         !  =0 no ice boundary condition   , 
    9058   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 
    9159   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    9260   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
    93 / 
    94 !----------------------------------------------------------------------- 
    95 &namsbc_ana    !   analytical surface boundary condition 
    96 !----------------------------------------------------------------------- 
    97    nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps 
    98    rn_utau0    =   0.1e0   !  uniform value for the i-stress 
    9961/ 
    10062!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm

    r5930 r7277  
    1 bld::tool::fppkeys key_zdftke key_top key_my_trc key_mpp_mpi key_iomput 
     1bld::tool::fppkeys key_zdftke key_top key_my_trc key_mpp_mpi key_iomput key_mpp_rep 
    22inc $BFMDIR/src/nemo/bfm.fcm 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg

    r6140 r7277  
    1515&namcfg     !   parameters of the configuration    
    1616!----------------------------------------------------------------------- 
    17    cp_cfg      =  "gyre"                 !  name of the configuration 
    18    jp_cfg      =       1                 !  resolution of the configuration 
    19    jpidta      =      32                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2 
    20    jpjdta      =      22                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2  
    21    jpkdta      =      31                 !  number of levels      ( >= jpk ) 
    22    jpiglo      =      32                 !  1st dimension of global domain --> i  = jpidta 
    23    jpjglo      =      22                 !  2nd    -                  -    --> j  = jpjdta 
    24    jpizoom     =       1                 !  left bottom (i,j) indices of the zoom 
    25    jpjzoom     =       1                 !  in data domain indices 
    26    jperio      =       0                 !  lateral cond. type (between 0 and 6) 
    27 / 
    28 !----------------------------------------------------------------------- 
    29 &namzgr        !   vertical coordinate 
    30 !----------------------------------------------------------------------- 
    31    ln_zco      = .true.    !  z-coordinate - full    steps 
    32    ln_linssh   = .true.    !  linear free surface 
     17   ln_read_cfg = .false.   !  (=T) read the domain configuration file 
     18      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     19   ln_write_cfg= .false.   !  (=T) create the domain configuration file 
    3320/ 
    3421!----------------------------------------------------------------------- 
    3522&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3623!----------------------------------------------------------------------- 
    37    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file 
    38    rn_rdt      = 7200.     !  time step for the dynamics  
    39    jphgr_msh   =       5                 !  type of horizontal mesh 
    40    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1) 
    41    ppgphi0     =      29.0               ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    42    ppe1_deg    =  999999.0               !  zonal      grid-spacing (degrees) 
    43    ppe2_deg    =  999999.0               !  meridional grid-spacing (degrees) 
    44    ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees) 
    45    ppe2_m      =  999999.0               !  meridional grid-spacing (degrees) 
    46    ppsur       =   -2033.194295283385    !  ORCA r4, r2 and r05 coefficients 
    47    ppa0        =     155.8325369664153   ! (default coefficients) 
    48    ppa1        =     146.3615918601890   ! 
    49    ppkth       =      17.28520372419791  ! 
    50    ppacr       =       5.0               ! 
    51    ppdzmin     =  999999.0               !  Minimum vertical spacing 
    52    pphmax      =  999999.0               !  Maximum depth 
    53    ldbletanh   =  .FALSE.                !  Use/do not use double tanf function for vertical coordinates 
    54    ppa2        =  999999.0               !  Double tanh function parameters 
    55    ppkth2      =  999999.0               ! 
    56    ppacr2      =  999999.0               ! 
     24   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
     25   ! 
     26   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     27   ! 
     28   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0) 
    5729/ 
    5830!----------------------------------------------------------------------- 
    … …  
    7345   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    7446                           !     (also = the frequency of sea-ice model call) 
    75    ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    76    ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
     47   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc) 
    7748   nn_ice      = 0         !  =0 no ice boundary condition   , 
    7849   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg

    r6140 r7277  
    1515&namcfg     !   parameters of the configuration    
    1616!----------------------------------------------------------------------- 
    17    cp_cfg      =  "gyre"                 !  name of the configuration 
    18    jp_cfg      =       1                 !  resolution of the configuration 
    19    jpidta      =      32                 !  1st lateral dimension ( >= jpi ) = 30*jp_cfg+2 
    20    jpjdta      =      22                 !  2nd    "         "    ( >= jpj ) = 20*jp_cfg+2  
    21    jpkdta      =      31                 !  number of levels      ( >= jpk ) 
    22    jpiglo      =      32                 !  1st dimension of global domain --> i  = jpidta 
    23    jpjglo      =      22                 !  2nd    -                  -    --> j  = jpjdta 
    24    jpizoom     =       1                 !  left bottom (i,j) indices of the zoom 
    25    jpjzoom     =       1                 !  in data domain indices 
    26    jperio      =       0                 !  lateral cond. type (between 0 and 6) 
    27 / 
    28 !----------------------------------------------------------------------- 
    29 &namzgr        !   vertical coordinate 
    30 !----------------------------------------------------------------------- 
    31    ln_zco      = .true.    !  z-coordinate - full    steps 
    32    ln_linssh   = .true.    !  linear free surface 
    33 / 
    34 !----------------------------------------------------------------------- 
    35 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate 
    36 !----------------------------------------------------------------------- 
     17   ln_read_cfg = .false.   !  (=T) read the domain configuration file 
     18      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     19   ln_write_cfg= .false.   !  (=T) create the domain configuration file 
    3720/ 
    3821!----------------------------------------------------------------------- 
    3922&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    4023!----------------------------------------------------------------------- 
    41    nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file 
    42    rn_rdt      = 7200.     !  time step for the dynamics  
    43 !   nn_baro     =   60      !  number of barotropic time step            ("key_dynspg_ts") 
    44    jphgr_msh   =       5                 !  type of horizontal mesh 
    45    ppglam0     =       0.0               !  longitude of first raw and column T-point (jphgr_msh = 1) 
    46    ppgphi0     =      29.0               ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    47    ppe1_deg    =  999999.0               !  zonal      grid-spacing (degrees) 
    48    ppe2_deg    =  999999.0               !  meridional grid-spacing (degrees) 
    49    ppe1_m      =  999999.0               !  zonal      grid-spacing (degrees) 
    50    ppe2_m      =  999999.0               !  meridional grid-spacing (degrees) 
    51    ppsur       =   -2033.194295283385    !  ORCA r4, r2 and r05 coefficients 
    52    ppa0        =     155.8325369664153   ! (default coefficients) 
    53    ppa1        =     146.3615918601890   ! 
    54    ppkth       =      17.28520372419791  ! 
    55    ppacr       =       5.0               ! 
    56    ppdzmin     =  999999.0               !  Minimum vertical spacing 
    57    pphmax      =  999999.0               !  Maximum depth 
    58    ldbletanh   =  .FALSE.                !  Use/do not use double tanf function for vertical coordinates 
    59    ppa2        =  999999.0               !  Double tanh function parameters 
    60    ppkth2      =  999999.0               ! 
    61    ppacr2      =  999999.0               ! 
     24   ln_linssh   = .true.    !  =T  linear free surface  ==>>  model level are fixed in time 
     25   ! 
     26   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     27   ! 
     28   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0) 
    6229/ 
    6330!----------------------------------------------------------------------- 
    … …  
    6936&namtsd    !   data : Temperature  & Salinity 
    7037!----------------------------------------------------------------------- 
    71    cn_dir        = './'      !  root directory for the location of the runoff files 
    72    ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
    73    ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     38   cn_dir        = './'    !  root directory for the location of the runoff files 
     39   ln_tsd_init   = .false. !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     40   ln_tsd_tradmp = .false. !  damping of ocean T & S toward T &S input data (T) or not (F) 
    7441/ 
    7542!----------------------------------------------------------------------- 
    … …  
    7845   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
    7946                           !     (also = the frequency of sea-ice model call) 
    80    ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
    81    ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
     47   ln_usr      = .true.    !  user defined formulation                  (T => check usrdef_sbc) 
    8248   nn_ice      = 0         !  =0 no ice boundary condition   , 
    8349   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg

    r6140 r7277  
    44!----------------------------------------------------------------------- 
    55&namrun        !   parameters of the run 
    6  nn_it000=1 
    76!----------------------------------------------------------------------- 
    87   cn_exp      = "Agulhas" !  experience name  
    9    nn_itend    =   10950 
     8   nn_it000    =       1   !  first time step 
     9   nn_itend    =   10950   !  last  time step 
    1010   nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1) 
    1111   nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000) 
    12    ln_clobber  =  .true. 
     12   ln_clobber  = .true.    !  clobber (overwrite) an existing file 
    1313/ 
    1414!----------------------------------------------------------------------- 
    1515&namcfg        !   parameters of the configuration 
    1616!----------------------------------------------------------------------- 
    17    cp_cfg      =  "default"             !  name of the configuration 
    18    jp_cfg      =      -1               !  resolution of the configuration 
    19    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    20    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    21    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    22    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    23    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    24    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    25    jpjzoom     =       1               !  in data domain indices 
    26    jperio      =       0               !  lateral cond. type (between 0 and 6) 
     17   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     18      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     19      cn_domcfg = "AGRIF_AGULHAS_domain_cfg"    ! domain configuration filename 
    2720/ 
    2821!----------------------------------------------------------------------- 
    … …  
    3023!----------------------------------------------------------------------- 
    3124   ln_zps      = .true.    !  z-coordinate - partial steps 
    32    ln_linssh   = .true.    !  linear free surface 
    3325/ 
    3426!----------------------------------------------------------------------- 
    3527&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3628!-----------------------------------------------------------------------   
    37    jphgr_msh   =       0               !  type of horizontal mesh 
    38    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    39    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    40    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    41    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    42    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    43    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    44    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    45    ppa0        =     255.58049070440   ! (default coefficients) 
    46    ppa1        =     245.58132232490   ! 
    47    ppkth       =      21.43336197938   ! 
    48    ppacr       =       3.0             ! 
    49    ppdzmin     =  999999.              !  Minimum vertical spacing 
    50    pphmax      =  999999.              !  Maximum depth 
    51    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    52    ppa2        =  999999.              !  Double tanh function parameters 
    53    ppkth2      =  999999.              ! 
    54    ppacr2      =  999999.              ! 
     29   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     30   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
     31   ! 
    5532   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0) 
    5633/ 
    … …  
    6744&namsbc        !   Surface Boundary Condition (surface module) 
    6845!----------------------------------------------------------------------- 
     46   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    6947   nn_ice      = 0         !  =0 no ice boundary condition   , 
    7048                           !  =1 use observed ice-cover      , 
    … …  
    194172   ln_dynvor_mix = .false. !  mixed scheme 
    195173   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    196       nn_een_e3f = 1             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     174      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    197175/ 
    198176!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg

    r6140 r7277  
    99   cn_exp      =  "ORCA2"  !  experience name 
    1010   nn_it000    =       1   !  first time step 
    11    nn_itend    =     300   !  last  time step (std 5475) 
    12 / 
    13 !----------------------------------------------------------------------- 
    14 &namcfg        !   parameters of the configuration 
    15 !----------------------------------------------------------------------- 
    16    cp_cfg      =  "orca"               !  name of the configuration 
    17    jp_cfg      =       2               !  resolution of the configuration 
    18    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    19    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    20    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    21    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    22    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    23    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    24    jpjzoom     =       1               !  in data domain indices 
    25    jperio      =       4               !  lateral cond. type (between 0 and 6) 
     11   nn_itend    =    5475   !  last  time step (std 5475) 
     12/ 
     13!----------------------------------------------------------------------- 
     14&namcfg     !   parameters of the configuration 
     15!----------------------------------------------------------------------- 
     16   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     17      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     18      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    2619/ 
    2720!----------------------------------------------------------------------- 
    … …  
    2922!----------------------------------------------------------------------- 
    3023   ln_zps      = .true.    !  z-coordinate - partial steps 
    31    ln_linssh   = .true.    !  linear free surface 
    3224/ 
    3325!----------------------------------------------------------------------- 
    3426&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3527!----------------------------------------------------------------------- 
    36    jphgr_msh   =       0               !  type of horizontal mesh 
    37    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    38    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    39    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    40    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    41    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    42    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    43    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    44    ppa0        =     255.58049070440   ! (default coefficients) 
    45    ppa1        =     245.58132232490   ! 
    46    ppkth       =      21.43336197938   ! 
    47    ppacr       =       3.0             ! 
    48    ppdzmin     =  999999.              !  Minimum vertical spacing 
    49    pphmax      =  999999.              !  Maximum depth 
    50    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    51    ppa2        =  999999.              !  Double tanh function parameters 
    52    ppkth2      =  999999.              ! 
    53    ppacr2      =  999999.              ! 
     28   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
     29   ! 
     30   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     31   ! 
    5432/ 
    5533!----------------------------------------------------------------------- 
    … …  
    6543&namsbc        !   Surface Boundary Condition (surface module) 
    6644!----------------------------------------------------------------------- 
     45   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    6746/ 
    6847!----------------------------------------------------------------------- 
    … …  
    133112   ln_traldf_lev   =  .false.  !  iso-level 
    134113   ln_traldf_hor   =  .false.  !  horizontal (geopotential) 
    135    ln_traldf_iso   =  .true.   !  iso-neutral (standard operator) 
    136    ln_traldf_triad =  .false.  !  iso-neutral (triad    operator) 
     114   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator) 
     115   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator) 
    137116   ! 
    138117   !                       !  iso-neutral options:         
    … …  
    146125   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef 
    147126   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file 
    148    !                                !   =  0           constant 
    149    !                                !   = 10 F(k)      =ldf_c1d 
    150    !                                !   = 20 F(i,j)    =ldf_c2d 
     127   !                                !   =  0           constant  
     128   !                                !   = 10 F(k)      =ldf_c1d  
     129   !                                !   = 20 F(i,j)    =ldf_c2d  
    151130   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
    152131   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d 
    … …  
    163142   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient 
    164143   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
    165    !                                !   =  0           constant 
    166    !                                !   = 10 F(k)      =ldf_c1d 
    167    !                                !   = 20 F(i,j)    =ldf_c2d 
     144   !                                !   =  0           constant  
     145   !                                !   = 10 F(k)      =ldf_c1d  
     146   !                                !   = 20 F(i,j)    =ldf_c2d  
    168147   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
    169148   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d 
    170149/ 
    171150!----------------------------------------------------------------------- 
    172 &namtra_dmp    !   tracer: T & S newtonian damping 
    173 !----------------------------------------------------------------------- 
    174 / 
     151&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
     152!----------------------------------------------------------------------- 
    175153!----------------------------------------------------------------------- 
    176154&namdyn_adv    !   formulation of the momentum advection 
    … …  
    189167&namdyn_hpg    !   Hydrostatic pressure gradient option 
    190168!----------------------------------------------------------------------- 
    191 / 
    192 !----------------------------------------------------------------------- 
    193 &namdyn_spg    !   Surface pressure gradient 
    194 !----------------------------------------------------------------------- 
    195    ln_dynspg_ts = .true.   !  Split-explicit free surface 
     169   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation) 
     170/ 
     171!----------------------------------------------------------------------- 
     172&namdyn_spg    !   surface pressure gradient 
     173!----------------------------------------------------------------------- 
     174   ln_dynspg_ts  = .true.  !  split-explicit free surface 
    196175/ 
    197176!----------------------------------------------------------------------- 
    … …  
    218197   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s] 
    219198   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s] 
     199   ! 
     200   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km) 
    220201/ 
    221202!----------------------------------------------------------------------- 
    … …  
    248229/ 
    249230!----------------------------------------------------------------------- 
    250 &namhsb       !  Heat and salt budgets 
    251 !----------------------------------------------------------------------- 
    252 / 
    253 !----------------------------------------------------------------------- 
    254 &namobs       !  observation usage 
     231&namhsb       !  Heat and salt budgets                                  (default F) 
     232!----------------------------------------------------------------------- 
     233/ 
     234!----------------------------------------------------------------------- 
     235&namobs       !  observation usage                                      ('key_diaobs') 
    255236!----------------------------------------------------------------------- 
    256237/ 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/1_namelist_cfg

    r6140 r7277  
    66!----------------------------------------------------------------------- 
    77   cn_exp      = "Agulhas" !  experience name  
    8    nn_itend    =     480   !  last  time step 
     8   nn_it000    =       1   !  first time step 
     9   nn_itend    =   10950   !  last  time step 
    910   nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1) 
    1011   nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000) 
    … …  
    1415&namcfg        !   parameters of the configuration 
    1516!----------------------------------------------------------------------- 
    16    cp_cfg      =  "default"             !  name of the configuration 
    17    jp_cfg      =      -1               !  resolution of the configuration 
    18    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    19    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    20    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    21    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    22    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    23    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    24    jpjzoom     =       1               !  in data domain indices 
    25    jperio      =       0               !  lateral cond. type (between 0 and 6) 
     17   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     18      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     19      cn_domcfg = "AGRIF_AGULHAS_domain_cfg"    ! domain configuration filename 
    2620/ 
    2721!----------------------------------------------------------------------- 
    … …  
    3327&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3428!-----------------------------------------------------------------------   
    35    jphgr_msh   =       0               !  type of horizontal mesh 
    36    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    37    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    38    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    39    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    40    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    41    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    42    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    43    ppa0        =     255.58049070440   ! (default coefficients) 
    44    ppa1        =     245.58132232490   ! 
    45    ppkth       =      21.43336197938   ! 
    46    ppacr       =       3.0             ! 
    47    ppdzmin     =  999999.              !  Minimum vertical spacing 
    48    pphmax      =  999999.              !  Maximum depth 
    49    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    50    ppa2        =  999999.              !  Double tanh function parameters 
    51    ppkth2      =  999999.              ! 
    52    ppacr2      =  999999.              ! 
     29   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     30   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
     31   ! 
    5332   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0) 
     33   ! 
    5434/ 
    5535!----------------------------------------------------------------------- 
    … …  
    6545&namsbc        !   Surface Boundary Condition (surface module) 
    6646!----------------------------------------------------------------------- 
     47   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    6748   nn_ice      = 0         !  =0 no ice boundary condition   , 
    6849                           !  =1 use observed ice-cover      , 
    … …  
    193174   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
    194175      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
    195    ln_dynvor_msk = .false. !  vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes) 
    196176/ 
    197177!----------------------------------------------------------------------- 
    … …  
    216196   ln_dynldf_iso =  .false.    !  iso-neutral 
    217197   !                       !  Coefficient 
    218    nn_ahm_ijk_t  = 20          !  space/time variation of eddy coef 
     198   nn_ahm_ijk_t  =  0          !  space/time variation of eddy coef 
    219199   !                                !  =-30  read in eddy_viscosity_3D.nc file 
    220200   !                                !  =-20  read in eddy_viscosity_2D.nc file 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg

    r6140 r7277  
    99   cn_exp      =  "ORCA2"  !  experience name 
    1010   nn_it000    =       1   !  first time step 
    11    nn_itend    =     300   !  last  time step (std 5475) 
    12 / 
    13 !----------------------------------------------------------------------- 
    14 &namcfg        !   parameters of the configuration 
    15 !----------------------------------------------------------------------- 
    16    cp_cfg      =  "orca"               !  name of the configuration 
    17    jp_cfg      =       2               !  resolution of the configuration 
    18    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    19    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    20    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    21    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    22    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    23    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    24    jpjzoom     =       1               !  in data domain indices 
    25    jperio      =       4               !  lateral cond. type (between 0 and 6) 
     11   nn_itend    =    5475   !  last  time step (std 5475) 
     12/ 
     13!----------------------------------------------------------------------- 
     14&namcfg     !   parameters of the configuration 
     15!----------------------------------------------------------------------- 
     16   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     17      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     18      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    2619/ 
    2720!----------------------------------------------------------------------- 
    … …  
    3326&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3427!----------------------------------------------------------------------- 
    35    jphgr_msh   =       0               !  type of horizontal mesh 
    36    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    37    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    38    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    39    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    40    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    41    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    42    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    43    ppa0        =     255.58049070440   ! (default coefficients) 
    44    ppa1        =     245.58132232490   ! 
    45    ppkth       =      21.43336197938   ! 
    46    ppacr       =       3.0             ! 
    47    ppdzmin     =  999999.              !  Minimum vertical spacing 
    48    pphmax      =  999999.              !  Maximum depth 
    49    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    50    ppa2        =  999999.              !  Double tanh function parameters 
    51    ppkth2      =  999999.              ! 
    52    ppacr2      =  999999.              ! 
     28   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
     29   ! 
     30   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     31   ! 
    5332/ 
    5433!----------------------------------------------------------------------- 
    … …  
    6443&namsbc        !   Surface Boundary Condition (surface module) 
    6544!----------------------------------------------------------------------- 
     45   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    6646/ 
    6747!----------------------------------------------------------------------- 
    … …  
    8868&namberg       !   iceberg parameters 
    8969!----------------------------------------------------------------------- 
     70      ln_icebergs              = .true.               ! iceberg floats or not 
     71      ln_bergdia               = .true.               ! Calculate budgets 
     72      nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0 
     73      nn_verbose_write         = 15                   ! Timesteps between verbose messages 
     74      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage 
     75                                                      ! Initial mass required for an iceberg of each class 
     76      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11 
     77                                                      ! Proportion of calving mass to apportion to each class 
     78      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02 
     79                                                      ! Ratio between effective and real iceberg mass (non-dim) 
     80                                                      ! i.e. number of icebergs represented at a point 
     81      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1 
     82                                                      ! thickness of newly calved bergs (m) 
     83      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250. 
     84      rn_rho_bergs             = 850.                 ! Density of icebergs 
     85      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs 
     86      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics 
     87      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits 
     88      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1) 
     89      ln_passive_mode          = .false.              ! iceberg - ocean decoupling 
     90      nn_test_icebergs         = -1                   ! Create test icebergs of this class (-1 = no) 
     91                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2) 
     92      rn_test_box              = 108.0,  116.0, -66.0, -58.0 
     93      rn_speed_limit           = 0.                   ! CFL speed limit for a berg 
     94 
     95!            ! file name ! frequency (hours) !   variable   ! time interp.!  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     96!            !           !  (if <0  months)  !     name     !  (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
     97      sn_icb =  'calving',       -1          , 'calving'    ,   .true.    , .true.  , 'yearly'  ,    ''    ,    ''    ,     '' 
     98 
     99      cn_dir = './' 
    90100/ 
    91101!----------------------------------------------------------------------- 
    … …  
    169179/ 
    170180!----------------------------------------------------------------------- 
    171 &namtra_dmp    !   tracer: T & S newtonian damping 
     181&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
    172182!----------------------------------------------------------------------- 
    173183/ 
    … …  
    188198&namdyn_hpg    !   Hydrostatic pressure gradient option 
    189199!----------------------------------------------------------------------- 
    190    ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation) 
    191    ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation) 
     200   ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation) 
    192201/ 
    193202!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg

    r6140 r7277  
    116116   nn_fsbc     = 5         !  frequency of surface boundary condition computation  
    117117                           !     (also = the frequency of sea-ice model call) 
    118    ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana )  
    119    ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx ) 
    120    ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio)  
    121118   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core)  
    122    ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl ) 
    123    ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    124119   nn_ice      = 0         !  =0 no ice boundary condition   , 
    125120                           !  =1 use observed ice-cover      , 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg

    r6140 r7277  
    1717&namcfg        !   parameters of the configuration 
    1818!----------------------------------------------------------------------- 
    19    cp_cfg      =  "orca"               !  name of the configuration 
    20    jp_cfg      =       2               !  resolution of the configuration 
    21    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    22    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    23    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    24    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    25    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    26    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    27    jpjzoom     =       1               !  in data domain indices 
    28    jperio      =       4               !  lateral cond. type (between 0 and 6) 
     19   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     20      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     21      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    2922/ 
    3023!----------------------------------------------------------------------- 
    … …  
    4942&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    5043!----------------------------------------------------------------------- 
    51    jphgr_msh   =       0               !  type of horizontal mesh 
    52    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    53    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    54    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    55    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    56    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    57    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    5844   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    5945   ppa0        =     255.58049070440   ! (default coefficients) 
    … …  
    8470&namsbc        !   Surface Boundary Condition (surface module) 
    8571!----------------------------------------------------------------------- 
    86 / 
    87 !----------------------------------------------------------------------- 
    88 &namsbc_ana    !   analytical surface boundary condition 
    89 !----------------------------------------------------------------------- 
     72   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    9073/ 
    9174!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg

    r6140 r7277  
    66&namrun        !   parameters of the run 
    77!----------------------------------------------------------------------- 
    8 / 
    9 !----------------------------------------------------------------------- 
    10 &namcfg        !   parameters of the configuration 
    11 !----------------------------------------------------------------------- 
    12    cp_cfg      =  "orca"               !  name of the configuration 
    13    jp_cfg      =       2               !  resolution of the configuration 
    14    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    15    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    16    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    17    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    18    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    19    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    20    jpjzoom     =       1               !  in data domain indices 
    21    jperio      =       4               !  lateral cond. type (between 0 and 6) 
     8   nn_no       =       0       !  job number (no more used...) 
     9   cn_exp      =  "ORCA2_PIS"  !  experience name 
     10   nn_it000    =       1       !  first time step 
     11   nn_itend    =    5475       !  last  time step (std 5475) 
     12/ 
     13!----------------------------------------------------------------------- 
     14&namcfg     !   parameters of the configuration 
     15!----------------------------------------------------------------------- 
     16   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     17      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     18      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    2219/ 
    2320!----------------------------------------------------------------------- 
    … …  
    2522!----------------------------------------------------------------------- 
    2623   ln_zps      = .true.    !  z-coordinate - partial steps 
    27    ln_linssh   = .true.    !  linear free surface 
    2824/ 
    2925!----------------------------------------------------------------------- 
    3026&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3127!----------------------------------------------------------------------- 
    32    jphgr_msh   =       0               !  type of horizontal mesh 
    33    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    34    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    35    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    36    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    37    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    38    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    39    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    40    ppa0        =     255.58049070440   ! (default coefficients) 
    41    ppa1        =     245.58132232490   ! 
    42    ppkth       =      21.43336197938   ! 
    43    ppacr       =       3.0             ! 
    44    ppdzmin     =  999999.              !  Minimum vertical spacing 
    45    pphmax      =  999999.              !  Maximum depth 
    46    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    47    ppa2        =  999999.              !  Double tanh function parameters 
    48    ppkth2      =  999999.              ! 
    49    ppacr2      =  999999.              ! 
     28   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
     29   ! 
     30   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     31   ! 
    5032/ 
    5133!----------------------------------------------------------------------- 
    … …  
    6143&namsbc        !   Surface Boundary Condition (surface module) 
    6244!----------------------------------------------------------------------- 
     45   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    6346/ 
    6447!----------------------------------------------------------------------- 
    … …  
    129112   ln_traldf_lev   =  .false.  !  iso-level 
    130113   ln_traldf_hor   =  .false.  !  horizontal (geopotential) 
    131    ln_traldf_iso   =  .true.   !  iso-neutral (standard operator) 
    132    ln_traldf_triad =  .false.  !  iso-neutral (triad    operator) 
     114   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator) 
     115   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator) 
    133116   ! 
    134117   !                       !  iso-neutral options:         
    … …  
    166149/ 
    167150!----------------------------------------------------------------------- 
    168 &namtra_dmp    !   tracer: T & S newtonian damping 
     151&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
    169152!----------------------------------------------------------------------- 
    170153/ 
    … …  
    185168&namdyn_hpg    !   Hydrostatic pressure gradient option 
    186169!----------------------------------------------------------------------- 
     170  ln_hpg_sco  = .true.   !  s-coordinate (standard jacobian formulation) 
    187171/ 
    188172!----------------------------------------------------------------------- 
    … …  
    214198   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s] 
    215199   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s] 
     200   ! 
     201   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km) 
    216202/ 
    217203!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_cfg

    r6140 r7277  
    1313&namcfg        !   parameters of the configuration 
    1414!----------------------------------------------------------------------- 
    15    cp_cfg      =  "orca"               !  name of the configuration 
    16    jp_cfg      =       2               !  resolution of the configuration 
    17    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    18    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    19    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    20    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    21    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    22    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    23    jpjzoom     =       1               !  in data domain indices 
    24    jperio      =       4               !  lateral cond. type (between 0 and 6) 
     15   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     16      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     17      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    2518/ 
    2619!----------------------------------------------------------------------- 
    … …  
    2821!----------------------------------------------------------------------- 
    2922   ln_zps      = .true.    !  z-coordinate - partial steps 
    30    ln_linssh   = .true.    !  linear free surface 
    3123/ 
    3224!----------------------------------------------------------------------- 
    3325&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3426!----------------------------------------------------------------------- 
    35    nn_msh      =    1      !  create (=1) a mesh file or not (=0) 
    36    rn_rdt      = 21600.    !  time step for the dynamics  
    37    jphgr_msh   =       0               !  type of horizontal mesh 
    38    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    39    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    40    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    41    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    42    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    43    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    44    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    45    ppa0        =     255.58049070440   ! (default coefficients) 
    46    ppa1        =     245.58132232490   ! 
    47    ppkth       =      21.43336197938   ! 
    48    ppacr       =       3.0             ! 
    49    ppdzmin     =  999999.              !  Minimum vertical spacing 
    50    pphmax      =  999999.              !  Maximum depth 
    51    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    52    ppa2        =  999999.              !  Double tanh function parameters 
    53    ppkth2      =  999999.              ! 
    54    ppacr2      =  999999.              ! 
     27   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     28   ! 
     29   rn_rdt      = 21600.     !  time step for the dynamics (and tracer if nn_acc=0) 
     30/ 
     31!----------------------------------------------------------------------- 
     32&namlbc        !   lateral momentum boundary condition 
     33!----------------------------------------------------------------------- 
     34   !                       !  free slip  !   partial slip  !   no slip   ! strong slip 
     35   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat 
     36   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs. 
    5537/ 
    5638!----------------------------------------------------------------------- 
    … …  
    6749!----------------------------------------------------------------------- 
    6850   nn_fsbc     = 1         !  frequency of surface boundary condition computation  
     51   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    6952   ln_rnf      = .false.   !  runoffs 
    7053   ln_traqsr   = .false.   !  Light penetration (T) or not (F) 
    … …  
    136119!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    137120!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
     121!          !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     122!          !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  ! filename      ! 
    138123   sn_tem  = 'dyna_grid_T' ,    120            , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    139124   sn_sal  = 'dyna_grid_T' ,    120            , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    … …  
    144129   sn_qsr  = 'dyna_grid_T' ,    120            , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    145130   sn_wnd  = 'dyna_grid_T' ,    120            , 'sowindsp' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    146    sn_uwd  = 'dyna_grid_U' ,    120            , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    147    sn_vwd  = 'dyna_grid_V' ,    120            , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    148    sn_wwd  = 'dyna_grid_W' ,    120            , 'vovecrtz' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
     131   sn_uwd  = 'dyna_grid_U' ,    120            , 'uocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
     132   sn_vwd  = 'dyna_grid_V' ,    120            , 'vocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
     133   sn_wwd  = 'dyna_grid_W' ,    120            , 'wocetr_eff' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    149134   sn_avt  = 'dyna_grid_W' ,    120            , 'voddmavs' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    150135   sn_ubl  = 'dyna_grid_U' ,    120            , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    151136   sn_vbl  = 'dyna_grid_V' ,    120            , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , ''    , '' 
    152137! 
    153    cn_dir      = './'      !  root directory for the location of the dynamical files 
    154    ln_dynwzv   =  .true.   !  computation of vertical velocity instead of using the one read in file 
    155    ln_dynbbl   =  .true.   !  bbl coef are in files, so read them - requires ("key_trabbl") 
     138   cn_dir          = './'       !  root directory for the location of the dynamical files 
     139   ln_dynrnf       =  .false.   !  runoffs option enabled (T) or not (F) 
     140   ln_dynrnf_depth =  .false.   ! runoffs is spread in vertical (T) or not (F) 
     141!   fwbcorr      = 3.786e-06    ! annual global mean of empmr for ssh correction 
    156142/ 
    157143!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top_cfg

    r6140 r7277  
    55&namtrc_run     !   run information 
    66!----------------------------------------------------------------------- 
    7    nn_writetrc   =  1460     !  time step frequency for sn_tracer outputs 
    87/ 
    98!----------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist_cfg

    r6140 r7277  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    2 !! NEMO/OPA  :  Configuration namelist used to overwrite namelist_ref 
     2!! NEMO/OPA  Configuration namelist : used to overwrite defaults values defined in SHARED/namelist_ref 
    33!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     4! 
    45!----------------------------------------------------------------------- 
    56&namrun        !   parameters of the run 
    67!----------------------------------------------------------------------- 
    7    cn_exp      =  "ORCA2_SAS"  !  experience name  
    8    nn_it000    =       1       !  first time step 
    9    nn_itend    =     100       !  last  time step (std 5475) 
    10 / 
    11 !----------------------------------------------------------------------- 
    12 &namcfg        !   parameters of the configuration 
    13 !----------------------------------------------------------------------- 
    14    cp_cfg      =  "orca"               !  name of the configuration 
    15    jp_cfg      =       2               !  resolution of the configuration 
    16    jpidta      =     182               !  1st lateral dimension ( >= jpi ) 
    17    jpjdta      =     149               !  2nd    "         "    ( >= jpj ) 
    18    jpkdta      =      31               !  number of levels      ( >= jpk ) 
    19    jpiglo      =     182               !  1st dimension of global domain --> i =jpidta 
    20    jpjglo      =     149               !  2nd    -                  -    --> j  =jpjdta 
    21    jpizoom     =       1               !  left bottom (i,j) indices of the zoom 
    22    jpjzoom     =       1               !  in data domain indices 
    23    jperio      =       4               !  lateral cond. type (between 0 and 6) 
     8   nn_no       =       0   !  job number (no more used...) 
     9   cn_exp      =  "ORCA2_SAS"  !  experience name 
     10   nn_it000    =       1   !  first time step 
     11   nn_itend    =     100   !  last  time step (std 5475) 
     12/ 
     13!----------------------------------------------------------------------- 
     14&namcfg     !   parameters of the configuration 
     15!----------------------------------------------------------------------- 
     16   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
     17      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     18      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
    2419/ 
    2520!----------------------------------------------------------------------- 
    2621&namzgr        !   vertical coordinate 
    2722!----------------------------------------------------------------------- 
    28    ln_zco      = .true.    !  z-coordinate - full    steps 
    29    ln_linssh   = .true.    !  linear free surface 
     23   ln_zps      = .true.    !  z-coordinate - partial steps 
    3024/ 
    3125!----------------------------------------------------------------------- 
    3226&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    3327!----------------------------------------------------------------------- 
    34    jphgr_msh   =       0               !  type of horizontal mesh 
    35    ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    36    ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    37    ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees) 
    38    ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees) 
    39    ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees) 
    40    ppe2_m      =  999999.0             !  meridional grid-spacing (degrees) 
    41    ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients 
    42    ppa0        =     255.58049070440   ! (default coefficients) 
    43    ppa1        =     245.58132232490   ! 
    44    ppkth       =      21.43336197938   ! 
    45    ppacr       =       3.0             ! 
    46    ppdzmin     =  999999.              !  Minimum vertical spacing 
    47    pphmax      =  999999.              !  Maximum depth 
    48    ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates 
    49    ppa2        =  999999.              !  Double tanh function parameters 
    50    ppkth2      =  999999.              ! 
    51    ppacr2      =  999999.              ! 
     28   ln_linssh   = .true.   !  =T  linear free surface  ==>>  model level are fixed in time 
     29   ! 
     30   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
     31   ! 
    5232/ 
    5333!----------------------------------------------------------------------- 
    … …  
    5737/ 
    5838!----------------------------------------------------------------------- 
     39&namtsd    !   data : Temperature  & Salinity 
     40!----------------------------------------------------------------------- 
     41/ 
     42!----------------------------------------------------------------------- 
     43&namsbc        !   Surface Boundary Condition (surface module) 
     44!----------------------------------------------------------------------- 
     45   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
     46/ 
     47!----------------------------------------------------------------------- 
     48&namsbc_core   !   namsbc_core  CORE bulk formulae 
     49!----------------------------------------------------------------------- 
     50/ 
     51!----------------------------------------------------------------------- 
     52&namtra_qsr    !   penetrative solar radiation 
     53!----------------------------------------------------------------------- 
     54/ 
     55!----------------------------------------------------------------------- 
     56&namsbc_rnf    !   runoffs namelist surface boundary condition 
     57!----------------------------------------------------------------------- 
     58/ 
     59!----------------------------------------------------------------------- 
     60&namsbc_ssr    !   surface boundary condition : sea surface restoring 
     61!----------------------------------------------------------------------- 
     62/ 
     63!----------------------------------------------------------------------- 
     64&namsbc_alb    !   albedo parameters 
     65!----------------------------------------------------------------------- 
     66/ 
     67!----------------------------------------------------------------------- 
     68&namberg       !   iceberg parameters 
     69!----------------------------------------------------------------------- 
     70/ 
     71!----------------------------------------------------------------------- 
     72&namlbc        !   lateral momentum boundary condition 
     73!----------------------------------------------------------------------- 
     74/ 
     75!----------------------------------------------------------------------- 
     76&nambfr        !   bottom friction 
     77!----------------------------------------------------------------------- 
     78/ 
     79!----------------------------------------------------------------------- 
     80&nambbc        !   bottom temperature boundary condition                (default: NO) 
     81!----------------------------------------------------------------------- 
     82   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
     83/ 
     84!----------------------------------------------------------------------- 
     85&nambbl        !   bottom boundary layer scheme 
     86!----------------------------------------------------------------------- 
     87/ 
     88!----------------------------------------------------------------------- 
     89&nameos        !   ocean physical parameters 
     90!----------------------------------------------------------------------- 
     91/ 
     92!----------------------------------------------------------------------- 
     93&namtra_adv    !   advection scheme for tracer 
     94!----------------------------------------------------------------------- 
     95   ln_traadv_fct =  .true.    !  FCT scheme 
     96      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
     97      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
     98      nn_fct_zts =  0               !  > 1 , 2nd order FCT scheme with vertical sub-timestepping 
     99      !                             !        (number of sub-timestep = nn_fct_zts) 
     100/ 
     101!----------------------------------------------------------------------- 
     102&namtra_adv_mle !  mixed layer eddy parametrisation (Fox-Kemper param) 
     103!----------------------------------------------------------------------- 
     104/ 
     105!---------------------------------------------------------------------------------- 
     106&namtra_ldf    !   lateral diffusion scheme for tracers 
     107!---------------------------------------------------------------------------------- 
     108   !                       !  Operator type: 
     109   ln_traldf_lap   =  .true.   !    laplacian operator 
     110   ln_traldf_blp   =  .false.  !  bilaplacian operator 
     111   !                       !  Direction of action: 
     112   ln_traldf_lev   =  .false.  !  iso-level 
     113   ln_traldf_hor   =  .false.  !  horizontal (geopotential) 
     114   ln_traldf_iso   =  .true.   !  iso-neutral (Standard operator) 
     115   ln_traldf_triad =  .false.  !  iso-neutral (Triads   operator) 
     116   ! 
     117   !                       !  iso-neutral options:         
     118   ln_traldf_msc   =  .true.   !  Method of Stabilizing Correction (both operators) 
     119   rn_slpmax       =   0.01    !  slope limit                      (both operators) 
     120   ln_triad_iso    =  .false.  !  pure horizontal mixing in ML              (triad only) 
     121   rn_sw_triad     =  1        !  =1 switching triad ; =0 all 4 triads used (triad only) 
     122   ln_botmix_triad =  .false.  !  lateral mixing on bottom                  (triad only) 
     123   ! 
     124   !                       !  Coefficients: 
     125   nn_aht_ijk_t    = 20        !  space/time variation of eddy coef 
     126   !                                !   =-20 (=-30)    read in eddy_diffusivity_2D.nc (..._3D.nc) file 
     127   !                                !   =  0           constant  
     128   !                                !   = 10 F(k)      =ldf_c1d  
     129   !                                !   = 20 F(i,j)    =ldf_c2d  
     130   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
     131   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d 
     132   !                                !   = 31 F(i,j,k,t)=F(local velocity) 
     133   rn_aht_0        = 2000.     !  lateral eddy diffusivity   (lap. operator) [m2/s] 
     134   rn_bht_0        = 1.e+12    !  lateral eddy diffusivity (bilap. operator) [m4/s] 
     135/ 
     136!---------------------------------------------------------------------------------- 
     137&namtra_ldfeiv !   eddy induced velocity param. 
     138!---------------------------------------------------------------------------------- 
     139   ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization 
     140   ln_ldfeiv_dia =.true.   ! diagnose eiv stream function and velocities 
     141   rn_aeiv_0     = 2000.   ! eddy induced velocity coefficient   [m2/s] 
     142   nn_aei_ijk_t  = 21      ! space/time variation of the eiv coeficient 
     143   !                                !   =-20 (=-30)    read in eddy_induced_velocity_2D.nc (..._3D.nc) file 
     144   !                                !   =  0           constant  
     145   !                                !   = 10 F(k)      =ldf_c1d  
     146   !                                !   = 20 F(i,j)    =ldf_c2d  
     147   !                                !   = 21 F(i,j,t)  =Treguier et al. JPO 1997 formulation 
     148   !                                !   = 30 F(i,j,k)  =ldf_c2d + ldf_c1d 
     149/ 
     150!----------------------------------------------------------------------- 
     151&namtra_dmp    !   tracer: T & S newtonian damping                      (default: NO) 
     152!----------------------------------------------------------------------- 
     153!----------------------------------------------------------------------- 
     154&namdyn_adv    !   formulation of the momentum advection 
     155!----------------------------------------------------------------------- 
     156/ 
     157!----------------------------------------------------------------------- 
     158&namdyn_vor    !   option of physics/algorithm (not control by CPP keys) 
     159!----------------------------------------------------------------------- 
     160   ln_dynvor_ene = .false. !  enstrophy conserving scheme 
     161   ln_dynvor_ens = .false. !  energy conserving scheme 
     162   ln_dynvor_mix = .false. !  mixed scheme 
     163   ln_dynvor_een = .true.  !  energy & enstrophy scheme 
     164      nn_een_e3f = 0             !  e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 
     165/ 
     166!----------------------------------------------------------------------- 
     167&namdyn_hpg    !   Hydrostatic pressure gradient option 
     168!----------------------------------------------------------------------- 
     169/ 
     170!----------------------------------------------------------------------- 
     171&namdyn_spg    !   surface pressure gradient 
     172!----------------------------------------------------------------------- 
     173   ln_dynspg_ts  = .true.  !  split-explicit free surface 
     174/ 
     175!----------------------------------------------------------------------- 
     176&namdyn_ldf    !   lateral diffusion on momentum 
     177!----------------------------------------------------------------------- 
     178   !                       !  Type of the operator : 
     179   !                           !  no diffusion: set ln_dynldf_lap=..._blp=F  
     180   ln_dynldf_lap =  .true.     !    laplacian operator 
     181   ln_dynldf_blp =  .false.    !  bilaplacian operator 
     182   !                       !  Direction of action  : 
     183   ln_dynldf_lev =  .true.     !  iso-level 
     184   ln_dynldf_hor =  .false.    !  horizontal (geopotential) 
     185   ln_dynldf_iso =  .false.    !  iso-neutral 
     186   !                       !  Coefficient 
     187   nn_ahm_ijk_t  = -30         !  space/time variation of eddy coef 
     188   !                                !  =-30  read in eddy_viscosity_3D.nc file 
     189   !                                !  =-20  read in eddy_viscosity_2D.nc file 
     190   !                                !  =  0  constant  
     191   !                                !  = 10  F(k)=c1d 
     192   !                                !  = 20  F(i,j)=F(grid spacing)=c2d 
     193   !                                !  = 30  F(i,j,k)=c2d*c1d 
     194   !                                !  = 31  F(i,j,k)=F(grid spacing and local velocity) 
     195   rn_ahm_0      =  40000.     !  horizontal laplacian eddy viscosity   [m2/s] 
     196   rn_ahm_b      =      0.     !  background eddy viscosity for ldf_iso [m2/s] 
     197   rn_bhm_0      = 1.e+12      !  horizontal bilaplacian eddy viscosity [m4/s] 
     198   ! 
     199   ! Caution in 20 and 30 cases the coefficient have to be given for a 1 degree grid (~111km) 
     200/ 
     201!----------------------------------------------------------------------- 
     202&namzdf        !   vertical physics 
     203!----------------------------------------------------------------------- 
     204/ 
     205!----------------------------------------------------------------------- 
     206&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke") 
     207!----------------------------------------------------------------------- 
     208/ 
     209!----------------------------------------------------------------------- 
     210&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm") 
     211!----------------------------------------------------------------------- 
     212/ 
     213!----------------------------------------------------------------------- 
     214&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx") 
     215!----------------------------------------------------------------------- 
     216/ 
     217!----------------------------------------------------------------------- 
     218&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
     219!----------------------------------------------------------------------- 
     220/ 
     221!----------------------------------------------------------------------- 
    59222&namctl        !   Control prints & Benchmark 
    60223!----------------------------------------------------------------------- 
    61224/ 
    62225!----------------------------------------------------------------------- 
    63 &namsbc        !   Surface Boundary Condition (surface module) 
    64 !----------------------------------------------------------------------- 
    65 / 
    66 !----------------------------------------------------------------------- 
    67 &namsbc_sas    !   analytical surface boundary condition 
    68 !----------------------------------------------------------------------- 
    69 /       
    70 !----------------------------------------------------------------------- 
    71 &namsbc_core   !   namsbc_core  CORE bulk formulae 
    72 !----------------------------------------------------------------------- 
    73 / 
    74 !----------------------------------------------------------------------- 
    75 &namsbc_ssr    !   surface boundary condition : sea surface restoring 
    76 !----------------------------------------------------------------------- 
    77 /       
    78 !----------------------------------------------------------------------- 
    79 &namsbc_alb    !   albedo parameters 
    80 !----------------------------------------------------------------------- 
    81 / 
    82 !----------------------------------------------------------------------- 
    83 &namlbc        !   lateral momentum boundary condition 
    84 !----------------------------------------------------------------------- 
    85 / 
    86 !----------------------------------------------------------------------- 
    87 &nameos        !   ocean physical parameters 
    88 !----------------------------------------------------------------------- 
    89 / 
    90 !----------------------------------------------------------------------- 
    91 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi) 
    92 !----------------------------------------------------------------------- 
    93 / 
     226&namptr       !   Poleward Transport Diagnostic 
     227!----------------------------------------------------------------------- 
     228/ 
     229!----------------------------------------------------------------------- 
     230&namhsb       !  Heat and salt budgets                                  (default F) 
     231!----------------------------------------------------------------------- 
     232/ 
     233!----------------------------------------------------------------------- 
     234&namobs       !  observation usage                                      ('key_diaobs') 
     235!----------------------------------------------------------------------- 
     236/ 
     237!----------------------------------------------------------------------- 
     238&nam_asminc   !   assimilation increments                               ('key_asminc') 
     239!----------------------------------------------------------------------- 
     240/ 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/ORCA2_SAS_LIM/cpp_ORCA2_SAS_LIM.fcm

    r6140 r7277  
    1  bld::tool::fppkeys key_trabbl key_lim2  key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_trabbl key_lim2  key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_mpp_rep 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/SHARED/namelist_ref

    r6152 r7277  
    33!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    44!! NEMO/OPA  :  1 - run manager      (namrun) 
    5 !! namelists    2 - Domain           (namcfg, namzgr, namzgr_sco, namdom, namtsd) 
    6 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 
     5!! namelists    2 - Domain           (namcfg, namzgr, namdom, namtsd) 
     6!!              3 - Surface boundary (namsbc, namsbc_flx, namsbc_clio, namsbc_core, namsbc_sas 
    77!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
    88!!                                    namsbc_apr, namsbc_ssr, namsbc_alb, namsbc_wave) 
    … …  
    6060!!   namcfg       parameters of the configuration 
    6161!!   namzgr       vertical coordinate 
    62 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    6362!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    6463!!   namcrs       coarsened grid (for outputs and/or TOP)               ("key_crs") 
    … …  
    7271&namcfg        !   parameters of the configuration 
    7372!----------------------------------------------------------------------- 
    74    cp_cfg      = "default" !  name of the configuration 
    75    cp_cfz      = "no zoom" !  name of the zoom of configuration 
    76    jp_cfg      =      0    !  resolution of the configuration 
    77    jpidta      =     10    !  1st lateral dimension ( >= jpi ) 
    78    jpjdta      =     12    !  2nd    "         "    ( >= jpj ) 
    79    jpkdta      =     31    !  number of levels      ( >= jpk ) 
    80    jpiglo      =     10    !  1st dimension of global domain --> i =jpidta 
    81    jpjglo      =     12    !  2nd    -                  -    --> j =jpjdta 
    82    jpizoom     =      1    !  left bottom (i,j) indices of the zoom 
    83    jpjzoom     =      1    !  in data domain indices 
    84    jperio      =      0    !  lateral cond. type (between 0 and 6) 
    85                                  !  = 0 closed                 ;   = 1 cyclic East-West 
    86                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot 
    87                                  !  = 4 cyclic East-West AND North fold T-point pivot 
    88                                  !  = 5 North fold F-point pivot 
    89                                  !  = 6 cyclic East-West AND North fold F-point pivot 
     73   ln_read_cfg = .false.   !  (=T) read the domain configuration file 
     74      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     75      cn_domcfg = "domain_cfg"         ! domain configuration filename 
     76      ! 
     77   ln_write_cfg= .false.   !  (=T) create the domain configuration file 
     78      cn_domcfg_out = "domain_cfg_out" ! newly created domain configuration filename 
     79      ! 
    9080   ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present 
    91                            !  in netcdf input files, as the start j-row for reading 
    92 / 
    93 !----------------------------------------------------------------------- 
    94 &namzgr        !   vertical coordinate                                  (default: NO selection) 
    95 !----------------------------------------------------------------------- 
    96    ln_zco      = .false.   !  z-coordinate - full    steps 
    97    ln_zps      = .false.   !  z-coordinate - partial steps 
    98    ln_sco      = .false.   !  s- or hybrid z-s-coordinate 
    99    ln_isfcav   = .false.   !  ice shelf cavity 
    100    ln_linssh   = .false.   !  linear free surface 
    101 / 
    102 !----------------------------------------------------------------------- 
    103 &namzgr_sco    !   s-coordinate or hybrid z-s-coordinate 
    104 !----------------------------------------------------------------------- 
    105    ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)| 
    106    ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied 
    107    ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch 
    108                            !  stretching coefficients for all functions 
    109    rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m) 
    110    rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
    111    rn_hc       =  150.0    !  critical depth for transition to stretched coordinates 
    112                         !!!!!!!  Envelop bathymetry 
    113    rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1) 
    114                         !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.) 
    115    rn_theta    =    6.0    !  surface control parameter (0<=theta<=20) 
    116    rn_bb       =    0.8    !  stretching with SH94 s-sigma 
    117                         !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.) 
    118    rn_alpha    =    4.4    !  stretching with SF12 s-sigma 
    119    rn_efold    =    0.0    !  efold length scale for transition to stretched coord 
    120    rn_zs       =    1.0    !  depth of surface grid box 
    121                            !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b 
    122    rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb 
    123    rn_zb_b     =   -0.2    !  offset for calculating Zb 
    124                         !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above] 
    125    rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1) 
     81   !                       !  in netcdf input files, as the start j-row for reading 
    12682/ 
    12783!----------------------------------------------------------------------- 
    12884&namdom        !   space and time domain (bathymetry, mesh, timestep) 
    12985!----------------------------------------------------------------------- 
    130    nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file 
    131    rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1 
     86   ln_linssh   = .false.   !  =T  linear free surface  ==>>  model level are fixed in time 
    13287   nn_closea   =    0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA) 
    133    nn_msh      =    1      !  create (=1) a mesh file or not (=0) 
    134    rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0) 
     88   ! 
     89   nn_msh      =    0      !  create (>0) a mesh file or not (=0) 
    13590   rn_isfhmin  =    1.00   !  treshold (m) to discriminate grounding ice to floating ice 
    136    rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of 
    137    rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1 
    138                            ! 
     91   ! 
    13992   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0) 
    14093   rn_atfp     =    0.1    !  asselin time filter parameter 
    141    ln_crs      = .false.      !  Logical switch for coarsening module 
    142    jphgr_msh   =       0               !  type of horizontal mesh 
    143                                        !  = 0 curvilinear coordinate on the sphere read in coordinate.nc 
    144                                        !  = 1 geographical mesh on the sphere with regular grid-spacing 
    145                                        !  = 2 f-plane with regular grid-spacing 
    146                                        !  = 3 beta-plane with regular grid-spacing 
    147                                        !  = 4 Mercator grid with T/U point at the equator 
    148    ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1) 
    149    ppgphi0     =     -35.0             ! latitude  of first raw and column T-point (jphgr_msh = 1) 
    150    ppe1_deg    =       1.0             !  zonal      grid-spacing (degrees) 
    151    ppe2_deg    =       0.5             !  meridional grid-spacing (degrees) 
    152    ppe1_m      =    5000.0             !  zonal      grid-spacing (degrees) 
    153    ppe2_m      =    5000.0             !  meridional grid-spacing (degrees) 
    154    ppsur       =    -4762.96143546300  !  ORCA r4, r2 and r05 coefficients 
    155    ppa0        =      255.58049070440  ! (default coefficients) 
    156    ppa1        =      245.58132232490  ! 
    157    ppkth       =       21.43336197938  ! 
    158    ppacr       =        3.0            ! 
    159    ppdzmin     =       10.             !  Minimum vertical spacing 
    160    pphmax      =     5000.             !  Maximum depth 
    161    ldbletanh   =    .TRUE.             !  Use/do not use double tanf function for vertical coordinates 
    162    ppa2        =      100.760928500000 !  Double tanh function parameters 
    163    ppkth2      =       48.029893720000 ! 
    164    ppacr2      =       13.000000000000 ! 
     94   ! 
     95   ln_crs      = .false.   !  Logical switch for coarsening module 
    16596/ 
    16697!----------------------------------------------------------------------- 
    … …  
    220151!!====================================================================== 
    221152!!   namsbc          surface boundary condition 
    222 !!   namsbc_ana      analytical         formulation                     (ln_ana     =T) 
    223153!!   namsbc_flx      flux               formulation                     (ln_flx     =T) 
    224154!!   namsbc_clio     CLIO bulk formulae formulation                     (ln_blk_clio=T) 
    … …  
    244174                           !     (also = the frequency of sea-ice & iceberg model call) 
    245175                     ! Type of air-sea fluxes  
    246    ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
     176   ln_usr      = .false.   !  user defined formulation                  (T => check usrdef_sbc) 
    247177   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx ) 
    248178   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
    249    ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
     179   ln_blk_core = .false.    !  CORE bulk formulation                     (T => fill namsbc_core) 
    250180   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs ) 
    251181                     ! Type of coupling (Ocean/Ice/Atmosphere) : 
    … …  
    278208   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr ) 
    279209   ln_isf      = .false.   !  ice shelf                                 (T   => fill namsbc_isf) 
    280    ln_wave = .false.       !  coupling with surface wave                (T => fill namsbc_wave) 
    281    nn_lsm  = 0             !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
     210   ln_wave     = .false.   !  coupling with surface wave                (T => fill namsbc_wave) 
     211   nn_lsm      = 0         !  =0 land/sea mask for input fields is not applied (keep empty land/sea mask filename field) , 
    282212                           !  =1:n number of iterations of land/sea mask application for input fields (fill land/sea mask filename field) 
    283 / 
    284 !----------------------------------------------------------------------- 
    285 &namsbc_ana    !   analytical surface boundary condition 
    286 !----------------------------------------------------------------------- 
    287    nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps 
    288    rn_utau0    =   0.5     !  uniform value for the i-stress 
    289    rn_vtau0    =   0.e0    !  uniform value for the j-stress 
    290    rn_qns0     =   0.e0    !  uniform value for the total heat flux 
    291    rn_qsr0     =   0.e0    !  uniform value for the solar radiation 
    292    rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P) 
    293213/ 
    294214!----------------------------------------------------------------------- 
    … …  
    387307/ 
    388308!----------------------------------------------------------------------- 
    389 &namsbc_sas    !   analytical surface boundary condition 
     309&namsbc_sas    !   Stand Alone Surface boundary condition 
    390310!----------------------------------------------------------------------- 
    391311!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    … …  
    539459&namberg       !   iceberg parameters                                   (default: No iceberg) 
    540460!----------------------------------------------------------------------- 
    541       ln_icebergs              = .false.              ! iceberg floats or not 
    542       ln_bergdia               = .true.               ! Calculate budgets 
    543       nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0 
    544       nn_verbose_write         = 15                   ! Timesteps between verbose messages 
    545       nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage 
    546                                                       ! Initial mass required for an iceberg of each class 
    547       rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11 
    548                                                       ! Proportion of calving mass to apportion to each class 
    549       rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02 
    550                                                       ! Ratio between effective and real iceberg mass (non-dim) 
    551                                                       ! i.e. number of icebergs represented at a point 
    552       rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1 
    553                                                       ! thickness of newly calved bergs (m) 
    554       rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250. 
    555       rn_rho_bergs             = 850.                 ! Density of icebergs 
    556       rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs 
    557       ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics 
    558       rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits 
    559       rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1) 
    560       ln_passive_mode          = .false.              ! iceberg - ocean decoupling 
    561       nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no) 
    562                                                       ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2) 
    563       rn_test_box              = 108.0,  116.0, -66.0, -58.0 
    564       rn_speed_limit           = 0.                   ! CFL speed limit for a berg 
    565  
    566 !            ! file name ! frequency (hours) !   variable   ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
    567 !            !           !  (if <0  months)  !     name     !   (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
    568       sn_icb =  'calving',       -1          , 'calvingmask',  .true.      , .true.  , 'yearly'  , ''       , ''       , '' 
    569  
    570       cn_dir = './' 
     461   ln_icebergs              = .false.              ! iceberg floats or not 
     462   ln_bergdia               = .true.               ! Calculate budgets 
     463   nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0 
     464   nn_verbose_write         = 15                   ! Timesteps between verbose messages 
     465   nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage 
     466                                                   ! Initial mass required for an iceberg of each class 
     467   rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11 
     468                                                   ! Proportion of calving mass to apportion to each class 
     469   rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02 
     470                                                   ! Ratio between effective and real iceberg mass (non-dim) 
     471                                                   ! i.e. number of icebergs represented at a point 
     472   rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1 
     473                                                   ! thickness of newly calved bergs (m) 
     474   rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250. 
     475   rn_rho_bergs             = 850.                 ! Density of icebergs 
     476   rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs 
     477   ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics 
     478   rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits 
     479   rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1) 
     480   ln_passive_mode          = .false.              ! iceberg - ocean decoupling 
     481   nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no) 
     482                                                   ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2) 
     483   rn_test_box              = 108.0,  116.0, -66.0, -58.0 
     484   rn_speed_limit           = 0.                   ! CFL speed limit for a berg 
     485 
     486!         ! file name ! frequency (hours) !   variable   ! time interp. !  clim   ! 'yearly'/ ! weights  ! rotation ! land/sea mask ! 
     487!         !           !  (if <0  months)  !     name     !   (logical)  !  (T/F ) ! 'monthly' ! filename ! pairing  ! filename      ! 
     488   sn_icb =  'calving',       -1          , 'calvingmask',  .true.      , .true.  , 'yearly'  , ''       , ''       , '' 
     489 
     490   cn_dir = './' 
    571491/ 
    572492 
    … …  
    600520&nam_tide      !   tide parameters                                      ("key_tide") 
    601521!----------------------------------------------------------------------- 
    602    ln_tide_pot   = .true.   !  use tidal potential forcing 
    603    ln_tide_ramp  = .false.  ! 
    604    rdttideramp   =    0.    ! 
    605    clname(1)     = 'DUMMY'  !  name of constituent - all tidal components must be set in namelist_cfg 
     522   ln_tide_pot = .true.    !  use tidal potential forcing 
     523   ln_tide_ramp= .false.   ! 
     524   rdttideramp =    0.     ! 
     525   clname(1)   = 'DUMMY'   !  name of constituent  
     526   !                       !  all tidal components must be set in namelist_cfg 
    606527/ 
    607528!----------------------------------------------------------------------- 
    608529&nambdy        !  unstructured open boundaries                          ("key_bdy") 
    609530!----------------------------------------------------------------------- 
    610     nb_bdy         = 0                    !  number of open boundary sets 
    611     ln_coords_file = .true.               !  =T : read bdy coordinates from file 
    612     cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
    613     ln_mask_file   = .false.              !  =T : read mask from file 
    614     cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.) 
    615     cn_dyn2d       = 'none'               ! 
    616     nn_dyn2d_dta   =  0                   !  = 0, bdy data are equal to the initial state 
    617                                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    618                                           !  = 2, use tidal harmonic forcing data from files 
    619                                           !  = 3, use external data AND tidal harmonic forcing 
    620     cn_dyn3d      =  'none'               ! 
    621     nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    622                                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    623     cn_tra        =  'none'               ! 
    624     nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state 
    625                                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    626     cn_ice_lim      =  'none'             ! 
    627     nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state 
    628                                           !  = 1, bdy data are read in 'bdydata   .nc' files 
    629     rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice 
    630     rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           -- 
    631     rn_ice_age      = 30.                 !  lim3 only:      --   age                -- 
    632  
    633     ln_tra_dmp    =.false.                !  open boudaries conditions for tracers 
    634     ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities 
    635     rn_time_dmp   =  1.                   ! Damping time scale in days 
    636     rn_time_dmp_out =  1.                 ! Outflow damping time scale 
    637     nn_rimwidth   = 10                    !  width of the relaxation zone 
    638     ln_vol        = .false.               !  total volume correction (see nn_volctl parameter) 
    639     nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero 
     531   nb_bdy         = 0                    !  number of open boundary sets 
     532   ln_coords_file = .true.               !  =T : read bdy coordinates from file 
     533   cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files 
     534   ln_mask_file   = .false.              !  =T : read mask from file 
     535   cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.) 
     536   cn_dyn2d       = 'none'               ! 
     537   nn_dyn2d_dta   =  0                   !  = 0, bdy data are equal to the initial state 
     538      !                                  !  = 1, bdy data are read in 'bdydata   .nc' files 
     539      !                                  !  = 2, use tidal harmonic forcing data from files 
     540      !                                  !  = 3, use external data AND tidal harmonic forcing 
     541   cn_dyn3d      =  'none'               ! 
     542   nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
     543      !                                  !  = 1, bdy data are read in 'bdydata   .nc' files 
     544   cn_tra        =  'none'               ! 
     545   nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state 
     546      !                                  !  = 1, bdy data are read in 'bdydata   .nc' files 
     547   cn_ice_lim      =  'none'             ! 
     548   nn_ice_lim_dta  =  0                  !  = 0, bdy data are equal to the initial state 
     549      !                                  !  = 1, bdy data are read in 'bdydata   .nc' files 
     550   rn_ice_tem      = 270.                !  lim3 only: arbitrary temperature of incoming sea ice 
     551   rn_ice_sal      = 10.                 !  lim3 only:      --   salinity           -- 
     552   rn_ice_age      = 30.                 !  lim3 only:      --   age                -- 
     553   ! 
     554   ln_tra_dmp    =.false.                !  open boudaries conditions for tracers 
     555   ln_dyn3d_dmp  =.false.                !  open boundary condition for baroclinic velocities 
     556   rn_time_dmp   =  1.                   ! Damping time scale in days 
     557   rn_time_dmp_out =  1.                 ! Outflow damping time scale 
     558   nn_rimwidth   = 10                    !  width of the relaxation zone 
     559   ln_vol        = .false.               !  total volume correction (see nn_volctl parameter) 
     560   nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero 
    640561/ 
    641562!----------------------------------------------------------------------- 
    … …  
    887808!----------------------------------------------------------------------- 
    888809   ln_hpg_zco  = .false.   !  z-coordinate - full steps 
    889    ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation) 
     810   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation) 
    890811   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation) 
    891812   ln_hpg_isf  = .false.   !  s-coordinate (sco ) adapted to isf 
    … …  
    1041962!!====================================================================== 
    1042963!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi) 
    1043 !!   namctl            Control prints & Benchmark 
     964!!   namctl            Control prints  
    1044965!!   namsto            Stochastic parametrization of EOS 
    1045966!!====================================================================== 
    … …  
    1057978/ 
    1058979!----------------------------------------------------------------------- 
    1059 &namctl        !   Control prints & Benchmark 
     980&namctl        !   Control prints  
    1060981!----------------------------------------------------------------------- 
    1061982   ln_ctl      = .false.   !  trends control print (expensive!) 
    … …  
    1067988   nn_isplt    =    1      !  number of processors in i-direction 
    1068989   nn_jsplt    =    1      !  number of processors in j-direction 
    1069    nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench 
    1070                            !     (no physical validity of the results) 
    1071990   nn_timing   =    0      !  timing by routine activated (=1) creates timing.output file, or not (=0) 
    1072991   nn_diacfl   =    0      !  Write out CFL diagnostics (=1) in cfl_diagnostics.ascii, or not (=0) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/cfg.txt

    r6403 r7277  
    99ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 
    1010ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 
     11ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     12OVERFLOW OPA_SRC 
     13LOCK_EXCHANGE OPA_SRC 
    1114GYRE OPA_SRC 
    12 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 
     15ISOMIP OPA_SRC 

  • branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/makenemo

    r5144 r7277  
    150150   echo ""; 
    151151        echo "Available unsupported (external) configurations :"; cat ${CONFIG_DIR}/uspcfg.txt; 
     152   echo ""; 
     153   echo "Example to install an unsupoorted configuration MY_USP"; 
     154   echo "makenemo -n MY_USP -u MY_USP" ; 
    152155   echo ""; 
    153156   echo "Example to remove bad configuration "; 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    r3764 r7277  
    2727      !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
    2828 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   fs2cor , fcor     !: coriolis factor and coeficient 
    3029   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   covrai            !: sine of geographic latitude 
    3130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   area              !: surface of grid cell  
    … …  
    4847      ierr(:) = 0 
    4948      ! 
    50       ALLOCATE( fs2cor(jpi,jpj)     , fcor(jpi,jpj) ,                                   & 
    51          &      covrai(jpi,jpj)     , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) ,     & 
     49      ALLOCATE( covrai(jpi,jpj)     , area(jpi,jpj) , tms(jpi,jpj) , tmu(jpi,jpj) ,     & 
    5250         &      wght  (jpi,jpj,2,2)                                               , STAT=ierr(1) ) 
    5351         ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

    r5836 r7277  
    144144       
    145145         resto_ice(:,:,:) = 0._wp 
    146          !      Re-calculate the North and South boundary restoring term 
    147          !      because those boundaries may change with the prescribed zoom area. 
    148146         ! 
    149147         irelax  = 16                     ! width of buffer zone with respect to close boundary 
    … …  
    156154         ! REM: if there is no ice in the model and in the data,  
    157155         !      no restoring even with non zero resto_ice 
    158          DO jj = mj0(jpjzoom - 1 + 1), mj1(jpjzoom -1 + irelax) 
    159             zreltim = zdmpmin + zfactor * ( mjg(jj) - jpjzoom + 1 ) 
     156         DO jj = mj0(1), mj1( irelax) 
     157            zreltim = zdmpmin + zfactor * mjg(jj) 
    160158            resto_ice(:,jj,:) = 1._wp / ( zreltim * 86400._wp ) 
    161159         END DO 
    162160 
    163161         ! North boundary restoring term 
    164          DO jj =  mj0(jpjzoom -1 + jpjglo - irelax), mj1(jpjzoom - 1 + jpjglo) 
    165             zreltim = zdmpmin + zfactor * (jpjglo - ( mjg(jj) - jpjzoom + 1 )) 
     162         DO jj =  mj0(jpjglo - irelax), mj1(jpjglo) 
     163            zreltim = zdmpmin + zfactor * (jpjglo - mjg(jj)) 
    166164            resto_ice(:,jj,:) = 1.e0 / ( zreltim * 86400 ) 
    167165         END DO 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    r5541 r7277  
    6969      IF( .NOT. ln_limini ) THEN   
    7070          
    71          CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celcius] 
     71         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celsius] 
    7272         tfu(:,:) = tfu(:,:) *  tmask(:,:,1) 
    7373 
    … …  
    7979               ENDIF 
    8080               ! 
    81                IF( fcor(ji,jj) >= 0.e0 ) THEN     !--  Northern hemisphere. 
     81               IF( ff_t(ji,jj) >= 0._wp ) THEN     !--  Northern hemisphere. 
    8282                  hicif(ji,jj)   = zidto * hginn 
    8383                  frld(ji,jj)    = zidto * alinn + ( 1.0 - zidto ) * 1.0 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    r3625 r7277  
    7070      ENDIF 
    7171       
    72       IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 )   & 
    73           &      CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' ) 
    74  
    7572      !----------------------------------------------------------                           
    7673      !    Initialization of local and some global (common) variables  
    … …  
    7976      njeq   = INT( jpj / 2 )   !i bug mpp potentiel 
    8077      njeqm1 = njeq - 1  
    81  
    82       fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor at T-point 
    8378  
    8479!i    DO jj = 1, jpj 
    … …  
    8782!i    END DO 
    8883 
    89       IF( fcor(1,1) * fcor(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere 
     84      IF( ff_t(1,1) * ff_t(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere 
    9085         l_jeq = .TRUE. 
    9186         njeq  = 1 
    92          DO WHILE ( njeq <= jpj .AND. fcor(1,njeq) < 0.e0 ) 
     87         DO WHILE ( njeq <= jpj .AND. ff_t(1,njeq) < 0.e0 ) 
    9388            njeq = njeq + 1 
    9489         END DO 
    9590         IF(lwp ) WRITE(numout,*) '          the equator is inside the domain at about njeq = ', njeq 
    96       ELSEIF( fcor(1,1) < 0.e0 ) THEN 
     91      ELSEIF( ff_t(1,1) < 0.e0 ) THEN 
    9792         l_jeq = .FALSE. 
    9893         njeq = jpj 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r5836 r7277  
    163163         DO ji = 1 , jpi 
    164164            ! only the sinus changes its sign with the hemisphere 
    165             zsang(ji,jj)  = SIGN( 1._wp, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere 
     165            zsang(ji,jj)  = SIGN( 1._wp, ff_t(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere 
    166166            ! 
    167167            zmasst(ji,jj) = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) ) 
    … …  
    198198               &           + zmasst(ji,jj-1) * wght(ji,jj,2,1) + zmasst(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw 
    199199            zcorl(ji,jj) = zmass(ji,jj) & 
    200                &           *( fcor(ji,jj  ) * wght(ji,jj,2,2) + fcor(ji-1,jj  )*wght(ji,jj,1,2)   & 
    201                &            + fcor(ji,jj-1) * wght(ji,jj,2,1) + fcor(ji-1,jj-1)*wght(ji,jj,1,1) ) * zusw 
     200               &           *( ff_t(ji,jj  ) * wght(ji,jj,2,2) + ff_t(ji-1,jj  )*wght(ji,jj,1,2)   & 
     201               &            + ff_t(ji,jj-1) * wght(ji,jj,2,1) + ff_t(ji-1,jj-1)*wght(ji,jj,1,1) ) * zusw 
    202202 
    203203            ! Wind stress. 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r6140 r7277  
    449449      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    450450      sice_0(:,:) = sice 
    451       ! 
    452       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    453          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    454             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    455             soce_0(:,:) = 4._wp 
    456             sice_0(:,:) = 2._wp 
    457          END WHERE 
    458       ENDIF 
     451      !                                      ! decrease ocean & ice reference salinities in the Baltic sea  
     452      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     453         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     454         soce_0(:,:) = 4._wp 
     455         sice_0(:,:) = 2._wp 
     456      END WHERE 
    459457      !                                      ! embedded sea ice 
    460458      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    … …  
    473471!!gm 
    474472         IF( .NOT.ln_linssh ) THEN 
    475  
    476             do jk = 1,jpkm1                     ! adjust initial vertical scale factors 
     473            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    477474               e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    478475               e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    479             end do 
     476            END DO 
    480477            e3t_a(:,:,:) = e3t_b(:,:,:) 
    481478            ! Reconstruction of all vertical scale factors at now and before time steps 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r6140 r7277  
    347347      ! Tricky trick : add 2 to frld in the Southern Hemisphere 
    348348      !-------------------------------------------------------- 
    349       IF( fcor(1,1) < 0.e0 ) THEN 
     349      IF( ff_t(1,1) < 0._wp ) THEN 
    350350         DO jj = 1, njeqm1 
    351351            DO ji = 1, jpi 
    … …  
    479479 
    480480      !! Fram Strait sea-ice transport (sea-ice + snow)  (in ORCA2 = 5 points) 
    481       IF( iom_use('fram_trans') .and. cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     481      IF( iom_use('fram_trans') .and. cn_cfg == "orca" .AND. nn_cfg == 2 ) THEN    ! ORCA R2 configuration 
    482482         DO jj = mj0(137), mj1(137) ! B grid 
    483483            IF( mj0(jj-1) >= nldj ) THEN 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r4624 r7277  
    234234         !-------------------------------------------------------------------! 
    235235         DO jj = 1, jpj 
    236             zindhe = MAX( 0.e0, SIGN( 1.e0, fcor(1,jj) ) )              ! = 0 for SH, =1 for NH 
     236            zindhe = MAX( 0._wp, SIGN( 1._wp, ff_t(1,jj) ) )              ! = 0 for SH, =1 for NH 
    237237            DO ji = 1, jpi 
    238238               ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r5123 r7277  
    2020   INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    2121 
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   fcor   !: coriolis coefficient 
    2322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages 
    2423 
    … …  
    3736      !!------------------------------------------------------------------- 
    3837      ! 
    39       ALLOCATE( fcor(jpi,jpj), wght(jpi,jpj,2,2), STAT = dom_ice_alloc ) 
     38      ALLOCATE( wght(jpi,jpj,2,2), STAT = dom_ice_alloc ) 
    4039      ! 
    4140      IF( dom_ice_alloc /= 0 )   CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' ) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r6140 r7277  
    168168            DO jj = 1, jpj 
    169169               DO ji = 1, jpi 
    170                   IF( fcor(ji,jj) >= 0._wp ) THEN 
     170                  IF( ff_t(ji,jj) >= 0._wp ) THEN 
    171171                     zht_i_ini(ji,jj) = rn_hti_ini_n 
    172172                     zht_s_ini(ji,jj) = rn_hts_ini_n 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90

    r5123 r7277  
    5454      ENDIF 
    5555 
    56       IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 )   & 
    57           &      CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane') 
    58  
    59       !                           !==  coriolis factor & Equator position ==! 
     56      !                           !==  Equator position  ==! 
    6057      njeq   = INT( jpj / 2 )  
    6158      njeqm1 = njeq - 1  
    6259      ! 
    63       fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   ! coriolis factor 
    64       ! 
    65       IF( fcor(1,1) * fcor(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere 
     60      IF( ff_t(1,1) * ff_t(1,nlcj) < 0._wp ) THEN   ! local domain include both hemisphere 
    6661         l_jeq = .TRUE. 
    6762         njeq  = 1 
    68          DO WHILE ( njeq <= jpj .AND. fcor(1,njeq) < 0.e0 ) 
     63         DO WHILE ( njeq <= jpj .AND. ff_t(1,njeq) < 0._wp ) 
    6964            njeq = njeq + 1 
    7065         END DO 
    7166         IF(lwp ) WRITE(numout,*) '          the equator is inside the domain at about njeq = ', njeq 
    72       ELSEIF( fcor(1,1) < 0.e0 ) THEN 
     67      ELSEIF( ff_t(1,1) < 0._wp ) THEN 
    7368         l_jeq = .FALSE. 
    7469         njeq = jpj 
    … …  
    8479 
    8580      !                           !==  metric coefficients for sea ice dynamic  ==! 
    86       wght(:,:,:,:) = 0.e0 
     81      wght(:,:,:,:) = 0._wp 
    8782!!gm  Optimisation :  wght to be defined at F-point, not I-point  and change in limrhg 
    8883      DO jj = 2, jpj 
    8984         DO ji = 2, jpi 
    90             zusden = 1.e0 / (  ( e1t(ji,jj) + e1t(ji-1,jj  ) )   & 
    91                &             * ( e2t(ji,jj) + e2t(ji  ,jj-1) ) ) 
     85            zusden = 1._wp / (  ( e1t(ji,jj) + e1t(ji-1,jj  ) )   & 
     86               &              * ( e2t(ji,jj) + e2t(ji  ,jj-1) ) ) 
    9287            wght(ji,jj,1,1) = zusden * e1t(ji  ,jj) * e2t(ji,jj  ) 
    9388            wght(ji,jj,1,2) = zusden * e1t(ji  ,jj) * e2t(ji,jj-1) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r5836 r7277  
    267267            zmass1(ji,jj) = ( zt12 * zc1 + zt11 * zc2 ) / ( zt11 + zt12 + zepsi ) 
    268268            zmass2(ji,jj) = ( zt22 * zc1 + zt21 * zc3 ) / ( zt21 + zt22 + zepsi ) 
    269             zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * fcor(ji,jj) + e1t(ji,jj) * fcor(ji+1,jj) )   & 
     269            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj) * ff_t(ji,jj) + e1t(ji,jj) * ff_t(ji+1,jj) )   & 
    270270               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + zepsi ) 
    271             zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * fcor(ji,jj) + e2t(ji,jj) * fcor(ji,jj+1) )   & 
     271            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1) * ff_t(ji,jj) + e2t(ji,jj) * ff_t(ji,jj+1) )   & 
    272272               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + zepsi ) 
    273273            ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6140 r7277  
    316316      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    317317      sice_0(:,:) = sice 
    318       ! 
    319       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    320          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    321             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    322             soce_0(:,:) = 4._wp 
    323             sice_0(:,:) = 2._wp 
    324          END WHERE 
    325       ENDIF 
     318      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
     319      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     320         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     321         soce_0(:,:) = 4._wp 
     322         sice_0(:,:) = 2._wp 
     323      END WHERE 
    326324      ! 
    327325      IF( .NOT. ln_rstart ) THEN 
    … …  
    331329            snwice_mass_b(:,:) = snwice_mass(:,:) 
    332330         ELSE 
    333             snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
    334             snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     331            snwice_mass  (:,:) = 0._wp          ! no mass exchanges 
     332            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges 
    335333         ENDIF 
    336334         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r6403 r7277  
    55   !!===================================================================== 
    66   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module 
     7   !!---------------------------------------------------------------------- 
     8#if defined key_lim3 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_lim3'                                      LIM3 sea-ice model 
    711   !!---------------------------------------------------------------------- 
    812   USE in_out_manager ! I/O manager 
    … …  
    175179   END FUNCTION thd_ice_alloc 
    176180    
     181#else 
     182   !!---------------------------------------------------------------------- 
     183   !!   Default option :         Empty module          NO LIM sea-ice model 
     184   !!---------------------------------------------------------------------- 
     185CONTAINS 
     186   SUBROUTINE thd_ice_alloc          ! Empty routine 
     187   END SUBROUTINE thd_ice_alloc 
     188#endif 
     189  
    177190   !!====================================================================== 
    178191END MODULE thd_ice 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r6140 r7277  
    11#if defined key_agrif 
    22!!---------------------------------------------------------------------- 
    3 !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     3!! NEMO/NST 3.7 , NEMO Consortium (2016) 
    44!! $Id$ 
    55!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    1818   USE dom_oce 
    1919   USE nemogcm 
    20    ! 
     20   !! 
    2121   IMPLICIT NONE 
    2222   !!---------------------------------------------------------------------- 
    … …  
    3232! JC: change to allow for different vertical levels 
    3333!     jpk is already set 
    34 !     keep it jpk possibly different from jpkdta which  
     34!     keep it jpk possibly different from jpkglo which  
    3535!     hold parent grid vertical levels number (set earlier) 
    36 !      jpk     = jpkdta  
     36!      jpk     = jpkglo  
    3737      jpim1   = jpi-1  
    3838      jpjm1   = jpj-1  
    3939      jpkm1   = jpk-1                                          
    4040      jpij    = jpi*jpj  
    41       jpidta  = jpiglo 
    42       jpjdta  = jpjglo 
    43       jpizoom = 1 
    44       jpjzoom = 1 
     41 !SF      jpidta  = jpiglo 
     42 !SF     jpjdta  = jpjglo 
    4543      nperio  = 0 
    4644      jperio  = 0 
    … …  
    6260   USE tradmp 
    6361   USE bdy_par 
    64  
    65    IMPLICIT NONE 
    66    !!---------------------------------------------------------------------- 
    67    ! 0. Initializations 
    68    !------------------- 
    69    IF( cp_cfg == 'orca' ) THEN 
    70       IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 & 
    71             &                      .OR. jp_cfg == 4 ) THEN 
    72          jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    73          cp_cfg = "default" 
     62   !! 
     63   IMPLICIT NONE 
     64   !!---------------------------------------------------------------------- 
     65   ! 
     66!!gm  I think this is now useless ...   nn_cfg & cn_cfg are set to -999999 and "UNKNOWN"  
     67!!gm                                    when reading the AGRIF domain configuration file 
     68   IF( cn_cfg == 'orca' ) THEN 
     69      IF ( nn_cfg == 2 .OR. nn_cfg == 025 .OR. nn_cfg == 05  .OR. nn_cfg == 4 ) THEN 
     70         nn_cfg = -1    ! set special value for nn_cfg on fine grids 
     71         cn_cfg = "default" 
    7472      ENDIF 
    7573   ENDIF 
    76    ! Specific fine grid Initializations 
    77    ! no tracer damping on fine grids 
    78    ln_tradmp = .FALSE. 
    79    ! no open boundary on fine grids 
    80    lk_bdy = .FALSE. 
    81  
    82  
    83    CALL nemo_init  ! Initializations of each fine grid 
    84  
     74!!gm end 
     75 
     76   !                    !* Specific fine grid Initializations 
     77   ln_tradmp = .FALSE.        ! no tracer damping on fine grids 
     78   ! 
     79   lk_bdy    = .FALSE.        ! no open boundary on fine grids 
     80 
     81   CALL nemo_init       !* Initializations of each fine grid 
     82 
     83   !                    !* Agrif initialization 
    8584   CALL agrif_nemo_init 
    8685   CALL Agrif_InitValues_cont_dom 
    … …  
    9089# if defined key_top 
    9190   CALL Agrif_InitValues_cont_top 
    92 # endif       
     91# endif 
     92   ! 
    9393END SUBROUTINE Agrif_initvalues 
    9494 
    … …  
    108108   USE agrif_opa_interp 
    109109   USE agrif_opa_sponge 
    110    ! 
    111    IMPLICIT NONE 
    112    ! 
    113    !!---------------------------------------------------------------------- 
    114  
     110   !! 
     111   IMPLICIT NONE 
     112   !!---------------------------------------------------------------------- 
     113   ! 
    115114   ! Declaration of the type of variable which have to be interpolated 
    116    !--------------------------------------------------------------------- 
     115   ! 
    117116   CALL agrif_declare_var_dom 
    118117   ! 
    … …  
    129128   USE par_oce        
    130129   USE oce 
     130   !! 
    131131   IMPLICIT NONE 
    132132   !!---------------------------------------------------------------------- 
    … …  
    176176   USE agrif_opa_interp 
    177177   USE agrif_opa_sponge 
    178    ! 
     178   !! 
    179179   IMPLICIT NONE 
    180180   ! 
    … …  
    259259 
    260260      ! Check coordinates 
    261       IF( ln_zps ) THEN 
    262          ! check parameters for partial steps  
    263          IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    264             WRITE(*,*) 'incompatible e3zps_min between grids' 
    265             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
    266             WRITE(*,*) 'child grid  :',e3zps_min 
    267             WRITE(*,*) 'those values should be identical' 
    268             STOP 
    269          ENDIF 
    270          IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
    271             WRITE(*,*) 'incompatible e3zps_rat between grids' 
    272             WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
    273             WRITE(*,*) 'child grid  :',e3zps_rat 
    274             WRITE(*,*) 'those values should be identical'                   
    275             STOP 
    276          ENDIF 
    277       ENDIF 
     261     !SF IF( ln_zps ) THEN 
     262     !SF     ! check parameters for partial steps  
     263     !SF     IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
     264     !SF        WRITE(*,*) 'incompatible e3zps_min between grids' 
     265     !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     266     !SF        WRITE(*,*) 'child grid  :',e3zps_min 
     267     !SF        WRITE(*,*) 'those values should be identical' 
     268     !SF        STOP 
     269     !SF     ENDIF 
     270     !SF     IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN 
     271     !SF        WRITE(*,*) 'incompatible e3zps_rat between grids' 
     272     !SF        WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     273     !SF        WRITE(*,*) 'child grid  :',e3zps_rat 
     274     !SF        WRITE(*,*) 'those values should be identical'                   
     275     !SF        STOP 
     276     !SF     ENDIF 
     277     !SF ENDIF 
    278278 
    279279      ! Check free surface scheme 
    … …  
    346346   USE oce 
    347347   USE agrif_oce 
     348   !! 
    348349   IMPLICIT NONE 
    349350   !!---------------------------------------------------------------------- 
    … …  
    484485   USE agrif_lim2_interp 
    485486   USE lib_mpp 
    486    ! 
    487    IMPLICIT NONE 
    488    ! 
     487   !! 
     488   IMPLICIT NONE 
    489489   !!---------------------------------------------------------------------- 
    490490 
    … …  
    521521END SUBROUTINE Agrif_InitValues_cont_lim2 
    522522 
     523 
    523524SUBROUTINE agrif_declare_var_lim2 
    524525   !!---------------------------------------------------------------------- 
    … …  
    529530   USE agrif_util 
    530531   USE ice_2 
    531  
     532   !! 
    532533   IMPLICIT NONE 
    533534   !!---------------------------------------------------------------------- 
    … …  
    585586   USE agrif_top_interp 
    586587   USE agrif_top_sponge 
    587    ! 
     588   !! 
    588589   IMPLICIT NONE 
    589590   ! 
    … …  
    684685   USE dom_oce 
    685686   USE trc 
    686  
    687    IMPLICIT NONE 
     687   !! 
     688   IMPLICIT NONE 
     689   !!---------------------------------------------------------------------- 
    688690 
    689691   ! 1. Declaration of the type of variable which have to be interpolated 
    … …  
    716718SUBROUTINE Agrif_detect( kg, ksizex ) 
    717719   !!---------------------------------------------------------------------- 
    718    !!   *** ROUTINE Agrif_detect *** 
    719    !!---------------------------------------------------------------------- 
    720    ! 
     720   !!                      *** ROUTINE Agrif_detect *** 
     721   !!---------------------------------------------------------------------- 
    721722   INTEGER, DIMENSION(2) :: ksizex 
    722723   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    … …  
    736737   USE in_out_manager 
    737738   USE lib_mpp 
     739   !! 
    738740   IMPLICIT NONE 
    739741   ! 
    … …  
    789791   !!---------------------------------------------------------------------- 
    790792   USE dom_oce 
     793   !! 
    791794   IMPLICIT NONE 
    792795   ! 
    … …  
    803806END SUBROUTINE Agrif_InvLoc 
    804807 
     808 
    805809SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    806810   !!---------------------------------------------------------------------- 
    … …  
    808812   !!---------------------------------------------------------------------- 
    809813   USE par_oce 
     814   !! 
    810815   IMPLICIT NONE 
    811816   ! 
    … …  
    821826END SUBROUTINE Agrif_get_proc_info 
    822827 
     828 
    823829SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    824830   !!---------------------------------------------------------------------- 
    … …  
    826832   !!---------------------------------------------------------------------- 
    827833   USE par_oce 
     834   !! 
    828835   IMPLICIT NONE 
    829836   ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r6140 r7277  
    2222   USE c1d             ! 1D configuration: lk_c1d 
    2323   USE dom_oce         ! ocean domain: variables 
     24   USE domvvl          ! variable volume 
    2425   USE zdf_oce         ! ocean vertical physics: variables 
    2526   USE sbc_oce         ! surface module: variables 
    2627   USE trc_oce         ! share ocean/biogeo variables 
    2728   USE phycst          ! physical constants 
    28    USE ldftra          ! lateral diffusivity coefficients 
    2929   USE trabbl          ! active tracer: bottom boundary layer 
    3030   USE ldfslp          ! lateral diffusion: iso-neutral slopes 
     31   USE sbcrnf          ! river runoffs 
     32   USE ldftra          ! ocean tracer   lateral physics 
    3133   USE zdfmxl          ! vertical physics: mixed layer depth 
    3234   USE eosbn2          ! equation of state - Brunt Vaisala frequency 
    … …  
    3840   USE prtctl          ! print control 
    3941   USE fldread         ! read input fields  
     42   USE wrk_nemo        ! Memory allocation  
    4043   USE timing          ! Timing 
    41    USE wrk_nemo 
     44   USE trc, ONLY : ln_rsttr, numrtr, numrtw, lrst_trc 
    4245 
    4346   IMPLICIT NONE 
    … …  
    4649   PUBLIC   dta_dyn_init   ! called by opa.F90 
    4750   PUBLIC   dta_dyn        ! called by step.F90 
    48  
    49    CHARACTER(len=100) ::   cn_dir       !: Root directory for location of ssr files 
    50    LOGICAL            ::   ln_dynwzv    !: vertical velocity read in a file (T) or computed from u/v (F) 
    51    LOGICAL            ::   ln_dynbbl    !: bbl coef read in a file (T) or computed (F) 
    52    LOGICAL            ::   ln_dynrnf    !: read runoff data in file (T) or set to zero (F) 
    53  
    54    INTEGER  , PARAMETER ::   jpfld = 15     ! maximum number of fields to read 
     51   PUBLIC   dta_dyn_swp   ! called by step.F90 
     52 
     53   CHARACTER(len=100) ::   cn_dir          !: Root directory for location of ssr files 
     54   LOGICAL            ::   ln_dynrnf       !: read runoff data in file (T) or set to zero (F) 
     55   LOGICAL            ::   ln_dynrnf_depth       !: read runoff data in file (T) or set to zero (F) 
     56   REAL(wp)           ::   fwbcorr 
     57 
     58 
     59   INTEGER  , PARAMETER ::   jpfld = 20     ! maximum number of fields to read 
    5560   INTEGER  , SAVE      ::   jf_tem         ! index of temperature 
    5661   INTEGER  , SAVE      ::   jf_sal         ! index of salinity 
    57    INTEGER  , SAVE      ::   jf_uwd         ! index of u-wind 
    58    INTEGER  , SAVE      ::   jf_vwd         ! index of v-wind 
    59    INTEGER  , SAVE      ::   jf_wwd         ! index of w-wind 
     62   INTEGER  , SAVE      ::   jf_uwd         ! index of u-transport 
     63   INTEGER  , SAVE      ::   jf_vwd         ! index of v-transport 
     64   INTEGER  , SAVE      ::   jf_wwd         ! index of v-transport 
    6065   INTEGER  , SAVE      ::   jf_avt         ! index of Kz 
    6166   INTEGER  , SAVE      ::   jf_mld         ! index of mixed layer deptht 
    6267   INTEGER  , SAVE      ::   jf_emp         ! index of water flux 
     68   INTEGER  , SAVE      ::   jf_empb        ! index of water flux 
    6369   INTEGER  , SAVE      ::   jf_qsr         ! index of solar radiation 
    6470   INTEGER  , SAVE      ::   jf_wnd         ! index of wind speed 
    6571   INTEGER  , SAVE      ::   jf_ice         ! index of sea ice cover 
    6672   INTEGER  , SAVE      ::   jf_rnf         ! index of river runoff 
     73   INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux 
    6774   INTEGER  , SAVE      ::   jf_ubl         ! index of u-bbl coef 
    6875   INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef 
    69    INTEGER  , SAVE      ::   jf_fmf         ! index of downward salt flux 
    70  
    71    TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read) 
     76   INTEGER  , SAVE      ::   jf_div         ! index of e3t 
     77 
     78 
     79   TYPE(FLD), ALLOCATABLE, SAVE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read) 
    7280   !                                               !  
    73    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta       ! vertical velocity at 2 time step 
    74    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) :: wnow       ! vertical velocity at 2 time step 
    7581   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes 
    7682   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes 
    7783   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta   ! zonal diapycnal slopes 
    7884   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta   ! meridional diapycnal slopes 
    79    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: uslpnow    ! zonal isopycnal slopes 
    80    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: vslpnow    ! meridional isopycnal slopes 
    81    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpinow   ! zonal diapycnal slopes 
    82    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpjnow   ! meridional diapycnal slopes 
    83  
    84    INTEGER :: nrecprev_tem , nrecprev_uwd 
    85  
    86    !! * Substitutions 
    87 #  include "vectopt_loop_substitute.h90" 
     85 
     86   INTEGER, SAVE  :: nprevrec, nsecdyn 
     87 
     88 
    8889   !!---------------------------------------------------------------------- 
    8990   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    … …  
    104105      !!             - interpolates data if needed 
    105106      !!---------------------------------------------------------------------- 
    106       USE oce, ONLY:  zts    => tsa 
    107       USE oce, ONLY:  zuslp  => ua   , zvslp  => va 
    108       USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => rke 
    109       ! 
     107      ! 
     108      USE oce, ONLY:  zhdivtr => ua 
    110109      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    111       ! 
    112        REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zwslpi, zwslpj 
    113 !      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)  :: zts 
    114 !      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zuslp, zvslp, zwslpi, zwslpj 
    115 !      REAL(wp), DIMENSION(jpi,jpj,jpk     )  :: zu, zv, zw 
    116       ! 
    117       ! 
    118       INTEGER  ::   ji, jj     ! dummy loop indices 
    119       INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
    120       REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    121       REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    122       INTEGER  ::   iswap_tem, iswap_uwd    !  
     110      INTEGER             ::   ji, jj, jk 
     111      REAL(wp), POINTER, DIMENSION(:,:)   :: zemp 
     112      ! 
    123113      !!---------------------------------------------------------------------- 
    124114       
    … …  
    126116      IF( nn_timing == 1 )  CALL timing_start( 'dta_dyn') 
    127117      ! 
    128       isecsbc = nsec_year + nsec1jan000  
    129       ! 
    130       IF( kt == nit000 ) THEN 
    131          nrecprev_tem = 0 
    132          nrecprev_uwd = 0 
    133          ! 
    134          CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    135          ! 
    136          IF( l_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
    137             zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
    138             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
    139             avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
    140             CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
    141             uslpdta (:,:,:,1) = zuslp (:,:,:)  
    142             vslpdta (:,:,:,1) = zvslp (:,:,:)  
    143             wslpidta(:,:,:,1) = zwslpi(:,:,:)  
    144             wslpjdta(:,:,:,1) = zwslpj(:,:,:)  
    145          ENDIF 
    146          IF( ln_dynwzv .AND. sf_dyn(jf_uwd)%ln_tint )  THEN    ! compute vertical velocity from u/v 
    147             zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,1) 
    148             zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,1) 
    149             CALL dta_dyn_wzv( zu, zv, zw ) 
    150             wdta(:,:,:,1) = zw(:,:,:) * tmask(:,:,:) 
    151          ENDIF 
    152       ELSE 
    153          nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2) 
    154          nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2) 
    155          ! 
    156          CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==! 
    157          ! 
    158       ENDIF 
    159       !  
    160       IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                        
    161          iswap_tem = 0 
    162          IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1 
    163          IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data 
    164             IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
    165             IF( sf_dyn(jf_tem)%ln_tint ) THEN                 ! time interpolation of data 
    166                IF( kt /= nit000 ) THEN 
    167                   uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data 
    168                   vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)   
    169                   wslpidta(:,:,:,1) =  wslpidta(:,:,:,2)  
    170                   wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2)  
    171                ENDIF 
    172                ! 
    173                zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
    174                zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
    175                avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
    176                CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
    177                ! 
    178                uslpdta (:,:,:,2) = zuslp (:,:,:)  
    179                vslpdta (:,:,:,2) = zvslp (:,:,:)  
    180                wslpidta(:,:,:,2) = zwslpi(:,:,:)  
    181                wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
    182             ELSE 
    183                zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) 
    184                zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) 
    185                avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) 
    186                CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
    187                uslpnow (:,:,:)   = zuslp (:,:,:)  
    188                vslpnow (:,:,:)   = zvslp (:,:,:)  
    189                wslpinow(:,:,:)   = zwslpi(:,:,:)  
    190                wslpjnow(:,:,:)   = zwslpj(:,:,:)  
    191             ENDIF 
    192          ENDIF 
    193          IF( sf_dyn(jf_tem)%ln_tint )  THEN 
    194             ztinta =  REAL( isecsbc - sf_dyn(jf_tem)%nrec_b(2), wp )  & 
    195                &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 
    196             ztintb =  1. - ztinta 
    197             uslp (:,:,:) = ztintb * uslpdta (:,:,:,1)  + ztinta * uslpdta (:,:,:,2)   
    198             vslp (:,:,:) = ztintb * vslpdta (:,:,:,1)  + ztinta * vslpdta (:,:,:,2)   
    199             wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1)  + ztinta * wslpidta(:,:,:,2)   
    200             wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1)  + ztinta * wslpjdta(:,:,:,2)   
    201          ELSE 
    202             uslp (:,:,:) = uslpnow (:,:,:) 
    203             vslp (:,:,:) = vslpnow (:,:,:) 
    204             wslpi(:,:,:) = wslpinow(:,:,:) 
    205             wslpj(:,:,:) = wslpjnow(:,:,:) 
    206          ENDIF 
    207       ENDIF 
    208       ! 
    209       IF( ln_dynwzv )  THEN    ! compute vertical velocity from u/v 
    210          iswap_uwd = 0 
    211          IF(  kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 )  iswap_uwd = 1 
    212          IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data 
    213             IF(lwp) WRITE(numout,*) ' Compute new vertical velocity at kt = ', kt 
    214             IF(lwp) WRITE(numout,*) 
    215             IF( sf_dyn(jf_uwd)%ln_tint ) THEN                 ! time interpolation of data 
    216                IF( kt /= nit000 )  THEN 
    217                   wdta(:,:,:,1) =  wdta(:,:,:,2)     ! swap the data for initialisation 
    218                ENDIF 
    219                zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2) 
    220                zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2) 
    221                CALL dta_dyn_wzv( zu, zv, zw ) 
    222                wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
    223             ELSE 
    224                zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:)  
    225                zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) 
    226                CALL dta_dyn_wzv( zu, zv, zw ) 
    227                wnow(:,:,:)  = zw(:,:,:) * tmask(:,:,:) 
    228             ENDIF 
    229          ENDIF 
    230          IF( sf_dyn(jf_uwd)%ln_tint )  THEN 
    231             ztinta =  REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp )  & 
    232                &    / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp ) 
    233             ztintb =  1. - ztinta 
    234             wn(:,:,:) = ztintb * wdta(:,:,:,1)  + ztinta * wdta(:,:,:,2)   
    235          ELSE 
    236             wn(:,:,:) = wnow(:,:,:) 
    237          ENDIF 
    238       ENDIF 
     118      nsecdyn = nsec_year + nsec1jan000   ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
     119      ! 
     120      IF( kt == nit000 ) THEN    ;    nprevrec = 0 
     121      ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec_a(2) 
     122      ENDIF 
     123      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==! 
     124      ! 
     125      IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt )    ! Computation of slopes 
    239126      ! 
    240127      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:)  * tmask(:,:,:)    ! temperature 
    241128      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:)  * tmask(:,:,:)    ! salinity 
    242       ! 
     129      wndm(:,:)         = sf_dyn(jf_wnd)%fnow(:,:,1)  * tmask(:,:,1)    ! wind speed - needed for gas exchange 
     130      fmmflx(:,:)       = sf_dyn(jf_fmf)%fnow(:,:,1)  * tmask(:,:,1)    ! downward salt flux (v3.5+) 
     131      fr_i(:,:)         = sf_dyn(jf_ice)%fnow(:,:,1)  * tmask(:,:,1)    ! Sea-ice fraction 
     132      qsr (:,:)         = sf_dyn(jf_qsr)%fnow(:,:,1)  * tmask(:,:,1)    ! solar radiation 
     133      emp (:,:)         = sf_dyn(jf_emp)%fnow(:,:,1)  * tmask(:,:,1)    ! E-P 
     134      IF( ln_dynrnf ) THEN  
     135         rnf (:,:)      = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     136         IF( ln_dynrnf_depth .AND. .NOT. ln_linssh )    CALL  dta_dyn_hrnf 
     137      ENDIF 
     138      ! 
     139      un(:,:,:)        = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport 
     140      vn(:,:,:)        = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport 
     141      wn(:,:,:)        = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport 
     142      ! 
     143      IF( .NOT.ln_linssh ) THEN 
     144         CALL wrk_alloc(jpi, jpj, zemp ) 
     145         zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:)    ! effective u-transport 
     146         emp_b (:,:)    = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     147         zemp   (:,:)   = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr * tmask(:,:,1) 
     148         CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) )  !=  ssh, vertical scale factor & vertical transport 
     149         CALL wrk_dealloc(jpi, jpj, zemp ) 
     150         !                                           Write in the tracer restart file 
     151         !                                          ******************************* 
     152         IF( lrst_trc ) THEN 
     153            IF(lwp) WRITE(numout,*) 
     154            IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file ',   & 
     155               &                    'at it= ', kt,' date= ', ndastp 
     156            IF(lwp) WRITE(numout,*) '~~~~' 
     157            CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssha ) 
     158            CALL iom_rstput( kt, nitrst, numrtw, 'sshb', sshn ) 
     159         ENDIF 
     160      ENDIF 
    243161      ! 
    244162      CALL eos    ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 
    … …  
    247165 
    248166      rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
    249       CALL zdf_mxl( kt )                                                   ! In any case, we need mxl  
    250       ! 
    251       avt(:,:,:)       = sf_dyn(jf_avt)%fnow(:,:,:)  * tmask(:,:,:)    ! vertical diffusive coefficient  
    252       un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:)  * umask(:,:,:)    ! u-velocity 
    253       vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:)  * vmask(:,:,:)    ! v-velocity  
    254       IF( .NOT.ln_dynwzv ) &                                          ! w-velocity read in file  
    255          wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)     
    256       hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
    257       wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
    258       emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    259       fmmflx(:,:)      = sf_dyn(jf_fmf)%fnow(:,:,1) * tmask(:,:,1)    ! downward salt flux (v3.5+) 
    260       fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction 
    261       qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
    262       IF( ln_dynrnf ) & 
    263       rnf (:,:)        = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! river runoffs  
    264  
    265       !                                               ! update eddy diffusivity coeff. and/or eiv coeff. at kt 
    266       IF( l_ldftra_time .OR. l_ldfeiv_time )   CALL ldf_tra( kt )  
    267       !                                                      ! bbl diffusive coef 
     167      CALL zdf_mxl( kt )                                                   ! In any case, we need mxl 
     168      ! 
     169      hmld(:,:)         = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht 
     170      avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient  
     171      ! 
    268172#if defined key_trabbl && ! defined key_c1d 
    269       IF( ln_dynbbl ) THEN                                        ! read in a file 
    270          ahu_bbl(:,:)  = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1) 
    271          ahv_bbl(:,:)  = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1) 
    272       ELSE                                                        ! Compute bbl coefficients if needed 
    273          tsb(:,:,:,:) = tsn(:,:,:,:) 
    274          CALL bbl( kt, nit000, 'TRC') 
    275       END IF 
     173      ahu_bbl(:,:)      = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)    ! bbl diffusive coef 
     174      ahv_bbl(:,:)      = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1) 
    276175#endif 
     176      ! 
     177      ! 
     178      CALL eos( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 
    277179      ! 
    278180      IF(ln_ctl) THEN                  ! print control 
    … …  
    283185         CALL prt_ctl(tab3d_1=wn               , clinfo1=' wn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    284186         CALL prt_ctl(tab3d_1=avt              , clinfo1=' kz      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
    285          CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
    286          CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
    287          CALL prt_ctl(tab2d_1=fmmflx           , clinfo1=' fmmflx  - : ', mask1=tmask, ovlap=1 ) 
    288          CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', mask1=tmask, ovlap=1 ) 
    289          CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
    290          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 ) 
     187         CALL prt_ctl(tab3d_1=uslp             , clinfo1=' slp  - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 
     188         CALL prt_ctl(tab3d_1=wslpi            , clinfo1=' slp  - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 
     189!         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
     190!         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
     191!         CALL prt_ctl(tab2d_1=fmmflx           , clinfo1=' fmmflx  - : ', mask1=tmask, ovlap=1 ) 
     192!         CALL prt_ctl(tab2d_1=emp              , clinfo1=' emp     - : ', mask1=tmask, ovlap=1 ) 
     193!         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
     194!         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 ) 
    291195      ENDIF 
    292196      ! 
    … …  
    310214      INTEGER  :: inum, idv, idimv                   ! local integer 
    311215      INTEGER  :: ios                                ! Local integer output status for namelist read 
    312       !! 
    313       CHARACTER(len=100)            ::  cn_dir   !   Root directory for location of core files 
    314       TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist informations on the fields to read 
    315       TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf  ! informations about the fields to be read 
    316       TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf          !   "                                 " 
    317       NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_dynrnf,    & 
    318          &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf,  & 
    319          &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf   
    320       !!---------------------------------------------------------------------- 
     216      INTEGER  :: ji, jj, jk 
     217      REAL(wp) :: zcoef 
     218      INTEGER  :: nkrnf_max 
     219      REAL(wp) :: hrnf_max 
     220      !! 
     221      CHARACTER(len=100)            ::  cn_dir        !   Root directory for location of core files 
     222      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d         ! array of namelist informations on the fields to read 
     223      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_empb, sn_emp  ! informations about the fields to be read 
     224      TYPE(FLD_N) :: sn_tem , sn_sal , sn_avt   !   "                 " 
     225      TYPE(FLD_N) :: sn_mld, sn_qsr, sn_wnd , sn_ice , sn_fmf   !   "               " 
     226      TYPE(FLD_N) :: sn_ubl, sn_vbl, sn_rnf    !   "              " 
     227      TYPE(FLD_N) :: sn_div  ! informations about the fields to be read 
     228 
     229      !!---------------------------------------------------------------------- 
     230      ! 
     231      NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth,  fwbcorr, & 
     232         &                sn_uwd, sn_vwd, sn_wwd, sn_emp,    & 
     233         &                sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr ,   & 
     234         &                sn_wnd, sn_ice, sn_fmf,                    & 
     235         &                sn_ubl, sn_vbl, sn_rnf,                   & 
     236         &                sn_empb, sn_div  
    321237      ! 
    322238      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
    … …  
    335251         WRITE(numout,*) '~~~~~~~ ' 
    336252         WRITE(numout,*) '   Namelist namdta_dyn' 
    337          WRITE(numout,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv 
    338          WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl 
    339          WRITE(numout,*) '      river runoff option enabled (T) or not (F)           ln_dynrnf  = ', ln_dynrnf 
     253         WRITE(numout,*) '      runoffs option enabled (T) or not (F)            ln_dynrnf        = ', ln_dynrnf 
     254         WRITE(numout,*) '      runoffs is spread in vertical                    ln_dynrnf_depth  = ', ln_dynrnf_depth 
     255         WRITE(numout,*) '      annual global mean of empmr for ssh correction   fwbcorr          = ', fwbcorr 
    340256         WRITE(numout,*) 
    341257      ENDIF 
    342258      !  
    343       IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 
    344          CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) 
    345          ln_dynbbl = .FALSE. 
    346       ENDIF 
    347  
    348       jf_tem = 1   ;   jf_sal = 2   ;  jf_mld = 3   ;  jf_emp = 4   ;   jf_fmf  = 5   ;  jf_ice = 6   ;   jf_qsr = 7 
    349       jf_wnd = 8   ;   jf_uwd = 9   ;  jf_vwd = 10  ;  jf_wwd = 11  ;   jf_avt  = 12  ;  jfld  = jf_avt 
    350       ! 
    351       slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal)  = sn_sal   ;   slf_d(jf_mld) = sn_mld 
    352       slf_d(jf_emp) = sn_emp   ;   slf_d(jf_fmf ) = sn_fmf   ;   slf_d(jf_ice) = sn_ice  
    353       slf_d(jf_qsr) = sn_qsr   ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_avt) = sn_avt  
    354       slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd 
    355  
     259 
     260      jf_uwd  = 1     ;   jf_vwd  = 2    ;   jf_wwd = 3    ;   jf_emp = 4    ;   jf_avt = 5 
     261      jf_tem  = 6     ;   jf_sal  = 7    ;   jf_mld = 8    ;   jf_qsr = 9 
     262      jf_wnd  = 10    ;   jf_ice  = 11   ;   jf_fmf = 12   ;   jfld   = jf_fmf 
     263 
     264      ! 
     265      slf_d(jf_uwd)  = sn_uwd    ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd 
     266      slf_d(jf_emp)  = sn_emp    ;   slf_d(jf_avt)  = sn_avt 
     267      slf_d(jf_tem)  = sn_tem    ;   slf_d(jf_sal)  = sn_sal   ;   slf_d(jf_mld) = sn_mld 
     268      slf_d(jf_qsr)  = sn_qsr    ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_ice) = sn_ice 
     269      slf_d(jf_fmf)  = sn_fmf 
     270 
     271      ! 
     272      IF( .NOT.ln_linssh ) THEN 
     273                 jf_div  = jfld + 1    ;         jf_empb  = jfld + 2      ;      jfld = jf_empb 
     274           slf_d(jf_div) = sn_div      ;   slf_d(jf_empb) = sn_empb 
     275      ENDIF 
     276      ! 
     277      IF( lk_trabbl ) THEN 
     278                 jf_ubl  = jfld + 1    ;         jf_vbl  = jfld + 2     ;      jfld = jf_vbl 
     279           slf_d(jf_ubl) = sn_ubl      ;   slf_d(jf_vbl) = sn_vbl 
     280      ENDIF 
    356281      ! 
    357282      IF( ln_dynrnf ) THEN 
    358                 jf_rnf = jfld + 1  ;  jfld  = jf_rnf 
    359          slf_d(jf_rnf) = sn_rnf 
    360          ! Activate runoff key of sbc_oce 
    361          ln_rnf = .true. 
    362          WRITE(numout,*) 'dta_dyn : Activate the runoff data structure from ocean core ( force ln_rnf = .true.) ' 
    363          WRITE(numout,*) 
     283                jf_rnf  = jfld + 1     ;     jfld  = jf_rnf 
     284          slf_d(jf_rnf) = sn_rnf     
    364285      ELSE 
    365          rnf (:,:) = 0._wp 
    366       ENDIF 
    367  
    368       IF( ln_dynbbl ) THEN         ! eiv & bbl 
    369                  jf_ubl  = jfld + 1 ;        jf_vbl  = jfld + 2 ;  jfld = jf_vbl 
    370            slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl 
    371       ENDIF 
    372  
    373  
     286         rnf(:,:) = 0._wp 
     287      ENDIF 
     288 
     289   
    374290      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
    375       IF( ierr > 0 ) THEN 
     291      IF( ierr > 0 )  THEN 
    376292         CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' )   ;   RETURN 
    377293      ENDIF 
    378294      !                                         ! fill sf with slf_i and control print 
    379295      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 
     296      ! 
    380297      ! Open file for each variable to get his number of dimension 
    381298      DO ifpr = 1, jfld 
    … …  
    401318            ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    402319            &         wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 ) 
    403          ELSE 
    404             ALLOCATE( uslpnow (jpi,jpj,jpk)  , vslpnow (jpi,jpj,jpk)  ,    & 
    405             &         wslpinow(jpi,jpj,jpk)  , wslpjnow(jpi,jpj,jpk)  , STAT=ierr2 ) 
    406          ENDIF  
    407          IF( ierr2 > 0 ) THEN 
    408             CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN 
     320            ! 
     321            IF( ierr2 > 0 )  THEN 
     322               CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN 
     323            ENDIF 
    409324         ENDIF 
    410325      ENDIF 
    411       IF( ln_dynwzv ) THEN                  ! slopes  
    412          IF( sf_dyn(jf_uwd)%ln_tint ) THEN      ! time interpolation 
    413             ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 ) 
    414          ELSE 
    415             ALLOCATE( wnow(jpi,jpj,jpk)  , STAT=ierr3 ) 
    416          ENDIF  
    417          IF( ierr3 > 0 ) THEN 
    418             CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' )   ;   RETURN 
    419          ENDIF 
    420       ENDIF 
    421       ! 
    422       CALL dta_dyn( nit000 ) 
    423       ! 
    424    END SUBROUTINE dta_dyn_init 
    425  
    426  
    427    SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 
    428       !!---------------------------------------------------------------------- 
    429       !!                    ***  ROUTINE wzv  *** 
    430       !! 
    431       !! ** Purpose :   Compute the now vertical velocity after the array swap 
    432       !! 
    433       !! ** Method  : - compute the now divergence given by : 
    434       !!         * z-coordinate ONLY !!!! 
    435       !!         hdiv = 1/(e1t*e2t) [ di(e2u  u) + dj(e1v  v) ] 
    436       !!     - Using the incompressibility hypothesis, the vertical 
    437       !!      velocity is computed by integrating the horizontal divergence 
    438       !!      from the bottom to the surface. 
    439       !!        The boundary conditions are w=0 at the bottom (no flux). 
    440       !!---------------------------------------------------------------------- 
    441       USE oce, ONLY:  zhdiv => hdivn 
    442       ! 
    443       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities 
    444       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  vertical velocity 
    445       !! 
    446       INTEGER  ::  ji, jj, jk 
    447       REAL(wp) ::  zu, zu1, zv, zv1, zet 
    448       !!---------------------------------------------------------------------- 
    449       ! 
    450       ! Computation of vertical velocity using horizontal divergence 
    451       zhdiv(:,:,:) = 0._wp 
    452       DO jk = 1, jpkm1 
    453          DO jj = 2, jpjm1 
    454             DO ji = fs_2, fs_jpim1   ! vector opt. 
    455                zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * e3u_n(ji  ,jj  ,jk) 
    456                zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * e3u_n(ji-1,jj  ,jk) 
    457                zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * e3v_n(ji  ,jj  ,jk) 
    458                zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * e3v_n(ji  ,jj-1,jk) 
    459                zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)  
     326      ! 
     327      IF( .NOT.ln_linssh ) THEN 
     328        IF( .NOT. sf_dyn(jf_uwd)%ln_clim .AND. ln_rsttr .AND.    &                     ! Restart: read in restart file 
     329           iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 
     330           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation' 
     331           CALL iom_get( numrtr, jpdom_autoglo, 'sshn', sshn(:,:)   ) 
     332           CALL iom_get( numrtr, jpdom_autoglo, 'sshb', sshb(:,:)   ) 
     333        ELSE 
     334           IF(lwp) WRITE(numout,*) ' sshn forcing fields read in the restart file for initialisation' 
     335           CALL iom_open( 'restart', inum ) 
     336           CALL iom_get( inum, jpdom_autoglo, 'sshn', sshn(:,:)   ) 
     337           CALL iom_get( inum, jpdom_autoglo, 'sshb', sshb(:,:)   ) 
     338           CALL iom_close( inum )                                        ! close file 
     339        ENDIF 
     340        ! 
     341        DO jk = 1, jpkm1 
     342           e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 
     343        ENDDO 
     344        e3t_a(:,:,jpk) = e3t_0(:,:,jpk) 
     345 
     346        ! Horizontal scale factor interpolations 
     347        ! -------------------------------------- 
     348        CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
     349        CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
     350 
     351        ! Vertical scale factor interpolations 
     352        ! ------------------------------------ 
     353        CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n(:,:,:), 'W' ) 
     354   
     355        e3t_b(:,:,:)  = e3t_n(:,:,:) 
     356        e3u_b(:,:,:)  = e3u_n(:,:,:) 
     357        e3v_b(:,:,:)  = e3v_n(:,:,:) 
     358 
     359        ! t- and w- points depth 
     360        ! ---------------------- 
     361        gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     362        gdepw_n(:,:,1) = 0.0_wp 
     363 
     364        DO jk = 2, jpk 
     365           DO jj = 1,jpj 
     366              DO ji = 1,jpi 
     367                !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere 
     368                !    tmask = wmask, ie everywhere expect at jk = mikt 
     369                                                                   ! 1 for jk = 
     370                                                                   ! mikt 
     371                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     372                 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
     373                 gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
     374                     &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 
     375              END DO 
     376           END DO 
     377        END DO 
     378 
     379        gdept_b(:,:,:) = gdept_n(:,:,:) 
     380        gdepw_b(:,:,:) = gdepw_n(:,:,:) 
     381        ! 
     382      ENDIF 
     383      ! 
     384      IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN       ! read depht over which runoffs are distributed 
     385         IF(lwp) WRITE(numout,*)  
     386         IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed' 
     387         CALL iom_open ( "runoffs", inum )                           ! open file 
     388         CALL iom_get  ( inum, jpdom_data, 'rodepth', h_rnf )   ! read the river mouth array 
     389         CALL iom_close( inum )                                        ! close file 
     390         ! 
     391         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
     392         DO jj = 1, jpj 
     393            DO ji = 1, jpi 
     394               IF( h_rnf(ji,jj) > 0._wp ) THEN 
     395                  jk = 2 
     396                  DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 
     397                  END DO 
     398                  nk_rnf(ji,jj) = jk 
     399               ELSEIF( h_rnf(ji,jj) == -1._wp   ) THEN   ;  nk_rnf(ji,jj) = 1 
     400               ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj) 
     401               ELSE 
     402                  CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  ) 
     403                  WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 
     404               ENDIF 
    460405            END DO 
    461406         END DO 
     407         DO jj = 1, jpj                                ! set the associated depth 
     408            DO ji = 1, jpi 
     409               h_rnf(ji,jj) = 0._wp 
     410               DO jk = 1, nk_rnf(ji,jj) 
     411                  h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 
     412               END DO 
     413            END DO 
     414         END DO 
     415      ELSE                                       ! runoffs applied at the surface 
     416         nk_rnf(:,:) = 1 
     417         h_rnf (:,:) = e3t_n(:,:,1) 
     418      ENDIF 
     419      nkrnf_max = MAXVAL( nk_rnf(:,:) ) 
     420      hrnf_max = MAXVAL( h_rnf(:,:) ) 
     421      IF( lk_mpp )  THEN 
     422         CALL mpp_max( nkrnf_max )                 ! max over the  global domain 
     423         CALL mpp_max( hrnf_max )                 ! max over the  global domain 
     424      ENDIF 
     425      IF(lwp) WRITE(numout,*) ' ' 
     426      IF(lwp) WRITE(numout,*) ' max depht of runoff : ', hrnf_max,'    max level  : ', nkrnf_max 
     427      IF(lwp) WRITE(numout,*) ' ' 
     428      ! 
     429      CALL dta_dyn( nit000 ) 
     430      ! 
     431   END SUBROUTINE dta_dyn_init 
     432 
     433   SUBROUTINE dta_dyn_swp( kt ) 
     434     !!--------------------------------------------------------------------- 
     435      !!                    ***  ROUTINE dta_dyn_swp  *** 
     436      !! 
     437      !! ** Purpose : Swap and the data and compute the vertical scale factor at U/V/W point 
     438      !!              and the depht 
     439      !! 
     440      !!--------------------------------------------------------------------- 
     441      INTEGER, INTENT(in) :: kt       ! time step 
     442      INTEGER             :: ji, jj, jk 
     443      REAL(wp)            :: zcoef 
     444      ! 
     445      !!--------------------------------------------------------------------- 
     446 
     447      IF( kt == nit000 ) THEN 
     448         IF(lwp) WRITE(numout,*) 
     449         IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height' 
     450         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     451      ENDIF 
     452 
     453      sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:))  ! before <-- now filtered 
     454      sshn(:,:) = ssha(:,:) 
     455 
     456      e3t_n(:,:,:) = e3t_a(:,:,:) 
     457 
     458      ! Reconstruction of all vertical scale factors at now and before time steps 
     459      ! ============================================================================= 
     460 
     461      ! Horizontal scale factor interpolations 
     462      ! -------------------------------------- 
     463      CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
     464      CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
     465 
     466      ! Vertical scale factor interpolations 
     467      ! ------------------------------------ 
     468      CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 
     469 
     470      e3t_b(:,:,:)  = e3t_n(:,:,:) 
     471      e3u_b(:,:,:)  = e3u_n(:,:,:) 
     472      e3v_b(:,:,:)  = e3v_n(:,:,:) 
     473 
     474      ! t- and w- points depth 
     475      ! ---------------------- 
     476      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     477      gdepw_n(:,:,1) = 0.0_wp 
     478 
     479      DO jk = 2, jpk 
     480         DO jj = 1,jpj 
     481            DO ji = 1,jpi 
     482                 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     483                 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
     484                 gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
     485                     &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 
     486              END DO 
     487           END DO 
     488        END DO 
     489 
     490      gdept_b(:,:,:) = gdept_n(:,:,:) 
     491      gdepw_b(:,:,:) = gdepw_n(:,:,:) 
     492 
     493      ! 
     494   END SUBROUTINE dta_dyn_swp 
     495 
     496   SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb,  pemp, pssha, pe3ta ) 
     497      !!---------------------------------------------------------------------- 
     498      !!                ***  ROUTINE dta_dyn_wzv  *** 
     499      !!                    
     500      !! ** Purpose :   compute the after ssh (ssha) and the now vertical velocity 
     501      !! 
     502      !! ** Method  : Using the incompressibility hypothesis,  
     503      !!        - the ssh increment is computed by integrating the horizontal divergence  
     504      !!          and multiply by the time step. 
     505      !! 
     506      !!        - compute the after scale factor : repartition of ssh INCREMENT proportionnaly 
     507      !!                                           to the level thickness ( z-star case ) 
     508      !! 
     509      !!        - the vertical velocity is computed by integrating the horizontal divergence   
     510      !!          from the bottom to the surface minus the scale factor evolution. 
     511      !!          The boundary conditions are w=0 at the bottom (no flux) 
     512      !! 
     513      !! ** action  :   ssha / e3t_a / wn 
     514      !! 
     515      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
     516      !!---------------------------------------------------------------------- 
     517      !! * Arguments 
     518      INTEGER,                                   INTENT(in )    :: kt        !  time-step 
     519      REAL(wp), DIMENSION(jpi,jpj,jpk)          , INTENT(in )   :: phdivtr   ! horizontal divergence transport 
     520      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(in )   :: psshb     ! now ssh 
     521      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(in )   :: pemp      ! evaporation minus precipitation 
     522      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(inout) :: pssha     ! after ssh 
     523      REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(out)   :: pe3ta     ! after vertical scale factor 
     524      !! * Local declarations 
     525      INTEGER                       :: jk 
     526      REAL(wp), DIMENSION(jpi,jpj)  :: zhdiv   
     527      REAL(wp)  :: z2dt   
     528      !!---------------------------------------------------------------------- 
     529       
     530      ! 
     531      z2dt = 2._wp * rdt 
     532      ! 
     533      zhdiv(:,:) = 0._wp 
     534      DO jk = 1, jpkm1 
     535         zhdiv(:,:) = zhdiv(:,:) +  phdivtr(:,:,jk) * tmask(:,:,jk) 
    462536      END DO 
    463       !                              !  update the horizontal divergence with the runoff inflow 
    464       IF( ln_dynrnf )   zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 
    465       ! 
    466       CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv 
    467       ! computation of vertical velocity from the bottom 
    468       pw(:,:,jpk) = 0._wp 
    469       DO jk = jpkm1, 1, -1 
    470          pw(:,:,jk) = pw(:,:,jk+1) - e3t_n(:,:,jk) * zhdiv(:,:,jk) 
     537      !                                                ! Sea surface  elevation time-stepping 
     538      pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rau0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:) 
     539      !                                                 !  
     540      !                                                 ! After acale factors at t-points ( z_star coordinate ) 
     541      DO jk = 1, jpkm1 
     542        pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 
    471543      END DO 
    472544      ! 
    473    END SUBROUTINE dta_dyn_wzv 
    474  
    475    SUBROUTINE dta_dyn_slp( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
     545   END SUBROUTINE dta_dyn_ssh 
     546 
     547 
     548   SUBROUTINE dta_dyn_hrnf 
     549      !!---------------------------------------------------------------------- 
     550      !!                  ***  ROUTINE sbc_rnf  *** 
     551      !! 
     552      !! ** Purpose :   update the horizontal divergence with the runoff inflow 
     553      !! 
     554      !! ** Method  : 
     555      !!                CAUTION : rnf is positive (inflow) decreasing the 
     556      !!                          divergence and expressed in m/s 
     557      !! 
     558      !! ** Action  :   phdivn   decreased by the runoff inflow 
     559      !!---------------------------------------------------------------------- 
     560      !! 
     561      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     562      !!---------------------------------------------------------------------- 
     563      ! 
     564      DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
     565         DO ji = 1, jpi 
     566            h_rnf(ji,jj) = 0._wp 
     567            DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres 
     568                h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk)   ! to the bottom of the relevant grid box 
     569            END DO 
     570        END DO 
     571      END DO 
     572      ! 
     573   END SUBROUTINE dta_dyn_hrnf 
     574 
     575 
     576 
     577   SUBROUTINE dta_dyn_slp( kt ) 
     578      !!--------------------------------------------------------------------- 
     579      !!                    ***  ROUTINE dta_dyn_slp  *** 
     580      !! 
     581      !! ** Purpose : Computation of slope 
     582      !! 
     583      !!--------------------------------------------------------------------- 
     584      USE oce, ONLY:  zts => tsa  
     585      ! 
     586      INTEGER,  INTENT(in) :: kt       ! time step 
     587      ! 
     588      INTEGER  ::   ji, jj     ! dummy loop indices 
     589      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
     590      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
     591      INTEGER  ::   iswap  
     592      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuslp, zvslp, zwslpi, zwslpj 
     593      !!--------------------------------------------------------------------- 
     594      ! 
     595      CALL wrk_alloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj ) 
     596      ! 
     597      IF( sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
     598         IF( kt == nit000 ) THEN 
     599            IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
     600            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
     601            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
     602            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
     603            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     604            uslpdta (:,:,:,1) = zuslp (:,:,:)  
     605            vslpdta (:,:,:,1) = zvslp (:,:,:)  
     606            wslpidta(:,:,:,1) = zwslpi(:,:,:)  
     607            wslpjdta(:,:,:,1) = zwslpj(:,:,:)  
     608            ! 
     609            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
     610            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
     611            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     612            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     613            uslpdta (:,:,:,2) = zuslp (:,:,:)  
     614            vslpdta (:,:,:,2) = zvslp (:,:,:)  
     615            wslpidta(:,:,:,2) = zwslpi(:,:,:)  
     616            wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
     617         ELSE 
     618           !  
     619           iswap = 0 
     620           IF( sf_dyn(jf_tem)%nrec_a(2) - nprevrec /= 0 )  iswap = 1 
     621           IF( nsecdyn > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap == 1 )  THEN    ! read/update the after data 
     622              IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
     623              uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data 
     624              vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)   
     625              wslpidta(:,:,:,1) =  wslpidta(:,:,:,2)  
     626              wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2)  
     627              ! 
     628              zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
     629              zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
     630              avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     631              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     632              ! 
     633              uslpdta (:,:,:,2) = zuslp (:,:,:)  
     634              vslpdta (:,:,:,2) = zvslp (:,:,:)  
     635              wslpidta(:,:,:,2) = zwslpi(:,:,:)  
     636              wslpjdta(:,:,:,2) = zwslpj(:,:,:)  
     637            ENDIF 
     638         ENDIF 
     639      ENDIF 
     640      ! 
     641      IF( sf_dyn(jf_tem)%ln_tint )  THEN 
     642         ztinta =  REAL( nsecdyn - sf_dyn(jf_tem)%nrec_b(2), wp )  & 
     643            &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 
     644         ztintb =  1. - ztinta 
     645         IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace) 
     646            uslp (:,:,:) = ztintb * uslpdta (:,:,:,1)  + ztinta * uslpdta (:,:,:,2)   
     647            vslp (:,:,:) = ztintb * vslpdta (:,:,:,1)  + ztinta * vslpdta (:,:,:,2)   
     648            wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1)  + ztinta * wslpidta(:,:,:,2)   
     649            wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1)  + ztinta * wslpjdta(:,:,:,2)   
     650         ENDIF 
     651      ELSE 
     652         zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)   ! temperature 
     653         zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)   ! salinity  
     654         avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)   ! vertical diffusive coef. 
     655         CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj ) 
     656         ! 
     657         IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace) 
     658            uslp (:,:,:) = zuslp (:,:,:) 
     659            vslp (:,:,:) = zvslp (:,:,:) 
     660            wslpi(:,:,:) = zwslpi(:,:,:) 
     661            wslpj(:,:,:) = zwslpj(:,:,:) 
     662         ENDIF 
     663      ENDIF 
     664      ! 
     665      CALL wrk_dealloc(jpi, jpj, jpk, zuslp, zvslp, zwslpi, zwslpj ) 
     666      ! 
     667   END SUBROUTINE dta_dyn_slp 
     668 
     669   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
    476670      !!--------------------------------------------------------------------- 
    477671      !!                    ***  ROUTINE dta_dyn_slp  *** 
    … …  
    487681      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes 
    488682      !!--------------------------------------------------------------------- 
    489       IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                        
     683      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace) 
    490684         CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) ) 
    491685         CALL eos_rab( pts, rab_n )       ! now local thermal/haline expension ratio at T-points 
    … …  
    497691         &                                        rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    498692      IF( ln_zps .AND.        ln_isfcav)                            & 
    499          &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
    500          &                                        rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level 
     693         &            CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi, &  ! Partial steps for top cell (ISF) 
     694         &                                        rhd, gru , grv , grui, grvi )  ! of t, s, rd at the first ocean level 
    501695 
    502696         rn2b(:,:,:) = rn2(:,:,:)         ! need for zdfmxl 
    503697         CALL zdf_mxl( kt )            ! mixed layer depth 
    504698         CALL ldf_slp( kt, rhd, rn2 )  ! slopes 
    505          puslp (:,:,:) = uslp (:,:,:)  
    506          pvslp (:,:,:) = vslp (:,:,:)  
    507          pwslpi(:,:,:) = wslpi(:,:,:)  
    508          pwslpj(:,:,:) = wslpj(:,:,:)  
     699         puslp (:,:,:) = uslp (:,:,:) 
     700         pvslp (:,:,:) = vslp (:,:,:) 
     701         pwslpi(:,:,:) = wslpi(:,:,:) 
     702         pwslpj(:,:,:) = wslpj(:,:,:) 
    509703     ELSE 
    510704         puslp (:,:,:) = 0.            ! to avoid warning when compiling 
    … …  
    514708     ENDIF 
    515709      ! 
    516    END SUBROUTINE dta_dyn_slp 
     710   END SUBROUTINE compute_slopes 
    517711   !!====================================================================== 
    518712END MODULE dtadyn 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r6140 r7277  
    55   !!====================================================================== 
    66   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line: phasing with the on-line 
    7    !!            4.0  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation 
     7   !!            3.4  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation 
     8   !!            4.0  ! 2016-10  (C. Ethe, G. Madec, S. Flavoni)  domain configuration / user defined interface 
    89   !!---------------------------------------------------------------------- 
    910 
    … …  
    1718   USE oce             ! dynamics and tracers variables 
    1819   USE c1d             ! 1D configuration 
    19    USE domcfg          ! domain configuration               (dom_cfg routine) 
    2020   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine) 
    21    USE domrea          ! domain initialization from mesh_mask            (dom_init routine) 
     21   USE usrdef_nam      ! user defined configuration 
    2222   USE eosbn2          ! equation of state            (eos bn2 routine) 
    2323   !              ! ocean physics 
    … …  
    3535   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    3636   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
     37   !              ! Passive tracers needs 
     38   USE trc             ! passive tracer : variables 
     39   USE trcnam          ! passive tracer : namelist 
     40   USE trcrst          ! passive tracer restart 
     41   USE diaptr          ! Need to initialise this as some variables are used in if statements later 
     42   USE sbc_oce  , ONLY : ln_rnf 
     43   USE sbcrnf          ! surface boundary condition : runoffs 
    3744   !              ! I/O & MPP 
    3845   USE iom             ! I/O library 
    … …  
    4855   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
    4956 
    50    USE trc 
    51    USE trcnam 
    52    USE trcrst 
    53    USE diaptr         ! Need to initialise this as some variables are used in if statements later 
    54    USE sbc_oce, ONLY: ln_rnf 
    55    USE sbcrnf 
     57 
    5658 
    5759   IMPLICIT NONE 
    … …  
    104106      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
    105107         ! 
    106          IF( istp /= nit000 )   CALL day      ( istp )         ! Calendar (day was already called at nit000 in day_init) 
    107                                 CALL iom_setkt( istp - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp 
    108                                 CALL dta_dyn  ( istp )         ! Interpolation of the dynamical fields 
    109                                 CALL trc_stp  ( istp )         ! time-stepping 
    110                                 CALL stp_ctl  ( istp, indic )  ! Time loop: control and print 
     108         IF( istp /= nit000 )   CALL day        ( istp )         ! Calendar (day was already called at nit000 in day_init) 
     109                                CALL iom_setkt  ( istp - nit000 + 1, "nemo" )   ! say to iom that we are at time step kstp 
     110                                CALL dta_dyn    ( istp )         ! Interpolation of the dynamical fields 
     111         IF( .NOT.ln_linssh )   CALL dta_dyn_swp( istp )         ! swap of sea  surface height and vertical scale factors 
     112 
     113                                CALL trc_stp    ( istp )         ! time-stepping 
     114                                CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
    111115         istp = istp + 1 
    112116         IF( lk_mpp )   CALL mpp_max( nstop ) 
    … …  
    147151      INTEGER ::   ji            ! dummy loop indices 
    148152      INTEGER ::   ilocal_comm   ! local integer 
    149       INTEGER ::   ios 
    150       LOGICAL ::   llexist 
    151       CHARACTER(len=80), DIMENSION(16) ::   cltxt 
     153      INTEGER ::   ios, inum 
     154      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   ! local scalars 
     155      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    152156      !! 
    153157      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    154158         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    155          &             nn_bench, nn_timing, nn_diacfl 
    156       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    157          &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    158       !!---------------------------------------------------------------------- 
    159       cltxt = '' 
     159         &             nn_timing, nn_diacfl 
     160 
     161      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
     162      !!---------------------------------------------------------------------- 
     163      cltxt  = '' 
     164      cltxt2 = '' 
     165      clnam  = ''   
    160166      cxios_context = 'nemo' 
    161167      ! 
    … …  
    181187904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    182188 
     189 
     190      !                             !--------------------------! 
     191      !                             !  Set global domain size  !   (control print return in cltxt2) 
     192      ! 
     193      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     194         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     195         ! 
     196      ELSE                                ! user-defined namelist 
     197         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     198      ENDIF 
     199      jpk    = jpkglo 
    183200      ! 
    184201      !                             !--------------------------------------------! 
    … …  
    206223         WRITE( numond, namctl ) 
    207224         WRITE( numond, namcfg ) 
     225         IF( .NOT.ln_read_cfg ) THEN 
     226            DO ji = 1, SIZE(clnam) 
     227               IF( TRIM(clnam (ji)) /= '' )   WRITE(numond, * ) clnam(ji)    ! namusr_def print 
     228            END DO 
     229         ENDIF 
    208230      ENDIF 
    209231 
    … …  
    225247      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    226248      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    227       jpk = jpkdta                                             ! third dim 
    228249      jpim1 = jpi-1                                            ! inner domain indices 
    229250      jpjm1 = jpj-1                                            !   "           " 
    … …  
    274295                            CALL     eos_init   ! Equation of state 
    275296      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    276                             CALL     dom_cfg    ! Domain configuration 
    277       ! 
    278       INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist 
    279       ! 
    280       IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry 
    281       ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask 
    282       ENDIF 
     297 
     298                            CALL     dom_init   ! Domain 
     299 
    283300                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    284301 
    … …  
    315332      !!                     ***  ROUTINE nemo_ctl  *** 
    316333      !! 
    317       !! ** Purpose :   control print setting  
     334      !! ** Purpose :   control print setting 
    318335      !! 
    319336      !! ** Method  : - print namctl information and check some consistencies 
    320337      !!---------------------------------------------------------------------- 
    321338      ! 
    322       IF(lwp) THEN                  ! Parameter print 
     339      IF(lwp) THEN                  ! control print 
    323340         WRITE(numout,*) 
    324          WRITE(numout,*) 'nemo_flg: Control prints & Benchmark' 
     341         WRITE(numout,*) 'nemo_ctl: Control prints' 
    325342         WRITE(numout,*) '~~~~~~~ ' 
    326343         WRITE(numout,*) '   Namelist namctl' 
    … …  
    333350         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    334351         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    335          WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
     352         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
    336353      ENDIF 
    337354      ! 
    … …  
    343360      isplt     = nn_isplt 
    344361      jsplt     = nn_jsplt 
    345       nbench    = nn_bench 
    346      IF(lwp) THEN                  ! control print 
     362 
     363 
     364      IF(lwp) THEN                  ! control print 
    347365         WRITE(numout,*) 
    348366         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read' 
    349367         WRITE(numout,*) '~~~~~~~ ' 
    350368         WRITE(numout,*) '   Namelist namcfg' 
    351          WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg) 
    352          WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg 
    353          WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta 
    354          WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta 
    355          WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta 
    356          WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo 
    357          WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo 
    358          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 
    359          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    360          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
    361          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
    362       ENDIF 
     369         WRITE(numout,*) '      read domain configuration files             ln_read_cfg      = ', ln_read_cfg 
     370         WRITE(numout,*) '         filename to be read                         cn_domcfg     = ', TRIM(cn_domcfg) 
     371         WRITE(numout,*) '      write  configuration definition files       ln_write_cfg     = ', ln_write_cfg 
     372         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out) 
     373         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr 
     374      ENDIF 
     375 
    363376      !                             ! Parameter control 
    364377      ! 
    365378      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints 
    366          IF( lk_mpp ) THEN 
    367             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain 
     379         IF( lk_mpp .AND. jpnij > 1 ) THEN 
     380            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    368381         ELSE 
    369382            IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    … …  
    400413      ENDIF 
    401414      ! 
    402       IF( nbench == 1 )   THEN            ! Benchmark  
    403          SELECT CASE ( cp_cfg ) 
    404          CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
    405          CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
    406             &                                 ' cp_cfg="gyre" in namelsit &namcfg or set nbench = 0' ) 
    407          END SELECT 
    408       ENDIF 
    409       ! 
    410       IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   & 
    411          &                                               'with the IOM Input/Output manager. '        ,   & 
    412          &                                               'Compile with key_iomput enabled' ) 
    413       ! 
    414415      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    415416         &                                               'f2003 standard. '                              ,  & 
    … …  
    434435      IF( numnam_cfg /= -1 )   CLOSE( numnam_cfg )   ! oce configuration namelist 
    435436      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file 
     437      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist 
     438 
    436439      numout = 6                                     ! redefine numout in case it is used after this point... 
    437440      ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r6140 r7277  
    769769!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    770770!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1       
    771       iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2 
    772       ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1 
    773       iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2 
    774       ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1 
     771      iwe = mig(1) - 1 + 2         ! if monotasking and no zoom, iw=2 
     772      ies = mig(1) + nlci-1 - 1  ! if monotasking and no zoom, ie=jpim1 
     773      iso = mjg(1) - 1 + 2         ! if monotasking and no zoom, is=2 
     774      ino = mjg(1) + nlcj-1 - 1  ! if monotasking and no zoom, in=jpjm1 
    775775 
    776776      ALLOCATE( nbondi_bdy(nb_bdy)) 
    … …  
    785785      ! Work out dimensions of boundary data on each neighbour process 
    786786      IF(nbondi == 0) THEN 
    787          iw_b(1) = jpizoom + nimppt(nowe+1) 
    788          ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    789          is_b(1) = jpjzoom + njmppt(nowe+1) 
    790          in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    791  
    792          iw_b(2) = jpizoom + nimppt(noea+1) 
    793          ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
    794          is_b(2) = jpjzoom + njmppt(noea+1) 
    795          in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
     787         iw_b(1) = 1 + nimppt(nowe+1) 
     788         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3 
     789         is_b(1) = 1 + njmppt(nowe+1) 
     790         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3 
     791 
     792         iw_b(2) = 1 + nimppt(noea+1) 
     793         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3 
     794         is_b(2) = 1 + njmppt(noea+1) 
     795         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3 
    796796      ELSEIF(nbondi == 1) THEN 
    797          iw_b(1) = jpizoom + nimppt(nowe+1) 
    798          ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    799          is_b(1) = jpjzoom + njmppt(nowe+1) 
    800          in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
     797         iw_b(1) = 1 + nimppt(nowe+1) 
     798         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3 
     799         is_b(1) = 1 + njmppt(nowe+1) 
     800         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    801801      ELSEIF(nbondi == -1) THEN 
    802          iw_b(2) = jpizoom + nimppt(noea+1) 
    803          ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
    804          is_b(2) = jpjzoom + njmppt(noea+1) 
    805          in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
     802         iw_b(2) = 1 + nimppt(noea+1) 
     803         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3 
     804         is_b(2) = 1 + njmppt(noea+1) 
     805         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3 
    806806      ENDIF 
    807807 
    808808      IF(nbondj == 0) THEN 
    809          iw_b(3) = jpizoom + nimppt(noso+1) 
    810          ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    811          is_b(3) = jpjzoom + njmppt(noso+1) 
    812          in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
    813  
    814          iw_b(4) = jpizoom + nimppt(nono+1) 
    815          ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
    816          is_b(4) = jpjzoom + njmppt(nono+1) 
    817          in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
     809         iw_b(3) = 1 + nimppt(noso+1) 
     810         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3 
     811         is_b(3) = 1 + njmppt(noso+1) 
     812         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3 
     813 
     814         iw_b(4) = 1 + nimppt(nono+1) 
     815         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3 
     816         is_b(4) = 1 + njmppt(nono+1) 
     817         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3 
    818818      ELSEIF(nbondj == 1) THEN 
    819          iw_b(3) = jpizoom + nimppt(noso+1) 
    820          ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    821          is_b(3) = jpjzoom + njmppt(noso+1) 
    822          in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
     819         iw_b(3) = 1 + nimppt(noso+1) 
     820         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3 
     821         is_b(3) = 1 + njmppt(noso+1) 
     822         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3 
    823823      ELSEIF(nbondj == -1) THEN 
    824          iw_b(4) = jpizoom + nimppt(nono+1) 
    825          ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
    826          is_b(4) = jpjzoom + njmppt(nono+1) 
    827          in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
     824         iw_b(4) = 1 + nimppt(nono+1) 
     825         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3 
     826         is_b(4) = 1 + njmppt(nono+1) 
     827         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3 
    828828      ENDIF 
    829829 
    … …  
    899899!                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
    900900!                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
    901                      idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+jpizoom 
    902                      idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+jpjzoom 
     901                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
     902                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
    903903                     ! check if point has to be sent 
    904904                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r6140 r7277  
    100100 
    101101      DO ib_bdy = 1, nb_bdy 
    102          IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    103  
     102         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     103            ! 
    104104            td => tides(ib_bdy) 
    105105            nblen => idx_bdy(ib_bdy)%nblen 
    … …  
    134134            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    135135            ! relaxation area       
    136             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    137                ilen0(:)=nblen(:) 
    138             ELSE 
    139                ilen0(:)=nblenrim(:) 
     136            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
     137            ELSE                                   ;   ilen0(:) = nblenrim(:) 
    140138            ENDIF 
    141139 
    … …  
    156154            td%v   (:,:,:) = 0._wp 
    157155 
    158             IF (ln_bdytide_2ddta) THEN 
     156            IF( ln_bdytide_2ddta ) THEN 
    159157               ! It is assumed that each data file contains all complex harmonic amplitudes 
    160                ! given on the data domain (ie global, jpidta x jpjdta) 
    161                ! 
    162                CALL wrk_alloc( jpi, jpj, zti, ztr ) 
     158               ! given on the global domain (ie global, jpiglo x jpjglo) 
     159               ! 
     160               CALL wrk_alloc( jpi,jpj,  zti, ztr ) 
    163161               ! 
    164162               ! SSH fields 
    165163               clfile = TRIM(filtide)//'_grid_T.nc' 
    166                CALL iom_open (clfile , inum )  
     164               CALL iom_open( clfile , inum )  
    167165               igrd = 1                       ! Everything is at T-points here 
    168166               DO itide = 1, nb_harmo 
    169                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
    170                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
     167                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
     168                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
    171169                  DO ib = 1, ilen0(igrd) 
    172170                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    180178               ! U fields 
    181179               clfile = TRIM(filtide)//'_grid_U.nc' 
    182                CALL iom_open (clfile , inum )  
     180               CALL iom_open( clfile , inum )  
    183181               igrd = 2                       ! Everything is at U-points here 
    184182               DO itide = 1, nb_harmo 
    185                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
    186                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
     183                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
     184                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
    187185                  DO ib = 1, ilen0(igrd) 
    188186                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    196194               ! V fields 
    197195               clfile = TRIM(filtide)//'_grid_V.nc' 
    198                CALL iom_open (clfile , inum )  
     196               CALL iom_open( clfile , inum )  
    199197               igrd = 3                       ! Everything is at V-points here 
    200198               DO itide = 1, nb_harmo 
    201                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
    202                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
     199                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
     200                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
    203201                  DO ib = 1, ilen0(igrd) 
    204202                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    210208               CALL iom_close( inum ) 
    211209               ! 
    212                CALL wrk_dealloc( jpi, jpj, ztr, zti )  
     210               CALL wrk_dealloc( jpi,jpj,  ztr, zti )  
    213211               ! 
    214212            ELSE             
    … …  
    219217               ! 
    220218               ! Set map structure 
    221                ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1) 
    222                ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
    223                ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2) 
    224                ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
    225                ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3) 
    226                ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
     219               ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)   ;   ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
     220               ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)   ;   ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
     221               ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)   ;   ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
    227222 
    228223               ! Open files and read in tidal forcing data 
    … …  
    258253               ! 
    259254               DEALLOCATE( dta_read ) 
     255               ! 
    260256            ENDIF ! ln_bdytide_2ddta=.true. 
    261257            ! 
    … …  
    275271            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    276272            ! 
    277          ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
     273         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 
    278274         ! 
    279275      END DO ! loop on ib_bdy 
    … …  
    376372   END SUBROUTINE bdytide_update 
    377373 
     374 
    378375   SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) 
    379376      !!---------------------------------------------------------------------- 
    … …  
    422419 
    423420      DO ib_bdy = 1,nb_bdy 
    424  
    425          IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    426  
     421         ! 
     422         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     423            ! 
    427424            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    428425            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    429  
    430             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    431                ilen0(:)=nblen(:) 
    432             ELSE 
    433                ilen0(:)=nblenrim(:) 
     426            ! 
     427            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
     428            ELSE                                   ;   ilen0(:) = nblenrim(:) 
    434429            ENDIF      
    435  
     430            ! 
    436431            ! We refresh nodal factors every day below 
    437432            ! This should be done somewhere else 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90

    r6140 r7277  
    2424 
    2525   PUBLIC   dom_c1d   ! called in domcfg.F90 
     26 
     27   INTEGER ::   jpizoom = 1      !: left bottom (i,j) indices of the zoom 
     28   INTEGER ::   jpjzoom = 1      !: in data domain indices 
    2629 
    2730   !!---------------------------------------------------------------------- 
    … …  
    8285      !  mesh, only glamt and gphit   ! 
    8386      ! ============================= ! 
    84  
     87      ! 
    8588      SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    86  
     89      ! 
    8790      CASE ( 0 )                 !  curvilinear coordinate on the sphere read in coordinate.nc file 
    88  
     91         ! 
    8992         CALL iom_open( 'coordinates', inum ) 
    9093         CALL iom_get( inum, jpdom_unknown, 'glamt', glamdta ) ! mig, mjg undefined at this point 
    9194         CALL iom_get( inum, jpdom_unknown, 'gphit', gphidta ) ! so use jpdom_unknown not jpdom_data 
    9295         CALL iom_close ( inum ) 
    93  
     96         ! 
    9497      CASE ( 1 )                 ! geographical mesh on the sphere with regular grid-spacing 
    95  
     98         ! 
    9699         DO jj = 1, jpjdta 
    97100            DO ji = 1, jpidta 
    98101               zti = FLOAT( ji - 1 + nimpp - 1 ) 
    99102               ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    100  
     103               ! 
    101104               glamdta(ji,jj) = ppglam0 + ppe1_deg * zti 
    102105               gphidta(ji,jj) = ppgphi0 + ppe2_deg * ztj 
    103106            END DO 
    104107         END DO 
    105  
     108         ! 
    106109      CASE ( 2:3 )               ! f- or beta-plane with regular grid-spacing 
    107           
     110         ! 
    108111         glam0 = 0.e0 
    109112         gphi0 = - ppe2_m * 1.e-3 
    110  
     113         ! 
    111114         DO jj = 1, jpjdta 
    112115            DO ji = 1, jpidta 
    … …  
    115118            END DO 
    116119         END DO 
    117  
     120         ! 
    118121      CASE ( 4 )                 ! geographical mesh on the sphere, isotropic MERCATOR type 
    119  
     122         ! 
    120123         IF( ppgphi0 == -90 )   CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 
    121  
     124         ! 
    122125         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2. 
    123126         ijeq = ABS( 180. / rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 
    124127         IF( ppgphi0 > 0 )   ijeq = -ijeq 
    125  
     128         ! 
    126129         DO jj = 1, jpjdta 
    127130            DO ji = 1, jpidta 
    128131               zti = FLOAT( ji - 1    + nimpp - 1 ) 
    129132               ztj = FLOAT( jj - ijeq + njmpp - 1 ) 
    130  
     133               ! 
    131134               glamdta(ji,jj) = ppglam0 + ppe1_deg * zti 
    132135               gphidta(ji,jj) = 1. / rad * ASIN ( TANH( ppe1_deg * rad * ztj ) ) 
    133136            END DO 
    134137         END DO 
    135  
     138         ! 
    136139      CASE ( 5 )                 ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration) 
    137     
     140         ! 
    138141         zlam1 = -85 
    139142         zphi1 = 29 
    140          ze1 = 106000. / FLOAT(jp_cfg) 
    141   
     143         ze1 = 106000. / REAL( nn_cfg , wp ) 
     144         ! 
    142145         zsin_alpha = - SQRT( 2. ) / 2. 
    143146         zcos_alpha =   SQRT( 2. ) / 2. 
    144147         ze1deg = ze1 / (ra * rad) 
    145  
     148         ! 
    146149         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjdta-2 ) ! Force global 
    147150         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjdta-2 ) 
    148  
     151         ! 
    149152         DO jj = 1, jpjdta 
    150153            DO ji = 1, jpidta 
    … …  
    156159            END DO 
    157160         END DO 
    158  
     161         ! 
    159162      CASE DEFAULT 
    160  
     163         ! 
    161164         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh 
    162165         CALL ctl_stop( ctmp1 ) 
    163  
     166         ! 
    164167      END SELECT 
    165168 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90

    r6140 r7277  
    4949      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    5050 
    51       SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    52       ! 
    53       CASE ( 0, 1, 4 )               ! mesh on the sphere 
    54          ff(:,:) = 2. * omega * SIN( rad * gphit(:,:) )  
    55          ! 
    56       CASE ( 2 )                     ! f-plane at ppgphi0  
    57          ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 
    58          IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1) 
    59          ! 
    60       CASE ( 3 )                     ! beta-plane 
    61          zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    62          zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3  / ( ra * rad ) ! latitude of the first row F-points 
    63          zf0     = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    64          ff(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                      ! f = f0 +beta* y ( y=0 at south) 
    65          IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1) 
    66          IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj) 
    67          ! 
    68       CASE ( 5 )                     ! beta-plane and rotated domain 
    69          zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    70          zphi0 = 15.e0                                                      ! latitude of the first row F-points 
    71          zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    72          ff(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
    73          IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1) 
    74          IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj) 
    75          ! 
    76       END SELECT 
    7751      ! 
    7852   END SUBROUTINE cor_c1d 
    … …  
    10074         DO jj = 2, jpjm1 
    10175            DO ji = fs_2, fs_jpim1   ! vector opt. 
    102                ua(ji,jj,jk) = ua(ji,jj,jk) + ff(ji,jj) * vn(ji,jj,jk) 
    103                va(ji,jj,jk) = va(ji,jj,jk) - ff(ji,jj) * un(ji,jj,jk) 
     76               ua(ji,jj,jk) = ua(ji,jj,jk) + ff_t(ji,jj) * vn(ji,jj,jk) 
     77               va(ji,jj,jk) = va(ji,jj,jk) - ff_t(ji,jj) * un(ji,jj,jk) 
    10478            END DO 
    10579         END DO 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90

    r6140 r7277  
    20232023         nimpp_crs = nimppt_crs(nproc + 1) 
    20242024 
    2025          ! No coarsening with zoom 
    2026          IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP  
    2027  
    20282025         DO ji = 1, jpi_crs 
    20292026            mig_crs(ji) = ji + nimpp_crs - 1 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90

    r6140 r7277  
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_kind, ONLY: wp 
    13    USE par_oce                  ! For parameter jpi,jpj,jphgr_msh 
     13   USE par_oce                  ! For parameter jpi,jpj 
    1414   USE dom_oce                  ! For parameters in par_oce 
    1515   USE crs                      ! Coarse grid domain 
    … …  
    170170     !      3.c.2 Coriolis factor   
    171171 
    172       SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    173  
    174       CASE ( 0, 1, 4 )           ! mesh on the sphere 
    175  
    176          ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) ) 
    177  
    178       CASE DEFAULT  
    179  
    180        IF(lwp)    WRITE(numout,*) 'crsini.F90. crs_init. Only jphgr_msh = 0, 1 or 4 supported'  
     172!!gm  Not sure CRS needs Coriolis parameter.... 
     173!!gm  If needed, then update this to have Coriolis at both f- and t-points 
     174 
     175      ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) ) 
     176 
     177      CALL ctl_warn( 'crsini: CAUTION, CRS only designed for Coriolis defined on the sphere' )  
    181178  
    182       END SELECT  
    183179 
    184180     !    3.d.1 mbathy ( vertical k-levels of bathymetry )      

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r6140 r7277  
    392392        ENDIF                
    393393 
    394         IF( iptglo .NE. 0 )THEN 
     394        IF( iptglo /= 0 )THEN 
    395395              
    396396           !read points'coordinates and directions  
    … …  
    399399           directemp(:) = 0                  !value of directions of each points 
    400400           DO jpt=1,iptglo 
    401               READ(numdct_in)i1,i2 
     401              READ(numdct_in) i1, i2 
    402402              coordtemp(jpt)%I = i1  
    403403              coordtemp(jpt)%J = i2 
    404404           ENDDO 
    405            READ(numdct_in)directemp(1:iptglo) 
     405           READ(numdct_in) directemp(1:iptglo) 
    406406     
    407407           !debug 
    … …  
    416416           !Now each proc selects only points that are in its domain: 
    417417           !-------------------------------------------------------- 
    418            iptloc = 0                    !initialize number of points selected 
    419            DO jpt=1,iptglo               !loop on listpoint read in the file 
    420                      
     418           iptloc = 0                    ! initialize number of points selected 
     419           DO jpt = 1, iptglo            ! loop on listpoint read in the file 
     420              !       
    421421              iiglo=coordtemp(jpt)%I          ! global coordinates of the point 
    422422              ijglo=coordtemp(jpt)%J          !  "  
    423423 
    424               IF( iiglo==jpidta .AND. nimpp==1 ) iiglo = 2 
    425  
    426               iiloc=iiglo-jpizoom+1-nimpp+1   ! local coordinates of the point 
    427               ijloc=ijglo-jpjzoom+1-njmpp+1   !  " 
     424              IF( iiglo==jpiglo .AND. nimpp==1 )   iiglo = 2         !!gm BUG: Hard coded periodicity ! 
     425 
     426              iiloc=iiglo-nimpp+1   ! local coordinates of the point 
     427              ijloc=ijglo-njmpp+1   !  " 
    428428 
    429429              !verify if the point is on the local domain:(1,nlei)*(1,nlej) 
    430               IF( iiloc .GE. 1 .AND. iiloc .LE. nlei .AND. & 
    431                   ijloc .GE. 1 .AND. ijloc .LE. nlej       )THEN 
     430              IF( iiloc >= 1 .AND. iiloc <= nlei .AND. & 
     431                  ijloc >= 1 .AND. ijloc <= nlej       )THEN 
    432432                 iptloc = iptloc + 1                                                 ! count local points 
    433433                 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates 
    434434                 secs(jsec)%direction(iptloc) = directemp(jpt)                       ! store local direction 
    435435              ENDIF 
    436  
    437            ENDDO 
     436              ! 
     437           END DO 
    438438      
    439439           secs(jsec)%nb_point=iptloc !store number of section's points 
    … …  
    444444              WRITE(numout,*)"      List of points selected by the proc:" 
    445445              DO jpt = 1,iptloc 
    446                  iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 
    447                  ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 
     446                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 
     447                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 
    448448                 WRITE(numout,*)'         # I J : ',iiglo,ijglo 
    449449              ENDDO 
    … …  
    452452              IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 
    453453              DO jpt = 1,iptloc 
    454                  iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 
    455                  ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 
     454                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 
     455                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 
    456456              ENDDO 
    457457              ENDIF 
    … …  
    468468           IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 
    469469              DO jpt = 1,secs(jsec)%nb_point 
    470                  iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 
    471                  ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 
     470                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 
     471                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 
    472472              ENDDO 
    473473           ENDIF 
    … …  
    479479              iptloc = secs(jsec)%nb_point 
    480480              DO jpt = 1,iptloc 
    481                  iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 
    482                  ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 
     481                 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 
     482                 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 
    483483                 WRITE(numout,*)'         # I J : ',iiglo,ijglo 
    484484                 CALL FLUSH(numout) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

    r6140 r7277  
    44   !! Harmonic analysis of tidal constituents  
    55   !!====================================================================== 
    6    !! History :  3.6  !  2014  (E O'Dea)  Original code 
     6   !! History :  3.6  !  08-2014  (E O'Dea)  Original code 
     7   !!            3.7  !  05-2016  (G. Madec)  use mbkt, mikt to account for ocean cavities 
    78   !!---------------------------------------------------------------------- 
    89   USE oce             ! ocean dynamics and tracers variables 
    910   USE dom_oce         ! ocean space and time domain 
     11   ! 
    1012   USE in_out_manager  ! I/O units 
    1113   USE iom             ! I/0 library 
    … …  
    3133      !!                  ***  ROUTINE dia_tmb_init  *** 
    3234      !!      
    33       !! ** Purpose: Initialization of tmb namelist  
     35      !! ** Purpose :  Initialization of tmb namelist  
    3436      !!         
    35       !! ** Method : Read namelist 
    36       !!   History 
    37       !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb 
     37      !! ** Method  :   Read namelist 
    3838      !!--------------------------------------------------------------------------- 
    39       !! 
    4039      INTEGER ::   ios                 ! Local integer output status for namelist read 
    4140      ! 
    … …  
    5958         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb 
    6059      ENDIF 
    61  
     60      ! 
    6261   END SUBROUTINE dia_tmb_init 
    6362 
    64    SUBROUTINE dia_calctmb( pinfield,pouttmb ) 
     63 
     64   SUBROUTINE dia_calctmb( pfield, ptmb ) 
    6565      !!--------------------------------------------------------------------- 
    6666      !!                  ***  ROUTINE dia_tmb  *** 
    … …  
    6868      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column 
    6969      !! 
    70       !! ** Method  :    
    71       !!      use mbathy to find surface, mid and bottom of model levels 
     70      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of  
     71      !!              model levels due to potential existence of ocean cavities 
    7272      !! 
    73       !! History : 
    74       !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam 
    7573      !!---------------------------------------------------------------------- 
    76       !! * Modules used 
    77  
    78       ! Routine to map 3d field to top, middle, bottom 
    79       IMPLICIT NONE 
    80  
    81  
    82       ! Routine arguments 
    83       REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: pinfield    ! Input 3d field and mask 
    84       REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: pouttmb     ! Output top, middle, bottom 
    85  
    86  
    87  
    88       ! Local variables 
    89       INTEGER :: ji,jj,jk  ! Dummy loop indices 
    90  
    91       ! Local Real 
    92       REAL(wp)                         ::   zmdi  !  set masked values 
    93  
    94       zmdi=1.e+20 !missing data indicator for masking 
    95  
    96       ! Calculate top 
    97       pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1)) 
    98  
    99       ! Calculate middle 
    100       DO jj = 1,jpj 
    101          DO ji = 1,jpi 
    102             jk              = max(1,mbathy(ji,jj)/2) 
    103             pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk)) 
     74      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) :: pfield   ! Input 3d field and mask 
     75      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) :: ptmb     ! top, middle, bottom extracted from pfield 
     76      ! 
     77      INTEGER  ::   ji, jj  ! Dummy loop indices 
     78      INTEGER  ::   itop, imid, ibot  ! local integers 
     79      REAL(wp) ::   zmdi = 1.e+20_wp  ! land value 
     80      !!--------------------------------------------------------------------- 
     81      ! 
     82      DO jj = 1, jpj 
     83         DO ji = 1, jpi 
     84            itop = mikt(ji,jj)                        ! top    ocean  
     85            ibot = mbkt(ji,jj)                        ! bottom ocean  
     86            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean           
     87            !                     
     88            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop)  + zmdi*( 1._wp-tmask(ji,jj,itop) ) 
     89            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid)  + zmdi*( 1._wp-tmask(ji,jj,imid) ) 
     90            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot)  + zmdi*( 1._wp-tmask(ji,jj,ibot) ) 
    10491         END DO 
    10592      END DO 
    106  
    107       ! Calculate bottom 
    108       DO jj = 1,jpj 
    109          DO ji = 1,jpi 
    110             jk              = max(1,mbathy(ji,jj) - 1) 
    111             pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk)) 
    112          END DO 
    113       END DO 
    114  
     93      ! 
    11594   END SUBROUTINE dia_calctmb 
    116  
    11795 
    11896 
    … …  
    122100      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column 
    123101      !! 
    124       !! ** Method  :    
    125       !!      use mbathy to find surface, mid and bottom of model levels 
     102      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels 
    126103      !!      calls calctmb to retrieve TMB values before sending to iom_put 
    127104      !! 
    128       !! History : 
    129       !!   3.6  !  08-14  (E. O'Dea)  
    130       !!          
    131105      !!-------------------------------------------------------------------- 
    132       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace  
    133       REAL(wp)                         ::   zmdi      ! set masked values 
    134  
    135       zmdi=1.e+20 !missing data indicator for maskin 
    136  
     106      REAL(wp) ::   zmdi =1.e+20     ! land value 
     107      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! workspace  
     108      !!-------------------------------------------------------------------- 
     109      ! 
    137110      IF (ln_diatmb) THEN 
    138          CALL wrk_alloc( jpi , jpj, 3 , zwtmb ) 
     111         CALL wrk_alloc( jpi,jpj,3  , zwtmb ) 
    139112         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb ) 
    140113         !ssh already output but here we output it masked 
    141          CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature 
     114         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 
    142115         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature 
    143116         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature 
    … …  
    161134         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity 
    162135!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity 
     136         CALL wrk_dealloc( jpi,jpj,3   , zwtmb ) 
    163137      ELSE 
    164138         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this') 
    165139      ENDIF 
    166  
     140      ! 
    167141   END SUBROUTINE dia_tmb 
    168142   !!====================================================================== 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6387 r7277  
    666666         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28 
    667667            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    668          CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3 
     668         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "J/m2"   ,   & ! htc3 
    669669            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    670670#endif 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r6140 r7277  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  daymod  *** 
    4    !! Ocean        : calendar 
     4   !! Ocean :   management of the model calendar 
    55   !!===================================================================== 
    66   !! History :  OPA  ! 1994-09  (M. Pontaud M. Imbard)  Original code 
    … …  
    1616   !!---------------------------------------------------------------------- 
    1717   !!   day        : calendar 
    18    !! 
    19    !!           ------------------------------- 
    20    !!           ----------- WARNING ----------- 
    21    !! 
    22    !!   we suppose that the time step is deviding the number of second of in a day 
    23    !!             ---> MOD( rday, rdt ) == 0 
    24    !! 
    25    !!           ----------- WARNING ----------- 
    26    !!           ------------------------------- 
    27    !! 
     18   !!---------------------------------------------------------------------- 
     19   !!                    ----------- WARNING ----------- 
     20   !!                    ------------------------------- 
     21   !!   sbcmod assume that the time step is dividing the number of second of  
     22   !!   in a day, i.e. ===> MOD( rday, rdt ) == 0  
     23   !!   except when user defined forcing is used (see sbcmod.F90) 
    2824   !!---------------------------------------------------------------------- 
    2925   USE dom_oce        ! ocean space and time domain 
    3026   USE phycst         ! physical constants 
     27   USE ioipsl  , ONLY :   ymds2ju      ! for calendar 
     28   USE trc_oce , ONLY :   lk_offline   ! offline flag 
     29   ! 
    3130   USE in_out_manager ! I/O manager 
     31   USE prtctl         ! Print control 
    3232   USE iom            ! 
    33    USE ioipsl  , ONLY :   ymds2ju   ! for calendar 
    34    USE prtctl         ! Print control 
    35    USE trc_oce , ONLY : lk_offline ! offline flag 
    3633   USE timing         ! Timing 
    3734   USE restart        ! restart 
    … …  
    4744 
    4845   !!---------------------------------------------------------------------- 
    49    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    5047   !! $Id$ 
    5148   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7067      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    7168      !!---------------------------------------------------------------------- 
    72       INTEGER  ::   inbday, idweek 
    73       REAL(wp) ::   zjul 
     69      INTEGER  ::   inbday, idweek   ! local integers 
     70      REAL(wp) ::   zjul             ! local scalar 
    7471      !!---------------------------------------------------------------------- 
    7572      ! 
    … …  
    7976            &           'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 
    8077      ENDIF 
    81       ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0 
    82       IF( MOD( rday     , rdt   ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 
    83       IF( MOD( rday     , 2.    ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    ) 
    84       IF( MOD( rdt      , 2.    ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           ) 
    85       nsecd   = NINT(rday       ) 
    86       nsecd05 = NINT(0.5 * rday ) 
    87       ndt     = NINT(      rdt  ) 
    88       ndt05   = NINT(0.5 * rdt  ) 
    89  
    90       IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 
     78      nsecd   = NINT( rday       ) 
     79      nsecd05 = NINT( 0.5 * rday ) 
     80      ndt     = NINT(       rdt  ) 
     81      ndt05   = NINT( 0.5 * rdt  ) 
     82 
     83      IF( .NOT. lk_offline )   CALL day_rst( nit000, 'READ' ) 
    9184 
    9285      ! set the calandar from ndastp (read in restart file and namelist) 
    93  
    9486      nyear   =   ndastp / 10000 
    9587      nmonth  = ( ndastp - (nyear * 10000) ) / 100 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r6140 r7277  
    2929   !! time & space domain namelist 
    3030   !! ---------------------------- 
    31    !                                    !!* Namelist namdom : time & space domain * 
    32    INTEGER , PUBLIC ::   nn_bathy        !: = 0/1 ,compute/read the bathymetry file 
    33    REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1) 
    34    REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0) 
    35    REAL(wp), PUBLIC ::   rn_isfhmin      !: threshold to discriminate grounded ice to floating ice 
    36    REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters) 
    37    REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps 
    38    INTEGER , PUBLIC ::   nn_msh          !: = 1 create a mesh-mask file 
    39    REAL(wp), PUBLIC ::   rn_atfp         !: asselin time filter parameter 
    40    REAL(wp), PUBLIC ::   rn_rdt          !: time step for the dynamics and tracer 
    41    INTEGER , PUBLIC ::   nn_closea       !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
    42    INTEGER , PUBLIC ::   nn_euler        !: =0 start with forward time step or not (=1) 
     31   !                                   !!* Namelist namdom : time & space domain * 
     32   LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time 
     33   INTEGER , PUBLIC ::   nn_closea      !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
     34   INTEGER , PUBLIC ::   nn_msh         !: >0  create a mesh-mask file (mesh_mask.nc) 
     35   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice 
     36   REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer 
     37   REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter 
     38   INTEGER , PUBLIC ::   nn_euler       !: =0 start with forward time step or not (=1) 
    4339   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet 
    44    LOGICAL , PUBLIC ::   ln_crs          !: Apply grid coarsening to dynamical model output or online passive tracers 
     40   LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers 
    4541 
    4642   !! Free surface parameters 
    4743   !! ======================= 
    48    LOGICAL , PUBLIC :: ln_dynspg_exp     !: Explicit free surface flag 
    49    LOGICAL , PUBLIC :: ln_dynspg_ts      !: Split-Explicit free surface flag 
     44   LOGICAL , PUBLIC :: ln_dynspg_exp    !: Explicit free surface flag 
     45   LOGICAL , PUBLIC :: ln_dynspg_ts     !: Split-Explicit free surface flag 
    5046 
    5147   !! Time splitting parameters 
    5248   !! ========================= 
    53    LOGICAL,  PUBLIC :: ln_bt_fw          !: Forward integration of barotropic sub-stepping 
    54    LOGICAL,  PUBLIC :: ln_bt_av          !: Time averaging of barotropic variables 
    55    LOGICAL,  PUBLIC :: ln_bt_auto        !: Set number of barotropic iterations automatically 
    56    INTEGER,  PUBLIC :: nn_bt_flt         !: Filter choice 
    57    INTEGER,  PUBLIC :: nn_baro           !: Number of barotropic iterations during one baroclinic step (rdt) 
    58    REAL(wp), PUBLIC :: rn_bt_cmax        !: Maximum allowed courant number (used if ln_bt_auto=T) 
    59  
    60    !! Horizontal grid parameters for domhgr 
    61    !! ===================================== 
    62    INTEGER       ::   jphgr_msh          !: type of horizontal mesh 
    63    !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc 
    64    !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing 
    65    !                                       !  = 2 f-plane with regular grid-spacing 
    66    !                                       !  = 3 beta-plane with regular grid-spacing 
    67    !                                       !  = 4 Mercator grid with T/U point at the equator 
    68  
    69    REAL(wp)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1) 
    70    REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1) 
    71    !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3) 
    72    REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees) 
    73    REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees) 
    74    REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees) 
    75    REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees) 
    76  
    77    !! Vertical grid parameter for domzgr 
    78    !! ================================== 
    79    REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients 
    80    REAL(wp)      ::   ppa0               !: (default coefficients) 
    81    REAL(wp)      ::   ppa1               !: 
    82    REAL(wp)      ::   ppkth              !: 
    83    REAL(wp)      ::   ppacr              !: 
    84    ! 
    85    !  If both ppa0 ppa1 and ppsur are specified to 0, then 
    86    !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 
    87    REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing 
    88    REAL(wp)      ::   pphmax             !: Maximum depth 
    89    ! 
    90    LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates 
    91    REAL(wp)      ::   ppa2               !: Double tanh function parameters 
    92    REAL(wp)      ::   ppkth2             !: 
    93    REAL(wp)      ::   ppacr2             !: 
    94  
    95    !                                    !! old non-DOCTOR names still used in the model 
    96    INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file 
    97    REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters) 
    98    REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps 
    99    INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file 
    100    REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter 
    101    REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics and tracer 
    102  
    103    !                                                  !!! associated variables 
    104    INTEGER , PUBLIC                 ::   neuler        !: restart euler forward option (0=Euler) 
    105    REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    106    REAL(wp), PUBLIC                 ::   r2dt          !: = 2*rdt except at nit000 (=rdt) if neuler=0 
     49   LOGICAL,  PUBLIC :: ln_bt_fw         !: Forward integration of barotropic sub-stepping 
     50   LOGICAL,  PUBLIC :: ln_bt_av         !: Time averaging of barotropic variables 
     51   LOGICAL,  PUBLIC :: ln_bt_auto       !: Set number of barotropic iterations automatically 
     52   INTEGER,  PUBLIC :: nn_bt_flt        !: Filter choice 
     53   INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt) 
     54   REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T) 
     55 
     56 
     57   !                                   !! old non-DOCTOR names still used in the model 
     58   REAL(wp), PUBLIC ::   atfp           !: asselin time filter parameter 
     59   REAL(wp), PUBLIC ::   rdt            !: time step for the dynamics and tracer 
     60 
     61   !                                   !!! associated variables 
     62   INTEGER , PUBLIC ::   neuler         !: restart euler forward option (0=Euler) 
     63   REAL(wp), PUBLIC ::   r2dt           !: = 2*rdt except at nit000 (=rdt) if neuler=0 
    10764 
    10865   !!---------------------------------------------------------------------- 
    10966   !! space domain parameters 
    11067   !!---------------------------------------------------------------------- 
    111    LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag 
    112    LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag 
    113    LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag 
    114    LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag 
    115    LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag 
    116  
    117    !                                     !!! domain parameters linked to mpp 
    118    INTEGER, PUBLIC ::   nperio            !: type of lateral boundary condition 
    119    INTEGER, PUBLIC ::   nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom 
    120    INTEGER, PUBLIC ::   nreci, nrecj      !: overlap region in i and j 
    121    INTEGER, PUBLIC ::   nproc             !: number for local processor 
    122    INTEGER, PUBLIC ::   narea             !: number for local area 
    123    INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries 
     68   INTEGER, PUBLIC ::   jperio   !: Global domain lateral boundary type (between 0 and 6) 
     69   !                                !  = 0 closed                 ;   = 1 cyclic East-West 
     70   !                                !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot 
     71   !                                !  = 4 cyclic East-West AND North fold T-point pivot 
     72   !                                !  = 5 North fold F-point pivot 
     73   !                                !  = 6 cyclic East-West AND North fold F-point pivot 
     74   INTEGER, PUBLIC ::   nperio   !: Local domain lateral boundary type (deduced from jperio and MPP decomposition) 
     75 
     76   !                                 !  domain MPP decomposition parameters 
     77   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom 
     78   INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j 
     79   INTEGER             , PUBLIC ::   nproc            !: number for local processor 
     80   INTEGER             , PUBLIC ::   narea            !: number for local area 
     81   INTEGER             , PUBLIC ::   nbondi, nbondj   !: mark of i- and j-direction local boundaries 
    12482   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries 
    12583   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries 
    … …  
    14098   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index 
    14199   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index 
    142    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution? 
    143    !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
    144    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution? 
    145    !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
     100   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index (mi0=1 and mi1=0 if the global index 
     101   !                                                                !                                            is not in the local domain) 
     102   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index (mj0=1 and mj1=0 if the global index 
     103   !                                                                !                                            is not in the local domain) 
    146104   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor 
    147105   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
    … …  
    154112   !! horizontal curvilinear coordinate and scale factors 
    155113   !! --------------------------------------------------------------------- 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree] 
    157    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree] 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree] 
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree] 
    158116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m] 
    159117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m] 
    … …  
    161119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
    162120   ! 
    163    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
    166    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    167125   ! 
    168    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s] 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f, ff_t                      !: coriolis factor at f- and t-point         [1/s] 
    169127 
    170128   !!---------------------------------------------------------------------- 
    171129   !! vertical coordinate and scale factors 
    172130   !! --------------------------------------------------------------------- 
    173    !                                !!* Namelist namzgr : vertical coordinate * 
    174131   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step 
    175132   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step 
    176133   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate 
    177134   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
    178    LOGICAL, PUBLIC ::   ln_linssh    !: variable grid flag 
    179  
    180135   !                                                        !  ref.   ! before  !   now   ! after  ! 
    181136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    … …  
    207162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m) 
    208163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m) 
    209    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points 
    210  
    211 !!gm  This should be removed from here....  ==>>> only used in domzgr at initialization phase 
    212    !! s-coordinate and hybrid z-s-coordinate 
    213    !! =----------------======--------------- 
    214    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsigt, gsigw       !: model level depth coefficient at t-, w-levels (analytic) 
    215    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsi3w              !: model level depth coefficient at w-level (sum of gsigw) 
    216    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   esigt, esigw       !: vertical scale factor coef. at t-, w-levels 
    217  
    218    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f 
    219    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m) 
    220    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies  
    221    !                                                                           !  (if deviating from coordinate surfaces in HYBRID) 
    222    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f 
    223    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m) 
    224    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio 
    225 !!gm end 
    226  
    227    !!---------------------------------------------------------------------- 
    228    !! masks, bathymetry 
     164 
     165 
     166   !!---------------------------------------------------------------------- 
     167   !! masks, top and bottom ocean point position 
    229168   !! --------------------------------------------------------------------- 
    230    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1) 
    231    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt               !: vertical index of the bottom last T- ocean level 
    232    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv         !: vertical index of the bottom last U- and W- ocean level 
    233    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters) 
     169!!gm Proposition of new name for top/bottom vertical indices 
     170!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top first wet T-, U-, V-, F-level (ISF) 
     171!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last wet T-, U- and V-level 
     172!!gm 
     173   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level 
    234174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask 
    235175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book) 
    236176 
    237    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level                (ISF) 
    238    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: first wet T-, U-, V-, F- ocean level (ISF) 
    239    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                       (ISF) 
    240  
    241    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts 
     177   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF) 
     178   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF) 
     179   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF) 
     180 
     181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts 
    242182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    243183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    … …  
    319259         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    320260         &                                      nleit(jpnij) , nlejt(jpnij) ,     & 
    321          &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta),      & 
    322          &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) ) 
     261         &      mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
     262         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
    323263         ! 
    324264      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 
    … …  
    332272         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
    333273         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
    334          &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
    335          ! 
    336       ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     & 
     274         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) ) 
     275         ! 
     276      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,      & 
    337277         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             & 
    338278         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) ) 
    … …  
    353293         ! 
    354294         ! 
    355       ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     & 
    356          &      e3t_1d  (jpk) , e3w_1d  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     & 
    357          &      gsigt   (jpk) , gsigw   (jpk) , gsi3w(jpk)    ,                     & 
    358          &      esigt   (jpk) , esigw   (jpk)                                 , STAT=ierr(7) ) 
    359          ! 
    360       ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     & 
    361          &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     & 
    362          &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
    363          &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
    364          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 
    365  
    366       ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       & 
    367          &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       &  
    368          &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 
    369          &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    370  
    371 ! (ISF) Allocation of basic array    
    372       ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     & 
    373          &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
    374          &     mikf(jpi,jpj), STAT=ierr(10) ) 
    375  
    376       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
    377          &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) ) 
    378  
     295      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(7) ) 
     296         ! 
     297      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        &  
     298         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     & 
     299         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
     300         ! 
     301      ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) ,     & 
     302         &      risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) ) 
     303         ! 
     304      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     &  
     305         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(11) ) 
     306         ! 
    379307      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) ) 
    380308      ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6140 r7277  
    1414   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 
    1515   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default 
     16   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    1617   !!---------------------------------------------------------------------- 
    1718    
    1819   !!---------------------------------------------------------------------- 
    19    !!   dom_init       : initialize the space and time domain 
    20    !!   dom_nam        : read and contral domain namelists 
    21    !!   dom_ctl        : control print for the ocean domain 
    22    !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 
     20   !!   dom_init      : initialize the space and time domain 
     21   !!   dom_glo       : initialize global domain <--> local domain indices 
     22   !!   dom_nam       : read and contral domain namelists 
     23   !!   dom_ctl       : control print for the ocean domain 
     24   !!   domain_cfg    : read the global domain size in domain configuration file 
     25   !!   cfg_write     : create the domain configuration file 
    2326   !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean variables 
    25    USE dom_oce         ! domain: ocean 
    26    USE sbc_oce         ! surface boundary condition: ocean 
    27    USE phycst          ! physical constants 
    28    USE closea          ! closed seas 
    29    USE domhgr          ! domain: set the horizontal mesh 
    30    USE domzgr          ! domain: set the vertical mesh 
    31    USE domstp          ! domain: set the time-step 
    32    USE dommsk          ! domain: set the mask system 
    33    USE domwri          ! domain: write the meshmask file 
    34    USE domvvl          ! variable volume 
    35    USE c1d             ! 1D vertical configuration 
    36    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine) 
     27   USE oce            ! ocean variables 
     28   USE dom_oce        ! domain: ocean 
     29   USE sbc_oce        ! surface boundary condition: ocean 
     30   USE trc_oce        ! shared ocean & passive tracers variab 
     31   USE phycst         ! physical constants 
     32   USE usrdef_closea  ! closed seas 
     33   USE domhgr         ! domain: set the horizontal mesh 
     34   USE domzgr         ! domain: set the vertical mesh 
     35   USE dommsk         ! domain: set the mask system 
     36   USE domwri         ! domain: write the meshmask file 
     37   USE domvvl         ! variable volume 
     38   USE c1d            ! 1D configuration 
     39   USE domc1d         ! 1D configuration: column location 
     40   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine) 
    3741   ! 
    38    USE in_out_manager  ! I/O manager 
    39    USE wrk_nemo        ! Memory Allocation 
    40    USE lib_mpp         ! distributed memory computing library 
    41    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    42    USE timing          ! Timing 
     42   USE in_out_manager ! I/O manager 
     43   USE iom            ! I/O library 
     44   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     45   USE lib_mpp        ! distributed memory computing library 
     46   USE wrk_nemo       ! Memory Allocation 
     47   USE timing         ! Timing 
    4348 
    4449   IMPLICIT NONE 
    4550   PRIVATE 
    4651 
    47    PUBLIC   dom_init   ! called by opa.F90 
     52   PUBLIC   dom_init     ! called by nemogcm.F90 
     53   PUBLIC   domain_cfg   ! called by nemogcm.F90 
    4854 
    4955   !!------------------------------------------------------------------------- 
    … …  
    6672      !!                         and scale factors, and the coriolis factor 
    6773      !!              - dom_zgr: define the vertical coordinate and the bathymetry 
    68       !!              - dom_stp: defined the model time step 
    69       !!              - dom_wri: create the meshmask file if nmsh=1 
     74      !!              - dom_wri: create the meshmask file if nn_msh=1 
    7075      !!              - 1D configuration, move Coriolis, u and v at T-point 
    7176      !!---------------------------------------------------------------------- 
    72       INTEGER ::   jk          ! dummy loop indices 
    73       INTEGER ::   iconf = 0   ! local integers 
    74       REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0 
     77      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices 
     78      INTEGER ::   iconf = 0    ! local integers 
     79      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))"  
     80      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level 
     81      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0 
    7582      !!---------------------------------------------------------------------- 
    7683      ! 
    7784      IF( nn_timing == 1 )   CALL timing_start('dom_init') 
    7885      ! 
    79       IF(lwp) THEN 
     86      IF(lwp) THEN         ! Ocean domain Parameters (control print) 
    8087         WRITE(numout,*) 
    8188         WRITE(numout,*) 'dom_init : domain initialization' 
    8289         WRITE(numout,*) '~~~~~~~~' 
    83       ENDIF 
    84       ! 
    85       !                       !==  Reference coordinate system  ==! 
    86       ! 
    87                      CALL dom_nam               ! read namelist ( namrun, namdom ) 
    88                      CALL dom_clo               ! Closed seas and lake 
    89                      CALL dom_hgr               ! Horizontal mesh 
    90                      CALL dom_zgr               ! Vertical mesh and bathymetry 
    91                      CALL dom_msk               ! Masks 
    92       IF( ln_sco )   CALL dom_stiff             ! Maximum stiffness ratio/hydrostatic consistency 
     90         ! 
     91         WRITE(numout,*)     '   Domain info' 
     92         WRITE(numout,*)     '      dimension of model:' 
     93         WRITE(numout,*)     '             Local domain      Global domain       Data domain ' 
     94         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo 
     95         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo 
     96         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo 
     97         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij 
     98         WRITE(numout,*)     '      mpp local domain info (mpp):' 
     99         WRITE(numout,*)     '              jpni    : ', jpni, '   jpreci  : ', jpreci 
     100         WRITE(numout,*)     '              jpnj    : ', jpnj, '   jprecj  : ', jprecj 
     101         WRITE(numout,*)     '              jpnij   : ', jpnij 
     102         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio 
     103         SELECT CASE ( jperio ) 
     104         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)' 
     105         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)' 
     106         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)' 
     107         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)' 
     108         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)' 
     109         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)' 
     110         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)' 
     111         CASE DEFAULT 
     112            CALL ctl_stop( 'jperio is out of range' ) 
     113         END SELECT 
     114         WRITE(numout,*)     '      Ocean model configuration used:' 
     115         WRITE(numout,*)     '              cn_cfg = ', cn_cfg 
     116         WRITE(numout,*)     '              nn_cfg = ', nn_cfg 
     117      ENDIF 
     118      ! 
     119      !       
     120!!gm  This should be removed with the new configuration interface 
     121      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d ) 
     122!!gm end 
     123      ! 
     124      !           !==  Reference coordinate system  ==! 
     125      ! 
     126      CALL dom_glo                     ! global domain versus local domain 
     127      CALL dom_nam                     ! read namelist ( namrun, namdom ) 
     128      CALL dom_clo( cn_cfg, nn_cfg )   ! Closed seas and lake 
     129      CALL dom_hgr                     ! Horizontal mesh 
     130      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry 
     131      IF( nn_closea == 0 )   CALL clo_bat( ik_top, ik_bot )    !==  remove closed seas or lakes  ==! 
     132      CALL dom_msk( ik_top, ik_bot )   ! Masks 
     133      ! 
     134      DO jj = 1, jpj                   ! depth of the iceshelves 
     135         DO ji = 1, jpi 
     136            ik = mikt(ji,jj) 
     137            risfdep(ji,jj) = gdepw_0(ji,jj,ik) 
     138         END DO 
     139      END DO 
    93140      ! 
    94141      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness 
    … …  
    101148      END DO 
    102149      ! 
    103       !              !==  time varying part of coordinate system  ==! 
    104       ! 
    105       IF( ln_linssh ) THEN          ! Fix in time : set to the reference one for all 
     150      !           !==  time varying part of coordinate system  ==! 
     151      ! 
     152      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all 
     153      ! 
    106154         !       before        !          now          !       after         ! 
    107155         ;  gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points 
    … …  
    117165         ;   e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          ! 
    118166         ! 
    119          CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 ) 
    120          ! 
    121167         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
    122168         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
    … …  
    129175         ;  r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   ! 
    130176         ! 
    131          CALL wrk_dealloc( jpi,jpj,   z1_hu_0, z1_hv_0 ) 
    132          ! 
    133       ELSE                         ! time varying : initialize before/now/after variables 
    134          ! 
    135          CALL dom_vvl_init  
     177         ! 
     178      ELSE                       != time varying : initialize before/now/after variables 
     179         ! 
     180         IF( .NOT.lk_offline )  CALL dom_vvl_init  
    136181         ! 
    137182      ENDIF 
    … …  
    139184      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point 
    140185      ! 
    141                              CALL dom_stp       ! time step 
    142       IF( nmsh /= 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file 
    143       IF( nmsh /= 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file 
     186      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file 
     187      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file 
    144188      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control 
    145189      ! 
     190       
     191      IF(lwp) THEN 
     192         WRITE(numout,*) 
     193         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh 
     194         WRITE(numout,*)  
     195      ENDIF 
     196      ! 
     197      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
     198      ! 
    146199      IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
    147200      ! 
    148201   END SUBROUTINE dom_init 
     202 
     203 
     204   SUBROUTINE dom_glo 
     205      !!---------------------------------------------------------------------- 
     206      !!                     ***  ROUTINE dom_glo  *** 
     207      !! 
     208      !! ** Purpose :   initialization of global domain <--> local domain indices 
     209      !! 
     210      !! ** Method  :    
     211      !! 
     212      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices 
     213      !!              - mi0 , mi1 : global domain indices ==> local  domain indices 
     214      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
     215      !!---------------------------------------------------------------------- 
     216      INTEGER ::   ji, jj   ! dummy loop argument 
     217      !!---------------------------------------------------------------------- 
     218      ! 
     219      DO ji = 1, jpi                 ! local domain indices ==> global domain indices 
     220        mig(ji) = ji + nimpp - 1 
     221      END DO 
     222      DO jj = 1, jpj 
     223        mjg(jj) = jj + njmpp - 1 
     224      END DO 
     225      !                              ! global domain indices ==> local domain indices 
     226      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
     227      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
     228      DO ji = 1, jpiglo 
     229        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) 
     230        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) ) 
     231      END DO 
     232      DO jj = 1, jpjglo 
     233        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) ) 
     234        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) ) 
     235      END DO 
     236      IF(lwp) THEN                   ! control print 
     237         WRITE(numout,*) 
     238         WRITE(numout,*) 'dom_glo : domain: global <<==>> local ' 
     239         WRITE(numout,*) '~~~~~~~ ' 
     240         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo 
     241         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk 
     242         WRITE(numout,*) 
     243         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done' 
     244         IF( nn_print >= 1 ) THEN 
     245            WRITE(numout,*) 
     246            WRITE(numout,*) '          conversion local  ==> global i-index domain' 
     247            WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
     248            WRITE(numout,*) 
     249            WRITE(numout,*) '          conversion global ==> local  i-index domain' 
     250            WRITE(numout,*) '             starting index' 
     251            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo) 
     252            WRITE(numout,*) '             ending index' 
     253            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo) 
     254            WRITE(numout,*) 
     255            WRITE(numout,*) '          conversion local  ==> global j-index domain' 
     256            WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
     257            WRITE(numout,*) 
     258            WRITE(numout,*) '          conversion global ==> local  j-index domain' 
     259            WRITE(numout,*) '             starting index' 
     260            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo) 
     261            WRITE(numout,*) '             ending index' 
     262            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo) 
     263         ENDIF 
     264      ENDIF 
     265 25   FORMAT( 100(10x,19i4,/) ) 
     266      ! 
     267   END SUBROUTINE dom_glo 
    149268 
    150269 
    … …  
    161280      USE ioipsl 
    162281      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 & 
    163                        nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     & 
     282         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     & 
    164283         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     & 
    165284         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     & 
    166285         &             ln_cfmeta, ln_iscpl 
    167       NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin, & 
    168          &             rn_atfp , rn_rdt   , nn_closea   , ln_crs      , jphgr_msh ,                  & 
    169          &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         & 
    170          &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  & 
    171          &             ppa2, ppkth2, ppacr2 
     286      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs 
    172287#if defined key_netcdf4 
    173288      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
    … …  
    175290      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    176291      !!---------------------------------------------------------------------- 
    177  
     292      ! 
    178293      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    179294      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    180295901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
    181  
     296      ! 
    182297      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
    183298      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
    … …  
    235350         neuler = 0 
    236351      ENDIF 
    237  
    238352      !                             ! control of output frequency 
    239353      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
    … …  
    269383      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    270384903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
    271    
    272385      ! 
    273386      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
    … …  
    279392         WRITE(numout,*) 
    280393         WRITE(numout,*) '   Namelist namdom : space & time domain' 
    281          WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy 
    282          WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy 
    283          WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin 
    284          WRITE(numout,*) '      min number of ocean level (<0)       ' 
    285          WRITE(numout,*) '      treshold to open the isf cavity   rn_isfhmin   = ', rn_isfhmin, ' (m)' 
    286          WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)' 
    287          WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat 
    288          WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh 
     394         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh 
     395         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea 
     396         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh 
    289397         WRITE(numout,*) '           = 0   no file created           ' 
    290398         WRITE(numout,*) '           = 1   mesh_mask                 ' 
    291399         WRITE(numout,*) '           = 2   mesh and mask             ' 
    292400         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask' 
    293          WRITE(numout,*) '      ocean time step                       rn_rdt    = ', rn_rdt 
    294          WRITE(numout,*) '      asselin time filter parameter         rn_atfp   = ', rn_atfp 
    295          WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea 
    296          WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs 
    297          WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh 
    298          WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0 
    299          WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0 
    300          WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg 
    301          WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg 
    302          WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m 
    303          WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m 
    304          WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur 
    305          WRITE(numout,*) '                                        ppa0            = ', ppa0 
    306          WRITE(numout,*) '                                        ppa1            = ', ppa1 
    307          WRITE(numout,*) '                                        ppkth           = ', ppkth 
    308          WRITE(numout,*) '                                        ppacr           = ', ppacr 
    309          WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin 
    310          WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax 
    311          WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh 
    312          WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2 
    313          WRITE(numout,*) '                                      ppkth2            = ', ppkth2 
    314          WRITE(numout,*) '                                      ppacr2            = ', ppacr2 
    315       ENDIF 
    316       ! 
    317       ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon) 
    318       e3zps_min = rn_e3zps_min 
    319       e3zps_rat = rn_e3zps_rat 
    320       nmsh      = nn_msh 
     401         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)' 
     402         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt 
     403         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp 
     404         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs 
     405      ENDIF 
     406       
     407      call flush( numout ) 
     408      ! 
     409!     !          ! conversion DOCTOR names into model names (this should disappear soon) 
    321410      atfp      = rn_atfp 
    322411      rdt       = rn_rdt 
    … …  
    327416      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
    328417907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
    329  
     418      ! 
    330419      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF 
    331420      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
    … …  
    378467         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    379468         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    380  
     469         ! 
    381470         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    382471         iimi1 = iloc(1) + nimpp - 1 
    … …  
    405494 
    406495 
    407    SUBROUTINE dom_stiff 
    408       !!---------------------------------------------------------------------- 
    409       !!                  ***  ROUTINE dom_stiff  *** 
    410       !!                      
    411       !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency 
    412       !! 
    413       !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio 
    414       !!                Save the maximum in the vertical direction 
    415       !!                (this number is only relevant in s-coordinates) 
    416       !! 
    417       !!                Haney, R. L., 1991: On the pressure gradient force 
    418       !!                over steep topography in sigma coordinate ocean models.  
    419       !!                J. Phys. Oceanogr., 21, 610???619. 
    420       !!---------------------------------------------------------------------- 
    421       INTEGER  ::   ji, jj, jk  
    422       REAL(wp) ::   zrxmax 
    423       REAL(wp), DIMENSION(4) ::   zr1 
    424       !!---------------------------------------------------------------------- 
    425       rx1(:,:) = 0._wp 
    426       zrxmax   = 0._wp 
    427       zr1(:)   = 0._wp 
    428       ! 
    429       DO ji = 2, jpim1 
    430          DO jj = 2, jpjm1 
    431             DO jk = 1, jpkm1 
    432                zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               &  
    433                     &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             & 
    434                     &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               & 
    435                     &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk) 
    436                zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               & 
    437                     &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             & 
    438                     &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               & 
    439                     &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk) 
    440                zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               & 
    441                     &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             & 
    442                     &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               & 
    443                     &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk) 
    444                zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               & 
    445                     &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             & 
    446                     &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               & 
    447                     &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk) 
    448                zrxmax = MAXVAL( zr1(1:4) ) 
    449                rx1(ji,jj) = MAX( rx1(ji,jj) , zrxmax ) 
    450             END DO 
    451          END DO 
    452       END DO 
    453       CALL lbc_lnk( rx1, 'T', 1. ) 
    454       ! 
    455       zrxmax = MAXVAL( rx1 ) 
    456       ! 
    457       IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain 
    458       ! 
    459       IF(lwp) THEN 
    460          WRITE(numout,*) 
    461          WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax 
    462          WRITE(numout,*) '~~~~~~~~~' 
    463       ENDIF 
    464       ! 
    465    END SUBROUTINE dom_stiff 
     496   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
     497      !!---------------------------------------------------------------------- 
     498      !!                     ***  ROUTINE dom_nam  *** 
     499      !!                     
     500      !! ** Purpose :   read the domain size in domain configuration file 
     501      !! 
     502      !! ** Method  :    
     503      !! 
     504      !!---------------------------------------------------------------------- 
     505      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information 
     506      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
     507      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
     508      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes  
     509      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.  
     510      ! 
     511      INTEGER ::   inum, ii   ! local integer 
     512      REAL(wp) ::   zorca_res                     ! local scalars 
     513      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      - 
     514      !!---------------------------------------------------------------------- 
     515      ! 
     516      ii = 1 
     517      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1 
     518      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1 
     519      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1 
     520      ! 
     521      CALL iom_open( cn_domcfg, inum ) 
     522      ! 
     523      !                                   !- ORCA family specificity 
     524      IF(  iom_varid( inum, 'ORCA'           , ldstop = .FALSE. ) > 0  .AND.  & 
     525         & iom_varid( inum, 'ORCA_resolution', ldstop = .FALSE. ) > 0    ) THEN 
     526         ! 
     527         cd_cfg = 'ORCA' 
     528         CALL iom_get( inum, 'ORCA_resolution', zorca_res )   ;   kk_cfg = INT( zorca_res ) 
     529         ! 
     530         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1 
     531         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1 
     532         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1 
     533         ! 
     534      ELSE                                !- cd_cfg & k_cfg are not used 
     535         cd_cfg = 'UNKNOWN' 
     536         kk_cfg = -9999999 
     537      ENDIF 
     538      ! 
     539      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo ) 
     540      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo ) 
     541      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo ) 
     542      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio ) 
     543      CALL iom_close( inum ) 
     544      ! 
     545      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1 
     546      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1 
     547      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1 
     548      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1 
     549      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1 
     550      !         
     551   END SUBROUTINE domain_cfg 
     552    
     553    
     554   SUBROUTINE cfg_write 
     555      !!---------------------------------------------------------------------- 
     556      !!                  ***  ROUTINE cfg_write  *** 
     557      !!                    
     558      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which  
     559      !!              contains all the ocean domain informations required to  
     560      !!              define an ocean configuration. 
     561      !! 
     562      !! ** Method  :   Write in a file all the arrays required to set up an 
     563      !!              ocean configuration. 
     564      !! 
     565      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal  
     566      !!                       mesh, Coriolis parameter, and vertical scale factors 
     567      !!                    NB: also contain ORCA family information 
     568      !!---------------------------------------------------------------------- 
     569      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
     570      INTEGER           ::   izco, izps, isco, icav 
     571      INTEGER           ::   inum     ! local units 
     572      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations) 
     573      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace 
     574      !!---------------------------------------------------------------------- 
     575      ! 
     576      IF(lwp) WRITE(numout,*) 
     577      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)' 
     578      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
     579      ! 
     580      !                       ! ============================= ! 
     581      !                       !  create 'domcfg_out.nc' file  ! 
     582      !                       ! ============================= ! 
     583      !          
     584      clnam = 'domcfg_out'  ! filename (configuration information) 
     585      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     586       
     587      ! 
     588      !                             !==  ORCA family specificities  ==! 
     589      IF( cn_cfg == "ORCA" ) THEN 
     590         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
     591         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )          
     592      ENDIF 
     593      ! 
     594      !                             !==  global domain size  ==! 
     595      ! 
     596      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
     597      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
     598      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 ) 
     599      ! 
     600      !                             !==  domain characteristics  ==! 
     601      ! 
     602      !                                   ! lateral boundary of the global domain 
     603      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
     604      ! 
     605      !                                   ! type of vertical coordinate 
     606      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
     607      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
     608      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
     609      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
     610      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
     611      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     612      ! 
     613      !                                   ! ocean cavities under iceshelves 
     614      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
     615      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     616      ! 
     617      !                             !==  horizontal mesh  ! 
     618      ! 
     619      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude 
     620      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 ) 
     621      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
     622      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
     623      !                                 
     624      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude 
     625      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
     626      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
     627      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
     628      !                                 
     629      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.) 
     630      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 ) 
     631      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 ) 
     632      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 ) 
     633      ! 
     634      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.) 
     635      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 ) 
     636      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 ) 
     637      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 ) 
     638      ! 
     639      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor 
     640      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 ) 
     641      ! 
     642      !                             !==  vertical mesh  ==! 
     643      !                                                      
     644      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate 
     645      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 ) 
     646      ! 
     647      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors 
     648      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 ) 
     649      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 ) 
     650      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 ) 
     651      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 ) 
     652      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 ) 
     653      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 ) 
     654      !                                          
     655      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask) 
     656      ! 
     657      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF) 
     658      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points 
     659      ! 
     660      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway) 
     661         CALL dom_stiff( z2d ) 
     662         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio 
     663      ENDIF 
     664      ! 
     665      !                                ! ============================ 
     666      !                                !        close the files  
     667      !                                ! ============================ 
     668      CALL iom_close( inum ) 
     669      ! 
     670   END SUBROUTINE cfg_write 
    466671 
    467672   !!====================================================================== 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6140 r7277  
    1616   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse 
    1717   !!                                       add optional read of e1e2u & e1e2v 
     18   !!             -   ! 2016-04  (S. Flavoni, G. Madec) new configuration interface: read or usrdef.F90 
    1819   !!---------------------------------------------------------------------- 
    1920 
    2021   !!---------------------------------------------------------------------- 
    2122   !!   dom_hgr       : initialize the horizontal mesh  
    22    !!   hgr_read      : read "coordinate" NetCDF file  
     23   !!   hgr_read      : read horizontal information in the domain configuration file  
    2324   !!---------------------------------------------------------------------- 
    2425   USE dom_oce        ! ocean space and time domain 
     26   USE par_oce        ! ocean space and time domain 
    2527   USE phycst         ! physical constants 
    26    USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files 
     28   USE usrdef_hgr     ! User defined routine 
    2729   ! 
    2830   USE in_out_manager ! I/O manager 
     31   USE iom            ! I/O library 
    2932   USE lib_mpp        ! MPP library 
    3033   USE timing         ! Timing 
    … …  
    3336   PRIVATE 
    3437 
    35    REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce 
    36  
    3738   PUBLIC   dom_hgr   ! called by domain.F90 
    3839 
    3940   !!---------------------------------------------------------------------- 
    40    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     41   !! NEMO/OPA 3.7 , NEMO Consortium (2016) 
    4142   !! $Id$  
    4243   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4849      !!                  ***  ROUTINE dom_hgr  *** 
    4950      !! 
    50       !! ** Purpose :   Compute the geographical position (in degre) of the  
    51       !!      model grid-points,  the horizontal scale factors (in meters) and  
    52       !!      the Coriolis factor (in s-1). 
    53       !! 
    54       !! ** Method  :   The geographical position of the model grid-points is 
    55       !!      defined from analytical functions, fslam and fsphi, the deriva- 
    56       !!      tives of which gives the horizontal scale factors e1,e2. 
    57       !!      Defining two function fslam and fsphi and their derivatives in  
    58       !!      the two horizontal directions (fse1 and fse2), the model grid- 
    59       !!      point position and scale factors are given by: 
    60       !!         t-point: 
    61       !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    ) 
    62       !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    ) 
    63       !!         u-point: 
    64       !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    ) 
    65       !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    ) 
    66       !!         v-point: 
    67       !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2) 
    68       !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2) 
    69       !!            f-point: 
    70       !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2) 
    71       !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2) 
    72       !!      Where fse1 and fse2 are defined by: 
    73       !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2 
    74       !!                                     +          di(fsphi) **2 )(i,j) 
    75       !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2 
    76       !!                                     +          dj(fsphi) **2 )(i,j) 
    77       !! 
    78       !!        The coriolis factor is given at z-point by: 
    79       !!                     ff = 2.*omega*sin(gphif)      (in s-1) 
    80       !! 
    81       !!        This routine is given as an example, it must be modified 
    82       !!      following the user s desiderata. nevertheless, the output as 
    83       !!      well as the way to compute the model grid-point position and 
    84       !!      horizontal scale factors must be respected in order to insure 
    85       !!      second order accuracy schemes. 
    86       !! 
    87       !! N.B. If the domain is periodic, verify that scale factors are also 
    88       !!      periodic, and the coriolis term again. 
    89       !! 
    90       !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-,  
    91       !!                u-, v- and f-points (in degre) 
    92       !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-, 
    93       !!               u-, v-  and f-points (in degre) 
    94       !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal 
    95       !!      scale factors (in meters) at t-, u-, v-, and f-points. 
    96       !!        define ff: coriolis factor at f-point 
    97       !! 
    98       !! References :   Marti, Madec and Delecluse, 1992, JGR 
    99       !!                Madec, Imbard, 1996, Clim. Dyn. 
    100       !!---------------------------------------------------------------------- 
    101       INTEGER  ::   ji, jj               ! dummy loop indices 
    102       INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers 
    103       INTEGER  ::   ijeq                 ! index of equator T point (used in case 4) 
    104       REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars 
    105       REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      - 
    106       REAL(wp) ::   zphi0, zbeta, znorme ! 
    107       REAL(wp) ::   zarg, zf0, zminff, zmaxff 
    108       REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg 
    109       REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05 
    110       INTEGER  ::   isrow                ! index for ORCA1 starting row 
    111       INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not 
     51      !! ** Purpose :   Read or compute the geographical position (in degrees)   
     52      !!      of the model grid-points, the horizontal scale factors (in meters),  
     53      !!      the associated horizontal metrics, and the Coriolis factor (in s-1). 
     54      !! 
     55      !! ** Method  :   Controlled by ln_read_cfg logical 
     56      !!              =T : all needed arrays are read in mesh_mask.nc file  
     57      !!              =F : user-defined configuration, all needed arrays  
     58      !!                   are computed in usr-def_hgr subroutine  
     59      !! 
     60      !!                If Coriolis factor is neither read nor computed (iff=0) 
     61      !!              it is computed from gphit assuming that the mesh is 
     62      !!              defined on the sphere : 
     63      !!                   ff = 2.*omega*sin(gphif)      (in s-1) 
     64      !!     
     65      !!                If u- & v-surfaces are neither read nor computed (ie1e2u_v=0) 
     66      !!              (i.e. no use of reduced scale factors in some straits) 
     67      !!              they are computed from e1u, e2u, e1v and e2v as: 
     68      !!                   e1e2u = e1u*e2u   and   e1e2v = e1v*e2v   
     69      !!     
     70      !! ** Action  : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 
     71      !!              - define Coriolis parameter at f-point                   (in 1/s) 
     72      !!              - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 
     73      !!              - define associated horizontal metrics at t-, u-, v- and f-points 
     74      !!                (inverse of scale factors 1/e1 & 1/e2, surface e1*e2, ratios e1/e2 & e2/e1) 
     75      !!---------------------------------------------------------------------- 
     76      INTEGER ::   ji, jj     ! dummy loop indices 
     77      INTEGER ::   ie1e2u_v   ! flag for u- & v-surfaces  
     78      INTEGER ::   iff        ! flag for Coriolis parameter 
    11279      !!---------------------------------------------------------------------- 
    11380      ! 
    … …  
    11784         WRITE(numout,*) 
    11885         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters ' 
    119          WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh 
    120          WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0 
    121          WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0 
    122          WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg 
    123          WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg 
    124          WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m   
    125          WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m   
    126       ENDIF 
    127       ! 
    128       ! 
    129       SELECT CASE( jphgr_msh )   !  type of horizontal mesh   
    130       ! 
    131       CASE ( 0 )                     !==  read in coordinate.nc file  ==! 
    132          ! 
     86         WRITE(numout,*) '~~~~~~~   ' 
     87         WRITE(numout,*) '   namcfg : read (=T) or user defined (=F) configuration    ln_read_cfg  = ', ln_read_cfg 
     88      ENDIF 
     89      ! 
     90      ! 
     91      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==! 
    13392         IF(lwp) WRITE(numout,*) 
    134          IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file' 
    135          ! 
    136          ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v 
    137          ! 
    138          CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file 
    139          ! 
    140          IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them 
    141             !                          ! e2u and e1v does not include a reduction in some strait: apply reduction 
    142             e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
    143             e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
     93         IF(lwp) WRITE(numout,*) '          read horizontal mesh in ', TRIM( cn_domcfg ), ' file' 
     94         ! 
     95         CALL hgr_read   ( glamt , glamu , glamv , glamf ,   &    ! geographic position (required) 
     96            &              gphit , gphiu , gphiv , gphif ,   &    !     -        - 
     97            &              iff   , ff_f  , ff_t  ,           &    ! Coriolis parameter (if not on the sphere) 
     98            &              e1t   , e1u   , e1v   , e1f   ,   &    ! scale factors (required) 
     99            &              e2t   , e2u   , e2v   , e2f   ,   &    !    -     -        - 
     100            &              ie1e2u_v      , e1e2u , e1e2v     )    ! u- & v-surfaces (if gridsize reduction in some straits) 
     101         ! 
     102      ELSE                          !==  User defined configuration  ==!  
     103         IF(lwp) WRITE(numout,*) 
     104         IF(lwp) WRITE(numout,*) '          User defined horizontal mesh (usr_def_hgr)' 
     105         ! 
     106         CALL usr_def_hgr( glamt , glamu , glamv , glamf ,   &    ! geographic position (required) 
     107            &              gphit , gphiu , gphiv , gphif ,   &    ! 
     108            &              iff   , ff_f  , ff_t  ,           &    ! Coriolis parameter  (if domain not on the sphere) 
     109            &              e1t   , e1u   , e1v   , e1f   ,   &    ! scale factors       (required) 
     110            &              e2t   , e2u   , e2v   , e2f   ,   &    ! 
     111            &              ie1e2u_v      , e1e2u , e1e2v     )    ! u- & v-surfaces (if gridsize reduction is used in strait(s)) 
     112         ! 
     113      ENDIF 
     114      ! 
     115      !                             !==  Coriolis parameter  ==!   (if necessary) 
     116      ! 
     117      IF( iff == 0 ) THEN                 ! Coriolis parameter has not been defined  
     118         IF(lwp) WRITE(numout,*) '          Coriolis parameter calculated on the sphere from gphif & gphit' 
     119         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) )     ! compute it on the sphere at f-point 
     120         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       -    at t-point 
     121      ELSE 
     122         IF( ln_read_cfg ) THEN 
     123            IF(lwp) WRITE(numout,*) '          Coriolis parameter have been read in ', TRIM( cn_domcfg ), ' file' 
     124         ELSE 
     125            IF(lwp) WRITE(numout,*) '          Coriolis parameter have been set in usr_def_hgr routine' 
    144126         ENDIF 
    145          ! 
    146       CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==! 
    147          ! 
    148          IF(lwp) WRITE(numout,*) 
    149          IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing' 
    150          IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg'  
    151          ! 
    152          DO jj = 1, jpj 
    153             DO ji = 1, jpi 
    154                zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 ) 
    155                zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 ) 
    156                zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
    157                zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
    158          ! Longitude 
    159                glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
    160                glamu(ji,jj) = ppglam0 + ppe1_deg * zui 
    161                glamv(ji,jj) = ppglam0 + ppe1_deg * zvi 
    162                glamf(ji,jj) = ppglam0 + ppe1_deg * zfi 
    163          ! Latitude 
    164                gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj 
    165                gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj 
    166                gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj 
    167                gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj 
    168          ! e1 
    169                e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg 
    170                e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg 
    171                e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg 
    172                e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg 
    173          ! e2 
    174                e2t(ji,jj) = ra * rad * ppe2_deg 
    175                e2u(ji,jj) = ra * rad * ppe2_deg 
    176                e2v(ji,jj) = ra * rad * ppe2_deg 
    177                e2f(ji,jj) = ra * rad * ppe2_deg 
    178             END DO 
    179          END DO 
    180          ! 
    181       CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==! 
    182          ! 
    183          IF(lwp) WRITE(numout,*) 
    184          IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing' 
    185          IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'  
    186          ! 
    187          ! Position coordinates (in kilometers) 
    188          !                          ========== 
    189          glam0 = 0._wp 
    190          gphi0 = - ppe2_m * 1.e-3 
    191          ! 
    192 #if defined key_agrif  
    193          IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    194             IF( .NOT. Agrif_Root() ) THEN 
    195               glam0  = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 
    196               gphi0  = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 
    197               ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox() 
    198               ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy()           
    199             ENDIF 
    200          ENDIF 
    201 #endif          
    202          DO jj = 1, jpj 
    203             DO ji = 1, jpi 
    204                glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       ) 
    205                glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 ) 
    206                glamv(ji,jj) = glamt(ji,jj) 
    207                glamf(ji,jj) = glamu(ji,jj) 
    208                ! 
    209                gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       ) 
    210                gphiu(ji,jj) = gphit(ji,jj) 
    211                gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 ) 
    212                gphif(ji,jj) = gphiv(ji,jj) 
    213             END DO 
    214          END DO 
    215          ! 
    216          ! Horizontal scale factors (in meters) 
    217          !                              ====== 
    218          e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m 
    219          e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m 
    220          e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m 
    221          e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m 
    222          ! 
    223       CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==! 
    224          ! 
    225          IF(lwp) WRITE(numout,*) 
    226          IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type' 
    227          IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg' 
    228          IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 
    229          ! 
    230          !  Find index corresponding to the equator, given the grid spacing e1_deg 
    231          !  and the (approximate) southern latitude ppgphi0. 
    232          !  This way we ensure that the equator is at a "T / U" point, when in the domain. 
    233          !  The formula should work even if the equator is outside the domain. 
    234          zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2. 
    235          ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 
    236          IF(  ppgphi0 > 0 )  ijeq = -ijeq 
    237          ! 
    238          IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq 
    239          ! 
    240          DO jj = 1, jpj 
    241             DO ji = 1, jpi 
    242                zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 ) 
    243                zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 ) 
    244                zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
    245                zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
    246          ! Longitude 
    247                glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
    248                glamu(ji,jj) = ppglam0 + ppe1_deg * zui 
    249                glamv(ji,jj) = ppglam0 + ppe1_deg * zvi 
    250                glamf(ji,jj) = ppglam0 + ppe1_deg * zfi 
    251          ! Latitude 
    252                gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) ) 
    253                gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zuj ) ) 
    254                gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zvj ) ) 
    255                gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zfj ) ) 
    256          ! e1 
    257                e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg 
    258                e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg 
    259                e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg 
    260                e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg 
    261          ! e2 
    262                e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg 
    263                e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg 
    264                e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg 
    265                e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg 
    266             END DO 
    267          END DO 
    268          ! 
    269       CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration) 
    270          ! 
    271          IF(lwp) WRITE(numout,*) 
    272          IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)' 
    273          IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
    274          ! 
    275          ! Position coordinates (in kilometers) 
    276          !                          ========== 
    277          ! 
    278          ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN 
    279          zlam1 = -85._wp 
    280          zphi1 =  29._wp 
    281          ! resolution in meters 
    282          ze1 = 106000. / REAL( jp_cfg , wp )             
    283          ! benchmark: forced the resolution to be about 100 km 
    284          IF( nbench /= 0 )   ze1 = 106000._wp      
    285          zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 
    286          zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
    287          ze1deg = ze1 / (ra * rad) 
    288          IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon 
    289          !                                                           ! at the right jp_cfg resolution 
    290          glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
    291          gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
    292          ! 
    293          IF( nprint==1 .AND. lwp )   THEN 
    294             WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 
    295             WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0 
    296          ENDIF 
    297          ! 
    298          DO jj = 1, jpj 
    299             DO ji = 1, jpi 
    300                zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
    301                zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
    302                ! 
    303                glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    304                gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    305                ! 
    306                glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    307                gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    308                ! 
    309                glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    310                gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    311                ! 
    312                glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    313                gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    314             END DO 
    315          END DO 
    316          ! 
    317          ! Horizontal scale factors (in meters) 
    318          !                              ====== 
    319          e1t(:,:) =  ze1     ;      e2t(:,:) = ze1 
    320          e1u(:,:) =  ze1     ;      e2u(:,:) = ze1 
    321          e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    322          e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
    323          ! 
    324       CASE DEFAULT 
    325          WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh 
    326          CALL ctl_stop( ctmp1 ) 
    327          ! 
    328       END SELECT 
    329        
    330       ! associated horizontal metrics 
    331       ! ----------------------------- 
     127      ENDIF 
     128      ! 
     129      !                             !==  associated horizontal metrics  ==! 
    332130      ! 
    333131      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
    … …  
    338136      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
    339137      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
    340       IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them 
    341          e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
     138      IF( ie1e2u_v == 0 ) THEN               ! u- & v-surfaces have not been defined 
     139         IF(lwp) WRITE(numout,*) '          u- & v-surfaces calculated as e1 e2 product' 
     140         e1e2u (:,:) = e1u(:,:) * e2u(:,:)         ! compute them 
    342141         e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
    343       ENDIF 
    344       r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases 
     142      ELSE 
     143         IF(lwp) WRITE(numout,*) '          u- & v-surfaces have been read in "mesh_mask" file:' 
     144         IF(lwp) WRITE(numout,*) '                     grid size reduction in strait(s) is used' 
     145      ENDIF 
     146      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in any cases 
    345147      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
    346148      !    
    347149      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    348150      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    349  
    350       IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
    351          WRITE(numout,*) 
    352          WRITE(numout,*) '          longitude and e1 scale factors' 
    353          WRITE(numout,*) '          ------------------------------' 
    354          WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   & 
    355             glamv(ji,1), glamf(ji,1),   & 
    356             e1t(ji,1), e1u(ji,1),   & 
    357             e1v(ji,1), e1f(ji,1), ji = 1, jpi,10) 
    358 9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
    359             f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 
    360             ! 
    361          WRITE(numout,*) 
    362          WRITE(numout,*) '          latitude and e2 scale factors' 
    363          WRITE(numout,*) '          -----------------------------' 
    364          WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   & 
    365             &                     gphiv(1,jj), gphif(1,jj),   & 
    366             &                     e2t  (1,jj), e2u  (1,jj),   & 
    367             &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 ) 
    368       ENDIF 
    369  
    370  
    371       ! ================= ! 
    372       !  Coriolis factor  ! 
    373       ! ================= ! 
    374  
    375       SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    376       ! 
    377       CASE ( 0, 1, 4 )               ! mesh on the sphere 
    378          ! 
    379          ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) )  
    380          ! 
    381       CASE ( 2 )                     ! f-plane at ppgphi0  
    382          ! 
    383          ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 
    384          ! 
    385          IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1) 
    386          ! 
    387       CASE ( 3 )                     ! beta-plane 
    388          ! 
    389          zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0 
    390          zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
    391          ! 
    392 #if defined key_agrif 
    393          IF( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN       ! for EEL6 configuration only 
    394             IF( .NOT.Agrif_Root() ) THEN 
    395               zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    396             ENDIF 
    397          ENDIF 
    398 #endif          
    399          zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south 
    400          ! 
    401          ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south) 
    402          ! 
    403          IF(lwp) THEN 
    404             WRITE(numout,*)  
    405             WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(nldi,nldj) 
    406             WRITE(numout,*) '          Coriolis parameter varies from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 
    407          ENDIF 
    408          IF( lk_mpp ) THEN  
    409             zminff=ff(nldi,nldj) 
    410             zmaxff=ff(nldi,nlej) 
    411             CALL mpp_min( zminff )   ! min over the global domain 
    412             CALL mpp_max( zmaxff )   ! max over the global domain 
    413             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    414          END IF 
    415          ! 
    416       CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration) 
    417          ! 
    418          zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0 
    419          zphi0 = 15._wp                                                     ! latitude of the first row F-points 
    420          zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south 
    421          ! 
    422          ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south) 
    423          ! 
    424          IF(lwp) THEN 
    425             WRITE(numout,*)  
    426             WRITE(numout,*) '          Beta-plane and rotated domain : ' 
    427             WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 
    428          ENDIF 
    429          ! 
    430          IF( lk_mpp ) THEN  
    431             zminff=ff(nldi,nldj) 
    432             zmaxff=ff(nldi,nlej) 
    433             CALL mpp_min( zminff )   ! min over the global domain 
    434             CALL mpp_max( zmaxff )   ! max over the global domain 
    435             IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff 
    436          END IF 
    437          ! 
    438       END SELECT 
    439  
    440  
    441       ! Control of domain for symetrical condition 
    442       ! ------------------------------------------ 
    443       ! The equator line must be the latitude coordinate axe 
    444  
    445       IF( nperio == 2 ) THEN 
    446          znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 
    447          IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 
    448       ENDIF 
     151      ! 
    449152      ! 
    450153      IF( nn_timing == 1 )  CALL timing_stop('dom_hgr') 
    … …  
    453156 
    454157 
    455    SUBROUTINE hgr_read( ke1e2u_v ) 
     158   SUBROUTINE hgr_read( plamt , plamu , plamv  , plamf  ,   &    ! gridpoints position (required) 
     159      &                 pphit , pphiu , pphiv  , pphif  ,   &      
     160      &                 kff   , pff_f , pff_t  ,            &    ! Coriolis parameter  (if not on the sphere) 
     161      &                 pe1t  , pe1u  , pe1v   , pe1f   ,   &    ! scale factors       (required) 
     162      &                 pe2t  , pe2u  , pe2v   , pe2f   ,   & 
     163      &                 ke1e2u_v      , pe1e2u , pe1e2v     )    ! u- & v-surfaces (if gridsize reduction in some straits) 
    456164      !!--------------------------------------------------------------------- 
    457165      !!              ***  ROUTINE hgr_read  *** 
    458166      !! 
    459       !! ** Purpose :   Read a coordinate file in NetCDF format using IOM 
    460       !! 
    461       !!---------------------------------------------------------------------- 
    462       USE iom 
    463       !! 
    464       INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0) 
    465       ! 
    466       INTEGER ::   inum   ! temporary logical unit 
     167      !! ** Purpose :   Read a mesh_mask file in NetCDF format using IOM 
     168      !! 
     169      !!---------------------------------------------------------------------- 
     170      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs  
     171      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs 
     172      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter read here, =0 otherwise 
     173      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point (if found in file) 
     174      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors  
     175      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors 
     176      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces read here, =0 otherwise  
     177      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v              ! u- & v-surfaces (if found in file) 
     178      ! 
     179      INTEGER  ::   inum                  ! logical unit 
    467180      !!---------------------------------------------------------------------- 
    468181      ! 
    469182      IF(lwp) THEN 
    470183         WRITE(numout,*) 
    471          WRITE(numout,*) 'hgr_read : read the horizontal coordinates' 
     184         WRITE(numout,*) 'hgr_read : read the horizontal coordinates in mesh_mask' 
    472185         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    473186      ENDIF 
    474187      ! 
    475       CALL iom_open( 'coordinates', inum ) 
    476       ! 
    477       CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr ) 
    478       CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr ) 
    479       CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr ) 
    480       CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr ) 
    481       ! 
    482       CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr ) 
    483       CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr ) 
    484       CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr ) 
    485       CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr ) 
    486       ! 
    487       CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr ) 
    488       CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr ) 
    489       CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr ) 
    490       CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr ) 
    491       ! 
    492       CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr ) 
    493       CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr ) 
    494       CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr ) 
    495       CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr ) 
     188      CALL iom_open( cn_domcfg, inum ) 
     189      ! 
     190      CALL iom_get( inum, jpdom_data, 'glamt', plamt, lrowattr=ln_use_jattr ) 
     191      CALL iom_get( inum, jpdom_data, 'glamu', plamu, lrowattr=ln_use_jattr ) 
     192      CALL iom_get( inum, jpdom_data, 'glamv', plamv, lrowattr=ln_use_jattr ) 
     193      CALL iom_get( inum, jpdom_data, 'glamf', plamf, lrowattr=ln_use_jattr ) 
     194      ! 
     195      CALL iom_get( inum, jpdom_data, 'gphit', pphit, lrowattr=ln_use_jattr ) 
     196      CALL iom_get( inum, jpdom_data, 'gphiu', pphiu, lrowattr=ln_use_jattr ) 
     197      CALL iom_get( inum, jpdom_data, 'gphiv', pphiv, lrowattr=ln_use_jattr ) 
     198      CALL iom_get( inum, jpdom_data, 'gphif', pphif, lrowattr=ln_use_jattr ) 
     199      ! 
     200      CALL iom_get( inum, jpdom_data, 'e1t'  , pe1t  , lrowattr=ln_use_jattr ) 
     201      CALL iom_get( inum, jpdom_data, 'e1u'  , pe1u  , lrowattr=ln_use_jattr ) 
     202      CALL iom_get( inum, jpdom_data, 'e1v'  , pe1v  , lrowattr=ln_use_jattr ) 
     203      CALL iom_get( inum, jpdom_data, 'e1f'  , pe1f  , lrowattr=ln_use_jattr ) 
     204      ! 
     205      CALL iom_get( inum, jpdom_data, 'e2t'  , pe2t  , lrowattr=ln_use_jattr ) 
     206      CALL iom_get( inum, jpdom_data, 'e2u'  , pe2u  , lrowattr=ln_use_jattr ) 
     207      CALL iom_get( inum, jpdom_data, 'e2v'  , pe2v  , lrowattr=ln_use_jattr ) 
     208      CALL iom_get( inum, jpdom_data, 'e2f'  , pe2f  , lrowattr=ln_use_jattr ) 
     209      ! 
     210      IF(  iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0  .AND.  & 
     211         & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0    ) THEN 
     212         IF(lwp) WRITE(numout,*) '           Coriolis factor at f- and t-points read in ', TRIM( cn_domcfg ), ' file' 
     213         CALL iom_get( inum, jpdom_data, 'ff_f'  , pff_f  , lrowattr=ln_use_jattr ) 
     214         CALL iom_get( inum, jpdom_data, 'ff_t'  , pff_t  , lrowattr=ln_use_jattr ) 
     215         kff = 1 
     216      ELSE 
     217         kff = 0 
     218      ENDIF 
    496219      ! 
    497220      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 
    498          IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file' 
    499          CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr ) 
    500          CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr ) 
     221         IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file' 
     222         CALL iom_get( inum, jpdom_data, 'e1e2u'  , pe1e2u  , lrowattr=ln_use_jattr ) 
     223         CALL iom_get( inum, jpdom_data, 'e1e2v'  , pe1e2v  , lrowattr=ln_use_jattr ) 
    501224         ke1e2u_v = 1 
    502225      ELSE 
    … …  
    505228      ! 
    506229      CALL iom_close( inum ) 
    507        
    508     END SUBROUTINE hgr_read 
     230      ! 
     231   END SUBROUTINE hgr_read 
    509232     
    510233   !!====================================================================== 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6140 r7277  
    99   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask 
    1010   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F 
    11    !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask 
     11   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask 
    1212   !!             -   ! 1998-05  (G. Roullet)  free surface 
    1313   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate 
    … …  
    1717   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option 
    1818   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask 
    19    !!---------------------------------------------------------------------- 
    20  
    21    !!---------------------------------------------------------------------- 
    22    !!   dom_msk        : compute land/ocean mask 
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and tracers 
    25    USE dom_oce         ! ocean space and time domain 
     19   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     20   !!---------------------------------------------------------------------- 
     21 
     22   !!---------------------------------------------------------------------- 
     23   !!   dom_msk       : compute land/ocean mask 
     24   !!---------------------------------------------------------------------- 
     25   USE oce            ! ocean dynamics and tracers 
     26   USE dom_oce        ! ocean space and time domain 
     27   USE usrdef_fmask   ! user defined fmask 
    2628   ! 
    27    USE in_out_manager  ! I/O manager 
    28    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    29    USE lib_mpp         ! 
    30    USE wrk_nemo        ! Memory allocation 
    31    USE timing          ! Timing 
     29   USE in_out_manager ! I/O manager 
     30   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     31   USE lib_mpp        ! Massively Parallel Processing library 
     32   USE wrk_nemo       ! Memory allocation 
     33   USE timing         ! Timing 
    3234 
    3335   IMPLICIT NONE 
    … …  
    5052CONTAINS 
    5153 
    52    SUBROUTINE dom_msk 
     54   SUBROUTINE dom_msk( k_top, k_bot ) 
    5355      !!--------------------------------------------------------------------- 
    5456      !!                 ***  ROUTINE dom_msk  *** 
    … …  
    5759      !!      zontal velocity points (u & v), vorticity points (f) points. 
    5860      !! 
    59       !! ** Method  :   The ocean/land mask is computed from the basin bathy- 
    60       !!      metry in level (mbathy) which is defined or read in dommba. 
    61       !!      mbathy equals 0 over continental T-point  
    62       !!      and the number of ocean level over the ocean. 
    63       !! 
    64       !!      At a given position (ji,jj,jk) the ocean/land mask is given by: 
    65       !!      t-point : 0. IF mbathy( ji ,jj) =< 0 
    66       !!                1. IF mbathy( ji ,jj) >= jk 
    67       !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0 
    68       !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 
    69       !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0 
    70       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 
    71       !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) 
    72       !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0 
    73       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 
    74       !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 
    75       !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 
    76       !!                rows/lines due to cyclic or North Fold boundaries as well 
    77       !!                as MPP halos. 
    78       !! 
    79       !!        The lateral friction is set through the value of fmask along 
    80       !!      the coast and topography. This value is defined by rn_shlat, a 
    81       !!      namelist parameter: 
     61      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top  
     62      !!      and ko_bot, the indices of the fist and last ocean t-levels which  
     63      !!      are either defined in usrdef_zgr or read in zgr_read. 
     64      !!                The velocity masks (umask, vmask, wmask, wumask, wvmask)  
     65      !!      are deduced from a product of the two neighboring tmask. 
     66      !!                The vorticity mask (fmask) is deduced from tmask taking 
     67      !!      into account the choice of lateral boundary condition (rn_shlat) : 
    8268      !!         rn_shlat = 0, free slip  (no shear along the coast) 
    8369      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast) 
    … …  
    8571      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer 
    8672      !! 
    87       !!      N.B. If nperio not equal to 0, the land/ocean mask arrays 
    88       !!      are defined with the proper value at lateral domain boundaries. 
    89       !! 
    90       !!      In case of open boundaries (lk_bdy=T): 
    91       !!        - tmask is set to 1 on the points to be computed bay the open 
    92       !!          boundaries routines. 
    93       !! 
    94       !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.) 
    95       !!               umask    : land/ocean mask at u-point (=0. or 1.) 
    96       !!               vmask    : land/ocean mask at v-point (=0. or 1.) 
    97       !!               fmask    : land/ocean mask at f-point (=0. or 1.) 
    98       !!                          =rn_shlat along lateral boundaries 
    99       !!               tmask_i  : interior ocean mask 
     73      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 
     74      !!                rows/lines due to cyclic or North Fold boundaries as well 
     75      !!                as MPP halos. 
     76      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines 
     77      !!                due to cyclic or North Fold boundaries as well as MPP halos. 
     78      !! 
     79      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask  
     80      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.) 
     81      !!               fmask   : land/ocean mask at f-point (=0., or =1., or  
     82      !!                         =rn_shlat along lateral boundaries) 
     83      !!               tmask_i : interior ocean mask  
     84      !!               tmask_h : halo mask 
     85      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask 
    10086      !!---------------------------------------------------------------------- 
    101       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    102       INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers 
    103       INTEGER  ::   ijf, ijl, ij0, ij1       !   -       - 
     87      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level 
     88      ! 
     89      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     90      INTEGER  ::   iif, iil       ! local integers 
     91      INTEGER  ::   ijf, ijl       !   -       - 
     92      INTEGER  ::   iktop, ikbot   !   -       - 
    10493      INTEGER  ::   ios 
    105       INTEGER  ::   isrow                    ! index for ORCA1 starting row 
    106       INTEGER , POINTER, DIMENSION(:,:) ::  imsk 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    10895      !! 
    10996      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    11198      ! 
    11299      IF( nn_timing == 1 )  CALL timing_start('dom_msk') 
    113       ! 
    114       CALL wrk_alloc( jpi, jpj, imsk ) 
    115       CALL wrk_alloc( jpi, jpj, zwf  ) 
    116100      ! 
    117101      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    … …  
    142126      ENDIF 
    143127 
    144       ! 1. Ocean/land mask at t-point (computed from mbathy) 
    145       ! ----------------------------- 
    146       ! N.B. tmask has already the right boundary conditions since mbathy is ok 
     128 
     129      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot) 
     130      ! ---------------------------- 
    147131      ! 
    148132      tmask(:,:,:) = 0._wp 
    149       DO jk = 1, jpk 
    150          DO jj = 1, jpj 
    151             DO ji = 1, jpi 
    152                IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp 
    153             END DO   
     133      DO jj = 1, jpj 
     134         DO ji = 1, jpi 
     135            iktop = k_top(ji,jj) 
     136            ikbot = k_bot(ji,jj) 
     137            IF( iktop /= 0 ) THEN       ! water in the column 
     138               tmask(ji,jj,iktop:ikbot  ) = 1._wp 
     139            ENDIF 
    154140         END DO   
    155141      END DO   
     142!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 
     143!!gm I don't understand why...   
     144   CALL lbc_lnk( tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
     145 
    156146       
    157       ! (ISF) define barotropic mask and mask the ice shelf point 
    158       ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked 
    159        
    160       DO jk = 1, jpk 
    161          DO jj = 1, jpj 
    162             DO ji = 1, jpi 
    163                IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp )   THEN 
    164                   tmask(ji,jj,jk) = 0._wp 
    165                END IF 
    166             END DO   
    167          END DO   
    168       END DO   
    169  
    170       ! Interior domain mask (used for global sum) 
    171       ! -------------------- 
    172       tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf 
    173  
    174       tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere 
    175       iif = jpreci                         ! ??? 
    176       iil = nlci - jpreci + 1 
    177       ijf = jprecj                         ! ??? 
    178       ijl = nlcj - jprecj + 1 
    179  
    180       tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    181       tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    182       tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
    183       tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    184  
    185       ! north fold mask 
    186       ! --------------- 
    187       tpol(1:jpiglo) = 1._wp  
    188       fpol(1:jpiglo) = 1._wp 
    189       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    190          tpol(jpiglo/2+1:jpiglo) = 0._wp 
    191          fpol(     1    :jpiglo) = 0._wp 
    192          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row 
    193             DO ji = iif+1, iil-1 
    194                tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
    195             END DO 
    196          ENDIF 
    197       ENDIF 
    198       
    199       tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:) 
    200  
    201       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    202          tpol(     1    :jpiglo) = 0._wp 
    203          fpol(jpiglo/2+1:jpiglo) = 0._wp 
    204       ENDIF 
    205  
    206       ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask) 
    207       ! ------------------------------------------- 
     147      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask) 
     148      ! ---------------------------------------- 
     149      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
    208150      DO jk = 1, jpk 
    209151         DO jj = 1, jpjm1 
    … …  
    218160         END DO 
    219161      END DO 
    220       ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 
    221       DO jj = 1, jpjm1 
    222          DO ji = 1, fs_jpim1   ! vector loop 
    223             ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    224             ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    225          END DO 
    226          DO ji = 1, jpim1      ! NO vector opt. 
    227             ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    228                &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    229          END DO 
    230       END DO 
    231162      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
    232163      CALL lbc_lnk( vmask  , 'V', 1._wp ) 
    233164      CALL lbc_lnk( fmask  , 'F', 1._wp ) 
    234       CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
    235       CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
    236       CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    237  
    238       ! 3. Ocean/land mask at wu-, wv- and w points  
    239       !---------------------------------------------- 
     165 
     166  
     167      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
     168      !----------------------------------------- 
    240169      wmask (:,:,1) = tmask(:,:,1)     ! surface 
    241170      wumask(:,:,1) = umask(:,:,1) 
    … …  
    247176      END DO 
    248177 
     178 
     179      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
     180      ! ---------------------------------------------- 
     181      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 ) 
     182      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 
     183      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
     184 
     185 
     186      ! Interior domain mask  (used for global sum) 
     187      ! -------------------- 
     188      ! 
     189      iif = jpreci   ;   iil = nlci - jpreci + 1 
     190      ijf = jprecj   ;   ijl = nlcj - jprecj + 1 
     191      ! 
     192      !                          ! halo mask : 0 on the halo and 1 elsewhere 
     193      tmask_h(:,:) = 1._wp                   
     194      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
     195      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
     196      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
     197      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
     198      ! 
     199      !                          ! north fold mask 
     200      tpol(1:jpiglo) = 1._wp  
     201      fpol(1:jpiglo) = 1._wp 
     202      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
     203         tpol(jpiglo/2+1:jpiglo) = 0._wp 
     204         fpol(     1    :jpiglo) = 0._wp 
     205         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h 
     206            DO ji = iif+1, iil-1 
     207               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
     208            END DO 
     209         ENDIF 
     210      ENDIF 
     211      ! 
     212      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
     213         tpol(     1    :jpiglo) = 0._wp 
     214         fpol(jpiglo/2+1:jpiglo) = 0._wp 
     215      ENDIF 
     216      ! 
     217      !                          ! interior mask : 2D ocean mask x halo mask  
     218      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
     219 
     220 
    249221      ! Lateral boundary conditions on velocity (modify fmask) 
    250       ! ---------------------------------------      
    251       DO jk = 1, jpk 
    252          zwf(:,:) = fmask(:,:,jk)          
    253          DO jj = 2, jpjm1 
    254             DO ji = fs_2, fs_jpim1   ! vector opt. 
    255                IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    256                   fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    257                      &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     222      ! ---------------------------------------   
     223      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
     224         ! 
     225         CALL wrk_alloc( jpi,jpj,   zwf ) 
     226         ! 
     227         DO jk = 1, jpk 
     228            zwf(:,:) = fmask(:,:,jk)          
     229            DO jj = 2, jpjm1 
     230               DO ji = fs_2, fs_jpim1   ! vector opt. 
     231                  IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     232                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     233                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     234                  ENDIF 
     235               END DO 
     236            END DO 
     237            DO jj = 2, jpjm1 
     238               IF( fmask(1,jj,jk) == 0._wp ) THEN 
     239                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     240               ENDIF 
     241               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
     242                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     243               ENDIF 
     244            END DO          
     245            DO ji = 2, jpim1 
     246               IF( fmask(ji,1,jk) == 0._wp ) THEN 
     247                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     248               ENDIF 
     249               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
     250                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    258251               ENDIF 
    259252            END DO 
    260253         END DO 
    261          DO jj = 2, jpjm1 
    262             IF( fmask(1,jj,jk) == 0._wp ) THEN 
    263                fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
    264             ENDIF 
    265             IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    266                fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    267             ENDIF 
    268          END DO          
    269          DO ji = 2, jpim1 
    270             IF( fmask(ji,1,jk) == 0._wp ) THEN 
    271                fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
    272             ENDIF 
    273             IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    274                fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    275             ENDIF 
    276          END DO 
    277       END DO 
    278       ! 
    279       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration 
    280          !                                                 ! Increased lateral friction near of some straits 
    281          !                                ! Gibraltar strait  : partial slip (fmask=0.5) 
    282          ij0 = 101   ;   ij1 = 101 
    283          ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    284          ij0 = 102   ;   ij1 = 102 
    285          ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    286          ! 
    287          !                                ! Bab el Mandeb : partial slip (fmask=1) 
    288          ij0 =  87   ;   ij1 =  88 
    289          ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    290          ij0 =  88   ;   ij1 =  88 
    291          ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    292          ! 
    293          !                                ! Danish straits  : strong slip (fmask > 2) 
    294 ! We keep this as an example but it is instable in this case  
    295 !         ij0 = 115   ;   ij1 = 115 
    296 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    297 !         ij0 = 116   ;   ij1 = 116 
    298 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    299          ! 
    300       ENDIF 
    301       ! 
    302       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
    303          !                                                 ! Increased lateral friction near of some straits 
    304          ! This dirty section will be suppressed by simplification process: 
    305          ! all this will come back in input files 
    306          ! Currently these hard-wired indices relate to configuration with 
    307          ! extend grid (jpjglo=332) 
    308          ! 
    309          isrow = 332 - jpjglo 
    310          ! 
    311          IF(lwp) WRITE(numout,*) 
    312          IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
    313          IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    314          ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait  
    315          ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    316  
    317          IF(lwp) WRITE(numout,*) '      Bhosporus ' 
    318          ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait  
    319          ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    320  
    321          IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
    322          ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)  
    323          ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    324  
    325          IF(lwp) WRITE(numout,*) '      Lombok ' 
    326          ii0 =  44           ;   ii1 =  44        ! Lombok Strait  
    327          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    328  
    329          IF(lwp) WRITE(numout,*) '      Ombai ' 
    330          ii0 =  53           ;   ii1 =  53        ! Ombai Strait  
    331          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    332  
    333          IF(lwp) WRITE(numout,*) '      Timor Passage ' 
    334          ii0 =  56           ;   ii1 =  56        ! Timor Passage  
    335          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    336  
    337          IF(lwp) WRITE(numout,*) '      West Halmahera ' 
    338          ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait  
    339          ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    340  
    341          IF(lwp) WRITE(numout,*) '      East Halmahera ' 
    342          ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait  
    343          ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    344          ! 
    345       ENDIF 
    346       ! 
    347       CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    348       ! 
    349       ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 
    350       ! 
    351       CALL wrk_dealloc( jpi, jpj, imsk ) 
    352       CALL wrk_dealloc( jpi, jpj, zwf  ) 
     254         ! 
     255         CALL wrk_dealloc( jpi,jpj,   zwf ) 
     256         ! 
     257         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
     258         ! 
     259         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat 
     260         ! 
     261      ENDIF 
     262       
     263      ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 
     264      ! --------------------------------  
     265      ! 
     266      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 
     267      ! 
    353268      ! 
    354269      IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r6140 r7277  
    6262      END SELECT 
    6363 
    64       IF (jphgr_msh /= 2 .AND. jphgr_msh /= 3) THEN 
    65          zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360 
    66          zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360 
    67          IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270 
    68          IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180 
    69          zglam(:,:) = zglam(:,:) - zlon 
    70       ELSE 
    71          zglam(:,:) = zglam(:,:) - plon 
    72       END IF 
     64      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360 
     65      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360 
     66      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270 
     67      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180 
     68      zglam(:,:) = zglam(:,:) - zlon 
    7369 
    7470      zgphi(:,:) = zgphi(:,:) - plat 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r6351 r7277  
    232232               END DO 
    233233            END DO 
    234             IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
     234            IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    235235               ii0 = 103   ;   ii1 = 111        
    236236               ij0 = 128   ;   ij1 = 135   ;    
    … …  
    885885                     e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1  
    886886                     e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1  
    887                      sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
    888                      sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
    889                      ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
     887                     sshb(ji,jj) = rn_wdmin1 - ht_0(ji,jj)           !!gm I don't understand that ! 
     888                     sshn(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
     889                     ssha(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    890890                  ENDIF 
    891891                ENDDO 
    … …  
    894894 
    895895            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 
    896                tilde_e3t_b(:,:,:) = 0.0_wp 
    897                tilde_e3t_n(:,:,:) = 0.0_wp 
    898                IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0.0_wp 
     896               tilde_e3t_b(:,:,:) = 0._wp 
     897               tilde_e3t_n(:,:,:) = 0._wp 
     898               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 
    899899            END IF 
    900900         ENDIF 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r5836 r7277  
    88   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file 
    99   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq  
     10   !!            4.0  ! 2016-01  (G. Madec)  simplified mesh_mask.nc file 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    1314   !!   dom_wri        : create and write mesh and mask file(s) 
    1415   !!   dom_uniq       : identify unique point of a grid (TUVF) 
     16   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 
    1517   !!---------------------------------------------------------------------- 
    1618   USE dom_oce         ! ocean space and time domain 
     19   USE phycst ,   ONLY :   rsmall 
     20   ! 
    1721   USE in_out_manager  ! I/O manager 
    1822   USE iom             ! I/O library 
    … …  
    2630 
    2731   PUBLIC   dom_wri              ! routine called by inidom.F90 
    28    PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90 
     32   PUBLIC   dom_stiff            ! routine called by inidom.F90 
     33 
    2934   !! * Substitutions 
    3035#  include "vectopt_loop_substitute.h90" 
    3136   !!---------------------------------------------------------------------- 
    32    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     37   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    3338   !! $Id$  
    3439   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3540   !!---------------------------------------------------------------------- 
    3641CONTAINS 
    37  
    38    SUBROUTINE dom_wri_coordinate 
    39       !!---------------------------------------------------------------------- 
    40       !!                  ***  ROUTINE dom_wri_coordinate  *** 
    41       !!                    
    42       !! ** Purpose :   Create the NetCDF file which contains all the 
    43       !!              standard coordinate information plus the surface, 
    44       !!              e1e2u and e1e2v. By doing so, those surface will 
    45       !!              not be changed by the reduction of e1u or e2v scale  
    46       !!              factors in some straits.  
    47       !!                 NB: call just after the read of standard coordinate 
    48       !!              and the reduction of scale factors in some straits 
    49       !! 
    50       !! ** output file :   coordinate_e1e2u_v.nc 
    51       !!---------------------------------------------------------------------- 
    52       INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file 
    53       CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
    54       !                                   !  workspaces 
    55       REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
    56       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
    57       !!---------------------------------------------------------------------- 
    58       ! 
    59       IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate') 
    60       ! 
    61       IF(lwp) WRITE(numout,*) 
    62       IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' 
    63       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' 
    64        
    65       clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations) 
    66        
    67       !  create 'coordinate_e1e2u_v.nc' file 
    68       ! ============================ 
    69       ! 
    70       CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
    71       ! 
    72       !                                                         ! horizontal mesh (inum3) 
    73       CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude 
    74       CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 ) 
    75       CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 ) 
    76       CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 ) 
    77        
    78       CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude 
    79       CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 ) 
    80       CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 ) 
    81       CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 ) 
    82        
    83       CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
    84       CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) 
    85       CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) 
    86       CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) 
    87        
    88       CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
    89       CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) 
    90       CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) 
    91       CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) 
    92        
    93       CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) 
    94       CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) 
    95  
    96       CALL iom_close( inum0 ) 
    97       ! 
    98       IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate') 
    99       ! 
    100    END SUBROUTINE dom_wri_coordinate 
    101  
    10242 
    10343   SUBROUTINE dom_wri 
    … …  
    11353      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on 
    11454      !!      the vertical coord. used (z-coord, partial steps, s-coord) 
    115       !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file 
     55      !!            MOD(nn_msh, 3) = 1  :   'mesh_mask.nc' file 
    11656      !!                         = 2  :   'mesh.nc' and mask.nc' files 
    11757      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
    … …  
    12060      !!      vertical coordinate. 
    12161      !! 
    122       !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 
    123       !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays  
     62      !!      if     nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 
     63      !!      if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays  
    12464      !!                        corresponding to the depth of the bottom t- and w-points 
    125       !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the 
     65      !!      if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the 
    12666      !!                        thickness (e3[tw]_ps) of the bottom points  
    12767      !! 
    … …  
    12969      !!                                   masks, depth and vertical scale factors 
    13070      !!---------------------------------------------------------------------- 
    131       !! 
    132       INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
    133       INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file 
    134       INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file 
    135       INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file 
    136       INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file 
    137       CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
    138       CHARACTER(len=21) ::   clnam1   ! filename (mesh informations) 
    139       CHARACTER(len=21) ::   clnam2   ! filename (mask informations) 
    140       CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations) 
    141       CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations) 
     71      INTEGER           ::   inum    ! temprary units for 'mesh_mask.nc' file 
     72      CHARACTER(len=21) ::   clnam   ! filename (mesh and mask informations) 
    14273      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    143       !                                   !  workspaces 
    144       REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
    145       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
     74      INTEGER           ::   izco, izps, isco, icav 
     75      !                                
     76      REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace 
    14678      !!---------------------------------------------------------------------- 
    14779      ! 
    14880      IF( nn_timing == 1 )  CALL timing_start('dom_wri') 
    14981      ! 
    150       CALL wrk_alloc( jpi, jpj, zprt, zprw ) 
    151       CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv ) 
     82      CALL wrk_alloc( jpi,jpj,       zprt , zprw ) 
     83      CALL wrk_alloc( jpi,jpj,jpk,  zdepu, zdepv ) 
    15284      ! 
    15385      IF(lwp) WRITE(numout,*) 
    … …  
    15587      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    15688       
    157       clnam0 = 'mesh_mask'  ! filename (mesh and mask informations) 
    158       clnam1 = 'mesh'       ! filename (mesh informations) 
    159       clnam2 = 'mask'       ! filename (mask informations) 
    160       clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations) 
    161       clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations) 
    162        
    163       SELECT CASE ( MOD(nmsh, 3) ) 
    164          !                                  ! ============================ 
    165       CASE ( 1 )                            !  create 'mesh_mask.nc' file 
    166          !                                  ! ============================ 
    167          CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
    168          inum2 = inum0                                            ! put all the informations 
    169          inum3 = inum0                                            ! in unit inum0 
    170          inum4 = inum0 
    171           
    172          !                                  ! ============================ 
    173       CASE ( 2 )                            !  create 'mesh.nc' and  
    174          !                                  !         'mask.nc' files 
    175          !                                  ! ============================ 
    176          CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 
    177          CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    178          inum3 = inum1                                            ! put mesh informations  
    179          inum4 = inum1                                            ! in unit inum1  
    180          !                                  ! ============================ 
    181       CASE ( 0 )                            !  create 'mesh_hgr.nc' 
    182          !                                  !         'mesh_zgr.nc' and 
    183          !                                  !         'mask.nc'     files 
    184          !                                  ! ============================ 
    185          CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    186          CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 
    187          CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 
    188          ! 
    189       END SELECT 
    190        
    191       !                                                         ! masks (inum2)  
    192       CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask 
    193       CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 
    194       CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 
    195       CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 
     89      clnam = 'mesh_mask'  ! filename (mesh and mask informations) 
     90       
     91      !                                  ! ============================ 
     92      !                                  !  create 'mesh_mask.nc' file 
     93      !                                  ! ============================ 
     94      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     95      ! 
     96      !                                                         ! global domain size 
     97      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
     98      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
     99      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 ) 
     100 
     101      !                                                         ! domain characteristics 
     102      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
     103      !                                                         ! type of vertical coordinate 
     104      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
     105      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
     106      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
     107      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
     108      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
     109      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     110      !                                                         ! ocean cavities under iceshelves 
     111      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
     112      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     113   
     114      !                                                         ! masks 
     115      CALL iom_rstput( 0, 0, inum, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask 
     116      CALL iom_rstput( 0, 0, inum, 'umask', umask, ktype = jp_i1 ) 
     117      CALL iom_rstput( 0, 0, inum, 'vmask', vmask, ktype = jp_i1 ) 
     118      CALL iom_rstput( 0, 0, inum, 'fmask', fmask, ktype = jp_i1 ) 
    196119       
    197120      CALL dom_uniq( zprw, 'T' ) 
    198121      DO jj = 1, jpj 
    199122         DO ji = 1, jpi 
    200             jk=mikt(ji,jj)  
    201             zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
     123            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    202124         END DO 
    203125      END DO                             !    ! unique point mask 
    204       CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )   
     126      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )   
    205127      CALL dom_uniq( zprw, 'U' ) 
    206128      DO jj = 1, jpj 
    207129         DO ji = 1, jpi 
    208             jk=miku(ji,jj)  
    209             zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
     130            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    210131         END DO 
    211132      END DO 
    212       CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
     133      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )   
    213134      CALL dom_uniq( zprw, 'V' ) 
    214135      DO jj = 1, jpj 
    215136         DO ji = 1, jpi 
    216             jk=mikv(ji,jj)  
    217             zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
     137            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    218138         END DO 
    219139      END DO 
    220       CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
    221       CALL dom_uniq( zprw, 'F' ) 
    222       DO jj = 1, jpj 
    223          DO ji = 1, jpi 
    224             jk=mikf(ji,jj)  
    225             zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
    226          END DO 
    227       END DO 
    228       CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
     140      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )   
     141!!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil 
     142!!    Here we just remove the output of fmaskutil. 
     143!      CALL dom_uniq( zprw, 'F' ) 
     144!      DO jj = 1, jpj 
     145!         DO ji = 1, jpi 
     146!            zprt(ji,jj) = ssfmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
     147!         END DO 
     148!      END DO 
     149!      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )   
     150!!gm 
    229151 
    230152      !                                                         ! horizontal mesh (inum3) 
    231       CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude 
    232       CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 ) 
    233       CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 ) 
    234       CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 ) 
    235        
    236       CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude 
    237       CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 ) 
    238       CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 ) 
    239       CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 ) 
    240        
    241       CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
    242       CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 ) 
    243       CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 ) 
    244       CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 ) 
    245        
    246       CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
    247       CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 ) 
    248       CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 ) 
    249       CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 ) 
    250        
    251       CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 )           !    ! coriolis factor 
     153      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude 
     154      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 ) 
     155      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
     156      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
     157       
     158      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude 
     159      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
     160      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
     161      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
     162       
     163      CALL iom_rstput( 0, 0, inum, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
     164      CALL iom_rstput( 0, 0, inum, 'e1u', e1u, ktype = jp_r8 ) 
     165      CALL iom_rstput( 0, 0, inum, 'e1v', e1v, ktype = jp_r8 ) 
     166      CALL iom_rstput( 0, 0, inum, 'e1f', e1f, ktype = jp_r8 ) 
     167       
     168      CALL iom_rstput( 0, 0, inum, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
     169      CALL iom_rstput( 0, 0, inum, 'e2u', e2u, ktype = jp_r8 ) 
     170      CALL iom_rstput( 0, 0, inum, 'e2v', e2v, ktype = jp_r8 ) 
     171      CALL iom_rstput( 0, 0, inum, 'e2f', e2f, ktype = jp_r8 ) 
     172       
     173      CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 )       !    ! coriolis factor 
     174      CALL iom_rstput( 0, 0, inum, 'ff_t', ff_t, ktype = jp_r8 ) 
    252175       
    253176      ! note that mbkt is set to 1 over land ==> use surface tmask 
    254177      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp ) 
    255       CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points 
     178      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )     !    ! nb of ocean T-points 
    256179      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp ) 
    257       CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i2 )       !    ! nb of ocean T-points 
     180      CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )       !    ! nb of ocean T-points 
    258181      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp ) 
    259       CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r4 )       !    ! nb of ocean T-points 
     182      CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 )   !    ! nb of ocean T-points 
    260183             
    261       IF( ln_sco ) THEN                                         ! s-coordinate 
    262          CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt ) 
    263          CALL iom_rstput( 0, 0, inum4, 'hbatu', hbatu ) 
    264          CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv ) 
    265          CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf ) 
    266          ! 
    267          CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef. 
    268          CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )   
    269          CALL iom_rstput( 0, 0, inum4, 'gsi3w', gsi3w ) 
    270          CALL iom_rstput( 0, 0, inum4, 'esigt', esigt ) 
    271          CALL iom_rstput( 0, 0, inum4, 'esigw', esigw ) 
    272          ! 
    273          CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         !    ! scale factors 
    274          CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 ) 
    275          CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 ) 
    276          CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 ) 
    277          CALL iom_rstput( 0, 0, inum4, 'rx1', rx1 )             !    ! Max. grid stiffness ratio 
    278          ! 
    279          CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system 
    280          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d ) 
    281          CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )      
    282          CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 
    283       ENDIF 
    284        
    285       IF( ln_zps ) THEN                                         ! z-coordinate - partial steps 
    286          ! 
    287          IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors 
    288             CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )          
    289             CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 ) 
    290             CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 ) 
    291             CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 ) 
    292          ELSE                                                   !    ! 2D masked bottom ocean scale factors 
    293             DO jj = 1,jpj    
    294                DO ji = 1,jpi 
    295                   e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj) 
    296                   e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj) 
    297                END DO 
    298             END DO 
    299             CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )       
    300             CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp ) 
    301          END IF 
    302          ! 
    303          IF( nmsh <= 3 ) THEN                                   !    ! 3D depth 
    304             CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )      
    305             DO jk = 1,jpk    
    306                DO jj = 1, jpjm1    
    307                   DO ji = 1, fs_jpim1   ! vector opt. 
    308                      zdepu(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk) ) 
    309                      zdepv(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk) ) 
    310                   END DO    
    311                END DO    
    312             END DO 
    313             CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. )  
    314             CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 ) 
    315             CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 ) 
    316             CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 
    317          ELSE                                                   !    ! 2D bottom depth 
    318             DO jj = 1,jpj    
    319                DO ji = 1,jpi 
    320                   zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * ssmask(ji,jj) 
    321                   zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj) 
    322                END DO 
    323             END DO 
    324             CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )      
    325             CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 )  
    326          ENDIF 
    327          ! 
    328          CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! reference z-coord. 
    329          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 
    330          CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   ) 
    331          CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   ) 
    332       ENDIF 
    333        
    334       IF( ln_zco ) THEN 
    335          !                                                      ! z-coordinate - full steps 
    336          CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! depth 
    337          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 
    338          CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )   !    ! scale factors 
    339          CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   ) 
    340       ENDIF 
     184      !                                                         ! vertical mesh 
     185      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8  )    !    ! scale factors 
     186      CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0, ktype = jp_r8  ) 
     187      CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0, ktype = jp_r8  ) 
     188      CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0, ktype = jp_r8  ) 
     189      ! 
     190      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 )  ! stretched system 
     191      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 ) 
     192      CALL iom_rstput( 0, 0, inum, 'gdept_0'  , gdept_0  , ktype = jp_r8 ) 
     193      CALL iom_rstput( 0, 0, inum, 'gdepw_0'  , gdepw_0  , ktype = jp_r8 ) 
     194      ! 
     195      IF( ln_sco ) THEN                                         ! s-coordinate stiffness 
     196         CALL dom_stiff( zprt ) 
     197         CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )      !    ! Max. grid stiffness ratio 
     198      ENDIF 
     199      ! 
    341200      !                                     ! ============================ 
    342       !                                     !        close the files  
     201      CALL iom_close( inum )                !        close the files  
    343202      !                                     ! ============================ 
    344       SELECT CASE ( MOD(nmsh, 3) ) 
    345       CASE ( 1 )                 
    346          CALL iom_close( inum0 ) 
    347       CASE ( 2 ) 
    348          CALL iom_close( inum1 ) 
    349          CALL iom_close( inum2 ) 
    350       CASE ( 0 ) 
    351          CALL iom_close( inum2 ) 
    352          CALL iom_close( inum3 ) 
    353          CALL iom_close( inum4 ) 
    354       END SELECT 
    355203      ! 
    356204      CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    … …  
    371219      !!                2) check which elements have been changed 
    372220      !!---------------------------------------------------------------------- 
    373       ! 
    374221      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    375222      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    … …  
    405252   END SUBROUTINE dom_uniq 
    406253 
     254 
     255   SUBROUTINE dom_stiff( px1 ) 
     256      !!---------------------------------------------------------------------- 
     257      !!                  ***  ROUTINE dom_stiff  *** 
     258      !!                      
     259      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency 
     260      !! 
     261      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio 
     262      !!                Save the maximum in the vertical direction 
     263      !!                (this number is only relevant in s-coordinates) 
     264      !! 
     265      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619. 
     266      !!---------------------------------------------------------------------- 
     267      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness 
     268      ! 
     269      INTEGER  ::   ji, jj, jk  
     270      REAL(wp) ::   zrxmax 
     271      REAL(wp), DIMENSION(4) ::   zr1 
     272      REAL(wp), DIMENSION(jpi,jpj) ::   zx1 
     273      !!---------------------------------------------------------------------- 
     274      zx1(:,:) = 0._wp 
     275      zrxmax   = 0._wp 
     276      zr1(:)   = 0._wp 
     277      ! 
     278      DO ji = 2, jpim1 
     279         DO jj = 2, jpjm1 
     280            DO jk = 1, jpkm1 
     281!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation.... 
     282!!             especially since it is gde3w which is used to compute the pressure gradient 
     283!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator 
     284!!             so that the ratio is computed at the same point (i.e. uw and vw) .... 
     285               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               &  
     286                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             & 
     287                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               & 
     288                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk) 
     289               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               & 
     290                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             & 
     291                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               & 
     292                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk) 
     293               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               & 
     294                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             & 
     295                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               & 
     296                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk) 
     297               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               & 
     298                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             & 
     299                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               & 
     300                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk) 
     301               zrxmax = MAXVAL( zr1(1:4) ) 
     302               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax ) 
     303            END DO 
     304         END DO 
     305      END DO 
     306      CALL lbc_lnk( zx1, 'T', 1. ) 
     307      ! 
     308      IF( PRESENT( px1 ) )    px1 = zx1 
     309      ! 
     310      zrxmax = MAXVAL( zx1 ) 
     311      ! 
     312      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain 
     313      ! 
     314      IF(lwp) THEN 
     315         WRITE(numout,*) 
     316         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax 
     317         WRITE(numout,*) '~~~~~~~~~' 
     318      ENDIF 
     319      ! 
     320   END SUBROUTINE dom_stiff 
     321 
    407322   !!====================================================================== 
    408323END MODULE domwri 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r6152 r7277  
    2222 
    2323   !!---------------------------------------------------------------------- 
    24    !!   dom_zgr          : defined the ocean vertical coordinate system 
    25    !!       zgr_bat      : bathymetry fields (levels and meters) 
    26    !!       zgr_bat_zoom : modify the bathymetry field if zoom domain 
    27    !!       zgr_bat_ctl  : check the bathymetry files 
    28    !!       zgr_bot_level: deepest ocean level for t-, u, and v-points 
    29    !!       zgr_z        : reference z-coordinate  
    30    !!       zgr_zco      : z-coordinate  
    31    !!       zgr_zps      : z-coordinate with partial steps 
    32    !!       zgr_sco      : s-coordinate 
    33    !!       fssig        : tanh stretch function 
    34    !!       fssig1       : Song and Haidvogel 1994 stretch function 
    35    !!       fgamma       : Siddorn and Furner 2012 stretching function 
     24   !!   dom_zgr       : read or set the ocean vertical coordinate system 
     25   !!   zgr_read      : read the vertical information in the domain configuration file 
     26   !!   zgr_top_bot   : ocean top and bottom level for t-, u, and v-points with 1 as minimum value 
    3627   !!--------------------------------------------------------------------- 
    37    USE oce               ! ocean variables 
    38    USE dom_oce           ! ocean domain 
    39    USE wet_dry           ! wetting and drying 
    40    USE closea            ! closed seas 
    41    USE c1d               ! 1D vertical configuration 
     28   USE oce            ! ocean variables 
     29   USE dom_oce        ! ocean domain 
     30   USE usrdef_zgr     ! user defined vertical coordinate system 
     31   USE depth_e3       ! depth <=> e3 
    4232   ! 
    43    USE in_out_manager    ! I/O manager 
    44    USE iom               ! I/O library 
    45    USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    46    USE lib_mpp           ! distributed memory computing library 
    47    USE wrk_nemo          ! Memory allocation 
    48    USE timing            ! Timing 
     33   USE in_out_manager ! I/O manager 
     34   USE iom            ! I/O library 
     35   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     36   USE lib_mpp        ! distributed memory computing library 
     37   USE wrk_nemo       ! Memory allocation 
     38   USE timing         ! Timing 
    4939 
    5040   IMPLICIT NONE 
    … …  
    5242 
    5343   PUBLIC   dom_zgr        ! called by dom_init.F90 
    54  
    55    !                              !!* Namelist namzgr_sco * 
    56    LOGICAL  ::   ln_s_sh94         ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T) 
    57    LOGICAL  ::   ln_s_sf12         ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T) 
    58    ! 
    59    REAL(wp) ::   rn_sbot_min       ! minimum depth of s-bottom surface (>0) (m) 
    60    REAL(wp) ::   rn_sbot_max       ! maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
    61    REAL(wp) ::   rn_rmax           ! maximum cut-off r-value allowed (0<rn_rmax<1) 
    62    REAL(wp) ::   rn_hc             ! Critical depth for transition from sigma to stretched coordinates 
    63    ! Song and Haidvogel 1994 stretching parameters 
    64    REAL(wp) ::   rn_theta          ! surface control parameter (0<=rn_theta<=20) 
    65    REAL(wp) ::   rn_thetb          ! bottom control parameter  (0<=rn_thetb<= 1) 
    66    REAL(wp) ::   rn_bb             ! stretching parameter  
    67    !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 
    68    ! Siddorn and Furner stretching parameters 
    69    LOGICAL  ::   ln_sigcrit        ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch  
    70    REAL(wp) ::   rn_alpha          ! control parameter ( > 1 stretch towards surface, < 1 towards seabed) 
    71    REAL(wp) ::   rn_efold          !  efold length scale for transition to stretched coord 
    72    REAL(wp) ::   rn_zs             !  depth of surface grid box 
    73                            !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b 
    74    REAL(wp) ::   rn_zb_a           !  bathymetry scaling factor for calculating Zb 
    75    REAL(wp) ::   rn_zb_b           !  offset for calculating Zb 
    7644 
    7745  !! * Substitutions 
    … …  
    8452CONTAINS        
    8553 
    86    SUBROUTINE dom_zgr 
     54   SUBROUTINE dom_zgr( k_top, k_bot ) 
    8755      !!---------------------------------------------------------------------- 
    8856      !!                ***  ROUTINE dom_zgr  *** 
    … …  
    10169      !! ** Action  :   define gdep., e3., mbathy and bathy 
    10270      !!---------------------------------------------------------------------- 
    103       INTEGER ::   ioptio, ibat   ! local integer 
    104       INTEGER ::   ios 
    105       ! 
    106       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh 
     71      INTEGER, DIMENSION(:,:), INTENT(out) ::   k_top, k_bot   ! ocean first and last level indices 
     72      ! 
     73      INTEGER  ::   jk                  ! dummy loop index 
     74      INTEGER  ::   ioptio, ibat, ios   ! local integer 
     75      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m) 
    10776      !!---------------------------------------------------------------------- 
    10877      ! 
    10978      IF( nn_timing == 1 )   CALL timing_start('dom_zgr') 
    11079      ! 
    111       REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate 
    112       READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 ) 
    113 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 
    114  
    115       REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate 
    116       READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
    117 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
    118       IF(lwm) WRITE ( numond, namzgr ) 
    119  
    12080      IF(lwp) THEN                     ! Control print 
    12181         WRITE(numout,*) 
    12282         WRITE(numout,*) 'dom_zgr : vertical coordinate' 
    12383         WRITE(numout,*) '~~~~~~~' 
    124          WRITE(numout,*) '   Namelist namzgr : set vertical coordinate' 
     84      ENDIF 
     85 
     86      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time' 
     87 
     88 
     89      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==! 
     90         IF(lwp) WRITE(numout,*) 
     91         IF(lwp) WRITE(numout,*) '          Read vertical mesh in ', TRIM( cn_domcfg ), ' file' 
     92         ! 
     93         CALL zgr_read   ( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   &  
     94            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth 
     95            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth  
     96            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors 
     97            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors 
     98            &              k_top   , k_bot            )                  ! 1st & last ocean level 
     99         ! 
     100      ELSE                          !==  User defined configuration  ==! 
     101         IF(lwp) WRITE(numout,*) 
     102         IF(lwp) WRITE(numout,*) '          User defined vertical mesh (usr_def_zgr)' 
     103         ! 
     104         CALL usr_def_zgr( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   &  
     105            &              gdept_1d, gdepw_1d, e3t_1d, e3w_1d   ,   &    ! 1D gridpoints depth 
     106            &              gdept_0 , gdepw_0                    ,   &    ! gridpoints depth  
     107            &              e3t_0   , e3u_0   , e3v_0 , e3f_0    ,   &    ! vertical scale factors 
     108            &              e3w_0   , e3uw_0  , e3vw_0           ,   &    ! vertical scale factors 
     109            &              k_top   , k_bot            )                  ! 1st & last ocean level 
     110         ! 
     111      ENDIF 
     112      ! 
     113!!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears 
     114      ! Compute gde3w_0 (vertical sum of e3w) 
     115      gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
     116      DO jk = 2, jpk 
     117         gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
     118      END DO 
     119      ! 
     120      IF(lwp) THEN                     ! Control print 
     121         WRITE(numout,*) 
     122         WRITE(numout,*) '   Type of vertical coordinate (read in ', TRIM( cn_domcfg ), ' file or set in userdef_nam) :' 
    125123         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco 
    126124         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps 
    127125         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco 
    128126         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav 
    129          WRITE(numout,*) '      linear free surface            ln_linssh = ', ln_linssh 
    130       ENDIF 
    131  
    132       IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time' 
     127      ENDIF 
    133128 
    134129      ioptio = 0                       ! Check Vertical coordinate options 
    … …  
    137132      IF( ln_sco      )   ioptio = ioptio + 1 
    138133      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' ) 
    139       ! 
    140       ! Build the vertical coordinate system 
    141       ! ------------------------------------ 
    142                           CALL zgr_z            ! Reference z-coordinate system (always called) 
    143                           CALL zgr_bat          ! Bathymetry fields (levels and meters) 
    144       IF( lk_c1d      )   CALL lbc_lnk( bathy , 'T', 1._wp )   ! 1D config.: same bathy value over the 3x3 domain 
    145       IF( ln_zco      )   CALL zgr_zco          ! z-coordinate 
    146       IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate 
    147       IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate 
    148       ! 
    149       ! final adjustment of mbathy & check  
    150       ! ----------------------------------- 
    151       IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain 
    152       IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isolated ocean points 
    153                           CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points 
    154                           CALL zgr_top_level    ! shallowest ocean level for T-, U-, V- points 
    155       ! 
    156       IF( lk_c1d ) THEN                         ! 1D config.: same mbathy value over the 3x3 domain 
    157          ibat = mbathy(2,2) 
    158          mbathy(:,:) = ibat 
    159       END IF 
     134 
     135 
     136      !                                ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top) 
     137      CALL zgr_top_bot( k_top, k_bot )      ! with a minimum value set to 1 
     138       
     139 
     140      !                                ! deepest/shallowest W level Above/Below ~10m 
     141!!gm BUG in s-coordinate this does not work! 
     142      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness) 
     143      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 
     144      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m 
     145!!gm end bug 
     146      ! 
    160147      ! 
    161148      IF( nprint == 1 .AND. lwp )   THEN 
    162          WRITE(numout,*) ' MIN val mbathy  ', MINVAL(  mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 
     149         WRITE(numout,*) ' MIN val k_top   ', MINVAL(   k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) 
     150         WRITE(numout,*) ' MIN val k_bot   ', MINVAL(   k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) ) 
    163151         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   & 
    164152            &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 
    … …  
    181169 
    182170 
    183    SUBROUTINE zgr_z 
    184       !!---------------------------------------------------------------------- 
    185       !!                   ***  ROUTINE zgr_z  *** 
    186       !!                    
    187       !! ** Purpose :   set the depth of model levels and the resulting  
    188       !!      vertical scale factors. 
    189       !! 
    190       !! ** Method  :   z-coordinate system (use in all type of coordinate) 
    191       !!        The depth of model levels is defined from an analytical 
    192       !!      function the derivative of which gives the scale factors. 
    193       !!        both depth and scale factors only depend on k (1d arrays). 
    194       !!              w-level: gdepw_1d  = gdep(k) 
    195       !!                       e3w_1d(k) = dk(gdep)(k)     = e3(k) 
    196       !!              t-level: gdept_1d  = gdep(k+0.5) 
    197       !!                       e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5) 
    198       !! 
    199       !! ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m) 
    200       !!              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m) 
    201       !! 
    202       !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 
    203       !!---------------------------------------------------------------------- 
    204       INTEGER  ::   jk                     ! dummy loop indices 
    205       REAL(wp) ::   zt, zw                 ! temporary scalars 
    206       REAL(wp) ::   zsur, za0, za1, zkth   ! Values set from parameters in 
    207       REAL(wp) ::   zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90 
    208       REAL(wp) ::   zrefdep                ! depth of the reference level (~10m) 
    209       REAL(wp) ::   za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters  
    210       !!---------------------------------------------------------------------- 
    211       ! 
    212       IF( nn_timing == 1 )  CALL timing_start('zgr_z') 
    213       ! 
    214       ! Set variables from parameters 
    215       ! ------------------------------ 
    216        zkth = ppkth       ;   zacr = ppacr 
    217        zdzmin = ppdzmin   ;   zhmax = pphmax 
    218        zkth2 = ppkth2     ;   zacr2 = ppacr2   ! optional (ldbletanh=T) double tanh parameters 
    219  
    220       ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed 
    221       !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr 
    222       IF(   ppa1  == pp_to_be_computed  .AND.  & 
    223          &  ppa0  == pp_to_be_computed  .AND.  & 
    224          &  ppsur == pp_to_be_computed           ) THEN 
    225          ! 
    226 #if defined key_agrif 
    227          za1  = (  ppdzmin - pphmax / FLOAT(jpkdta-1)  )                                                   & 
    228             & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * (  LOG( COSH( (jpkdta - ppkth) / ppacr) )& 
    229             &                                                      - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
    230 #else 
    231          za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      & 
    232             & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      & 
    233             &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
    234 #endif 
    235          za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr ) 
    236          zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  ) 
    237       ELSE 
    238          za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur 
    239          za2 = ppa2                            ! optional (ldbletanh=T) double tanh parameter 
    240       ENDIF 
    241  
    242       IF(lwp) THEN                         ! Parameter print 
     171   SUBROUTINE zgr_read( ld_zco  , ld_zps  , ld_sco  , ld_isfcav,   &   ! type of vertical coordinate 
     172      &                 pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d  ,   &   ! 1D reference vertical coordinate 
     173      &                 pdept , pdepw ,                            &   ! 3D t & w-points depth 
     174      &                 pe3t  , pe3u  , pe3v   , pe3f ,            &   ! vertical scale factors 
     175      &                 pe3w  , pe3uw , pe3vw         ,            &   !     -      -      - 
     176      &                 k_top  , k_bot    )                            ! top & bottom ocean level 
     177      !!--------------------------------------------------------------------- 
     178      !!              ***  ROUTINE zgr_read  *** 
     179      !! 
     180      !! ** Purpose :   Read the vertical information in the domain configuration file 
     181      !! 
     182      !!---------------------------------------------------------------------- 
     183      LOGICAL                   , INTENT(out) ::   ld_zco, ld_zps, ld_sco      ! vertical coordinate flags 
     184      LOGICAL                   , INTENT(out) ::   ld_isfcav                   ! under iceshelf cavity flag 
     185      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pdept_1d, pdepw_1d          ! 1D grid-point depth       [m] 
     186      REAL(wp), DIMENSION(:)    , INTENT(out) ::   pe3t_1d , pe3w_1d           ! 1D vertical scale factors [m] 
     187      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pdept, pdepw                ! grid-point depth          [m] 
     188      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3t , pe3u , pe3v , pe3f   ! vertical scale factors    [m] 
     189      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pe3w , pe3uw, pe3vw         !    -       -      - 
     190      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level 
     191      ! 
     192      INTEGER  ::   jk     ! dummy loop index 
     193      INTEGER  ::   inum   ! local logical unit 
     194      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav 
     195      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace 
     196      !!---------------------------------------------------------------------- 
     197      ! 
     198      IF(lwp) THEN 
    243199         WRITE(numout,*) 
    244          WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates' 
    245          WRITE(numout,*) '    ~~~~~~~' 
    246          IF(  ppkth == 0._wp ) THEN               
    247               WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers' 
    248               WRITE(numout,*) '            Total depth    :', zhmax 
    249 #if defined key_agrif 
    250               WRITE(numout,*) '            Layer thickness:', zhmax/(jpkdta-1) 
    251 #else 
    252               WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1) 
    253 #endif 
    254          ELSE 
    255             IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN 
    256                WRITE(numout,*) '         zsur, za0, za1 computed from ' 
    257                WRITE(numout,*) '                 zdzmin = ', zdzmin 
    258                WRITE(numout,*) '                 zhmax  = ', zhmax 
    259             ENDIF 
    260             WRITE(numout,*) '           Value of coefficients for vertical mesh:' 
    261             WRITE(numout,*) '                 zsur = ', zsur 
    262             WRITE(numout,*) '                 za0  = ', za0 
    263             WRITE(numout,*) '                 za1  = ', za1 
    264             WRITE(numout,*) '                 zkth = ', zkth 
    265             WRITE(numout,*) '                 zacr = ', zacr 
    266             IF( ldbletanh ) THEN 
    267                WRITE(numout,*) ' (Double tanh    za2  = ', za2 
    268                WRITE(numout,*) '  parameters)    zkth2= ', zkth2 
    269                WRITE(numout,*) '                 zacr2= ', zacr2 
    270             ENDIF 
     200         WRITE(numout,*) '   zgr_read : read the vertical coordinates in ', TRIM( cn_domcfg ), ' file' 
     201         WRITE(numout,*) '   ~~~~~~~~' 
     202      ENDIF 
     203      ! 
     204      CALL iom_open( cn_domcfg, inum ) 
     205      ! 
     206      !                          !* type of vertical coordinate 
     207      CALL iom_get( inum, 'ln_zco'   , z_zco ) 
     208      CALL iom_get( inum, 'ln_zps'   , z_zps ) 
     209      CALL iom_get( inum, 'ln_sco'   , z_sco ) 
     210      IF( z_zco == 0._wp ) THEN   ;   ld_zco = .false.   ;   ELSE   ;   ld_zco = .true.   ;   ENDIF 
     211      IF( z_zps == 0._wp ) THEN   ;   ld_zps = .false.   ;   ELSE   ;   ld_zps = .true.   ;   ENDIF 
     212      IF( z_sco == 0._wp ) THEN   ;   ld_sco = .false.   ;   ELSE   ;   ld_sco = .true.   ;   ENDIF 
     213      ! 
     214      !                          !* ocean cavities under iceshelves 
     215      CALL iom_get( inum, 'ln_isfcav', z_cav ) 
     216      IF( z_cav == 0._wp ) THEN   ;   ld_isfcav = .false.   ;   ELSE   ;   ld_isfcav = .true.   ;   ENDIF 
     217      ! 
     218      !                          !* vertical scale factors 
     219      CALL iom_get( inum, jpdom_unknown, 'e3t_1d'  , pe3t_1d  )                     ! 1D reference coordinate 
     220      CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  ) 
     221      ! 
     222      CALL iom_get( inum, jpdom_data, 'e3t_0'  , pe3t  , lrowattr=ln_use_jattr )    ! 3D coordinate 
     223      CALL iom_get( inum, jpdom_data, 'e3u_0'  , pe3u  , lrowattr=ln_use_jattr ) 
     224      CALL iom_get( inum, jpdom_data, 'e3v_0'  , pe3v  , lrowattr=ln_use_jattr ) 
     225      CALL iom_get( inum, jpdom_data, 'e3f_0'  , pe3f  , lrowattr=ln_use_jattr ) 
     226      CALL iom_get( inum, jpdom_data, 'e3w_0'  , pe3w  , lrowattr=ln_use_jattr ) 
     227      CALL iom_get( inum, jpdom_data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr ) 
     228      CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr ) 
     229      ! 
     230      !                          !* depths 
     231      !                                   !- old depth definition (obsolescent feature) 
     232      IF(  iom_varid( inum, 'gdept_1d', ldstop = .FALSE. ) > 0  .AND.  & 
     233         & iom_varid( inum, 'gdepw_1d', ldstop = .FALSE. ) > 0  .AND.  & 
     234         & iom_varid( inum, 'gdept_0' , ldstop = .FALSE. ) > 0  .AND.  & 
     235         & iom_varid( inum, 'gdepw_0' , ldstop = .FALSE. ) > 0    ) THEN 
     236         CALL ctl_warn( 'zgr_read : old definition of depths and scale factors used ', &  
     237            &           '           depths at t- and w-points read in the domain configuration file') 
     238         CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )    
     239         CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d ) 
     240         CALL iom_get( inum, jpdom_data   , 'gdept_0' , pdept , lrowattr=ln_use_jattr ) 
     241         CALL iom_get( inum, jpdom_data   , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr ) 
     242         ! 
     243      ELSE                                !- depths computed from e3. scale factors 
     244         CALL e3_to_depth( pe3t_1d, pe3w_1d, pdept_1d, pdepw_1d )    ! 1D reference depth 
     245         CALL e3_to_depth( pe3t   , pe3w   , pdept   , pdepw    )    ! 3D depths 
     246         IF(lwp) THEN 
     247            WRITE(numout,*) 
     248            WRITE(numout,*) '              Reference 1D z-coordinate depth and scale factors:' 
     249            WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" ) 
     250            WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, pdept_1d(jk), pdepw_1d(jk), pe3t_1d(jk), pe3w_1d(jk), jk = 1, jpk ) 
    271251         ENDIF 
    272252      ENDIF 
    273  
    274  
    275       ! Reference z-coordinate (depth - scale factor at T- and W-points) 
    276       ! ====================== 
    277       IF( ppkth == 0._wp ) THEN            !  uniform vertical grid  
    278 #if defined key_agrif 
    279          za1 = zhmax / FLOAT(jpkdta-1)  
    280 #else 
    281          za1 = zhmax / FLOAT(jpk-1)  
    282 #endif 
    283          DO jk = 1, jpk 
    284             zw = FLOAT( jk ) 
    285             zt = FLOAT( jk ) + 0.5_wp 
    286             gdepw_1d(jk) = ( zw - 1 ) * za1 
    287             gdept_1d(jk) = ( zt - 1 ) * za1 
    288             e3w_1d  (jk) =  za1 
    289             e3t_1d  (jk) =  za1 
    290          END DO 
    291       ELSE                                ! Madec & Imbard 1996 function 
    292          IF( .NOT. ldbletanh ) THEN 
    293             DO jk = 1, jpk 
    294                zw = REAL( jk , wp ) 
    295                zt = REAL( jk , wp ) + 0.5_wp 
    296                gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  ) 
    297                gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  ) 
    298                e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   ) 
    299                e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   ) 
    300             END DO 
    301          ELSE 
    302             DO jk = 1, jpk 
    303                zw = FLOAT( jk ) 
    304                zt = FLOAT( jk ) + 0.5_wp 
    305                ! Double tanh function 
    306                gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    & 
    307                   &                             + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  ) 
    308                gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    & 
    309                   &                             + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  ) 
    310                e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      & 
    311                   &                             + za2        * TANH(       (zw-zkth2) / zacr2 ) 
    312                e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      & 
    313                   &                             + za2        * TANH(       (zt-zkth2) / zacr2 ) 
    314             END DO 
    315          ENDIF 
    316          gdepw_1d(1) = 0._wp                    ! force first w-level to be exactly at zero 
    317       ENDIF 
    318  
    319       IF ( ln_isfcav ) THEN 
    320 ! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth) 
    321 ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively 
    322          DO jk = 1, jpkm1 
    323             e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)  
    324          END DO 
    325          e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO 
    326  
    327          DO jk = 2, jpk 
    328             e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)  
    329          END DO 
    330          e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1))  
    331       END IF 
    332  
    333 !!gm BUG in s-coordinate this does not work! 
    334       ! deepest/shallowest W level Above/Below ~10m 
    335       zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness) 
    336       nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 
    337       nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m 
    338 !!gm end bug 
    339  
    340       IF(lwp) THEN                        ! control print 
    341          WRITE(numout,*) 
    342          WRITE(numout,*) '              Reference z-coordinate depth and scale factors:' 
    343          WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" ) 
    344          WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk ) 
    345       ENDIF 
    346       DO jk = 1, jpk                      ! control positivity 
    347          IF( e3w_1d  (jk) <= 0._wp .OR. e3t_1d  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 '    ) 
    348          IF( gdepw_1d(jk) <  0._wp .OR. gdept_1d(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' ) 
    349       END DO 
    350       ! 
    351       IF( nn_timing == 1 )  CALL timing_stop('zgr_z') 
    352       ! 
    353    END SUBROUTINE zgr_z 
    354  
    355  
    356    SUBROUTINE zgr_bat 
    357       !!---------------------------------------------------------------------- 
    358       !!                    ***  ROUTINE zgr_bat  *** 
    359       !!  
    360       !! ** Purpose :   set bathymetry both in levels and meters 
    361       !! 
    362       !! ** Method  :   read or define mbathy and bathy arrays 
    363       !!       * level bathymetry: 
    364       !!      The ocean basin geometry is given by a two-dimensional array, 
    365       !!      mbathy, which is defined as follow : 
    366       !!            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level 
    367       !!                              at t-point (ji,jj). 
    368       !!                            = 0  over the continental t-point. 
    369       !!      The array mbathy is checked to verified its consistency with 
    370       !!      model option. in particular: 
    371       !!            mbathy must have at least 1 land grid-points (mbathy<=0) 
    372       !!                  along closed boundary. 
    373       !!            mbathy must be cyclic IF jperio=1. 
    374       !!            mbathy must be lower or equal to jpk-1. 
    375       !!            isolated ocean grid points are suppressed from mbathy 
    376       !!                  since they are only connected to remaining 
    377       !!                  ocean through vertical diffusion. 
    378       !!      ntopo=-1 :   rectangular channel or bassin with a bump  
    379       !!      ntopo= 0 :   flat rectangular channel or basin  
    380       !!      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file 
    381       !!                   bathy  is read in 'bathy_meter.nc' NetCDF file 
    382       !! 
    383       !! ** Action  : - mbathy: level bathymetry (in level index) 
    384       !!              - bathy : meter bathymetry (in meters) 
    385       !!---------------------------------------------------------------------- 
    386       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    387       INTEGER  ::   inum                      ! temporary logical unit 
    388       INTEGER  ::   ierror                    ! error flag 
    389       INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position 
    390       INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices 
    391       REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics  
    392       REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars 
    393       INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   idta   ! global domain integer data 
    394       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdta   ! global domain scalar data 
    395       !!---------------------------------------------------------------------- 
    396       ! 
    397       IF( nn_timing == 1 )  CALL timing_start('zgr_bat') 
    398       ! 
    399       IF(lwp) WRITE(numout,*) 
    400       IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry' 
    401       IF(lwp) WRITE(numout,*) '    ~~~~~~~' 
    402       !                                               ! ================== !  
    403       IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  ! 
    404          !                                            ! ================== ! 
    405          !                                            ! global domain level and meter bathymetry (idta,zdta) 
    406          ! 
    407          ALLOCATE( idta(jpidta,jpjdta), STAT=ierror ) 
    408          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' ) 
    409          ALLOCATE( zdta(jpidta,jpjdta), STAT=ierror ) 
    410          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' ) 
    411          ! 
    412          IF( ntopo == 0 ) THEN                        ! flat basin 
    413             IF(lwp) WRITE(numout,*) 
    414             IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin' 
    415             IF( rn_bathy > 0.01 ) THEN  
    416                IF(lwp) WRITE(numout,*) '         Depth = rn_bathy read in namelist' 
    417                zdta(:,:) = rn_bathy 
    418                IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk 
    419                   idta(:,:) = jpkm1 
    420                ELSE                                                ! z-coordinate (zco or zps): step-like topography 
    421                   idta(:,:) = jpkm1 
    422                   DO jk = 1, jpkm1 
    423                      WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk 
    424                   END DO 
    425                ENDIF 
    426             ELSE 
    427                IF(lwp) WRITE(numout,*) '         Depth = depthw(jpkm1)' 
    428                idta(:,:) = jpkm1                            ! before last level 
    429                zdta(:,:) = gdepw_1d(jpk)                     ! last w-point depth 
    430                h_oce     = gdepw_1d(jpk) 
    431             ENDIF 
    432          ELSE                                         ! bump centered in the basin 
    433             IF(lwp) WRITE(numout,*) 
    434             IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump' 
    435             ii_bump = jpidta / 2                           ! i-index of the bump center 
    436             ij_bump = jpjdta / 2                           ! j-index of the bump center 
    437             r_bump  = 50000._wp                            ! bump radius (meters)        
    438             h_bump  =  2700._wp                            ! bump height (meters) 
    439             h_oce   = gdepw_1d(jpk)                        ! background ocean depth (meters) 
    440             IF(lwp) WRITE(numout,*) '            bump characteristics: ' 
    441             IF(lwp) WRITE(numout,*) '               bump center (i,j)   = ', ii_bump, ii_bump 
    442             IF(lwp) WRITE(numout,*) '               bump height         = ', h_bump , ' meters' 
    443             IF(lwp) WRITE(numout,*) '               bump radius         = ', r_bump , ' index' 
    444             IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters' 
    445             !                                         
    446             DO jj = 1, jpjdta                              ! zdta : 
    447                DO ji = 1, jpidta 
    448                   zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump 
    449                   zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump 
    450                   zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) ) 
    451                END DO 
    452             END DO 
    453             !                                              ! idta : 
    454             IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk 
    455                idta(:,:) = jpkm1 
    456             ELSE                                                ! z-coordinate (zco or zps): step-like topography 
    457                idta(:,:) = jpkm1 
    458                DO jk = 1, jpkm1 
    459                   WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk 
    460                END DO 
    461             ENDIF 
    462          ENDIF 
    463          !                                            ! set GLOBAL boundary conditions  
    464          !                                            ! Caution : idta on the global domain: use of jperio, not nperio 
    465          IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 
    466             idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp 
    467             idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0._wp 
    468          ELSEIF( jperio == 2 ) THEN 
    469             idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  ) 
    470             idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0._wp 
    471             idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp 
    472             idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp 
    473          ELSE 
    474             ih = 0                                  ;      zh = 0._wp 
    475             IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce 
    476             idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh 
    477             idta( :    ,jpjdta) = ih                ;      zdta( :    ,jpjdta) =  zh 
    478             idta( 1    , :    ) = ih                ;      zdta( 1    , :    ) =  zh 
    479             idta(jpidta, :    ) = ih                ;      zdta(jpidta, :    ) =  zh 
    480          ENDIF 
    481  
    482          !                                            ! local domain level and meter bathymetries (mbathy,bathy) 
    483          mbathy(:,:) = 0                                   ! set to zero extra halo points 
    484          bathy (:,:) = 0._wp                               ! (require for mpp case) 
    485          DO jj = 1, nlcj                                   ! interior values 
    486             DO ji = 1, nlci 
    487                mbathy(ji,jj) = idta( mig(ji), mjg(jj) ) 
    488                bathy (ji,jj) = zdta( mig(ji), mjg(jj) ) 
    489             END DO 
    490          END DO 
    491          risfdep(:,:)=0.e0 
    492          misfdep(:,:)=1 
    493          ! 
    494          DEALLOCATE( idta, zdta ) 
    495          ! 
    496          !                                            ! ================ ! 
    497       ELSEIF( ntopo == 1 ) THEN                       !   read in file   ! (over the local domain) 
    498          !                                            ! ================ ! 
    499          ! 
    500          IF( ln_zco )   THEN                          ! zco : read level bathymetry  
    501             CALL iom_open ( 'bathy_level.nc', inum )   
    502             CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy ) 
    503             CALL iom_close( inum ) 
    504             mbathy(:,:) = INT( bathy(:,:) ) 
    505             !                                                ! ===================== 
    506             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    507                !                                             ! ===================== 
    508                ! 
    509                ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open  
    510                ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995) 
    511                DO ji = mi0(ii0), mi1(ii1) 
    512                   DO jj = mj0(ij0), mj1(ij1) 
    513                      mbathy(ji,jj) = 15 
    514                   END DO 
    515                END DO 
    516                IF(lwp) WRITE(numout,*) 
    517                IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
    518                ! 
    519                ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open 
    520                ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995) 
    521                DO ji = mi0(ii0), mi1(ii1) 
    522                   DO jj = mj0(ij0), mj1(ij1) 
    523                      mbathy(ji,jj) = 12 
    524                   END DO 
    525                END DO 
    526                IF(lwp) WRITE(numout,*) 
    527                IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 
    528                ! 
    529             ENDIF 
    530             ! 
    531          ENDIF 
    532          IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry 
    533             CALL iom_open ( 'bathy_meter.nc', inum )  
    534             IF ( ln_isfcav ) THEN 
    535                CALL iom_get  ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. ) 
    536             ELSE 
    537                CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  ) 
    538             END IF 
    539             CALL iom_close( inum ) 
    540             !                                                 
    541             risfdep(:,:)=0._wp          
    542             misfdep(:,:)=1              
    543             IF ( ln_isfcav ) THEN 
    544                CALL iom_open ( 'isf_draft_meter.nc', inum )  
    545                CALL iom_get  ( inum, jpdom_data, 'isf_draft', risfdep ) 
    546                CALL iom_close( inum ) 
    547                WHERE( bathy(:,:) <= 0._wp )  risfdep(:,:) = 0._wp 
    548  
    549                ! set grounded point to 0  
    550                ! (a treshold could be set here if needed, or set it offline based on the grounded fraction) 
    551                WHERE ( bathy(:,:) <= risfdep(:,:) + rn_isfhmin ) 
    552                   misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    553                   mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
    554                END WHERE 
    555             END IF 
    556             !        
    557             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    558             ! 
    559               ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open  
    560               ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995) 
    561               DO ji = mi0(ii0), mi1(ii1) 
    562                  DO jj = mj0(ij0), mj1(ij1) 
    563                     bathy(ji,jj) = 284._wp 
    564                  END DO 
    565                END DO 
    566               IF(lwp) WRITE(numout,*)      
    567               IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
    568               ! 
    569               ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open 
    570               ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995) 
    571                DO ji = mi0(ii0), mi1(ii1) 
    572                  DO jj = mj0(ij0), mj1(ij1) 
    573                     bathy(ji,jj) = 137._wp 
    574                  END DO 
    575               END DO 
    576               IF(lwp) WRITE(numout,*) 
    577                IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 
    578               ! 
    579            ENDIF 
    580             ! 
    581         ENDIF 
    582          !                                            ! =============== ! 
    583       ELSE                                            !      error      ! 
    584          !                                            ! =============== ! 
    585          WRITE(ctmp1,*) 'parameter , ntopo = ', ntopo 
    586          CALL ctl_stop( '    zgr_bat : '//trim(ctmp1) ) 
    587       ENDIF 
    588       ! 
    589       IF( nn_closea == 0 )   CALL clo_bat( bathy, mbathy )    !==  NO closed seas or lakes  ==! 
    590       !                        
    591       IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==! 
    592          IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level 
    593          ELSE                          ;   ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )  ! from a depth 
    594          ENDIF 
    595          zhmin = gdepw_1d(ik+1)                                                         ! minimum depth = ik+1 w-levels  
    596          WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands 
    597          ELSE WHERE                     ;   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans 
    598          END WHERE 
    599          IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik 
    600       ENDIF 
    601       ! 
    602       IF( nn_timing == 1 )  CALL timing_stop('zgr_bat') 
    603       ! 
    604    END SUBROUTINE zgr_bat 
    605  
    606  
    607    SUBROUTINE zgr_bat_zoom 
    608       !!---------------------------------------------------------------------- 
    609       !!                    ***  ROUTINE zgr_bat_zoom  *** 
    610       !! 
    611       !! ** Purpose : - Close zoom domain boundary if necessary 
    612       !!              - Suppress Med Sea from ORCA R2 and R05 arctic zoom 
    613       !! 
    614       !! ** Method  :  
    615       !! 
    616       !! ** Action  : - update mbathy: level bathymetry (in level index) 
    617       !!---------------------------------------------------------------------- 
    618       INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integers 
    619       !!---------------------------------------------------------------------- 
    620       ! 
    621       IF(lwp) WRITE(numout,*) 
    622       IF(lwp) WRITE(numout,*) '    zgr_bat_zoom : modify the level bathymetry for zoom domain' 
    623       IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~' 
    624       ! 
    625       ! Zoom domain 
    626       ! =========== 
    627       ! 
    628       ! Forced closed boundary if required 
    629       IF( lzoom_s )   mbathy(  : , mj0(jpjzoom):mj1(jpjzoom) )      = 0 
    630       IF( lzoom_w )   mbathy(      mi0(jpizoom):mi1(jpizoom) , :  ) = 0 
    631       IF( lzoom_e )   mbathy(      mi0(jpiglo+jpizoom-1):mi1(jpiglo+jpizoom-1) , :  ) = 0 
    632       IF( lzoom_n )   mbathy(  : , mj0(jpjglo+jpjzoom-1):mj1(jpjglo+jpjzoom-1) )      = 0 
    633       ! 
    634       ! Configuration specific domain modifications 
    635       ! (here, ORCA arctic configuration: suppress Med Sea) 
    636       IF( cp_cfg == "orca" .AND. cp_cfz == "arctic" ) THEN 
    637          SELECT CASE ( jp_cfg ) 
    638          !                                        ! ======================= 
    639          CASE ( 2 )                               !  ORCA_R2 configuration 
    640             !                                     ! ======================= 
    641             IF(lwp) WRITE(numout,*) '                   ORCA R2 arctic zoom: suppress the Med Sea' 
    642             ii0 = 141   ;   ii1 = 162      ! Sea box i,j indices 
    643             ij0 =  98   ;   ij1 = 110 
    644             !                                     ! ======================= 
    645          CASE ( 05 )                              !  ORCA_R05 configuration 
    646             !                                     ! ======================= 
    647             IF(lwp) WRITE(numout,*) '                   ORCA R05 arctic zoom: suppress the Med Sea' 
    648             ii0 = 563   ;   ii1 = 642      ! zero over the Med Sea boxe 
    649             ij0 = 314   ;   ij1 = 370  
    650          END SELECT 
    651          ! 
    652          mbathy( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0   ! zero over the Med Sea boxe 
    653          ! 
    654       ENDIF 
    655       ! 
    656    END SUBROUTINE zgr_bat_zoom 
    657  
    658  
    659    SUBROUTINE zgr_bat_ctl 
    660       !!---------------------------------------------------------------------- 
    661       !!                    ***  ROUTINE zgr_bat_ctl  *** 
    662       !! 
    663       !! ** Purpose :   check the bathymetry in levels 
    664       !! 
    665       !! ** Method  :   The array mbathy is checked to verified its consistency 
    666       !!      with the model options. in particular: 
    667       !!            mbathy must have at least 1 land grid-points (mbathy<=0) 
    668       !!                  along closed boundary. 
    669       !!            mbathy must be cyclic IF jperio=1. 
    670       !!            mbathy must be lower or equal to jpk-1. 
    671       !!            isolated ocean grid points are suppressed from mbathy 
    672       !!                  since they are only connected to remaining 
    673       !!                  ocean through vertical diffusion. 
    674       !!      C A U T I O N : mbathy will be modified during the initializa- 
    675       !!      tion phase to become the number of non-zero w-levels of a water 
    676       !!      column, with a minimum value of 1. 
    677       !! 
    678       !! ** Action  : - update mbathy: level bathymetry (in level index) 
    679       !!              - update bathy : meter bathymetry (in meters) 
    680       !!---------------------------------------------------------------------- 
    681       INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    682       INTEGER ::   icompt, ibtest, ikmax         ! temporary integers 
    683       REAL(wp), POINTER, DIMENSION(:,:) ::  zbathy 
    684       !!---------------------------------------------------------------------- 
    685       ! 
    686       IF( nn_timing == 1 )  CALL timing_start('zgr_bat_ctl') 
    687       ! 
    688       CALL wrk_alloc( jpi, jpj, zbathy ) 
    689       ! 
    690       IF(lwp) WRITE(numout,*) 
    691       IF(lwp) WRITE(numout,*) '    zgr_bat_ctl : check the bathymetry' 
    692       IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~' 
    693       !                                          ! Suppress isolated ocean grid points 
    694       IF(lwp) WRITE(numout,*) 
    695       IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points' 
    696       IF(lwp) WRITE(numout,*)'                   -----------------------------------' 
    697       icompt = 0 
    698       DO jl = 1, 2 
    699          IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN 
    700             mbathy( 1 ,:) = mbathy(jpim1,:)           ! local domain is cyclic east-west 
    701             mbathy(jpi,:) = mbathy(  2  ,:) 
    702          ENDIF 
    703          DO jj = 2, jpjm1 
    704             DO ji = 2, jpim1 
    705                ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   & 
    706                   &           mbathy(ji,jj-1), mbathy(ji,jj+1)  ) 
    707                IF( ibtest < mbathy(ji,jj) ) THEN 
    708                   IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   & 
    709                      &   'grid-point (i,j) =  ',ji,jj,' is changed from ', mbathy(ji,jj),' to ', ibtest 
    710                   mbathy(ji,jj) = ibtest 
    711                   icompt = icompt + 1 
    712                ENDIF 
    713             END DO 
    714          END DO 
    715       END DO 
    716       IF( lk_mpp )   CALL mpp_sum( icompt ) 
    717       IF( icompt == 0 ) THEN 
    718          IF(lwp) WRITE(numout,*)'     no isolated ocean grid points' 
    719       ELSE 
    720          IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed' 
    721       ENDIF 
    722       IF( lk_mpp ) THEN 
    723          zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    724          CALL lbc_lnk( zbathy, 'T', 1._wp ) 
    725          mbathy(:,:) = INT( zbathy(:,:) ) 
    726       ENDIF 
    727       !                                          ! East-west cyclic boundary conditions 
    728       IF( nperio == 0 ) THEN 
    729          IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: nperio = ', nperio 
    730          IF( lk_mpp ) THEN 
    731             IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    732                IF( jperio /= 1 )   mbathy(1,:) = 0 
    733             ENDIF 
    734             IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    735                IF( jperio /= 1 )   mbathy(nlci,:) = 0 
    736             ENDIF 
    737          ELSE 
    738             IF( ln_zco .OR. ln_zps ) THEN 
    739                mbathy( 1 ,:) = 0 
    740                mbathy(jpi,:) = 0 
    741             ELSE 
    742                mbathy( 1 ,:) = jpkm1 
    743                mbathy(jpi,:) = jpkm1 
    744             ENDIF 
    745          ENDIF 
    746       ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio ==  6 ) THEN 
    747          IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: nperio = ', nperio 
    748          mbathy( 1 ,:) = mbathy(jpim1,:) 
    749          mbathy(jpi,:) = mbathy(  2  ,:) 
    750       ELSEIF( nperio == 2 ) THEN 
    751          IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: nperio = ', nperio 
    752       ELSE 
    753          IF(lwp) WRITE(numout,*) '    e r r o r' 
    754          IF(lwp) WRITE(numout,*) '    parameter , nperio = ', nperio 
    755          !         STOP 'dom_mba' 
    756       ENDIF 
    757       !  Boundary condition on mbathy 
    758       IF( .NOT.lk_mpp ) THEN  
    759 !!gm     !!bug ???  think about it ! 
    760          !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab 
    761          zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    762          CALL lbc_lnk( zbathy, 'T', 1._wp ) 
    763          mbathy(:,:) = INT( zbathy(:,:) ) 
    764       ENDIF 
    765       ! Number of ocean level inferior or equal to jpkm1 
    766       ikmax = 0 
    767       DO jj = 1, jpj 
    768          DO ji = 1, jpi 
    769             ikmax = MAX( ikmax, mbathy(ji,jj) ) 
    770          END DO 
    771       END DO 
    772 !!gm  !!! test to do:   ikmax = MAX( mbathy(:,:) )   ??? 
    773       IF( ikmax > jpkm1 ) THEN 
    774          IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1' 
    775          IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry' 
    776       ELSE IF( ikmax < jpkm1 ) THEN 
    777          IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1'  
    778          IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1 
    779       ENDIF 
    780       ! 
    781       CALL wrk_dealloc( jpi, jpj, zbathy ) 
    782       ! 
    783       IF( nn_timing == 1 )  CALL timing_stop('zgr_bat_ctl') 
    784       ! 
    785    END SUBROUTINE zgr_bat_ctl 
    786  
    787  
    788    SUBROUTINE zgr_bot_level 
    789       !!---------------------------------------------------------------------- 
    790       !!                    ***  ROUTINE zgr_bot_level  *** 
     253      ! 
     254      !                          !* ocean top and bottom level 
     255      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF) 
     256      k_top(:,:) = INT( z2d(:,:) ) 
     257      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points 
     258      k_bot(:,:) = INT( z2d(:,:) ) 
     259      ! 
     260      CALL iom_close( inum ) 
     261      ! 
     262   END SUBROUTINE zgr_read 
     263 
     264 
     265   SUBROUTINE zgr_top_bot( k_top, k_bot ) 
     266      !!---------------------------------------------------------------------- 
     267      !!                    ***  ROUTINE zgr_top_bot  *** 
    791268      !! 
    792269      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays) 
    793270      !! 
    794       !! ** Method  :   computes from mbathy with a minimum value of 1 over land 
    795       !! 
     271      !! ** Method  :   computes from k_top and k_bot with a minimum value of 1 over land 
     272      !! 
     273      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest  
     274      !!                                     ocean level at t-, u- & v-points 
     275      !!                                     (min value = 1) 
    796276      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest  
    797277      !!                                     ocean level at t-, u- & v-points 
    798278      !!                                     (min value = 1 over land) 
    799279      !!---------------------------------------------------------------------- 
     280      INTEGER , DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! top & bottom ocean level indices 
     281      ! 
    800282      INTEGER ::   ji, jj   ! dummy loop indices 
    801       REAL(wp), POINTER, DIMENSION(:,:) ::  zmbk 
     283      REAL(wp), POINTER, DIMENSION(:,:) ::  zk 
    802284      !!---------------------------------------------------------------------- 
    803285      ! 
    804286      IF( nn_timing == 1 )  CALL timing_start('zgr_bot_level') 
    805287      ! 
    806       CALL wrk_alloc( jpi, jpj, zmbk ) 
     288      CALL wrk_alloc( jpi,jpj,   zk ) 
    807289      ! 
    808290      IF(lwp) WRITE(numout,*) 
    809       IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels ' 
    810       IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~' 
    811       ! 
    812       mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land) 
     291      IF(lwp) WRITE(numout,*) '    zgr_top_bot : ocean top and bottom k-index of T-, U-, V- and W-levels ' 
     292      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~' 
     293      ! 
     294      mikt(:,:) = MAX( k_top(:,:) , 1 )    ! top    ocean k-index of T-level (=1 over land) 
     295      ! 
     296      mbkt(:,:) = MAX( k_bot(:,:) , 1 )    ! bottom ocean k-index of T-level (=1 over land) 
    813297  
    814       !                                     ! bottom k-index of W-level = mbkt+1 
    815       DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level 
     298      !                                    ! N.B.  top     k-index of W-level = mikt 
     299      !                                    !       bottom  k-index of W-level = mbkt+1 
     300      DO jj = 1, jpjm1 
    816301         DO ji = 1, jpim1 
     302            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  ) 
     303            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  ) 
     304            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  ) 
     305            ! 
    817306            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  ) 
    818307            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  ) 
    … …  
    820309      END DO 
    821310      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    822       zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    823       zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    824       ! 
    825       CALL wrk_dealloc( jpi, jpj, zmbk ) 
    826       ! 
    827       IF( nn_timing == 1 )  CALL timing_stop('zgr_bot_level') 
    828       ! 
    829    END SUBROUTINE zgr_bot_level 
    830  
    831  
    832    SUBROUTINE zgr_top_level 
    833       !!---------------------------------------------------------------------- 
    834       !!                    ***  ROUTINE zgr_top_level  *** 
    835       !! 
    836       !! ** Purpose :   defines the vertical index of ocean top (mik. arrays) 
    837       !! 
    838       !! ** Method  :   computes from misfdep with a minimum value of 1 
    839       !! 
    840       !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest  
    841       !!                                     ocean level at t-, u- & v-points 
    842       !!                                     (min value = 1) 
    843       !!---------------------------------------------------------------------- 
    844       INTEGER ::   ji, jj   ! dummy loop indices 
    845       REAL(wp), POINTER, DIMENSION(:,:) ::  zmik 
    846       !!---------------------------------------------------------------------- 
    847       ! 
    848       IF( nn_timing == 1 )  CALL timing_start('zgr_top_level') 
    849       ! 
    850       CALL wrk_alloc( jpi, jpj, zmik ) 
    851       ! 
    852       IF(lwp) WRITE(numout,*) 
    853       IF(lwp) WRITE(numout,*) '    zgr_top_level : ocean top k-index of T-, U-, V- and W-levels ' 
    854       IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~' 
    855       ! 
    856       mikt(:,:) = MAX( misfdep(:,:) , 1 )    ! top k-index of T-level (=1) 
    857       !                                      ! top k-index of W-level (=mikt) 
    858       DO jj = 1, jpjm1                       ! top k-index of U- (U-) level 
    859          DO ji = 1, jpim1 
    860             miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  ) 
    861             mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  ) 
    862             mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  ) 
    863          END DO 
    864       END DO 
    865  
    866       ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    867       zmik(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk(zmik,'U',1.)   ;   miku  (:,:) = MAX( INT( zmik(:,:) ), 1 ) 
    868       zmik(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk(zmik,'V',1.)   ;   mikv  (:,:) = MAX( INT( zmik(:,:) ), 1 ) 
    869       zmik(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk(zmik,'F',1.)   ;   mikf  (:,:) = MAX( INT( zmik(:,:) ), 1 ) 
    870       ! 
    871       CALL wrk_dealloc( jpi, jpj, zmik ) 
     311      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   miku(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     312      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mikv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     313      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( zk, 'F', 1. )   ;   mikf(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     314      ! 
     315      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   mbku(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     316      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     317      ! 
     318      CALL wrk_dealloc( jpi,jpj,   zk ) 
    872319      ! 
    873320      IF( nn_timing == 1 )  CALL timing_stop('zgr_top_level') 
    874321      ! 
    875    END SUBROUTINE zgr_top_level 
    876  
    877  
    878    SUBROUTINE zgr_zco 
    879       !!---------------------------------------------------------------------- 
    880       !!                  ***  ROUTINE zgr_zco  *** 
    881       !! 
    882       !! ** Purpose :   define the reference z-coordinate system 
    883       !! 
    884       !! ** Method  :   set 3D coord. arrays to reference 1D array  
    885       !!---------------------------------------------------------------------- 
    886       INTEGER  ::   jk 
    887       !!---------------------------------------------------------------------- 
    888       ! 
    889       IF( nn_timing == 1 )  CALL timing_start('zgr_zco') 
    890       ! 
    891       DO jk = 1, jpk 
    892          gdept_0(:,:,jk) = gdept_1d(jk) 
    893          gdepw_0(:,:,jk) = gdepw_1d(jk) 
    894          gde3w_0(:,:,jk) = gdepw_1d(jk) 
    895          e3t_0  (:,:,jk) = e3t_1d  (jk) 
    896          e3u_0  (:,:,jk) = e3t_1d  (jk) 
    897          e3v_0  (:,:,jk) = e3t_1d  (jk) 
    898          e3f_0  (:,:,jk) = e3t_1d  (jk) 
    899          e3w_0  (:,:,jk) = e3w_1d  (jk) 
    900          e3uw_0 (:,:,jk) = e3w_1d  (jk) 
    901          e3vw_0 (:,:,jk) = e3w_1d  (jk) 
    902       END DO 
    903       ! 
    904       IF( nn_timing == 1 )  CALL timing_stop('zgr_zco') 
    905       ! 
    906    END SUBROUTINE zgr_zco 
    907  
    908  
    909    SUBROUTINE zgr_zps 
    910       !!---------------------------------------------------------------------- 
    911       !!                  ***  ROUTINE zgr_zps  *** 
    912       !!                      
    913       !! ** Purpose :   the depth and vertical scale factor in partial step 
    914       !!              reference z-coordinate case 
    915       !! 
    916       !! ** Method  :   Partial steps : computes the 3D vertical scale factors 
    917       !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with 
    918       !!      a partial step representation of bottom topography. 
    919       !! 
    920       !!        The reference depth of model levels is defined from an analytical 
    921       !!      function the derivative of which gives the reference vertical 
    922       !!      scale factors. 
    923       !!        From  depth and scale factors reference, we compute there new value 
    924       !!      with partial steps  on 3d arrays ( i, j, k ). 
    925       !! 
    926       !!              w-level: gdepw_0(i,j,k)  = gdep(k) 
    927       !!                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k) 
    928       !!              t-level: gdept_0(i,j,k)  = gdep(k+0.5) 
    929       !!                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5) 
    930       !! 
    931       !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc), 
    932       !!      we find the mbathy index of the depth at each grid point. 
    933       !!      This leads us to three cases: 
    934       !! 
    935       !!              - bathy = 0 => mbathy = 0 
    936       !!              - 1 < mbathy < jpkm1     
    937       !!              - bathy > gdepw_0(jpk) => mbathy = jpkm1   
    938       !! 
    939       !!        Then, for each case, we find the new depth at t- and w- levels 
    940       !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw-  
    941       !!      and f-points. 
    942       !!  
    943       !!        This routine is given as an example, it must be modified 
    944       !!      following the user s desiderata. nevertheless, the output as 
    945       !!      well as the way to compute the model levels and scale factors 
    946       !!      must be respected in order to insure second order accuracy 
    947       !!      schemes. 
    948       !! 
    949       !!         c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives 
    950       !!         - - - - - - -   gdept_0, gdepw_0 and e3. are positives 
    951       !!       
    952       !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    953       !!---------------------------------------------------------------------- 
    954       INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    955       INTEGER  ::   ik, it, ikb, ikt ! temporary integers 
    956       REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    957       REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t 
    958       REAL(wp) ::   zdiff            ! temporary scalar 
    959       REAL(wp) ::   zmax             ! temporary scalar 
    960       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt 
    961       !!--------------------------------------------------------------------- 
    962       ! 
    963       IF( nn_timing == 1 )  CALL timing_start('zgr_zps') 
    964       ! 
    965       CALL wrk_alloc( jpi,jpj,jpk,   zprt ) 
    966       ! 
    967       IF(lwp) WRITE(numout,*) 
    968       IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps' 
    969       IF(lwp) WRITE(numout,*) '    ~~~~~~~ ' 
    970       IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used' 
    971  
    972       ! bathymetry in level (from bathy_meter) 
    973       ! =================== 
    974       zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 
    975       bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat) 
    976       WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0 
    977       ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level 
    978       END WHERE 
    979  
    980       ! Compute mbathy for ocean points (i.e. the number of ocean levels) 
    981       ! find the number of ocean levels such that the last level thickness 
    982       ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where 
    983       ! e3t_1d is the reference level thickness 
    984       DO jk = jpkm1, 1, -1 
    985          zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
    986          WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1 
    987       END DO 
    988  
    989       ! Scale factors and depth at T- and W-points 
    990       DO jk = 1, jpk                        ! intitialization to the reference z-coordinate 
    991          gdept_0(:,:,jk) = gdept_1d(jk) 
    992          gdepw_0(:,:,jk) = gdepw_1d(jk) 
    993          e3t_0  (:,:,jk) = e3t_1d  (jk) 
    994          e3w_0  (:,:,jk) = e3w_1d  (jk) 
    995       END DO 
    996        
    997       ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf 
    998       IF ( ln_isfcav ) CALL zgr_isf 
    999  
    1000       ! Scale factors and depth at T- and W-points 
    1001       IF ( .NOT. ln_isfcav ) THEN 
    1002          DO jj = 1, jpj 
    1003             DO ji = 1, jpi 
    1004                ik = mbathy(ji,jj) 
    1005                IF( ik > 0 ) THEN               ! ocean point only 
    1006                   ! max ocean level case 
    1007                   IF( ik == jpkm1 ) THEN 
    1008                      zdepwp = bathy(ji,jj) 
    1009                      ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
    1010                      ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
    1011                      e3t_0(ji,jj,ik  ) = ze3tp 
    1012                      e3t_0(ji,jj,ik+1) = ze3tp 
    1013                      e3w_0(ji,jj,ik  ) = ze3wp 
    1014                      e3w_0(ji,jj,ik+1) = ze3tp 
    1015                      gdepw_0(ji,jj,ik+1) = zdepwp 
    1016                      gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
    1017                      gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
    1018                      ! 
    1019                   ELSE                         ! standard case 
    1020                      IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
    1021                      ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
    1022                      ENDIF 
    1023    !gm Bug?  check the gdepw_1d 
    1024                      !       ... on ik 
    1025                      gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
    1026                         &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
    1027                         &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
    1028                      e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   &  
    1029                         &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) )  
    1030                      e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   & 
    1031                         &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) ) 
    1032                      !       ... on ik+1 
    1033                      e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1034                      e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1035                      gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 
    1036                   ENDIF 
    1037                ENDIF 
    1038             END DO 
    1039          END DO 
    1040          ! 
    1041          it = 0 
    1042          DO jj = 1, jpj 
    1043             DO ji = 1, jpi 
    1044                ik = mbathy(ji,jj) 
    1045                IF( ik > 0 ) THEN               ! ocean point only 
    1046                   e3tp (ji,jj) = e3t_0(ji,jj,ik) 
    1047                   e3wp (ji,jj) = e3w_0(ji,jj,ik) 
    1048                   ! test 
    1049                   zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
    1050                   IF( zdiff <= 0._wp .AND. lwp ) THEN  
    1051                      it = it + 1 
    1052                      WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
    1053                      WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
    1054                      WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
    1055                      WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
    1056                   ENDIF 
    1057                ENDIF 
    1058             END DO 
    1059          END DO 
    1060       END IF 
    1061       ! 
    1062       ! Scale factors and depth at U-, V-, UW and VW-points 
    1063       DO jk = 1, jpk                        ! initialisation to z-scale factors 
    1064          e3u_0 (:,:,jk) = e3t_1d(jk) 
    1065          e3v_0 (:,:,jk) = e3t_1d(jk) 
    1066          e3uw_0(:,:,jk) = e3w_1d(jk) 
    1067          e3vw_0(:,:,jk) = e3w_1d(jk) 
    1068       END DO 
    1069  
    1070       DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors 
    1071          DO jj = 1, jpjm1 
    1072             DO ji = 1, fs_jpim1   ! vector opt. 
    1073                e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 
    1074                e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 
    1075                e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) ) 
    1076                e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) ) 
    1077             END DO 
    1078          END DO 
    1079       END DO 
    1080       IF ( ln_isfcav ) THEN 
    1081       ! (ISF) define e3uw (adapted for 2 cells in the water column) 
    1082          DO jj = 2, jpjm1  
    1083             DO ji = 2, fs_jpim1   ! vector opt.  
    1084                ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 
    1085                ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 
    1086                IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) & 
    1087                                        &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) ) 
    1088                ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 
    1089                ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 
    1090                IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) & 
    1091                                        &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) ) 
    1092             END DO 
    1093          END DO 
    1094       END IF 
    1095  
    1096       CALL lbc_lnk( e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw_0, 'U', 1._wp )   ! lateral boundary conditions 
    1097       CALL lbc_lnk( e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    1098       ! 
    1099  
    1100       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    1101          WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk) 
    1102          WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk) 
    1103          WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk) 
    1104          WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk) 
    1105       END DO 
    1106        
    1107       ! Scale factor at F-point 
    1108       DO jk = 1, jpk                        ! initialisation to z-scale factors 
    1109          e3f_0(:,:,jk) = e3t_1d(jk) 
    1110       END DO 
    1111       DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
    1112          DO jj = 1, jpjm1 
    1113             DO ji = 1, fs_jpim1   ! vector opt. 
    1114                e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) ) 
    1115             END DO 
    1116          END DO 
    1117       END DO 
    1118       CALL lbc_lnk( e3f_0, 'F', 1._wp )       ! Lateral boundary conditions 
    1119       ! 
    1120       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries) 
    1121          WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk) 
    1122       END DO 
    1123 !!gm  bug ? :  must be a do loop with mj0,mj1 
    1124       !  
    1125       e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2 
    1126       e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)  
    1127       e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:)  
    1128       e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)  
    1129       e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)  
    1130  
    1131       ! Control of the sign 
    1132       IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' ) 
    1133       IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' ) 
    1134       IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' ) 
    1135       IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' ) 
    1136       
    1137       ! Compute gde3w_0 (vertical sum of e3w) 
    1138       IF ( ln_isfcav ) THEN ! if cavity 
    1139          WHERE( misfdep == 0 )   misfdep = 1 
    1140          DO jj = 1,jpj 
    1141             DO ji = 1,jpi 
    1142                gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
    1143                DO jk = 2, misfdep(ji,jj) 
    1144                   gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    1145                END DO 
    1146                IF( misfdep(ji,jj) >= 2 )   gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 
    1147                DO jk = misfdep(ji,jj) + 1, jpk 
    1148                   gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk)  
    1149                END DO 
    1150             END DO 
    1151          END DO 
    1152       ELSE ! no cavity 
    1153          gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
    1154          DO jk = 2, jpk 
    1155             gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
    1156          END DO 
    1157       END IF 
    1158       ! 
    1159       CALL wrk_dealloc( jpi,jpj,jpk,   zprt ) 
    1160       ! 
    1161       IF( nn_timing == 1 )  CALL timing_stop('zgr_zps') 
    1162       ! 
    1163    END SUBROUTINE zgr_zps 
    1164  
    1165  
    1166    SUBROUTINE zgr_isf 
    1167       !!---------------------------------------------------------------------- 
    1168       !!                    ***  ROUTINE zgr_isf  *** 
    1169       !!    
    1170       !! ** Purpose :   check the bathymetry in levels 
    1171       !!    
    1172       !! ** Method  :   THe water column have to contained at least 2 cells 
    1173       !!                Bathymetry and isfdraft are modified (dig/close) to respect 
    1174       !!                this criterion. 
    1175       !!    
    1176       !! ** Action  : - test compatibility between isfdraft and bathy  
    1177       !!              - bathy and isfdraft are modified 
    1178       !!---------------------------------------------------------------------- 
    1179       INTEGER  ::   ji, jj, jl, jk       ! dummy loop indices 
    1180       INTEGER  ::   ik, it               ! temporary integers 
    1181       INTEGER  ::   icompt, ibtest       ! (ISF) 
    1182       INTEGER  ::   ibtestim1, ibtestip1 ! (ISF) 
    1183       INTEGER  ::   ibtestjm1, ibtestjp1 ! (ISF) 
    1184       REAL(wp) ::   zdepth           ! Ajusted ocean depth to avoid too small e3t 
    1185       REAL(wp) ::   zmax             ! Maximum and minimum depth 
    1186       REAL(wp) ::   zbathydiff       ! isf temporary scalar 
    1187       REAL(wp) ::   zrisfdepdiff     ! isf temporary scalar 
    1188       REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points 
    1189       REAL(wp) ::   zdepwp           ! Ajusted ocean depth to avoid too small e3t 
    1190       REAL(wp) ::   zdiff            ! temporary scalar 
    1191       REAL(wp), POINTER, DIMENSION(:,:)   ::   zrisfdep, zbathy, zmask   ! 2D workspace (ISH) 
    1192       INTEGER , POINTER, DIMENSION(:,:)   ::   zmbathy, zmisfdep         ! 2D workspace (ISH) 
    1193       !!--------------------------------------------------------------------- 
    1194       ! 
    1195       IF( nn_timing == 1 )   CALL timing_start('zgr_isf') 
    1196       ! 
    1197       CALL wrk_alloc( jpi,jpj,   zbathy, zmask, zrisfdep) 
    1198       CALL wrk_alloc( jpi,jpj,   zmisfdep, zmbathy ) 
    1199  
    1200       ! (ISF) compute misfdep 
    1201       WHERE( risfdep(:,:) == 0._wp .AND. bathy(:,:) /= 0 ) ;   misfdep(:,:) = 1   ! open water : set misfdep to 1   
    1202       ELSEWHERE                      ;                         misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level  
    1203       END WHERE   
    1204  
    1205       ! Compute misfdep for ocean points (i.e. first wet level)  
    1206       ! find the first ocean level such that the first level thickness  
    1207       ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where  
    1208       ! e3t_0 is the reference level thickness  
    1209       DO jk = 2, jpkm1  
    1210          zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )  
    1211          WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1  
    1212       END DO  
    1213       WHERE ( 0._wp < risfdep(:,:) .AND. risfdep(:,:) <= e3t_1d(1) ) 
    1214          risfdep(:,:) = 0. ; misfdep(:,:) = 1 
    1215       END WHERE 
    1216  
    1217       ! remove very shallow ice shelf (less than ~ 10m if 75L) 
    1218       WHERE (risfdep(:,:) <= 10._wp .AND. misfdep(:,:) > 1) 
    1219          misfdep = 0; risfdep = 0.0_wp; 
    1220          mbathy  = 0; bathy   = 0.0_wp; 
    1221       END WHERE 
    1222       WHERE (bathy(:,:) <= 30.0_wp .AND. gphit < -60._wp) 
    1223          misfdep = 0; risfdep = 0.0_wp; 
    1224          mbathy  = 0; bathy   = 0.0_wp; 
    1225       END WHERE 
    1226   
    1227 ! basic check for the compatibility of bathy and risfdep. I think it should be offline because it is not perfect and cannot solved all the situation 
    1228       icompt = 0  
    1229 ! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together 
    1230       DO jl = 1, 10      
    1231          ! check at each iteration if isf is grounded or not (1cm treshold have to be update after first coupling experiments) 
    1232          WHERE (bathy(:,:) <= risfdep(:,:) + rn_isfhmin) 
    1233             misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 
    1234             mbathy (:,:) = 0 ; bathy  (:,:) = 0._wp 
    1235          END WHERE 
    1236          WHERE (mbathy(:,:) <= 0)  
    1237             misfdep(:,:) = 0; risfdep(:,:) = 0._wp  
    1238             mbathy (:,:) = 0; bathy  (:,:) = 0._wp 
    1239          END WHERE 
    1240          IF( lk_mpp ) THEN 
    1241             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1242             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1243             misfdep(:,:) = INT( zbathy(:,:) ) 
    1244  
    1245             CALL lbc_lnk( risfdep,'T', 1. ) 
    1246             CALL lbc_lnk( bathy,  'T', 1. ) 
    1247  
    1248             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1249             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1250             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1251          ENDIF 
    1252          IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN  
    1253             misfdep( 1 ,:) = misfdep(jpim1,:)            ! local domain is cyclic east-west  
    1254             misfdep(jpi,:) = misfdep(  2  ,:)  
    1255             mbathy( 1 ,:)  = mbathy(jpim1,:)             ! local domain is cyclic east-west 
    1256             mbathy(jpi,:)  = mbathy(  2  ,:) 
    1257          ENDIF 
    1258  
    1259          ! split last cell if possible (only where water column is 2 cell or less) 
    1260          ! if coupled to ice sheet, we do not modify the bathymetry (can be discuss). 
    1261          IF ( .NOT. ln_iscpl) THEN 
    1262             DO jk = jpkm1, 1, -1 
    1263                zmax = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
    1264                WHERE( gdepw_1d(jk) < bathy(:,:) .AND. bathy(:,:) <= zmax .AND. misfdep + 1 >= mbathy) 
    1265                   mbathy(:,:) = jk 
    1266                   bathy(:,:)  = zmax 
    1267                END WHERE 
    1268             END DO 
    1269          END IF 
    1270   
    1271          ! split top cell if possible (only where water column is 2 cell or less) 
    1272          DO jk = 2, jpkm1 
    1273             zmax = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
    1274             WHERE( gdepw_1d(jk+1) > risfdep(:,:) .AND. risfdep(:,:) >= zmax .AND. misfdep + 1 >= mbathy) 
    1275                misfdep(:,:) = jk 
    1276                risfdep(:,:) = zmax 
    1277             END WHERE 
    1278          END DO 
    1279  
    1280   
    1281  ! Case where bathy and risfdep compatible but not the level variable mbathy/misfdep because of partial cell condition 
    1282          DO jj = 1, jpj 
    1283             DO ji = 1, jpi 
    1284                ! find the minimum change option: 
    1285                ! test bathy 
    1286                IF (risfdep(ji,jj) > 1) THEN 
    1287                   IF ( .NOT. ln_iscpl ) THEN 
    1288                      zbathydiff  =ABS(bathy(ji,jj)   - (gdepw_1d(mbathy (ji,jj)+1) & 
    1289                          &            + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
    1290                      zrisfdepdiff=ABS(risfdep(ji,jj) - (gdepw_1d(misfdep(ji,jj)  ) & 
    1291                          &            - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    1292                      IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN 
    1293                         IF (zbathydiff <= zrisfdepdiff) THEN 
    1294                            bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat ) 
    1295                            mbathy(ji,jj)= mbathy(ji,jj) + 1 
    1296                         ELSE 
    1297                            risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 
    1298                            misfdep(ji,jj) = misfdep(ji,jj) - 1 
    1299                         END IF 
    1300                      ENDIF 
    1301                   ELSE 
    1302                      IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) <  misfdep(ji,jj)) THEN 
    1303                         risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ) 
    1304                         misfdep(ji,jj) = misfdep(ji,jj) - 1 
    1305                      END IF 
    1306                   END IF 
    1307                END IF 
    1308             END DO 
    1309          END DO 
    1310   
    1311          ! At least 2 levels for water thickness at T, U, and V point. 
    1312          DO jj = 1, jpj 
    1313             DO ji = 1, jpi 
    1314                ! find the minimum change option: 
    1315                ! test bathy 
    1316                IF( misfdep(ji,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
    1317                   IF ( .NOT. ln_iscpl ) THEN  
    1318                      zbathydiff  =ABS(bathy(ji,jj)   - ( gdepw_1d(mbathy (ji,jj)+1) & 
    1319                          &                             + MIN( e3zps_min,e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) 
    1320                      zrisfdepdiff=ABS(risfdep(ji,jj) - ( gdepw_1d(misfdep(ji,jj)  ) &  
    1321                          &                             - MIN( e3zps_min,e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 
    1322                      IF (zbathydiff <= zrisfdepdiff) THEN 
    1323                         mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1324                         bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
    1325                      ELSE 
    1326                         misfdep(ji,jj)= misfdep(ji,jj) - 1 
    1327                         risfdep(ji,jj) = gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat ) 
    1328                      END IF 
    1329                   ELSE 
    1330                      misfdep(ji,jj)= misfdep(ji,jj) - 1 
    1331                      risfdep(ji,jj)= gdepw_1d(misfdep(ji,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj))*e3zps_rat ) 
    1332                   END IF 
    1333                ENDIF 
    1334             END DO 
    1335          END DO 
    1336   
    1337  ! point V mbathy(ji,jj) == misfdep(ji,jj+1)  
    1338          DO jj = 1, jpjm1 
    1339             DO ji = 1, jpim1 
    1340                IF( misfdep(ji,jj+1) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
    1341                   IF ( .NOT. ln_iscpl ) THEN  
    1342                      zbathydiff  =ABS(bathy(ji,jj    ) - ( gdepw_1d(mbathy (ji,jj)+1) & 
    1343                           &                              + MIN( e3zps_min, e3t_1d(mbathy (ji,jj  )+1)*e3zps_rat ))) 
    1344                      zrisfdepdiff=ABS(risfdep(ji,jj+1) - ( gdepw_1d(misfdep(ji,jj+1)) & 
    1345                           &                              - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1)-1)*e3zps_rat ))) 
    1346                      IF (zbathydiff <= zrisfdepdiff) THEN 
    1347                         mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1348                         bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj  )) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj   )+1)*e3zps_rat ) 
    1349                      ELSE 
    1350                         misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1 
    1351                         risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
    1352                      END IF 
    1353                   ELSE 
    1354                      misfdep(ji,jj+1)  = misfdep(ji,jj+1) - 1 
    1355                      risfdep (ji,jj+1) = gdepw_1d(misfdep(ji,jj+1)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj+1))*e3zps_rat ) 
    1356                   END IF 
    1357                ENDIF 
    1358             END DO 
    1359          END DO 
    1360   
    1361          IF( lk_mpp ) THEN 
    1362             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1363             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1364             misfdep(:,:) = INT( zbathy(:,:) ) 
    1365  
    1366             CALL lbc_lnk( risfdep,'T', 1. ) 
    1367             CALL lbc_lnk( bathy,  'T', 1. ) 
    1368  
    1369             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1370             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1371             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1372          ENDIF 
    1373  ! point V misdep(ji,jj) == mbathy(ji,jj+1)  
    1374          DO jj = 1, jpjm1 
    1375             DO ji = 1, jpim1 
    1376                IF( misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) > 1) THEN 
    1377                   IF ( .NOT. ln_iscpl ) THEN  
    1378                      zbathydiff  =ABS(  bathy(ji,jj+1) - ( gdepw_1d(mbathy (ji,jj+1)+1) & 
    1379                            &                             + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ))) 
    1380                      zrisfdepdiff=ABS(risfdep(ji,jj  ) - ( gdepw_1d(misfdep(ji,jj  )  ) & 
    1381                            &                             - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )-1)*e3zps_rat ))) 
    1382                      IF (zbathydiff <= zrisfdepdiff) THEN 
    1383                         mbathy (ji,jj+1) = mbathy(ji,jj+1) + 1 
    1384                         bathy  (ji,jj+1) = gdepw_1d(mbathy (ji,jj+1)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji,jj+1)+1)*e3zps_rat ) 
    1385                      ELSE 
    1386                         misfdep(ji,jj)   = misfdep(ji,jj) - 1 
    1387                         risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat ) 
    1388                      END IF 
    1389                   ELSE 
    1390                      misfdep(ji,jj)   = misfdep(ji,jj) - 1 
    1391                      risfdep(ji,jj)   = gdepw_1d(misfdep(ji,jj  )+1) - MIN( e3zps_min, e3t_1d(misfdep(ji,jj  )  )*e3zps_rat ) 
    1392                   END IF 
    1393                ENDIF 
    1394             END DO 
    1395          END DO 
    1396   
    1397   
    1398          IF( lk_mpp ) THEN  
    1399             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1400             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1401             misfdep(:,:) = INT( zbathy(:,:) ) 
    1402  
    1403             CALL lbc_lnk( risfdep,'T', 1. ) 
    1404             CALL lbc_lnk( bathy,  'T', 1. ) 
    1405  
    1406             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1407             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1408             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1409          ENDIF  
    1410   
    1411  ! point U mbathy(ji,jj) == misfdep(ji,jj+1)  
    1412          DO jj = 1, jpjm1 
    1413             DO ji = 1, jpim1 
    1414                IF( misfdep(ji+1,jj) == mbathy(ji,jj) .AND. mbathy(ji,jj) > 1) THEN 
    1415                   IF ( .NOT. ln_iscpl ) THEN  
    1416                   zbathydiff  =ABS(  bathy(ji  ,jj) - ( gdepw_1d(mbathy (ji,jj)+1) & 
    1417                        &                              + MIN( e3zps_min, e3t_1d(mbathy (ji  ,jj)+1)*e3zps_rat ))) 
    1418                   zrisfdepdiff=ABS(risfdep(ji+1,jj) - ( gdepw_1d(misfdep(ji+1,jj)) & 
    1419                        &                              - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj)-1)*e3zps_rat ))) 
    1420                   IF (zbathydiff <= zrisfdepdiff) THEN 
    1421                      mbathy(ji,jj) = mbathy(ji,jj) + 1 
    1422                      bathy(ji,jj)  = gdepw_1d(mbathy (ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj) +1)*e3zps_rat ) 
    1423                   ELSE 
    1424                      misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1 
    1425                      risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat ) 
    1426                   END IF 
    1427                   ELSE 
    1428                      misfdep(ji+1,jj)= misfdep(ji+1,jj) - 1 
    1429                      risfdep(ji+1,jj) = gdepw_1d(misfdep(ji+1,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji+1,jj))*e3zps_rat ) 
    1430                   ENDIF 
    1431                ENDIF 
    1432             ENDDO 
    1433          ENDDO 
    1434   
    1435          IF( lk_mpp ) THEN  
    1436             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1437             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1438             misfdep(:,:) = INT( zbathy(:,:) ) 
    1439  
    1440             CALL lbc_lnk( risfdep,'T', 1. ) 
    1441             CALL lbc_lnk( bathy,  'T', 1. ) 
    1442  
    1443             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1444             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1445             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1446          ENDIF  
    1447   
    1448  ! point U misfdep(ji,jj) == bathy(ji,jj+1)  
    1449          DO jj = 1, jpjm1 
    1450             DO ji = 1, jpim1 
    1451                IF( misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) > 1) THEN 
    1452                   IF ( .NOT. ln_iscpl ) THEN  
    1453                      zbathydiff  =ABS(  bathy(ji+1,jj) - ( gdepw_1d(mbathy (ji+1,jj)+1) & 
    1454                           &                              + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj)+1)*e3zps_rat ))) 
    1455                      zrisfdepdiff=ABS(risfdep(ji  ,jj) - ( gdepw_1d(misfdep(ji  ,jj)  ) & 
    1456                           &                              - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)-1)*e3zps_rat ))) 
    1457                      IF (zbathydiff <= zrisfdepdiff) THEN 
    1458                         mbathy(ji+1,jj)  = mbathy (ji+1,jj) + 1 
    1459                         bathy (ji+1,jj)  = gdepw_1d(mbathy (ji+1,jj)  ) + MIN( e3zps_min, e3t_1d(mbathy (ji+1,jj) +1)*e3zps_rat ) 
    1460                      ELSE 
    1461                         misfdep(ji,jj)   = misfdep(ji  ,jj) - 1 
    1462                         risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
    1463                      END IF 
    1464                   ELSE 
    1465                      misfdep(ji,jj)   = misfdep(ji  ,jj) - 1 
    1466                      risfdep(ji,jj)   = gdepw_1d(misfdep(ji  ,jj)+1) - MIN( e3zps_min, e3t_1d(misfdep(ji  ,jj)   )*e3zps_rat ) 
    1467                   ENDIF 
    1468                ENDIF 
    1469             ENDDO 
    1470          ENDDO 
    1471   
    1472          IF( lk_mpp ) THEN 
    1473             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1474             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1475             misfdep(:,:) = INT( zbathy(:,:) ) 
    1476  
    1477             CALL lbc_lnk( risfdep,'T', 1. ) 
    1478             CALL lbc_lnk( bathy,  'T', 1. ) 
    1479  
    1480             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1481             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1482             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1483          ENDIF 
    1484       END DO 
    1485       ! end dig bathy/ice shelf to be compatible 
    1486       ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness 
    1487       DO jl = 1,20 
    1488   
    1489  ! remove single point "bay" on isf coast line in the ice shelf draft' 
    1490          DO jk = 2, jpk 
    1491             WHERE (misfdep==0) misfdep=jpk 
    1492             zmask=0._wp 
    1493             WHERE (misfdep <= jk) zmask=1 
    1494             DO jj = 2, jpjm1 
    1495                DO ji = 2, jpim1 
    1496                   IF (misfdep(ji,jj) == jk) THEN 
    1497                      ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
    1498                      IF (ibtest <= 1) THEN 
    1499                         risfdep(ji,jj)=gdepw_1d(jk+1) ; misfdep(ji,jj)=jk+1 
    1500                         IF (misfdep(ji,jj) > mbathy(ji,jj)) misfdep(ji,jj) = jpk 
    1501                      END IF 
    1502                   END IF 
    1503                END DO 
    1504             END DO 
    1505          END DO 
    1506          WHERE (misfdep==jpk) 
    1507              misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 
    1508          END WHERE 
    1509          IF( lk_mpp ) THEN 
    1510             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1511             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1512             misfdep(:,:) = INT( zbathy(:,:) ) 
    1513  
    1514             CALL lbc_lnk( risfdep,'T', 1. ) 
    1515             CALL lbc_lnk( bathy,  'T', 1. ) 
    1516  
    1517             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1518             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1519             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1520          ENDIF 
    1521   
    1522  ! remove single point "bay" on bathy coast line beneath an ice shelf' 
    1523          DO jk = jpk,1,-1 
    1524             zmask=0._wp 
    1525             WHERE (mbathy >= jk ) zmask=1 
    1526             DO jj = 2, jpjm1 
    1527                DO ji = 2, jpim1 
    1528                   IF (mbathy(ji,jj) == jk .AND. misfdep(ji,jj) >= 2) THEN 
    1529                      ibtest = zmask(ji-1,jj) + zmask(ji+1,jj) + zmask(ji,jj-1) + zmask(ji,jj+1) 
    1530                      IF (ibtest <= 1) THEN 
    1531                         bathy(ji,jj)=gdepw_1d(jk) ; mbathy(ji,jj)=jk-1 
    1532                         IF (misfdep(ji,jj) > mbathy(ji,jj)) mbathy(ji,jj) = 0 
    1533                      END IF 
    1534                   END IF 
    1535                END DO 
    1536             END DO 
    1537          END DO 
    1538          WHERE (mbathy==0) 
    1539              misfdep=0 ; risfdep=0._wp ; mbathy=0 ; bathy=0._wp 
    1540          END WHERE 
    1541          IF( lk_mpp ) THEN 
    1542             zbathy(:,:)  = FLOAT( misfdep(:,:) ) 
    1543             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1544             misfdep(:,:) = INT( zbathy(:,:) ) 
    1545  
    1546             CALL lbc_lnk( risfdep,'T', 1. ) 
    1547             CALL lbc_lnk( bathy,  'T', 1. ) 
    1548  
    1549             zbathy(:,:)  = FLOAT( mbathy(:,:) ) 
    1550             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1551             mbathy(:,:)  = INT( zbathy(:,:) ) 
    1552          ENDIF 
    1553   
    1554  ! fill hole in ice shelf 
    1555          zmisfdep = misfdep 
    1556          zrisfdep = risfdep 
    1557          WHERE (zmisfdep <= 1._wp) zmisfdep=jpk 
    1558          DO jj = 2, jpjm1 
    1559             DO ji = 2, jpim1 
    1560                ibtestim1 = zmisfdep(ji-1,jj  ) ; ibtestip1 = zmisfdep(ji+1,jj  ) 
    1561                ibtestjm1 = zmisfdep(ji  ,jj-1) ; ibtestjp1 = zmisfdep(ji  ,jj+1) 
    1562                IF( zmisfdep(ji,jj) >= mbathy(ji-1,jj  ) ) ibtestim1 = jpk 
    1563                IF( zmisfdep(ji,jj) >= mbathy(ji+1,jj  ) ) ibtestip1 = jpk 
    1564                IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj-1) ) ibtestjm1 = jpk 
    1565                IF( zmisfdep(ji,jj) >= mbathy(ji  ,jj+1) ) ibtestjp1 = jpk 
    1566                ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1567                IF( ibtest == jpk .AND. misfdep(ji,jj) >= 2) THEN 
    1568                   mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp 
    1569                END IF 
    1570                IF( zmisfdep(ji,jj) < ibtest .AND. misfdep(ji,jj) >= 2) THEN 
    1571                   misfdep(ji,jj) = ibtest 
    1572                   risfdep(ji,jj) = gdepw_1d(ibtest) 
    1573                ENDIF 
    1574             ENDDO 
    1575          ENDDO 
    1576   
    1577          IF( lk_mpp ) THEN  
    1578             zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    1579             CALL lbc_lnk( zbathy,  'T', 1. )  
    1580             misfdep(:,:) = INT( zbathy(:,:) )  
    1581  
    1582             CALL lbc_lnk( risfdep, 'T', 1. )  
    1583             CALL lbc_lnk( bathy,   'T', 1. ) 
    1584  
    1585             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1586             CALL lbc_lnk( zbathy,  'T', 1. ) 
    1587             mbathy(:,:) = INT( zbathy(:,:) ) 
    1588          ENDIF  
    1589  ! 
    1590  !! fill hole in bathymetry 
    1591          zmbathy (:,:)=mbathy (:,:) 
    1592          DO jj = 2, jpjm1 
    1593             DO ji = 2, jpim1 
    1594                ibtestim1 = zmbathy(ji-1,jj  ) ; ibtestip1 = zmbathy(ji+1,jj  ) 
    1595                ibtestjm1 = zmbathy(ji  ,jj-1) ; ibtestjp1 = zmbathy(ji  ,jj+1) 
    1596                IF( zmbathy(ji,jj) <  misfdep(ji-1,jj  ) ) ibtestim1 = 0 
    1597                IF( zmbathy(ji,jj) <  misfdep(ji+1,jj  ) ) ibtestip1 = 0 
    1598                IF( zmbathy(ji,jj) <  misfdep(ji  ,jj-1) ) ibtestjm1 = 0 
    1599                IF( zmbathy(ji,jj) <  misfdep(ji  ,jj+1) ) ibtestjp1 = 0 
    1600                ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1) 
    1601                IF( ibtest == 0 .AND. misfdep(ji,jj) >= 2) THEN 
    1602                   mbathy(ji,jj) = 0 ; bathy(ji,jj) = 0.0_wp ; misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0.0_wp ; 
    1603                END IF 
    1604                IF( ibtest < zmbathy(ji,jj) .AND. misfdep(ji,jj) >= 2) THEN 
    1605                   mbathy(ji,jj) = ibtest 
    1606                   bathy(ji,jj)  = gdepw_1d(ibtest+1)  
    1607                ENDIF 
    1608             END DO 
    1609          END DO 
    1610          IF( lk_mpp ) THEN  
    1611             zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    1612             CALL lbc_lnk( zbathy,  'T', 1. )  
    1613             misfdep(:,:) = INT( zbathy(:,:) )  
    1614  
    1615             CALL lbc_lnk( risfdep, 'T', 1. )  
    1616             CALL lbc_lnk( bathy,   'T', 1. ) 
    1617  
    1618             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1619             CALL lbc_lnk( zbathy,  'T', 1. ) 
    1620             mbathy(:,:) = INT( zbathy(:,:) ) 
    1621          ENDIF  
    1622  ! if not compatible after all check (ie U point water column less than 2 cells), mask U 
    1623          DO jj = 1, jpjm1 
    1624             DO ji = 1, jpim1 
    1625                IF (mbathy(ji,jj) == misfdep(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 
    1626                   mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
    1627                END IF 
    1628             END DO 
    1629          END DO 
    1630          IF( lk_mpp ) THEN  
    1631             zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    1632             CALL lbc_lnk( zbathy,  'T', 1. )  
    1633             misfdep(:,:) = INT( zbathy(:,:) )  
    1634  
    1635             CALL lbc_lnk( risfdep, 'T', 1. )  
    1636             CALL lbc_lnk( bathy,   'T', 1. ) 
    1637  
    1638             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1639             CALL lbc_lnk( zbathy,  'T', 1. ) 
    1640             mbathy(:,:) = INT( zbathy(:,:) ) 
    1641          ENDIF  
    1642  ! if not compatible after all check (ie U point water column less than 2 cells), mask U 
    1643          DO jj = 1, jpjm1 
    1644             DO ji = 1, jpim1 
    1645                IF (misfdep(ji,jj) == mbathy(ji+1,jj) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji+1,jj) >= 1) THEN 
    1646                   mbathy(ji+1,jj)  = mbathy(ji+1,jj) - 1;   bathy(ji+1,jj)   = gdepw_1d(mbathy(ji+1,jj)+1) ; 
    1647                END IF 
    1648             END DO 
    1649          END DO 
    1650          IF( lk_mpp ) THEN  
    1651             zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    1652             CALL lbc_lnk( zbathy, 'T', 1. )  
    1653             misfdep(:,:) = INT( zbathy(:,:) )  
    1654  
    1655             CALL lbc_lnk( risfdep,'T', 1. )  
    1656             CALL lbc_lnk( bathy,  'T', 1. ) 
    1657  
    1658             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1659             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1660             mbathy(:,:) = INT( zbathy(:,:) ) 
    1661          ENDIF  
    1662  ! if not compatible after all check (ie V point water column less than 2 cells), mask V 
    1663          DO jj = 1, jpjm1 
    1664             DO ji = 1, jpi 
    1665                IF (mbathy(ji,jj) == misfdep(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 
    1666                   mbathy(ji,jj)  = mbathy(ji,jj) - 1 ; bathy(ji,jj)   = gdepw_1d(mbathy(ji,jj)+1) ; 
    1667                END IF 
    1668             END DO 
    1669          END DO 
    1670          IF( lk_mpp ) THEN  
    1671             zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    1672             CALL lbc_lnk( zbathy, 'T', 1. )  
    1673             misfdep(:,:) = INT( zbathy(:,:) )  
    1674  
    1675             CALL lbc_lnk( risfdep,'T', 1. )  
    1676             CALL lbc_lnk( bathy,  'T', 1. ) 
    1677  
    1678             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1679             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1680             mbathy(:,:) = INT( zbathy(:,:) ) 
    1681          ENDIF  
    1682  ! if not compatible after all check (ie V point water column less than 2 cells), mask V 
    1683          DO jj = 1, jpjm1 
    1684             DO ji = 1, jpi 
    1685                IF (misfdep(ji,jj) == mbathy(ji,jj+1) .AND. mbathy(ji,jj) >= 1 .AND. mbathy(ji,jj+1) >= 1) THEN 
    1686                   mbathy(ji,jj+1)  = mbathy(ji,jj+1) - 1 ; bathy(ji,jj+1) = gdepw_1d(mbathy(ji,jj+1)+1) ; 
    1687                END IF 
    1688             END DO 
    1689          END DO 
    1690          IF( lk_mpp ) THEN  
    1691             zbathy(:,:)  = FLOAT( misfdep(:,:) )  
    1692             CALL lbc_lnk( zbathy, 'T', 1. )  
    1693             misfdep(:,:) = INT( zbathy(:,:) )  
    1694  
    1695             CALL lbc_lnk( risfdep,'T', 1. )  
    1696             CALL lbc_lnk( bathy,  'T', 1. ) 
    1697  
    1698             zbathy(:,:) = FLOAT( mbathy(:,:) ) 
    1699             CALL lbc_lnk( zbathy, 'T', 1. ) 
    1700             mbathy(:,:) = INT( zbathy(:,:) ) 
    1701          ENDIF  
    1702  ! if not compatible after all check, mask T 
    1703          DO jj = 1, jpj 
    1704             DO ji = 1, jpi 
    1705                IF (mbathy(ji,jj) <= misfdep(ji,jj)) THEN 
    1706                   misfdep(ji,jj) = 0 ; risfdep(ji,jj) = 0._wp ; mbathy(ji,jj)  = 0 ; bathy(ji,jj)   = 0._wp ; 
    1707                END IF 
    1708             END DO 
    1709          END DO 
    1710   
    1711          WHERE (mbathy(:,:) == 1) 
    1712             mbathy = 0; bathy = 0.0_wp ; misfdep = 0 ; risfdep = 0.0_wp 
    1713          END WHERE 
    1714       END DO  
    1715 ! end check compatibility ice shelf/bathy 
    1716       ! remove very shallow ice shelf (less than ~ 10m if 75L) 
    1717       WHERE (risfdep(:,:) <= 10._wp) 
    1718          misfdep = 1; risfdep = 0.0_wp; 
    1719       END WHERE 
    1720  
    1721       IF( icompt == 0 ) THEN  
    1722          IF(lwp) WRITE(numout,*)'     no points with ice shelf too close to bathymetry'  
    1723       ELSE  
    1724          IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points with ice shelf thickness reduced to avoid bathymetry'  
    1725       ENDIF  
    1726  
    1727       ! compute scale factor and depth at T- and W- points 
    1728       DO jj = 1, jpj 
    1729          DO ji = 1, jpi 
    1730             ik = mbathy(ji,jj) 
    1731             IF( ik > 0 ) THEN               ! ocean point only 
    1732                ! max ocean level case 
    1733                IF( ik == jpkm1 ) THEN 
    1734                   zdepwp = bathy(ji,jj) 
    1735                   ze3tp  = bathy(ji,jj) - gdepw_1d(ik) 
    1736                   ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) ) 
    1737                   e3t_0(ji,jj,ik  ) = ze3tp 
    1738                   e3t_0(ji,jj,ik+1) = ze3tp 
    1739                   e3w_0(ji,jj,ik  ) = ze3wp 
    1740                   e3w_0(ji,jj,ik+1) = ze3tp 
    1741                   gdepw_0(ji,jj,ik+1) = zdepwp 
    1742                   gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp 
    1743                   gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp 
    1744                   ! 
    1745                ELSE                         ! standard case 
    1746                   IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj) 
    1747                   ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
    1748                   ENDIF 
    1749       !            gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1) 
    1750 !gm Bug?  check the gdepw_1d 
    1751                   !       ... on ik 
    1752                   gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   & 
    1753                      &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   & 
    1754                      &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) )) 
    1755                   e3t_0  (ji,jj,ik  ) = gdepw_0(ji,jj,ik+1) - gdepw_1d(ik  ) 
    1756                   e3w_0  (ji,jj,ik  ) = gdept_0(ji,jj,ik  ) - gdept_1d(ik-1) 
    1757                   !       ... on ik+1 
    1758                   e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1759                   e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik) 
    1760                ENDIF 
    1761             ENDIF 
    1762          END DO 
    1763       END DO 
    1764       ! 
    1765       it = 0 
    1766       DO jj = 1, jpj 
    1767          DO ji = 1, jpi 
    1768             ik = mbathy(ji,jj) 
    1769             IF( ik > 0 ) THEN               ! ocean point only 
    1770                e3tp (ji,jj) = e3t_0(ji,jj,ik) 
    1771                e3wp (ji,jj) = e3w_0(ji,jj,ik) 
    1772                ! test 
    1773                zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  ) 
    1774                IF( zdiff <= 0._wp .AND. lwp ) THEN  
    1775                   it = it + 1 
    1776                   WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj 
    1777                   WRITE(numout,*) ' bathy = ', bathy(ji,jj) 
    1778                   WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff 
    1779                   WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  ) 
    1780                ENDIF 
    1781             ENDIF 
    1782          END DO 
    1783       END DO 
    1784       ! 
    1785       ! (ISF) Definition of e3t, u, v, w for ISF case 
    1786       DO jj = 1, jpj  
    1787          DO ji = 1, jpi  
    1788             ik = misfdep(ji,jj)  
    1789             IF( ik > 1 ) THEN               ! ice shelf point only  
    1790                IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)  
    1791                gdepw_0(ji,jj,ik) = risfdep(ji,jj)  
    1792 !gm Bug?  check the gdepw_0  
    1793             !       ... on ik  
    1794                gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &  
    1795                   &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &  
    1796                   &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )  
    1797                e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)  
    1798                e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik) 
    1799  
    1800                IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column)  
    1801                   e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)  
    1802                ENDIF  
    1803             !       ... on ik / ik-1  
    1804                e3w_0  (ji,jj,ik  ) = e3t_0  (ji,jj,ik) !2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik))  
    1805                e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1) 
    1806 ! The next line isn't required and doesn't affect results - included for consistency with bathymetry code  
    1807                gdept_0(ji,jj,ik-1) = gdept_1d(ik-1) 
    1808             ENDIF  
    1809          END DO  
    1810       END DO  
    1811     
    1812       it = 0  
    1813       DO jj = 1, jpj  
    1814          DO ji = 1, jpi  
    1815             ik = misfdep(ji,jj)  
    1816             IF( ik > 1 ) THEN               ! ice shelf point only  
    1817                e3tp (ji,jj) = e3t_0(ji,jj,ik  )  
    1818                e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )  
    1819             ! test  
    1820                zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )  
    1821                IF( zdiff <= 0. .AND. lwp ) THEN   
    1822                   it = it + 1  
    1823                   WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj  
    1824                   WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)  
    1825                   WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff  
    1826                   WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)  
    1827                ENDIF  
    1828             ENDIF  
    1829          END DO  
    1830       END DO  
    1831  
    1832       CALL wrk_dealloc( jpi, jpj, zmask, zbathy, zrisfdep ) 
    1833       CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 
    1834       ! 
    1835       IF( nn_timing == 1 )   CALL timing_stop('zgr_isf') 
    1836       !       
    1837    END SUBROUTINE zgr_isf 
    1838  
    1839  
    1840    SUBROUTINE zgr_sco 
    1841       !!---------------------------------------------------------------------- 
    1842       !!                  ***  ROUTINE zgr_sco  *** 
    1843       !!                      
    1844       !! ** Purpose :   define the s-coordinate system 
    1845       !! 
    1846       !! ** Method  :   s-coordinate 
    1847       !!         The depth of model levels is defined as the product of an 
    1848       !!      analytical function by the local bathymetry, while the vertical 
    1849       !!      scale factors are defined as the product of the first derivative 
    1850       !!      of the analytical function by the bathymetry. 
    1851       !!      (this solution save memory as depth and scale factors are not 
    1852       !!      3d fields) 
    1853       !!          - Read bathymetry (in meters) at t-point and compute the 
    1854       !!         bathymetry at u-, v-, and f-points. 
    1855       !!            hbatu = mi( hbatt ) 
    1856       !!            hbatv = mj( hbatt ) 
    1857       !!            hbatf = mi( mj( hbatt ) ) 
    1858       !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical 
    1859       !!         function and its derivative given as function. 
    1860       !!            z_gsigt(k) = fssig (k    ) 
    1861       !!            z_gsigw(k) = fssig (k-0.5) 
    1862       !!            z_esigt(k) = fsdsig(k    ) 
    1863       !!            z_esigw(k) = fsdsig(k-0.5) 
    1864       !!      Three options for stretching are give, and they can be modified 
    1865       !!      following the users requirements. Nevertheless, the output as 
    1866       !!      well as the way to compute the model levels and scale factors 
    1867       !!      must be respected in order to insure second order accuracy 
    1868       !!      schemes. 
    1869       !! 
    1870       !!      The three methods for stretching available are: 
    1871       !!  
    1872       !!           s_sh94 (Song and Haidvogel 1994) 
    1873       !!                a sinh/tanh function that allows sigma and stretched sigma 
    1874       !! 
    1875       !!           s_sf12 (Siddorn and Furner 2012?) 
    1876       !!                allows the maintenance of fixed surface and or 
    1877       !!                bottom cell resolutions (cf. geopotential coordinates)  
    1878       !!                within an analytically derived stretched S-coordinate framework. 
    1879       !!  
    1880       !!          s_tanh  (Madec et al 1996) 
    1881       !!                a cosh/tanh function that gives stretched coordinates         
    1882       !! 
    1883       !!---------------------------------------------------------------------- 
    1884       INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    1885       INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
    1886       INTEGER  ::   ios                      ! Local integer output status for namelist read 
    1887       REAL(wp) ::   zrmax, ztaper   ! temporary scalars 
    1888       REAL(wp) ::   zrfact 
    1889       ! 
    1890       REAL(wp), POINTER, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2 
    1891       REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat 
    1892       !! 
    1893       NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, & 
    1894          &                rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b 
    1895      !!---------------------------------------------------------------------- 
    1896       ! 
    1897       IF( nn_timing == 1 )  CALL timing_start('zgr_sco') 
    1898       ! 
    1899       CALL wrk_alloc( jpi,jpj,   zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
    1900       ! 
    1901       REWIND( numnam_ref )              ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters 
    1902       READ  ( numnam_ref, namzgr_sco, IOSTAT = ios, ERR = 901) 
    1903 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in reference namelist', lwp ) 
    1904  
    1905       REWIND( numnam_cfg )              ! Namelist namzgr_sco in configuration namelist : Sigma-stretching parameters 
    1906       READ  ( numnam_cfg, namzgr_sco, IOSTAT = ios, ERR = 902 ) 
    1907 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in configuration namelist', lwp ) 
    1908       IF(lwm) WRITE ( numond, namzgr_sco ) 
    1909  
    1910       IF(lwp) THEN                           ! control print 
    1911          WRITE(numout,*) 
    1912          WRITE(numout,*) 'domzgr_sco : s-coordinate or hybrid z-s-coordinate' 
    1913          WRITE(numout,*) '~~~~~~~~~~~' 
    1914          WRITE(numout,*) '   Namelist namzgr_sco' 
    1915          WRITE(numout,*) '     stretching coeffs ' 
    1916          WRITE(numout,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max 
    1917          WRITE(numout,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min 
    1918          WRITE(numout,*) '        Critical depth                               rn_hc         = ',rn_hc 
    1919          WRITE(numout,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax 
    1920          WRITE(numout,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94 
    1921          WRITE(numout,*) '        Song and Haidvogel 1994 stretching coefficients' 
    1922          WRITE(numout,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta 
    1923          WRITE(numout,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb 
    1924          WRITE(numout,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb 
    1925          WRITE(numout,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12 
    1926          WRITE(numout,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit 
    1927          WRITE(numout,*) '        Siddorn and Furner 2012 stretching coefficients' 
    1928          WRITE(numout,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha 
    1929          WRITE(numout,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold 
    1930          WRITE(numout,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs 
    1931          WRITE(numout,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a 
    1932          WRITE(numout,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b 
    1933          WRITE(numout,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b' 
    1934       ENDIF 
    1935  
    1936       hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate 
    1937       hifu(:,:) = rn_sbot_min 
    1938       hifv(:,:) = rn_sbot_min 
    1939       hiff(:,:) = rn_sbot_min 
    1940  
    1941       !                                        ! set maximum ocean depth 
    1942       bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) ) 
    1943  
    1944       IF( .NOT.ln_wd ) THEN                       
    1945          DO jj = 1, jpj 
    1946             DO ji = 1, jpi 
    1947               IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    1948             END DO 
    1949          END DO 
    1950       END IF 
    1951       !                                        ! ============================= 
    1952       !                                        ! Define the envelop bathymetry   (hbatt) 
    1953       !                                        ! ============================= 
    1954       ! use r-value to create hybrid coordinates 
    1955       zenv(:,:) = bathy(:,:) 
    1956       ! 
    1957       IF( .NOT.ln_wd ) THEN     
    1958       ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing 
    1959          DO jj = 1, jpj 
    1960             DO ji = 1, jpi 
    1961                IF( bathy(ji,jj) == 0._wp ) THEN 
    1962                   iip1 = MIN( ji+1, jpi ) 
    1963                   ijp1 = MIN( jj+1, jpj ) 
    1964                   iim1 = MAX( ji-1, 1 ) 
    1965                   ijm1 = MAX( jj-1, 1 ) 
    1966 !!gm BUG fix see ticket #1617 
    1967                   IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1)              & 
    1968                      &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )              & 
    1969                      &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) & 
    1970                      &    zenv(ji,jj) = rn_sbot_min 
    1971 !!gm 
    1972 !!gm               IF( ( bathy(iip1,jj  ) + bathy(iim1,jj  ) + bathy(ji,ijp1  ) + bathy(ji,ijm1) +         & 
    1973 !!gm                  &  bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN 
    1974 !!gm               zenv(ji,jj) = rn_sbot_min 
    1975 !!gm             ENDIF 
    1976 !!gm end 
    1977               ENDIF 
    1978             END DO 
    1979          END DO 
    1980       END IF 
    1981  
    1982       ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero 
    1983       CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' ) 
    1984       !  
    1985       ! smooth the bathymetry (if required) 
    1986       scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea) 
    1987       scobot(:,:) = bathy(:,:)        ! ocean bottom  depth 
    1988       ! 
    1989       jl = 0 
    1990       zrmax = 1._wp 
    1991       !    
    1992       !      
    1993       ! set scaling factor used in reducing vertical gradients 
    1994       zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax ) 
    1995       ! 
    1996       ! initialise temporary evelope depth arrays 
    1997       ztmpi1(:,:) = zenv(:,:) 
    1998       ztmpi2(:,:) = zenv(:,:) 
    1999       ztmpj1(:,:) = zenv(:,:) 
    2000       ztmpj2(:,:) = zenv(:,:) 
    2001       ! 
    2002       ! initialise temporary r-value arrays 
    2003       zri(:,:) = 1._wp 
    2004       zrj(:,:) = 1._wp 
    2005       !                                                            ! ================ ! 
    2006       DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) !  Iterative loop  ! 
    2007          !                                                         ! ================ ! 
    2008          jl = jl + 1 
    2009          zrmax = 0._wp 
    2010          ! we set zrmax from previous r-values (zri and zrj) first 
    2011          ! if set after current r-value calculation (as previously) 
    2012          ! we could exit DO WHILE prematurely before checking r-value 
    2013          ! of current zenv 
    2014          DO jj = 1, nlcj 
    2015             DO ji = 1, nlci 
    2016                zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) ) 
    2017             END DO 
    2018          END DO 
    2019          zri(:,:) = 0._wp 
    2020          zrj(:,:) = 0._wp 
    2021          DO jj = 1, nlcj 
    2022             DO ji = 1, nlci 
    2023                iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi) 
    2024                ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj) 
    2025                IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN 
    2026                   zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) ) 
    2027                END IF 
    2028                IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN 
    2029                   zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) ) 
    2030                END IF 
    2031                IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact 
    2032                IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact 
    2033                IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact 
    2034                IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact 
    2035             END DO 
    2036          END DO 
    2037          IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain 
    2038          ! 
    2039          IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax 
    2040          ! 
    2041          DO jj = 1, nlcj 
    2042             DO ji = 1, nlci 
    2043                zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) ) 
    2044             END DO 
    2045          END DO 
    2046          ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero 
    2047          CALL lbc_lnk( zenv, 'T', 1._wp, 'no0' ) 
    2048          !                                                  ! ================ ! 
    2049       END DO                                                !     End loop     ! 
    2050       !                                                     ! ================ ! 
    2051       DO jj = 1, jpj 
    2052          DO ji = 1, jpi 
    2053             zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings 
    2054          END DO 
    2055       END DO 
    2056       ! 
    2057       ! Envelope bathymetry saved in hbatt 
    2058       hbatt(:,:) = zenv(:,:)  
    2059       IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN 
    2060          CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' ) 
    2061          DO jj = 1, jpj 
    2062             DO ji = 1, jpi 
    2063                ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp ) 
    2064                hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 
    2065             END DO 
    2066          END DO 
    2067       ENDIF 
    2068       ! 
    2069       !                                        ! ============================== 
    2070       !                                        !   hbatu, hbatv, hbatf fields 
    2071       !                                        ! ============================== 
    2072       IF(lwp) THEN 
    2073          WRITE(numout,*) 
    2074          IF( .NOT.ln_wd ) THEN 
    2075            WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min 
    2076          ELSE 
    2077            WRITE(numout,*) ' zgr_sco: minimum positive depth of the envelop topography set to : ', rn_sbot_min 
    2078            WRITE(numout,*) ' zgr_sco: minimum negative depth of the envelop topography set to : ', -rn_wdld 
    2079          ENDIF 
    2080       ENDIF 
    2081       hbatu(:,:) = rn_sbot_min 
    2082       hbatv(:,:) = rn_sbot_min 
    2083       hbatf(:,:) = rn_sbot_min 
    2084       DO jj = 1, jpjm1 
    2085         DO ji = 1, jpim1   ! NO vector opt. 
    2086            hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) ) 
    2087            hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) ) 
    2088            hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   & 
    2089               &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) ) 
    2090         END DO 
    2091       END DO 
    2092  
    2093       IF( ln_wd ) THEN               !avoid the zero depth on T- (U-,V-,F-) points 
    2094         DO jj = 1, jpj 
    2095           DO ji = 1, jpi 
    2096             IF(ABS(hbatt(ji,jj)) < rn_wdmin1) & 
    2097               & hbatt(ji,jj) = SIGN(1._wp, hbatt(ji,jj)) * rn_wdmin1 
    2098             IF(ABS(hbatu(ji,jj)) < rn_wdmin1) & 
    2099               & hbatu(ji,jj) = SIGN(1._wp, hbatu(ji,jj)) * rn_wdmin1 
    2100             IF(ABS(hbatv(ji,jj)) < rn_wdmin1) & 
    2101               & hbatv(ji,jj) = SIGN(1._wp, hbatv(ji,jj)) * rn_wdmin1 
    2102             IF(ABS(hbatf(ji,jj)) < rn_wdmin1) & 
    2103               & hbatf(ji,jj) = SIGN(1._wp, hbatf(ji,jj)) * rn_wdmin1 
    2104           END DO 
    2105         END DO 
    2106       END IF 
    2107       !  
    2108       ! Apply lateral boundary condition 
    2109 !!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL 
    2110       zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1._wp ) 
    2111       DO jj = 1, jpj 
    2112          DO ji = 1, jpi 
    2113             IF( hbatu(ji,jj) == 0._wp ) THEN 
    2114                !No worries about the following line when ln_wd == .true. 
    2115                IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min 
    2116                IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj) 
    2117             ENDIF 
    2118          END DO 
    2119       END DO 
    2120       zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp ) 
    2121       DO jj = 1, jpj 
    2122          DO ji = 1, jpi 
    2123             IF( hbatv(ji,jj) == 0._wp ) THEN 
    2124                IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min 
    2125                IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj) 
    2126             ENDIF 
    2127          END DO 
    2128       END DO 
    2129       zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1._wp ) 
    2130       DO jj = 1, jpj 
    2131          DO ji = 1, jpi 
    2132             IF( hbatf(ji,jj) == 0._wp ) THEN 
    2133                IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min 
    2134                IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj) 
    2135             ENDIF 
    2136          END DO 
    2137       END DO 
    2138  
    2139 !!bug:  key_helsinki a verifer 
    2140       IF( .NOT.ln_wd ) THEN 
    2141         hift(:,:) = MIN( hift(:,:), hbatt(:,:) ) 
    2142         hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) ) 
    2143         hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) ) 
    2144         hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) ) 
    2145       END IF 
    2146  
    2147       IF( nprint == 1 .AND. lwp )   THEN 
    2148          WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  & 
    2149             &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) ) 
    2150          WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  & 
    2151             &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) ) 
    2152          WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  & 
    2153             &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) ) 
    2154          WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  & 
    2155             &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) ) 
    2156       ENDIF 
    2157 !! helsinki 
    2158  
    2159       !                                            ! ======================= 
    2160       !                                            !   s-ccordinate fields     (gdep., e3.) 
    2161       !                                            ! ======================= 
    2162       ! 
    2163       ! non-dimensional "sigma" for model level depth at w- and t-levels 
    2164  
    2165  
    2166 !======================================================================== 
    2167 ! Song and Haidvogel  1994 (ln_s_sh94=T) 
    2168 ! Siddorn and Furner 2012 (ln_sf12=T) 
    2169 ! or  tanh function       (both false)                     
    2170 !======================================================================== 
    2171       IF      ( ln_s_sh94 ) THEN  
    2172                            CALL s_sh94() 
    2173       ELSE IF ( ln_s_sf12 ) THEN 
    2174                            CALL s_sf12() 
    2175       ELSE                  
    2176                            CALL s_tanh() 
    2177       ENDIF  
    2178  
    2179       CALL lbc_lnk( e3t_0 , 'T', 1._wp ) 
    2180       CALL lbc_lnk( e3u_0 , 'U', 1._wp ) 
    2181       CALL lbc_lnk( e3v_0 , 'V', 1._wp ) 
    2182       CALL lbc_lnk( e3f_0 , 'F', 1._wp ) 
    2183       CALL lbc_lnk( e3w_0 , 'W', 1._wp ) 
    2184       CALL lbc_lnk( e3uw_0, 'U', 1._wp ) 
    2185       CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 
    2186       ! 
    2187       IF( .NOT.ln_wd ) THEN 
    2188         WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp 
    2189         WHERE( e3u_0 (:,:,:) == 0._wp )   e3u_0 (:,:,:) = 1._wp 
    2190         WHERE( e3v_0 (:,:,:) == 0._wp )   e3v_0 (:,:,:) = 1._wp 
    2191         WHERE( e3f_0 (:,:,:) == 0._wp )   e3f_0 (:,:,:) = 1._wp 
    2192         WHERE( e3w_0 (:,:,:) == 0._wp )   e3w_0 (:,:,:) = 1._wp 
    2193         WHERE( e3uw_0(:,:,:) == 0._wp )   e3uw_0(:,:,:) = 1._wp 
    2194         WHERE( e3vw_0(:,:,:) == 0._wp )   e3vw_0(:,:,:) = 1._wp 
    2195       END IF 
    2196  
    2197 #if defined key_agrif 
    2198       IF( .NOT. Agrif_Root() ) THEN    ! Ensure meaningful vertical scale factors in ghost lines/columns 
    2199          IF( nbondi == -1 .OR. nbondi == 2 )   e3u_0(  1   ,  :   ,:) = e3u_0(  2   ,  :   ,:) 
    2200          IF( nbondi ==  1 .OR. nbondi == 2 )   e3u_0(nlci-1,  :   ,:) = e3u_0(nlci-2,  :   ,:) 
    2201          IF( nbondj == -1 .OR. nbondj == 2 )   e3v_0(  :   ,  1   ,:) = e3v_0(  :   ,  2   ,:) 
    2202          IF( nbondj ==  1 .OR. nbondj == 2 )   e3v_0(  :   ,nlcj-1,:) = e3v_0(  :   ,nlcj-2,:) 
    2203        ENDIF 
    2204 #endif 
    2205  
    2206 !!gm   I don't like that HERE we are supposed to set the reference coordinate (i.e. _0 arrays) 
    2207 !!gm   and only that !!!!! 
    2208 !!gm   THIS should be removed from here ! 
    2209       gdept_n(:,:,:) = gdept_0(:,:,:) 
    2210       gdepw_n(:,:,:) = gdepw_0(:,:,:) 
    2211       gde3w_n(:,:,:) = gde3w_0(:,:,:) 
    2212       e3t_n  (:,:,:) = e3t_0  (:,:,:) 
    2213       e3u_n  (:,:,:) = e3u_0  (:,:,:) 
    2214       e3v_n  (:,:,:) = e3v_0  (:,:,:) 
    2215       e3f_n  (:,:,:) = e3f_0  (:,:,:) 
    2216       e3w_n  (:,:,:) = e3w_0  (:,:,:) 
    2217       e3uw_n (:,:,:) = e3uw_0 (:,:,:) 
    2218       e3vw_n (:,:,:) = e3vw_0 (:,:,:) 
    2219 !!gm and obviously in the following, use the _0 arrays until the end of this subroutine 
    2220 !! gm end 
    2221 !! 
    2222       ! HYBRID :  
    2223       DO jj = 1, jpj 
    2224          DO ji = 1, jpi 
    2225             DO jk = 1, jpkm1 
    2226                IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk ) 
    2227             END DO 
    2228             IF( ln_wd ) THEN 
    2229               IF( scobot(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 
    2230                 mbathy(ji,jj) = 0 
    2231               ELSEIF(scobot(ji,jj) <= rn_wdmin1) THEN 
    2232                 mbathy(ji,jj) = 2 
    2233               ENDIF 
    2234             ELSE 
    2235               IF( scobot(ji,jj) == 0._wp )   mbathy(ji,jj) = 0 
    2236             ENDIF 
    2237          END DO 
    2238       END DO 
    2239       IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   & 
    2240          &                                                       ' MAX ', MAXVAL( mbathy(:,:) ) 
    2241  
    2242       IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain 
    2243          WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)    ), ' MAX ', MAXVAL( mbathy(:,:) ) 
    2244          WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   & 
    2245             &                          ' w ', MINVAL( gdepw_0(:,:,:) ), '3w '  , MINVAL( gde3w_0(:,:,:) ) 
    2246          WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0  (:,:,:) ),   & 
    2247             &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0  (:,:,:) ),   & 
    2248             &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0 (:,:,:) ),   & 
    2249             &                          ' w ', MINVAL( e3w_0  (:,:,:) ) 
    2250  
    2251          WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   & 
    2252             &                          ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w '  , MAXVAL( gde3w_0(:,:,:) ) 
    2253          WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0  (:,:,:) ),   & 
    2254             &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0  (:,:,:) ),   & 
    2255             &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0 (:,:,:) ),   & 
    2256             &                          ' w ', MAXVAL( e3w_0  (:,:,:) ) 
    2257       ENDIF 
    2258       !  END DO 
    2259       IF(lwp) THEN                                  ! selected vertical profiles 
    2260          WRITE(numout,*) 
    2261          WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1) 
    2262          WRITE(numout,*) ' ~~~~~~  --------------------' 
    2263          WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')") 
    2264          WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(1,1,jk), gdepw_0(1,1,jk),     & 
    2265             &                                 e3t_0 (1,1,jk) , e3w_0 (1,1,jk) , jk=1,jpk ) 
    2266          DO jj = mj0(20), mj1(20) 
    2267             DO ji = mi0(20), mi1(20) 
    2268                WRITE(numout,*) 
    2269                WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj) 
    2270                WRITE(numout,*) ' ~~~~~~  --------------------' 
    2271                WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')") 
    2272                WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     & 
    2273                   &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk ) 
    2274             END DO 
    2275          END DO 
    2276          DO jj = mj0(74), mj1(74) 
    2277             DO ji = mi0(100), mi1(100) 
    2278                WRITE(numout,*) 
    2279                WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj) 
    2280                WRITE(numout,*) ' ~~~~~~  --------------------' 
    2281                WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')") 
    2282                WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     & 
    2283                   &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk ) 
    2284             END DO 
    2285          END DO 
    2286       ENDIF 
    2287       ! 
    2288       !================================================================================ 
    2289       ! check the coordinate makes sense 
    2290       !================================================================================ 
    2291       DO ji = 1, jpi 
    2292          DO jj = 1, jpj 
    2293             ! 
    2294             IF( hbatt(ji,jj) > 0._wp) THEN 
    2295                DO jk = 1, mbathy(ji,jj) 
    2296                  ! check coordinate is monotonically increasing 
    2297                  IF (e3w_n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN 
    2298                     WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk 
    2299                     WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk 
    2300                     WRITE(numout,*) 'e3w',e3w_n(ji,jj,:) 
    2301                     WRITE(numout,*) 'e3t',e3t_n(ji,jj,:) 
    2302                     CALL ctl_stop( ctmp1 ) 
    2303                  ENDIF 
    2304                  ! and check it has never gone negative 
    2305                  IF( gdepw_n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN 
    2306                     WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk 
    2307                     WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk 
    2308                     WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:) 
    2309                     WRITE(numout,*) 'gdept',gdept_n(ji,jj,:) 
    2310                     CALL ctl_stop( ctmp1 ) 
    2311                  ENDIF 
    2312                  ! and check it never exceeds the total depth 
    2313                  IF( gdepw_n(ji,jj,jk) > hbatt(ji,jj) ) THEN 
    2314                     WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk 
    2315                     WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk 
    2316                     WRITE(numout,*) 'gdepw',gdepw_n(ji,jj,:) 
    2317                     CALL ctl_stop( ctmp1 ) 
    2318                  ENDIF 
    2319                END DO 
    2320                ! 
    2321                DO jk = 1, mbathy(ji,jj)-1 
    2322                  ! and check it never exceeds the total depth 
    2323                 IF( gdept_n(ji,jj,jk) > hbatt(ji,jj) ) THEN 
    2324                     WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk 
    2325                     WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk 
    2326                     WRITE(numout,*) 'gdept',gdept_n(ji,jj,:) 
    2327                     CALL ctl_stop( ctmp1 ) 
    2328                  ENDIF 
    2329                END DO 
    2330             ENDIF 
    2331          END DO 
    2332       END DO 
    2333       ! 
    2334       CALL wrk_dealloc( jpi, jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 
    2335       ! 
    2336       IF( nn_timing == 1 )  CALL timing_stop('zgr_sco') 
    2337       ! 
    2338    END SUBROUTINE zgr_sco 
    2339  
    2340  
    2341    SUBROUTINE s_sh94() 
    2342       !!---------------------------------------------------------------------- 
    2343       !!                  ***  ROUTINE s_sh94  *** 
    2344       !!                      
    2345       !! ** Purpose :   stretch the s-coordinate system 
    2346       !! 
    2347       !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994 
    2348       !!                mixed S/sigma coordinate 
    2349       !! 
    2350       !! Reference : Song and Haidvogel 1994.  
    2351       !!---------------------------------------------------------------------- 
    2352       INTEGER  ::   ji, jj, jk           ! dummy loop argument 
    2353       REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars 
    2354       REAL(wp) ::   ztmpu,  ztmpv,  ztmpf 
    2355       REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1 
    2356       ! 
    2357       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 
    2358       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3            
    2359       !!---------------------------------------------------------------------- 
    2360  
    2361       CALL wrk_alloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      ) 
    2362       CALL wrk_alloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 
    2363  
    2364       z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp 
    2365       z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp  
    2366       z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp 
    2367       z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp 
    2368       ! 
    2369       DO ji = 1, jpi 
    2370          DO jj = 1, jpj 
    2371             ! 
    2372             IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma 
    2373                DO jk = 1, jpk 
    2374                   z_gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb ) 
    2375                   z_gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb ) 
    2376                END DO 
    2377             ELSE ! shallow water, uniform sigma 
    2378                DO jk = 1, jpk 
    2379                   z_gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp) 
    2380                   z_gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp) 
    2381                   END DO 
    2382             ENDIF 
    2383             ! 
    2384             DO jk = 1, jpkm1 
    2385                z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk) 
    2386                z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk) 
    2387             END DO 
    2388             z_esigw3(ji,jj,1  ) = 2._wp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) ) 
    2389             z_esigt3(ji,jj,jpk) = 2._wp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) ) 
    2390             ! 
    2391             ! Coefficients for vertical depth as the sum of e3w scale factors 
    2392             z_gsi3w3(ji,jj,1) = 0.5_wp * z_esigw3(ji,jj,1) 
    2393             DO jk = 2, jpk 
    2394                z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk) 
    2395             END DO 
    2396             ! 
    2397             DO jk = 1, jpk 
    2398                zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 
    2399                zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 
    2400                gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft ) 
    2401                gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw ) 
    2402                gde3w_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj,jk)+rn_hc*zcoeft ) 
    2403             END DO 
    2404            ! 
    2405          END DO   ! for all jj's 
    2406       END DO    ! for all ji's 
    2407  
    2408       DO ji = 1, jpim1 
    2409          DO jj = 1, jpjm1 
    2410             ! extended for Wetting/Drying case 
    2411             ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj) 
    2412             ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1) 
    2413             ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) 
    2414             ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj) 
    2415             ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1) 
    2416             ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * & 
    2417                    & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) 
    2418             DO jk = 1, jpk 
    2419                IF( ln_wd .AND. (ztmpu1 < 0._wp.OR.ABS(ztmpu) < rn_wdmin1) ) THEN 
    2420                  z_esigtu3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) ) 
    2421                  z_esigwu3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) ) 
    2422                ELSE 
    2423                  z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) & 
    2424                         &              / ztmpu 
    2425                  z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) & 
    2426                         &              / ztmpu 
    2427                END IF 
    2428  
    2429                IF( ln_wd .AND. (ztmpv1 < 0._wp.OR.ABS(ztmpv) < rn_wdmin1) ) THEN 
    2430                  z_esigtv3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) ) 
    2431                  z_esigwv3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) ) 
    2432                ELSE 
    2433                  z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) & 
    2434                         &              / ztmpv 
    2435                  z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) & 
    2436                         &              / ztmpv 
    2437                END IF 
    2438  
    2439                IF( ln_wd .AND. (ztmpf1 < 0._wp.OR.ABS(ztmpf) < rn_wdmin1) ) THEN 
    2440                  z_esigtf3(ji,jj,jk) = 0.25_wp * ( z_esigt3(ji,jj  ,jk) + z_esigt3(ji+1,jj  ,jk)               & 
    2441                         &                        + z_esigt3(ji,jj+1,jk) + z_esigt3(ji+1,jj+1,jk) ) 
    2442                ELSE 
    2443                  z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               & 
    2444                         &            +   hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               & 
    2445                         &            +   hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               & 
    2446                         &            +   hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf 
    2447                END IF 
    2448  
    2449                ! 
    2450                e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2451                e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2452                e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2453                e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2454                ! 
    2455                e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2456                e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2457                e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) ) 
    2458             END DO 
    2459         END DO 
    2460       END DO 
    2461       ! 
    2462       CALL wrk_dealloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      ) 
    2463       CALL wrk_dealloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 
    2464       ! 
    2465    END SUBROUTINE s_sh94 
    2466  
    2467  
    2468    SUBROUTINE s_sf12 
    2469       !!---------------------------------------------------------------------- 
    2470       !!                  ***  ROUTINE s_sf12 ***  
    2471       !!                      
    2472       !! ** Purpose :   stretch the s-coordinate system 
    2473       !! 
    2474       !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012? 
    2475       !!                mixed S/sigma/Z coordinate 
    2476       !! 
    2477       !!                This method allows the maintenance of fixed surface and or 
    2478       !!                bottom cell resolutions (cf. geopotential coordinates)  
    2479       !!                within an analytically derived stretched S-coordinate framework. 
    2480       !! 
    2481       !! 
    2482       !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling). 
    2483       !!---------------------------------------------------------------------- 
    2484       INTEGER  ::   ji, jj, jk           ! dummy loop argument 
    2485       REAL(wp) ::   zsmth               ! smoothing around critical depth 
    2486       REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space 
    2487       REAL(wp) ::   ztmpu, ztmpv, ztmpf 
    2488       REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1 
    2489       ! 
    2490       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 
    2491       REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3            
    2492       !!---------------------------------------------------------------------- 
    2493       ! 
    2494       CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3                                      ) 
    2495       CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 
    2496  
    2497       z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp   ;   z_gsi3w3  = 0._wp 
    2498       z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp  
    2499       z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp 
    2500       z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp 
    2501  
    2502       DO ji = 1, jpi 
    2503          DO jj = 1, jpj 
    2504  
    2505           IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma 
    2506                
    2507               zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,. 
    2508                                                      ! could be changed by users but care must be taken to do so carefully 
    2509               zzb = 1.0_wp-(zzb/hbatt(ji,jj)) 
    2510              
    2511               zzs = rn_zs / hbatt(ji,jj)  
    2512                
    2513               IF (rn_efold /= 0.0_wp) THEN 
    2514                 zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold ) 
    2515               ELSE 
    2516                 zsmth = 1.0_wp  
    2517               ENDIF 
    2518                 
    2519               DO jk = 1, jpk 
    2520                 z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp) 
    2521                 z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp) 
    2522               ENDDO 
    2523               z_gsigw3(ji,jj,:) = fgamma( z_gsigw3(ji,jj,:), zzb, zzs, zsmth  ) 
    2524               z_gsigt3(ji,jj,:) = fgamma( z_gsigt3(ji,jj,:), zzb, zzs, zsmth  ) 
    2525   
    2526           ELSE IF (ln_sigcrit) THEN ! shallow water, uniform sigma 
    2527  
    2528             DO jk = 1, jpk 
    2529               z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp) 
    2530               z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp) 
    2531             END DO 
    2532  
    2533           ELSE  ! shallow water, z coordinates 
    2534  
    2535             DO jk = 1, jpk 
    2536               z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj)) 
    2537               z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj)) 
    2538             END DO 
    2539  
    2540           ENDIF 
    2541  
    2542           DO jk = 1, jpkm1 
    2543              z_esigt3(ji,jj,jk) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk) 
    2544              z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk) 
    2545           END DO 
    2546           z_esigw3(ji,jj,1  ) = 2.0_wp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  )) 
    2547           z_esigt3(ji,jj,jpk) = 2.0_wp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk)) 
    2548  
    2549           ! Coefficients for vertical depth as the sum of e3w scale factors 
    2550           z_gsi3w3(ji,jj,1) = 0.5 * z_esigw3(ji,jj,1) 
    2551           DO jk = 2, jpk 
    2552              z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk) 
    2553           END DO 
    2554  
    2555           DO jk = 1, jpk 
    2556              gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk) 
    2557              gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk) 
    2558              gde3w_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj,jk) 
    2559           END DO 
    2560  
    2561         ENDDO   ! for all jj's 
    2562       ENDDO    ! for all ji's 
    2563  
    2564       DO ji=1,jpi-1 
    2565         DO jj=1,jpj-1 
    2566  
    2567            ! extend to suit for Wetting/Drying case 
    2568            ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj) 
    2569            ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1) 
    2570            ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) 
    2571            ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj) 
    2572            ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1) 
    2573            ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * & 
    2574                   & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) 
    2575            DO jk = 1, jpk 
    2576               IF( ln_wd .AND. (ztmpu1 < 0._wp.OR.ABS(ztmpu) < rn_wdmin1) ) THEN 
    2577                 z_esigtu3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) ) 
    2578                 z_esigwu3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) ) 
    2579               ELSE 
    2580                 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) & 
    2581                        &              / ztmpu 
    2582                 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) & 
    2583                        &              / ztmpu 
    2584               END IF 
    2585  
    2586               IF( ln_wd .AND. (ztmpv1 < 0._wp.OR.ABS(ztmpv) < rn_wdmin1) ) THEN 
    2587                 z_esigtv3(ji,jj,jk) = 0.5_wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) ) 
    2588                 z_esigwv3(ji,jj,jk) = 0.5_wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) ) 
    2589               ELSE 
    2590                 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) & 
    2591                        &              / ztmpv 
    2592                 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) & 
    2593                        &              / ztmpv 
    2594               END IF 
    2595  
    2596               IF( ln_wd .AND. (ztmpf1 < 0._wp.OR.ABS(ztmpf) < rn_wdmin1) ) THEN 
    2597                 z_esigtf3(ji,jj,jk) = 0.25_wp * ( z_esigt3(ji,jj,jk)   + z_esigt3(ji+1,jj,jk)                 & 
    2598                        &                        + z_esigt3(ji,jj+1,jk) + z_esigt3(ji+1,jj+1,jk) ) 
    2599               ELSE 
    2600                 z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               & 
    2601                        &              + hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               & 
    2602                        &              + hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               & 
    2603                        &              + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf 
    2604               END IF 
    2605  
    2606              ! Code prior to wetting and drying option (for reference) 
    2607              !z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   & 
    2608              !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) ) 
    2609              ! 
    2610              !z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   & 
    2611              !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) ) 
    2612              ! 
    2613              !z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   & 
    2614              !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
    2615              ! 
    2616              !z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   & 
    2617              !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
    2618              ! 
    2619              !z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                                 & 
    2620              !                    &  +hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                                 & 
    2621              !                       +hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                                 & 
    2622              !                    &  +hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )                               & 
    2623              !                     /( hbatt(ji  ,jj  )+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) ) 
    2624  
    2625              e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk) 
    2626              e3u_0(ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk) 
    2627              e3v_0(ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk) 
    2628              e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk) 
    2629              ! 
    2630              e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk) 
    2631              e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk) 
    2632              e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk) 
    2633           END DO 
    2634  
    2635         ENDDO 
    2636       ENDDO 
    2637       ! 
    2638       CALL lbc_lnk(e3t_0 ,'T',1.) ; CALL lbc_lnk(e3u_0 ,'T',1.) 
    2639       CALL lbc_lnk(e3v_0 ,'T',1.) ; CALL lbc_lnk(e3f_0 ,'T',1.) 
    2640       CALL lbc_lnk(e3w_0 ,'T',1.) 
    2641       CALL lbc_lnk(e3uw_0,'T',1.) ; CALL lbc_lnk(e3vw_0,'T',1.) 
    2642       ! 
    2643       CALL wrk_dealloc( jpi,jpj,jpk,   z_gsigw3, z_gsigt3, z_gsi3w3                                      ) 
    2644       CALL wrk_dealloc( jpi,jpj,jpk,   z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 
    2645       ! 
    2646    END SUBROUTINE s_sf12 
    2647  
    2648  
    2649    SUBROUTINE s_tanh() 
    2650       !!---------------------------------------------------------------------- 
    2651       !!                  ***  ROUTINE s_tanh***  
    2652       !!                      
    2653       !! ** Purpose :   stretch the s-coordinate system 
    2654       !! 
    2655       !! ** Method  :   s-coordinate stretch  
    2656       !! 
    2657       !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    2658       !!---------------------------------------------------------------------- 
    2659       INTEGER  ::   ji, jj, jk       ! dummy loop argument 
    2660       REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars 
    2661       REAL(wp), POINTER, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w 
    2662       REAL(wp), POINTER, DIMENSION(:) :: z_esigt, z_esigw 
    2663       !!---------------------------------------------------------------------- 
    2664  
    2665       CALL wrk_alloc( jpk,   z_gsigw, z_gsigt, z_gsi3w ) 
    2666       CALL wrk_alloc( jpk,   z_esigt, z_esigw ) 
    2667  
    2668       z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp   ;   z_gsi3w  = 0._wp 
    2669       z_esigt  = 0._wp   ;   z_esigw  = 0._wp  
    2670  
    2671       DO jk = 1, jpk 
    2672         z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp ) 
    2673         z_gsigt(jk) = -fssig( REAL(jk,wp)        ) 
    2674       END DO 
    2675       IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk) 
    2676       ! 
    2677       ! Coefficients for vertical scale factors at w-, t- levels 
    2678 !!gm bug :  define it from analytical function, not like juste bellow.... 
    2679 !!gm        or betteroffer the 2 possibilities.... 
    2680       DO jk = 1, jpkm1 
    2681          z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk) 
    2682          z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk) 
    2683       END DO 
    2684       z_esigw( 1 ) = 2._wp * ( z_gsigt(1  ) - z_gsigw(1  ) )  
    2685       z_esigt(jpk) = 2._wp * ( z_gsigt(jpk) - z_gsigw(jpk) ) 
    2686       ! 
    2687       ! Coefficients for vertical depth as the sum of e3w scale factors 
    2688       z_gsi3w(1) = 0.5_wp * z_esigw(1) 
    2689       DO jk = 2, jpk 
    2690          z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk) 
    2691       END DO 
    2692 !!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays) 
    2693       DO jk = 1, jpk 
    2694          zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp) 
    2695          zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp) 
    2696          gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft ) 
    2697          gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw ) 
    2698          gde3w_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsi3w(jk) + hift(:,:)*zcoeft ) 
    2699       END DO 
    2700 !!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays) 
    2701       DO jj = 1, jpj 
    2702          DO ji = 1, jpi 
    2703             DO jk = 1, jpk 
    2704               e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) ) 
    2705               e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) ) 
    2706               e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) ) 
    2707               e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) ) 
    2708               ! 
    2709               e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) ) 
    2710               e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) ) 
    2711               e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) ) 
    2712             END DO 
    2713          END DO 
    2714       END DO 
    2715       ! 
    2716       CALL wrk_dealloc( jpk,   z_gsigw, z_gsigt, z_gsi3w ) 
    2717       CALL wrk_dealloc( jpk,   z_esigt, z_esigw          ) 
    2718       ! 
    2719    END SUBROUTINE s_tanh 
    2720  
    2721  
    2722    FUNCTION fssig( pk ) RESULT( pf ) 
    2723       !!---------------------------------------------------------------------- 
    2724       !!                 ***  ROUTINE fssig *** 
    2725       !!        
    2726       !! ** Purpose :   provide the analytical function in s-coordinate 
    2727       !!           
    2728       !! ** Method  :   the function provide the non-dimensional position of 
    2729       !!                T and W (i.e. between 0 and 1) 
    2730       !!                T-points at integer values (between 1 and jpk) 
    2731       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    2732       !!---------------------------------------------------------------------- 
    2733       REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate 
    2734       REAL(wp)             ::   pf   ! sigma value 
    2735       !!---------------------------------------------------------------------- 
    2736       ! 
    2737       pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   & 
    2738          &     - TANH( rn_thetb * rn_theta                                )  )   & 
    2739          & * (   COSH( rn_theta                           )                      & 
    2740          &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              & 
    2741          & / ( 2._wp * SINH( rn_theta ) ) 
    2742       ! 
    2743    END FUNCTION fssig 
    2744  
    2745  
    2746    FUNCTION fssig1( pk1, pbb ) RESULT( pf1 ) 
    2747       !!---------------------------------------------------------------------- 
    2748       !!                 ***  ROUTINE fssig1 *** 
    2749       !! 
    2750       !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate 
    2751       !! 
    2752       !! ** Method  :   the function provides the non-dimensional position of 
    2753       !!                T and W (i.e. between 0 and 1) 
    2754       !!                T-points at integer values (between 1 and jpk) 
    2755       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    2756       !!---------------------------------------------------------------------- 
    2757       REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate 
    2758       REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient 
    2759       REAL(wp)             ::   pf1   ! sigma value 
    2760       !!---------------------------------------------------------------------- 
    2761       ! 
    2762       IF ( rn_theta == 0 ) then      ! uniform sigma 
    2763          pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 ) 
    2764       ELSE                        ! stretched sigma 
    2765          pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              & 
    2766             &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  & 
    2767             &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  ) 
    2768       ENDIF 
    2769       ! 
    2770    END FUNCTION fssig1 
    2771  
    2772  
    2773    FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma ) 
    2774       !!---------------------------------------------------------------------- 
    2775       !!                 ***  ROUTINE fgamma  *** 
    2776       !! 
    2777       !! ** Purpose :   provide analytical function for the s-coordinate 
    2778       !! 
    2779       !! ** Method  :   the function provides the non-dimensional position of 
    2780       !!                T and W (i.e. between 0 and 1) 
    2781       !!                T-points at integer values (between 1 and jpk) 
    2782       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    2783       !! 
    2784       !!                This method allows the maintenance of fixed surface and or 
    2785       !!                bottom cell resolutions (cf. geopotential coordinates)  
    2786       !!                within an analytically derived stretched S-coordinate framework. 
    2787       !! 
    2788       !! Reference  :   Siddorn and Furner, in prep 
    2789       !!---------------------------------------------------------------------- 
    2790       REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate 
    2791       REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate 
    2792       REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth 
    2793       REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth 
    2794       REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter 
    2795       ! 
    2796       INTEGER  ::   jk             ! dummy loop index 
    2797       REAL(wp) ::   za1,za2,za3    ! local scalar 
    2798       REAL(wp) ::   zn1,zn2        !   -      -  
    2799       REAL(wp) ::   za,zb,zx       !   -      -  
    2800       !!---------------------------------------------------------------------- 
    2801       ! 
    2802       zn1  =  1._wp / REAL( jpkm1, wp ) 
    2803       zn2  =  1._wp -  zn1 
    2804       ! 
    2805       za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp)  
    2806       za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp) 
    2807       za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1) 
    2808       ! 
    2809       za = pzb - za3*(pzs-za1)-za2 
    2810       za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) ) 
    2811       zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1) 
    2812       zx = 1.0_wp-za/2.0_wp-zb 
    2813       ! 
    2814       DO jk = 1, jpk 
    2815          p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  & 
    2816             &          zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- & 
    2817             &               (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) ) 
    2818         p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth) 
    2819       END DO 
    2820       ! 
    2821    END FUNCTION fgamma 
     322   END SUBROUTINE zgr_top_bot 
    2822323 
    2823324   !!====================================================================== 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r6140 r7277  
    155155      ! 
    156156      ! 
     157!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed 
     158      ! 
    157159      !                                   !==   ORCA_R2 configuration and T & S damping   ==!  
    158       IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations 
     160      IF( cn_cfg == "orca" .AND. nn_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations 
    159161         ! 
    160162         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea 
    … …  
    178180         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 
    179181      ENDIF 
     182!!gm end 
    180183      ! 
    181184      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r6140 r7277  
    11MODULE iscplhsb 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  iscplhsb*** 
     3   !!                       ***  MODULE  iscplhsb  *** 
    44   !! Ocean forcing: ice sheet/ocean coupling (conservation) 
    55   !!===================================================================== 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

    r6140 r7277  
    11MODULE iscplini 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbciscpl*** 
     3   !!                       ***  MODULE  sbciscpl  *** 
    44   !! Ocean forcing:  river runoff 
    55   !!===================================================================== 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r6140 r7277  
    11MODULE iscplrst 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  iscplrst*** 
     3   !!                       ***  MODULE  iscplrst  *** 
    44   !! Ocean forcing: update the restart file in case of ice sheet/ocean coupling 
    55   !!===================================================================== 
    … …  
    5050      !!---------------------------------------------------------------------- 
    5151      INTEGER  ::   inum0 
    52       REAL(wp), DIMENSION(:,:  ), POINTER :: zsmask_b 
    53       REAL(wp), DIMENSION(:,:,:), POINTER :: ztmask_b, zumask_b, zvmask_b 
    54       REAL(wp), DIMENSION(:,:,:), POINTER :: ze3t_b  , ze3u_b  , ze3v_b   
    55       REAL(wp), DIMENSION(:,:,:), POINTER :: zdepw_b 
     52      REAL(wp), DIMENSION(:,:  ), POINTER ::   zsmask_b 
     53      REAL(wp), DIMENSION(:,:,:), POINTER ::   ztmask_b, zumask_b, zvmask_b 
     54      REAL(wp), DIMENSION(:,:,:), POINTER ::   ze3t_b  , ze3u_b  , ze3v_b   
     55      REAL(wp), DIMENSION(:,:,:), POINTER ::   zdepw_b 
    5656      CHARACTER(20) :: cfile 
    5757      !!---------------------------------------------------------------------- 
    5858 
    59       CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before 
    60       CALL wrk_alloc(jpi,jpj,jpk, ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before 
    61       CALL wrk_alloc(jpi,jpj,jpk, zdepw_b ) 
    62       CALL wrk_alloc(jpi,jpj,     zsmask_b                    ) 
     59      CALL wrk_alloc(jpi,jpj,jpk,   ztmask_b, zumask_b, zvmask_b) ! mask before 
     60      CALL wrk_alloc(jpi,jpj,jpk,   ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before 
     61      CALL wrk_alloc(jpi,jpj,jpk,   zdepw_b ) 
     62      CALL wrk_alloc(jpi,jpj,       zsmask_b                    ) 
    6363 
    6464 
    … …  
    8686          
    8787      !! print mesh/mask 
    88       IF( nmsh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file 
     88      IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file 
    8989 
    9090      IF ( ln_hsb ) THEN 
    … …  
    9898      END IF 
    9999 
    100       CALL wrk_dealloc(jpi,jpj,jpk, ztmask_b,zumask_b,zvmask_b )   
    101       CALL wrk_dealloc(jpi,jpj,jpk, ze3t_b  ,ze3u_b  ,ze3v_b   )   
    102       CALL wrk_dealloc(jpi,jpj,jpk, zdepw_b                    ) 
    103       CALL wrk_dealloc(jpi,jpj,     zsmask_b                   ) 
     100      CALL wrk_dealloc(jpi,jpj,jpk,   ztmask_b,zumask_b,zvmask_b )   
     101      CALL wrk_dealloc(jpi,jpj,jpk,   ze3t_b  ,ze3u_b  ,ze3v_b   )   
     102      CALL wrk_dealloc(jpi,jpj,jpk,   zdepw_b                    ) 
     103      CALL wrk_dealloc(jpi,jpj,       zsmask_b                   ) 
    104104 
    105105      !! next step is an euler time step 
    … …  
    108108      !! set _b and _n variables equal 
    109109      tsb (:,:,:,:) = tsn (:,:,:,:) 
    110       ub  (:,:,:  ) = un  (:,:,:  ) 
    111       vb  (:,:,:  ) = vn  (:,:,:  ) 
    112       sshb(:,:    ) = sshn(:,:) 
     110      ub  (:,:,:)   = un  (:,:,:) 
     111      vb  (:,:,:)   = vn  (:,:,:) 
     112      sshb(:,:)    = sshn(:,:) 
    113113 
    114114      !! set _b and _n vertical scale factor equal 
    … …  
    117117      e3v_b (:,:,:) = e3v_n (:,:,:) 
    118118 
    119       e3uw_b(:,:,:)  = e3uw_n(:,:,:) 
    120       e3vw_b(:,:,:)  = e3vw_n(:,:,:) 
    121       gdept_b(:,:,:)  = gdept_n(:,:,:) 
     119      e3uw_b (:,:,:) = e3uw_n (:,:,:) 
     120      e3vw_b (:,:,:) = e3vw_n (:,:,:) 
     121      gdept_b(:,:,:) = gdept_n(:,:,:) 
    122122      gdepw_b(:,:,:) = gdepw_n(:,:,:) 
    123       hu_b (:,:) = hu_n(:,:) 
    124       hv_b (:,:) = hv_n(:,:) 
    125       r1_hu_b(:,:) = r1_hu_n(:,:) 
    126       r1_hv_b(:,:) = r1_hv_n(:,:) 
     123      hu_b   (:,:)   = hu_n   (:,:) 
     124      hv_b   (:,:)   = hv_n   (:,:) 
     125      r1_hu_b(:,:)   = r1_hu_n(:,:) 
     126      r1_hv_b(:,:)   = r1_hv_n(:,:) 
    127127      ! 
    128128   END SUBROUTINE iscpl_stp 
    129     
     129 
     130 
    130131   SUBROUTINE iscpl_rst_interpol (ptmask_b, pumask_b, pvmask_b, psmask_b, pe3t_b, pe3u_b, pe3v_b, pdepw_b) 
    131132      !!----------------------------------------------------------------------  
    … …  
    436437      CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        )  
    437438      CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          )  
    438  
     439      ! 
    439440   END SUBROUTINE iscpl_rst_interpol 
    440441 
     442   !!====================================================================== 
    441443END MODULE iscplrst 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r6140 r7277  
    1414   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA 
    1515   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn  
     16   !!            3.7  !  2016-04  (S. Flavoni) introduce user defined initial state  
    1617   !!---------------------------------------------------------------------- 
    1718 
    1819   !!---------------------------------------------------------------------- 
    1920   !!   istate_init   : initial state setting 
    20    !!   istate_tem    : analytical profile for initial Temperature 
    21    !!   istate_sal    : analytical profile for initial Salinity 
    22    !!   istate_eel    : initial state setting of EEL R5 configuration 
    23    !!   istate_gyre   : initial state setting of GYRE configuration 
    2421   !!   istate_uvg    : initial velocity in geostropic balance 
    2522   !!---------------------------------------------------------------------- 
    26    USE oce             ! ocean dynamics and active tracers  
    27    USE dom_oce         ! ocean space and time domain  
    28    USE c1d             ! 1D vertical configuration 
    29    USE daymod          ! calendar 
    30    USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    31    USE ldftra          ! lateral physics: ocean active tracers 
    32    USE zdf_oce         ! ocean vertical physics 
    33    USE phycst          ! physical constants 
    34    USE dtatsd          ! data temperature and salinity   (dta_tsd routine) 
    35    USE dtauvd          ! data: U & V current             (dta_uvd routine) 
     23   USE oce            ! ocean dynamics and active tracers  
     24   USE dom_oce        ! ocean space and time domain  
     25   USE daymod         ! calendar 
     26   USE divhor         ! horizontal divergence            (div_hor routine) 
     27   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
     28   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    3629   USE domvvl          ! varying vertical mesh 
    3730   USE iscplrst        ! ice sheet coupling 
     31   USE usrdef_istate   ! User defined initial state 
    3832   ! 
    3933   USE in_out_manager  ! I/O manager 
    … …  
    7064      IF( nn_timing == 1 )   CALL timing_start('istate_init') 
    7165      ! 
     66      IF(lwp) WRITE(numout,*) 
     67      IF(lwp) WRITE(numout,*) 'istate_init : Initialization of the dynamics and tracers' 
     68      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    7269 
    73       IF(lwp) WRITE(numout,*) 
    74       IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 
    75       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    76  
     70!!gm  Why not include in the first call of dta_tsd ?   
     71!!gm  probably associated with the use of internal damping... 
    7772                     CALL dta_tsd_init        ! Initialisation of T & S input data 
    78       IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     73!!gm to be moved in usrdef of C1D case 
     74!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     75!!gm 
    7976 
    8077      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    … …  
    8683         !                                    ! ------------------- 
    8784         CALL rst_read                        ! Read the restart file 
    88          IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry 
     85         IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry 
    8986         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    90       ELSE 
    91          !                                    ! Start from rest 
     87         ! 
     88      ELSE                                    ! Start from rest 
    9289         !                                    ! --------------- 
    93          numror = 0                              ! define numror = 0 -> no restart file to read 
    94          neuler = 0                              ! Set time-step indicator at nit000 (euler forward) 
    95          CALL day_init                           ! model calendar (using both namelist and restart infos) 
    96          !                                       ! Initialization of ocean to zero 
    97          !   before fields      !       now fields      
    98          sshb (:,:)   = 0._wp   ;   sshn (:,:)   = 0._wp 
    99          ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp 
    100          vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp   
    101                                     hdivn(:,:,:) = 0._wp 
     90         numror = 0                           ! define numror = 0 -> no restart file to read 
     91         neuler = 0                           ! Set time-step indicator at nit000 (euler forward) 
     92         CALL day_init                        ! model calendar (using both namelist and restart infos) 
     93         !                                    ! Initialization of ocean to zero 
    10294         ! 
    103          IF( cp_cfg == 'eel' ) THEN 
    104             CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields 
    105          ELSEIF( cp_cfg == 'gyre' ) THEN          
    106             CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields 
    107          ELSE                                    ! Initial T-S, U-V fields read in files 
    108             IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000 
    109                CALL dta_tsd( nit000, tsb )   
    110                tsn(:,:,:,:) = tsb(:,:,:,:) 
    111                ! 
    112             ELSE                                 ! Initial T-S fields defined analytically 
    113                CALL istate_t_s 
    114             ENDIF 
    115             IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    116                CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
    117                CALL dta_uvd( nit000, zuvd ) 
    118                ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    119                vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
    120                CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd ) 
    121             ENDIF 
     95         IF( ln_tsd_init ) THEN                
     96            CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000 
     97            ! 
     98            sshb(:,:)   = 0._wp               ! set the ocean at rest 
     99            ub  (:,:,:) = 0._wp 
     100            vb  (:,:,:) = 0._wp   
     101            ! 
     102         ELSE                                 ! user defined initial T and S 
     103            CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )          
    122104         ENDIF 
     105         tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones 
     106         sshn (:,:)     = sshb(:,:)    
     107         un   (:,:,:)   = ub  (:,:,:) 
     108         vn   (:,:,:)   = vb  (:,:,:) 
     109         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
     110         CALL div_hor( 0 )                    ! compute interior hdivn value   
     111!!gm                                    hdivn(:,:,:) = 0._wp 
     112 
     113!!gm POTENTIAL BUG : 
     114!!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
     115!!             as well as gdept and gdepw....   !!!!!  
     116!!      ===>>>>   probably a call to domvvl initialisation here.... 
     117 
     118 
     119         ! 
     120!!gm to be moved in usrdef of C1D case 
     121!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
     122!            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
     123!            CALL dta_uvd( nit000, zuvd ) 
     124!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
     125!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
     126!            CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd ) 
     127!         ENDIF 
    123128         ! 
    124129!!gm This is to be changed !!!! 
    125          ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
    126          IF( .NOT.ln_linssh ) THEN 
    127             DO jk = 1, jpk 
    128                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    129             END DO 
    130          ENDIF 
     130!         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
     131!         IF( .NOT.ln_linssh ) THEN 
     132!            DO jk = 1, jpk 
     133!               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     134!            END DO 
     135!         ENDIF 
    131136!!gm  
    132137         !  
    133       ENDIF 
     138      ENDIF  
    134139      !  
    135140      ! Initialize "now" and "before" barotropic velocities: 
    … …  
    139144      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    140145      ! 
    141 !!gm  the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked 
     146!!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 
    142147      DO jk = 1, jpkm1 
    143148         DO jj = 1, jpj 
    … …  
    162167   END SUBROUTINE istate_init 
    163168 
    164  
    165    SUBROUTINE istate_t_s 
    166       !!--------------------------------------------------------------------- 
    167       !!                  ***  ROUTINE istate_t_s  *** 
    168       !!    
    169       !! ** Purpose :   Intialization of the temperature field with an  
    170       !!      analytical profile or a file (i.e. in EEL configuration) 
    171       !! 
    172       !! ** Method  : - temperature: use Philander analytic profile 
    173       !!              - salinity   : use to a constant value 35.5 
    174       !! 
    175       !! References :  Philander ??? 
    176       !!---------------------------------------------------------------------- 
    177       INTEGER  ::   ji, jj, jk 
    178       REAL(wp) ::   zsal = 35.50_wp 
    179       !!---------------------------------------------------------------------- 
    180       ! 
    181       IF(lwp) WRITE(numout,*) 
    182       IF(lwp) WRITE(numout,*) 'istate_t_s : Philander s initial temperature profile' 
    183       IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)' 
    184       ! 
    185       DO jk = 1, jpk 
    186          tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((gdept_n(:,:,jk)-80.)/30.) )   & 
    187             &                + 10. * ( 5000. - gdept_n(:,:,jk) ) /5000.)  ) * tmask(:,:,jk) 
    188          tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    189       END DO 
    190       tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
    191       tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    192       ! 
    193    END SUBROUTINE istate_t_s 
    194  
    195  
    196    SUBROUTINE istate_eel 
    197       !!---------------------------------------------------------------------- 
    198       !!                   ***  ROUTINE istate_eel  *** 
    199       !!  
    200       !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5 
    201       !!      configuration (channel with or without a topographic bump) 
    202       !! 
    203       !! ** Method  : - set temprature field 
    204       !!              - set salinity field 
    205       !!              - set velocity field including horizontal divergence 
    206       !!                and relative vorticity fields 
    207       !!---------------------------------------------------------------------- 
    208       USE divhor     ! hor. divergence      (div_hor routine) 
    209       USE iom 
    210       ! 
    211       INTEGER  ::   inum              ! temporary logical unit 
    212       INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    213       INTEGER  ::   ijloc 
    214       REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars 
    215       REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5) 
    216       REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5) 
    217       REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6) 
    218       REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5) 
    219       REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain 
    220       !!---------------------------------------------------------------------- 
    221       ! 
    222       SELECT CASE ( jp_cfg )  
    223          !                                              ! ==================== 
    224          CASE ( 5 )                                     ! EEL R5 configuration 
    225             !                                           ! ==================== 
    226             ! 
    227             ! set temperature field with a linear profile 
    228             ! ------------------------------------------- 
    229             IF(lwp) WRITE(numout,*) 
    230             IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile' 
    231             IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    232             ! 
    233             zh1 = gdept_1d(  1  ) 
    234             zh2 = gdept_1d(jpkm1) 
    235             ! 
    236             zslope = ( zt1 - zt2 ) / ( zh1 - zh2 ) 
    237             zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 ) 
    238             ! 
    239             DO jk = 1, jpk 
    240                tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - gdept_n(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
    241                tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    242             END DO 
    243             ! 
    244             ! set salinity field to a constant value 
    245             ! -------------------------------------- 
    246             IF(lwp) WRITE(numout,*) 
    247             IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal 
    248             IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    249             ! 
    250             tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
    251             tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    252             ! 
    253             ! set the dynamics: U,V, hdiv (and ssh if necessary) 
    254             ! ---------------- 
    255             ! Start EEL5 configuration with barotropic geostrophic velocities  
    256             ! according the sshb and sshn SSH imposed. 
    257             ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y) 
    258             ! we use the Coriolis frequency at mid-channel.    
    259             ub(:,:,:) = zueel * umask(:,:,:) 
    260             un(:,:,:) = ub(:,:,:) 
    261             ijloc = mj0(INT(jpjglo-1)/2) 
    262             zfcor = ff(1,ijloc) 
    263             ! 
    264             DO jj = 1, jpjglo 
    265                zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav  
    266             END DO 
    267             ! 
    268             IF(lwp) THEN 
    269                WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel 
    270                WRITE(numout,*) ' Geostrophic SSH profile as a function of y:' 
    271                WRITE(numout,'(12(1x,f6.2))') zssh(1,:) 
    272             ENDIF 
    273             ! 
    274             DO jj = 1, nlcj 
    275                DO ji = 1, nlci 
    276                   sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1) 
    277                END DO 
    278             END DO 
    279             sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns 
    280             sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows 
    281             ! 
    282             sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value 
    283             ! 
    284             IF( nn_rstssh /= 0 ) THEN   
    285                nn_rstssh = 0                        ! hand-made initilization of ssh  
    286                CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' ) 
    287             ENDIF 
    288             ! 
    289 !!gm  Check  here call to div_hor should not be necessary 
    290 !!gm         div_hor call runoffs  not sure they are defined at that level 
    291             CALL div_hor( nit000 )                  ! horizontal divergence and relative vorticity (curl) 
    292             ! N.B. the vertical velocity will be computed from the horizontal divergence field 
    293             ! in istate by a call to wzv routine 
    294  
    295  
    296             !                                     ! ========================== 
    297          CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration 
    298             !                                     ! ========================== 
    299             ! 
    300             ! set temperature field with a NetCDF file 
    301             ! ---------------------------------------- 
    302             IF(lwp) WRITE(numout,*) 
    303             IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file' 
    304             IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    305             ! 
    306             CALL iom_open ( 'eel.initemp', inum ) 
    307             CALL iom_get ( inum, jpdom_data, 'initemp', tsb(:,:,:,jp_tem) ) ! read before temprature (tb) 
    308             CALL iom_close( inum ) 
    309             ! 
    310             tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb 
    311             ! 
    312             ! set salinity field to a constant value 
    313             ! -------------------------------------- 
    314             IF(lwp) WRITE(numout,*) 
    315             IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal 
    316             IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    317             ! 
    318             tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
    319             tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    320             ! 
    321             !                                    ! =========================== 
    322          CASE DEFAULT                            ! NONE existing configuration 
    323             !                                    ! =========================== 
    324             WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded' 
    325             CALL ctl_stop( ctmp1 ) 
    326             ! 
    327       END SELECT 
    328       ! 
    329    END SUBROUTINE istate_eel 
    330  
    331  
    332    SUBROUTINE istate_gyre 
    333       !!---------------------------------------------------------------------- 
    334       !!                   ***  ROUTINE istate_gyre  *** 
    335       !!  
    336       !! ** Purpose :   Initialization of the dynamics and tracers for GYRE 
    337       !!      configuration (double gyre with rotated domain) 
    338       !! 
    339       !! ** Method  : - set temprature field 
    340       !!              - set salinity   field 
    341       !!---------------------------------------------------------------------- 
    342       INTEGER :: ji, jj, jk  ! dummy loop indices 
    343       INTEGER            ::   inum          ! temporary logical unit 
    344       INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization 
    345       !!---------------------------------------------------------------------- 
    346       ! 
    347       SELECT CASE ( ntsinit) 
    348       ! 
    349       CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS 
    350          IF(lwp) WRITE(numout,*) 
    351          IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS ' 
    352          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    353          ! 
    354          DO jk = 1, jpk 
    355             DO jj = 1, jpj 
    356                DO ji = 1, jpi 
    357                   tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (gdept_n(ji,jj,jk) - 400) / 700 )         )   & 
    358                        &           * (-TANH( (500-gdept_n(ji,jj,jk)) / 150 ) + 1) / 2               & 
    359                        &       + (      15. * ( 1. - TANH( (gdept_n(ji,jj,jk)-50.) / 1500.) )       & 
    360                        &                - 1.4 * TANH((gdept_n(ji,jj,jk)-100.) / 100.)               &     
    361                        &                + 7.  * (1500. - gdept_n(ji,jj,jk)) / 1500.             )   &  
    362                        &           * (-TANH( (gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2 
    363                   tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
    364                   tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) 
    365  
    366                   tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (gdept_n(ji,jj,jk) - 305) / 460 )  )  & 
    367                      &              * (-TANH((500 - gdept_n(ji,jj,jk)) / 150) + 1) / 2          & 
    368                      &          + (  35.55 + 1.25 * (5000. - gdept_n(ji,jj,jk)) / 5000.         & 
    369                      &                - 1.62 * TANH( (gdept_n(ji,jj,jk) - 60.  ) / 650. )       & 
    370                      &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 35.  ) / 100. )       & 
    371                      &                + 0.2  * TANH( (gdept_n(ji,jj,jk) - 1000.) / 5000.)    )  & 
    372                      &              * (-TANH((gdept_n(ji,jj,jk) - 500) / 150) + 1) / 2  
    373                   tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    374                   tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) 
    375                END DO 
    376             END DO 
    377          END DO 
    378          ! 
    379       CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files 
    380          IF(lwp) WRITE(numout,*) 
    381          IF(lwp) WRITE(numout,*) 'istate_gyre : initial T and S read from dta_tem.nc/data_sal.nc files' 
    382          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    383          IF(lwp) WRITE(numout,*) '              NetCDF FORMAT' 
    384  
    385          ! Read temperature field 
    386          ! ---------------------- 
    387          CALL iom_open ( 'data_tem', inum ) 
    388          CALL iom_get ( inum, jpdom_data, 'votemper', tsn(:,:,:,jp_tem) )  
    389          CALL iom_close( inum ) 
    390  
    391          tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)  
    392          tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
    393  
    394          ! Read salinity field 
    395          ! ------------------- 
    396          CALL iom_open ( 'data_sal', inum ) 
    397          CALL iom_get ( inum, jpdom_data, 'vosaline', tsn(:,:,:,jp_sal) )  
    398          CALL iom_close( inum ) 
    399  
    400          tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)  
    401          tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    402          ! 
    403       END SELECT 
    404       ! 
    405       IF(lwp) THEN 
    406          WRITE(numout,*) 
    407          WRITE(numout,*) '              Initial temperature and salinity profiles:' 
    408          WRITE(numout, "(9x,' level   gdept_1d   temperature   salinity   ')" ) 
    409          WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 
    410       ENDIF 
    411       ! 
    412    END SUBROUTINE istate_gyre 
    413  
    414  
    415    SUBROUTINE istate_uvg 
    416       !!---------------------------------------------------------------------- 
    417       !!                  ***  ROUTINE istate_uvg  *** 
    418       !! 
    419       !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields 
    420       !! 
    421       !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic  
    422       !!      pressure is computed by integrating the in-situ density from the 
    423       !!      surface to the bottom. 
    424       !!                 p=integral [ rau*g dz ] 
    425       !!---------------------------------------------------------------------- 
    426       USE divhor          ! hor. divergence                       (div_hor routine) 
    427       USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    428       ! 
    429       INTEGER ::   ji, jj, jk        ! dummy loop indices 
    430       REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars 
    431       REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn 
    432       !!---------------------------------------------------------------------- 
    433       ! 
    434       CALL wrk_alloc( jpi,jpj,jpk,   zprn) 
    435       ! 
    436       IF(lwp) WRITE(numout,*)  
    437       IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy' 
    438       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    439  
    440       ! Compute the now hydrostatic pressure 
    441       ! ------------------------------------ 
    442  
    443       zalfg = 0.5 * grav * rau0 
    444        
    445       zprn(:,:,1) = zalfg * e3w_n(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value 
    446  
    447       DO jk = 2, jpkm1                                              ! Vertical integration from the surface 
    448          zprn(:,:,jk) = zprn(:,:,jk-1)   & 
    449             &         + zalfg * e3w_n(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) ) 
    450       END DO   
    451  
    452       ! Compute geostrophic balance 
    453       ! --------------------------- 
    454       DO jk = 1, jpkm1 
    455          DO jj = 2, jpjm1 
    456             DO ji = fs_2, fs_jpim1   ! vertor opt. 
    457                zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   & 
    458                                + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  ) 
    459                zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   & 
    460                     + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   & 
    461                     + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   & 
    462                     + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  ) 
    463                zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk) 
    464  
    465                zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   & 
    466                                + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  ) 
    467                zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   & 
    468                     + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   & 
    469                     + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   & 
    470                     + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1) 
    471                zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk) 
    472  
    473                ! Compute the geostrophic velocities 
    474                un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) ) 
    475                vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) ) 
    476             END DO 
    477          END DO 
    478       END DO 
    479  
    480       IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity' 
    481  
    482       ! Susbtract the bottom velocity (level jpk-1 for flat bottom case) 
    483       ! to have a zero bottom velocity 
    484  
    485       DO jk = 1, jpkm1 
    486          un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk) 
    487          vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk) 
    488       END DO 
    489  
    490       CALL lbc_lnk( un, 'U', -1. ) 
    491       CALL lbc_lnk( vn, 'V', -1. ) 
    492        
    493       ub(:,:,:) = un(:,:,:) 
    494       vb(:,:,:) = vn(:,:,:) 
    495        
    496       ! 
    497 !!gm  Check  here call to div_hor should not be necessary 
    498 !!gm         div_hor call runoffs  not sure they are defined at that level 
    499       CALL div_hor( nit000 )            ! now horizontal divergence 
    500       ! 
    501       CALL wrk_dealloc( jpi,jpj,jpk,   zprn) 
    502       ! 
    503    END SUBROUTINE istate_uvg 
    504  
    505    !!===================================================================== 
     169   !!====================================================================== 
    506170END MODULE istate 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5147 r7277  
    100100      !!                       ***  ROUTINE phy_cst  *** 
    101101      !! 
    102       !! ** Purpose :   Print model parameters and set and print the constants 
    103       !!---------------------------------------------------------------------- 
    104       CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )"  
     102      !! ** Purpose :   set and print the constants 
    105103      !!---------------------------------------------------------------------- 
    106104 
    107105      IF(lwp) WRITE(numout,*) 
    108       IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
     106      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of physical constants' 
    109107      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    110108 
    111       ! Ocean Parameters 
    112       ! ---------------- 
    113       IF(lwp) THEN 
    114          WRITE(numout,*) '       Domain info' 
    115          WRITE(numout,*) '          dimension of model' 
    116          WRITE(numout,*) '                 Local domain      Global domain       Data domain ' 
    117          WRITE(numout,cform) '            ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
    118          WRITE(numout,cform) '            ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
    119          WRITE(numout,cform) '            ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta 
    120          WRITE(numout,*)      '           ','   jpij    : ', jpij 
    121          WRITE(numout,*) '          mpp local domain info (mpp)' 
    122          WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci 
    123          WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj 
    124          WRITE(numout,*) '             jpnij   : ', jpnij 
    125          WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    126       ENDIF 
    127  
    128       ! Define constants 
    129       ! ---------------- 
     109      ! Define & print constants 
     110      ! ------------------------ 
    130111      IF(lwp) WRITE(numout,*) 
    131112      IF(lwp) WRITE(numout,*) '       Constants' 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r6152 r7277  
    454454        DO jj = 2, jpjm1 
    455455           DO ji = 2, jpim1  
    456              ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj))  
    457              ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) > rn_wdmin1 + rn_wdmin2 
    458              ll_tmp3 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) + & 
     456             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj))  
     457             ll_tmp2 = MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj)) > rn_wdmin1 + rn_wdmin2 
     458             ll_tmp3 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj)) + & 
    459459                                                       & rn_wdmin1 + rn_wdmin2 
    460460 
    … …  
    464464             ELSE IF(ll_tmp3) THEN 
    465465               ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 
    466                zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) / & 
     466               zcpx(ji,jj) = ABS((sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) / & 
    467467                           &     (sshn(ji+1,jj) - sshn(ji,jj))) 
    468468               wduflt(ji,jj) = 1.0_wp 
    … …  
    472472             END IF 
    473473       
    474              ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1))  
    475              ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) > rn_wdmin1 + rn_wdmin2 
    476              ll_tmp3 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) + & 
     474             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1))  
     475             ll_tmp2 = MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1)) > rn_wdmin1 + rn_wdmin2 
     476             ll_tmp3 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1)) + & 
    477477                                                       & rn_wdmin1 + rn_wdmin2 
    478478 
    … …  
    482482             ELSE IF(ll_tmp3) THEN 
    483483               ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 
    484                zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) / & 
     484               zcpy(ji,jj) = ABS((sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) / & 
    485485                           &     (sshn(ji,jj+1) - sshn(ji,jj))) 
    486486               wdvflt(ji,jj) = 1.0_wp 
    … …  
    707707        DO jj = 2, jpjm1 
    708708           DO ji = 2, jpim1  
    709              ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 
    710                      & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 
     709             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj)) & 
     710                     & .and. MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj)) & 
    711711                     &  > rn_wdmin1 + rn_wdmin2 
    712              ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 
     712             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj)) +& 
    713713                                                       & rn_wdmin1 + rn_wdmin2 
    714714 
    … …  
    717717             ELSE IF(ll_tmp2) THEN 
    718718               ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 
    719                zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 
     719               zcpx(ji,jj) = ABS((sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) /& 
    720720                           &     (sshn(ji+1,jj) - sshn(ji,jj))) 
    721721             ELSE 
    … …  
    723723             END IF 
    724724       
    725              ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 
    726                      & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 
     725             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1)) & 
     726                     & .and. MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1)) & 
    727727                     &  > rn_wdmin1 + rn_wdmin2 
    728              ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 
     728             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1)) +& 
    729729                                                       & rn_wdmin1 + rn_wdmin2 
    730730 
    … …  
    733733             ELSE IF(ll_tmp2) THEN 
    734734               ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 
    735                zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 
     735               zcpy(ji,jj) = ABS((sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) /& 
    736736                           &     (sshn(ji,jj+1) - sshn(ji,jj))) 
    737737             ELSE 
    … …  
    10031003        DO jj = 2, jpjm1 
    10041004           DO ji = 2, jpim1  
    1005              ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 
    1006                      & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 
     1005             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj)) & 
     1006                     & .and. MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj)) & 
    10071007                     &  > rn_wdmin1 + rn_wdmin2 
    1008              ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 
     1008             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj)) +& 
    10091009                                                       & rn_wdmin1 + rn_wdmin2 
    10101010 
    … …  
    10131013             ELSE IF(ll_tmp2) THEN 
    10141014               ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 
    1015                zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 
     1015               zcpx(ji,jj) = ABS((sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) /& 
    10161016                           &     (sshn(ji+1,jj) - sshn(ji,jj))) 
    10171017             ELSE 
    … …  
    10191019             END IF 
    10201020       
    1021              ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 
    1022                      & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 
     1021             ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1)) & 
     1022                     & .and. MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1)) & 
    10231023                     &  > rn_wdmin1 + rn_wdmin2 
    1024              ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 
     1024             ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1)) +& 
    10251025                                                       & rn_wdmin1 + rn_wdmin2 
    10261026 
    … …  
    10291029             ELSE IF(ll_tmp2) THEN 
    10301030               ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 
    1031                zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 
     1031               zcpy(ji,jj) = ABS((sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) /& 
    10321032                           &     (sshn(ji,jj+1) - sshn(ji,jj))) 
    10331033             ELSE 
    … …  
    10461046      DO jj = 1, jpj 
    10471047        DO ji = 1, jpi 
    1048           jk = mbathy(ji,jj) 
     1048          jk = mbkt(ji,jj)+1 
    10491049          IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
    10501050          ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r6152 r7277  
    6969   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   wgtbtp1, wgtbtp2   !: 1st & 2nd weights used in time filtering of barotropic fields 
    7070 
    71    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff/h at F points 
     71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz          !: ff_f/h at F points 
    7272   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   !: triad of coriolis parameter 
    7373   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   !: (only used with een vorticity scheme) 
    … …  
    220220      IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN 
    221221         IF( ln_dynvor_een ) THEN               !==  EEN scheme  ==! 
    222             SELECT CASE( nn_een_e3f )              !* ff/e3 at F-point 
     222            SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    223223            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    224224               DO jj = 1, jpjm1 
    … …  
    226226                     zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    227227                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
    228                      IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 
     228                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    229229                  END DO 
    230230               END DO 
    … …  
    236236                        &       / ( MAX( 1._wp, tmask(ji  ,jj+1, 1) + tmask(ji+1,jj+1, 1) +    & 
    237237                        &                       tmask(ji  ,jj  , 1) + tmask(ji+1,jj  , 1) ) ) 
    238                      IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 
     238                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    239239                  END DO 
    240240               END DO 
    … …  
    255255            zwz(:,:) = 0._wp 
    256256            zhf(:,:) = 0._wp 
    257             IF ( .not. ln_sco ) THEN 
    258  
    259 !!gm  agree the JC comment  : this should be done in a much clear way 
    260  
    261 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 
    262 !     Set it to zero for the time being  
    263 !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level 
    264 !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth 
    265 !              ENDIF 
    266 !              zhf(:,:) = gdepw_0(:,:,jk+1) 
    267             ELSE 
    268                zhf(:,:) = hbatf(:,:) 
    269             END IF 
    270  
    271             DO jj = 1, jpjm1 
    272                zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
    273             END DO 
     257             
     258!!gm  assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed  
     259!!gm    A priori a better value should be something like : 
     260!!gm          zhf(i,j) = masked sum of  ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1)  
     261!!gm                     divided by the sum of the corresponding mask  
     262!!gm  
     263!!             
     264!!            IF ( .not. ln_sco ) THEN 
     265!! 
     266!! !!gm  agree the JC comment  : this should be done in a much clear way 
     267!! 
     268!! ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 
     269!! !     Set it to zero for the time being  
     270!! !              IF( rn_hmin < 0._wp ) THEN    ;   jk = - INT( rn_hmin )                                      ! from a nb of level 
     271!! !              ELSE                          ;   jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth 
     272!! !              ENDIF 
     273!! !              zhf(:,:) = gdepw_0(:,:,jk+1) 
     274!!             ELSE 
     275!!               zhf(:,:) = hbatf(:,:) 
     276!!            END IF 
     277!! 
     278!!            DO jj = 1, jpjm1 
     279!!               zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
     280!!            END DO 
     281!!gm end 
    274282 
    275283            DO jk = 1, jpkm1 
    … …  
    285293               END DO 
    286294            END DO 
    287             zwz(:,:) = ff(:,:) * zwz(:,:) 
     295            zwz(:,:) = ff_f(:,:) * zwz(:,:) 
    288296         ENDIF 
    289297      ENDIF 
    … …  
    378386          DO jj = 2, jpjm1 
    379387             DO ji = 2, jpim1 
    380                 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj))   & 
    381                         & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj))   & 
     388                ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj))   & 
     389                        & .and. MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji+1,jj) + ht_0(ji+1,jj))   & 
    382390                        &  > rn_wdmin1 + rn_wdmin2 
    383                 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj))   & 
     391                ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-ht_0(ji,jj), -ht_0(ji+1,jj))   & 
    384392                        &                                   + rn_wdmin1 + rn_wdmin2 
    385393                IF(ll_tmp1) THEN 
    … …  
    387395                ELSEIF(ll_tmp2) THEN 
    388396                   ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen here 
    389                   zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) & 
     397                  zcpx(ji,jj) = ABS((sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 
    390398                        &          /(sshn(ji+1,jj) - sshn(ji,jj))) 
    391399                ELSE 
    … …  
    394402                END IF 
    395403 
    396                 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1))   & 
    397                         & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1))   & 
     404                ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1))   & 
     405                        & .and. MAX(sshn(ji,jj) + ht_0(ji,jj), sshn(ji,jj+1) + ht_0(ji,jj+1))   & 
    398406                        &  > rn_wdmin1 + rn_wdmin2 
    399                 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1))   & 
     407                ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-ht_0(ji,jj), -ht_0(ji,jj+1))   & 
    400408                        &                                   + rn_wdmin1 + rn_wdmin2 
    401409                IF(ll_tmp1) THEN 
    … …  
    403411                ELSEIF(ll_tmp2) THEN 
    404412                   ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen here 
    405                   zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) & 
     413                  zcpy(ji,jj) = ABS((sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 
    406414                        &          /(sshn(ji,jj+1) - sshn(ji,jj))) 
    407415                ELSE 
    … …  
    569577      IF( ln_wd ) THEN      !preserve the positivity of water depth 
    570578                          !ssh[b,n,a] should have already been processed for this 
    571          sshbb_e(:,:) = MAX(sshbb_e(:,:), rn_wdmin1 - bathy(:,:)) 
    572          sshb_e(:,:)  = MAX(sshb_e(:,:) , rn_wdmin1 - bathy(:,:)) 
     579         sshbb_e(:,:) = MAX(sshbb_e(:,:), rn_wdmin1 - ht_0(:,:)) 
     580         sshb_e(:,:)  = MAX(sshb_e(:,:) , rn_wdmin1 - ht_0(:,:)) 
    573581      ENDIF 
    574582      ! 
    … …  
    702710         END DO 
    703711         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
    704          IF( ln_wd ) ssha_e(:,:) = MAX(ssha_e(:,:), rn_wdmin1 - bathy(:,:))  
     712         IF( ln_wd ) ssha_e(:,:) = MAX(ssha_e(:,:), rn_wdmin1 - ht_0(:,:))  
    705713         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
    706714 
    … …  
    754762           DO jj = 2, jpjm1 
    755763              DO ji = 2, jpim1 
    756                  ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -bathy(ji,jj), -bathy(ji+1,jj) ) & 
    757                         & .AND. MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji+1,jj) + bathy(ji+1,jj) )    & 
     764                 ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -ht_0(ji,jj), -ht_0(ji+1,jj) ) & 
     765                        & .AND. MAX( zsshp2_e(ji,jj) + ht_0(ji,jj), zsshp2_e(ji+1,jj) + ht_0(ji+1,jj) )    & 
    758766                        &                                  > rn_wdmin1 + rn_wdmin2 
    759                  ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -bathy(ji,jj), -bathy(ji+1,jj) ) & 
     767                 ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji+1,jj) ) > MAX( -ht_0(ji,jj), -ht_0(ji+1,jj) ) & 
    760768                        &                                  + rn_wdmin1 + rn_wdmin2 
    761769                 IF(ll_tmp1) THEN 
    … …  
    763771                 ELSE IF(ll_tmp2) THEN 
    764772                    ! no worries about zsshp2_e(ji+1,jj)-zsshp2_e(ji,jj) = 0, it won't happen here 
    765                     zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) + bathy(ji+1,jj) - zsshp2_e(ji,jj) - bathy(ji,jj)) & 
     773                    zcpx(ji,jj) = ABS( (zsshp2_e(ji+1,jj) + ht_0(ji+1,jj) - zsshp2_e(ji,jj) - ht_0(ji,jj)) & 
    766774                        &             / (zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj)) ) 
    767775                 ELSE 
    … …  
    770778                 END IF 
    771779 
    772                  ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -bathy(ji,jj), -bathy(ji,jj+1) ) & 
    773                         & .AND. MAX( zsshp2_e(ji,jj) + bathy(ji,jj), zsshp2_e(ji,jj+1) + bathy(ji,jj+1) )    & 
     780                 ll_tmp1 = MIN( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -ht_0(ji,jj), -ht_0(ji,jj+1) ) & 
     781                        & .AND. MAX( zsshp2_e(ji,jj) + ht_0(ji,jj), zsshp2_e(ji,jj+1) + ht_0(ji,jj+1) )    & 
    774782                        &                                  > rn_wdmin1 + rn_wdmin2 
    775                  ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -bathy(ji,jj), -bathy(ji,jj+1) ) & 
     783                 ll_tmp2 = MAX( zsshp2_e(ji,jj), zsshp2_e(ji,jj+1) ) > MAX( -ht_0(ji,jj), -ht_0(ji,jj+1) ) & 
    776784                        &                                  + rn_wdmin1 + rn_wdmin2 
    777785                 IF(ll_tmp1) THEN 
    … …  
    779787                 ELSE IF(ll_tmp2) THEN 
    780788                    ! no worries about zsshp2_e(ji,jj+1)-zsshp2_e(ji,jj) = 0, it won't happen here 
    781                     zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) + bathy(ji,jj+1) - zsshp2_e(ji,jj) - bathy(ji,jj)) & 
     789                    zcpy(ji,jj) = ABS( (zsshp2_e(ji,jj+1) + ht_0(ji,jj+1) - zsshp2_e(ji,jj) - ht_0(ji,jj)) & 
    782790                        &             / (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj)) ) 
    783791                 ELSE 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r6140 r7277  
    237237         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    238238         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    239             zwz(:,:) = ff(:,:)  
     239            zwz(:,:) = ff_f(:,:)  
    240240         CASE ( np_RVO )                           !* relative vorticity 
    241241            DO jj = 1, jpjm1 
    … …  
    256256            DO jj = 1, jpjm1 
    257257               DO ji = 1, fs_jpim1   ! vector opt. 
    258                   zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    259                      &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    260                      &                   * r1_e1e2f(ji,jj) 
     258                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     259                     &                        - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     260                     &                     * r1_e1e2f(ji,jj) 
    261261               END DO 
    262262            END DO 
    … …  
    264264            DO jj = 1, jpjm1 
    265265               DO ji = 1, fs_jpim1   ! vector opt. 
    266                   zwz(ji,jj) = ff(ji,jj)                                                                        & 
     266                  zwz(ji,jj) = ff_f(ji,jj)                                                                      & 
    267267                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    268268                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    … …  
    357357         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    358358         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    359             zwz(:,:) = ff(:,:)  
     359            zwz(:,:) = ff_f(:,:)  
    360360         CASE ( np_RVO )                           !* relative vorticity 
    361361            DO jj = 1, jpjm1 
    … …  
    376376            DO jj = 1, jpjm1 
    377377               DO ji = 1, fs_jpim1   ! vector opt. 
    378                   zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    379                      &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    380                      &                   * r1_e1e2f(ji,jj) 
     378                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     379                     &                        - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     380                     &                     * r1_e1e2f(ji,jj) 
    381381               END DO 
    382382            END DO 
    … …  
    384384            DO jj = 1, jpjm1 
    385385               DO ji = 1, fs_jpim1   ! vector opt. 
    386                   zwz(ji,jj) = ff(ji,jj)                                                                       & 
     386                  zwz(ji,jj) = ff_f(ji,jj)                                                                      & 
    387387                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    388388                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    … …  
    506506            DO jj = 1, jpjm1 
    507507               DO ji = 1, fs_jpim1   ! vector opt. 
    508                   zwz(ji,jj) = ff(ji,jj) * z1_e3f(ji,jj) 
     508                  zwz(ji,jj) = ff_f(ji,jj) * z1_e3f(ji,jj) 
    509509               END DO 
    510510            END DO 
    … …  
    528528            DO jj = 1, jpjm1 
    529529               DO ji = 1, fs_jpim1   ! vector opt. 
    530                   zwz(ji,jj) = (  ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    531                      &                         - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    532                      &                      * r1_e1e2f(ji,jj)    ) * z1_e3f(ji,jj) 
     530                  zwz(ji,jj) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
     531                     &                           - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
     532                     &                        * r1_e1e2f(ji,jj)    ) * z1_e3f(ji,jj) 
    533533               END DO 
    534534            END DO 
    … …  
    536536            DO jj = 1, jpjm1 
    537537               DO ji = 1, fs_jpim1   ! vector opt. 
    538                   zwz(ji,jj) = (  ff(ji,jj)                                                                        & 
     538                  zwz(ji,jj) = (  ff_f(ji,jj)                                                                      & 
    539539                       &        + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    540540                       &            - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90

    r6152 r7277  
    1  
    21MODULE wet_dry 
    32   !!============================================================================== 
    … …  
    76   !! only effects if wetting/drying is on (ln_wd == .true.) 
    87   !!============================================================================== 
    9    !! History :    
    10    !!  NEMO      3.6  ! 2014-09  ((H.Liu)  Original code 
     8   !! History :  3.6  ! 2014-09  ((H.Liu)  Original code 
    119   !!                 ! will add the runoff and periodic BC case later 
    1210   !!---------------------------------------------------------------------- 
    … …  
    8482         WRITE(numout,*) '      land elevation threshold         rn_wdld      = ', rn_wdld 
    8583         WRITE(numout,*) '      Max iteration for W/D limiter    nn_wdit      = ', nn_wdit 
    86        ENDIF 
    87  
     84      ENDIF 
     85      ! 
    8886      IF(ln_wd) THEN 
    8987         ALLOCATE( wduflt(jpi,jpj), wdvflt(jpi,jpj), wdmask(jpi,jpj), STAT=ierr ) 
    9088         IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error') 
    9189      ENDIF 
     90      ! 
    9291   END SUBROUTINE wad_init 
     92 
    9393 
    9494   SUBROUTINE wad_lmt( sshb1, sshemp, z2dt ) 
    … …  
    116116      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu,  zflxv            ! local 2D workspace 
    117117      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    118  
    119118      !!---------------------------------------------------------------------- 
    120119      ! 
    … …  
    124123      IF(ln_wd) THEN 
    125124 
    126         CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    127         CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 
     125        CALL wrk_alloc( jpi,jpj,  zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
     126        CALL wrk_alloc( jpi,jpj,  zwdlmtu, zwdlmtv) 
    128127        ! 
    129128        
    … …  
    156155        zflxv(:,:) = zflxv(:,:) * e1v(:,:) 
    157156        
    158         DO jj = 2, jpjm1 
     157         DO jj = 2, jpjm1 
    159158           DO ji = 2, jpim1  
    160159 
    161              IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE   ! we don't care about land cells 
    162              IF(bathy(ji,jj) > zdepwd) CYCLE       ! and cells which will unlikely go dried out 
     160             IF( tmask(ji,jj,1) == 0._wp  )  CYCLE   ! we don't care about land cells 
     161             IF( ht_0 (ji,jj)   >  zdepwd )   CYCLE   ! and cells which will unlikely go dried out 
    163162 
    164163              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    … …  
    167166                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    168167 
    169               zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
     168              zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
    170169              IF(zdep2 < 0._wp) THEN  !add more safty, but not necessary 
    171170                !zdep2 = 0._wp 
    172                 sshb1(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
     171                sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    173172              END IF 
    174173           ENDDO 
    … …  
    187186         
    188187                 wdmask(ji,jj) = 0 
    189                  IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE  
    190                  IF(bathy(ji,jj) > zdepwd) CYCLE 
     188                 IF( tmask(ji,jj,1) < 0.5_wp) CYCLE  
     189                 IF( ht_0(ji,jj) > zdepwd) CYCLE 
    191190         
    192191                 ztmp = e1e2t(ji,jj) 
    … …  
    198197           
    199198                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    200                  zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)  ! this one can be moved out of the loop 
     199                 zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)  ! this one can be moved out of the loop 
    201200           
    202201                 IF(zdep1 > zdep2) THEN 
    … …  
    240239        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 ) 
    241240        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    242       ! 
    243       END IF 
    244  
     241         ! 
     242      ENDIF 
     243      ! 
    245244      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     245      ! 
    246246   END SUBROUTINE wad_lmt 
     247 
    247248 
    248249   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt ) 
    … …  
    267268      REAL(wp) ::   ztmp                ! local scalars 
    268269      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters 
    269       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! local 2D workspace 
    270       REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! local 2D workspace 
    271  
    272       !!---------------------------------------------------------------------- 
    273       ! 
    274  
     270      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxp,  zflxn            ! 2D workspace 
     271      REAL(wp), POINTER,  DIMENSION(:,:) ::   zflxu1, zflxv1           ! 2D workspace 
     272      !!---------------------------------------------------------------------- 
     273      ! 
    275274      IF( nn_timing == 1 )  CALL timing_start('wad_lmt_bt') 
    276275 
    … …  
    305304           DO ji = 2, jpim1  
    306305 
    307              IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE   ! we don't care about land cells 
    308              IF(bathy(ji,jj) > zdepwd) CYCLE       ! and cells which will unlikely go dried out 
     306             IF(tmask(ji,jj,1) < 0.5_wp) CYCLE   ! we don't care about land cells 
     307             IF(ht_0 (ji,jj)  > zdepwd) CYCLE       ! and cells which will unlikely go dried out 
    309308 
    310309              zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj),   0._wp) + & 
    … …  
    313312                           & min(zflxv(ji,jj), 0._wp) - max(zflxv(ji,  jj-1), 0._wp)  
    314313 
    315               zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
     314              zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 
    316315              IF(zdep2 < 0._wp) THEN  !add more safty, but not necessary 
    317316                !zdep2 = 0._wp 
    318                sshn_e(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
     317               sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    319318              END IF 
    320319           ENDDO 
    … …  
    333332         
    334333                 wdmask(ji,jj) = 0 
    335                  IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE  
    336                  IF(bathy(ji,jj) > zdepwd) CYCLE 
     334                 IF(tmask(ji,jj,1) < 0.5_wp) CYCLE  
     335                 IF(ht_0 (ji,jj)  > zdepwd) CYCLE 
    337336         
    338337                 ztmp = e1e2t(ji,jj) 
    … …  
    344343           
    345344                 zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    346                  zdep2 = bathy(ji,jj) + sshn_e(ji,jj) - rn_wdmin1   ! this one can be moved out of the loop 
     345                 zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1   ! this one can be moved out of the loop 
    347346                 zdep2 = zdep2 - z2dt * zssh_frc(ji,jj) 
    348347           
    … …  
    385384        CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 
    386385        CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 
    387       ! 
     386         ! 
    388387      END IF 
    389  
     388      ! 
    390389      IF( nn_timing == 1 )  CALL timing_stop('wad_lmt') 
     390      ! 
    391391   END SUBROUTINE wad_lmt_bt 
     392    
     393   !!============================================================================== 
    392394END MODULE wet_dry 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r6140 r7277  
    106106222   DO jfl = 1, jpnfl 
    107107# if   defined key_mpp_mpi 
    108          IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    109              (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
    110             iiloc(jfl) = iil(jfl) - (mig(1)-jpizoom+1) + 1 
    111             ijloc(jfl) = ijl(jfl) - (mjg(1)-jpjzoom+1) + 1 
     108         IF( iil(jfl) >= mig(nldi) .AND. iil(jfl) <= mig(nlei) .AND.   & 
     109             ijl(jfl) >= mjg(nldj) .AND. ijl(jfl) <= mjg(nlej)  ) THEN 
     110            iiloc(jfl) = iil(jfl) - mig(1) + 1 
     111            ijloc(jfl) = ijl(jfl) - mjg(1) + 1 
    112112# else  
    113113            iiloc(jfl) = iil(jfl) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r6140 r7277  
    234234 
    235235            ! Translation of this distances (in meter) in indexes 
    236             zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
    237             zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
     236            zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-1) 
     237            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-1) 
    238238            zgkfl(jfl) = (( gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
    239239               &                 / (  gdepw_n(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90

    r6140 r7277  
    102102         IF( lk_mpp ) THEN 
    103103            DO jfl = 1, jpnfl 
    104                IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   & 
    105                   &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   & 
    106                   &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   & 
    107                   &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN 
     104               IF( (INT(tpifl(jfl)) >= mig(nldi)) .AND.   & 
     105                  &(INT(tpifl(jfl)) <= mig(nlei)) .AND.   & 
     106                  &(INT(tpjfl(jfl)) >= mjg(nldj)) .AND.   & 
     107                  &(INT(tpjfl(jfl)) <= mjg(nlej)) ) THEN 
    108108                  iperproc(narea) = iperproc(narea)+1 
    109109               ENDIF 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r5215 r7277  
    7272      uo_e(:,:) = 0._wp ;   uo_e(1:jpi, 1:jpj) = ssu_m(:,:) * umask(:,:,1) 
    7373      vo_e(:,:) = 0._wp ;   vo_e(1:jpi, 1:jpj) = ssv_m(:,:) * vmask(:,:,1) 
    74       ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff  (:,:)  
     74      ff_e(:,:) = 0._wp ;   ff_e(1:jpi, 1:jpj) = ff_f (:,:)  
    7575      tt_e(:,:) = 0._wp ;   tt_e(1:jpi, 1:jpj) = sst_m(:,:) 
    7676      fr_e(:,:) = 0._wp ;   fr_e(1:jpi, 1:jpj) = fr_i (:,:) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r6140 r7277  
    1717   IMPLICIT NONE 
    1818   PUBLIC 
    19  
    2019  
    21    ! 
    2220   !!---------------------------------------------------------------------- 
    2321   !!                   namrun namelist parameters 
    … …  
    4644   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file 
    4745   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
     46 
    4847#if defined key_netcdf4 
    4948   !!---------------------------------------------------------------------- 
    … …  
    6362   !                           !                     to produce netcdf3-compatible files  
    6463#endif 
     64 
    6565!$AGRIF_DO_NOT_TREAT 
    6666   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making) 
    … …  
    105105   INTEGER ::   nn_isplt     !: number of processors following i 
    106106   INTEGER ::   nn_jsplt     !: number of processors following j 
    107    INTEGER ::   nn_bench     !: benchmark parameter (0/1) 
    108107   INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1) 
    109108 
    110109   !                                           
    111    INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names 
     110   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names 
    112111 
    113112   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6140 r7277  
    789789                  ENDIF 
    790790                  IF( PRESENT(pv_r3d) ) THEN 
    791                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta 
     791                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkglo 
    792792                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    793793                     ELSE                                                           ; icnt(3) = jpk 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r6140 r7277  
    1818   PRIVATE 
    1919 
    20    INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta) 
     20   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed 
    2121   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo) 
    2222   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r6140 r7277  
    66      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED 
    77      !!     FOR DEFINING BETTER CUTTING OUT. 
    8       !!       This routine is used with a the bathymetry file. 
     8      !!       This routine requires the presence of the domain configuration file. 
    99      !!       In this version, the land processors are avoided and the adress 
    1010      !!     processor (nproc, narea,noea, ...) are calculated again. 
    … …  
    3232      !!                    nono      : number for local neighboring processor 
    3333      !! 
    34       !! History : 
    35       !!        !  94-11  (M. Guyon)  Original code 
    36       !!        !  95-04  (J. Escobar, M. Imbard) 
    37       !!        !  98-02  (M. Guyon)  FETI method 
    38       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    39       !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     34      !! History :       !  1994-11  (M. Guyon)  Original code 
     35      !!  OPA            !  1995-04  (J. Escobar, M. Imbard) 
     36      !!                 !  1998-02  (M. Guyon)  FETI method 
     37      !!                 !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
     38      !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     39      !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file 
    4040      !!---------------------------------------------------------------------- 
    4141      USE in_out_manager  ! I/O Manager 
    … …  
    6565         ione  , ionw  , iose  , iosw  ,   &  !    "           " 
    6666         ibne  , ibnw  , ibse  , ibsw         !    "           " 
    67       INTEGER,  DIMENSION(jpiglo,jpjglo) ::   & 
    68          imask                                ! temporary global workspace 
    69       REAL(wp), DIMENSION(jpiglo,jpjglo) ::   & 
    70          zdta, zdtaisf                     ! temporary data workspace 
    71       REAL(wp) ::   zidom , zjdom          ! temporary scalars 
    72  
    73       ! read namelist for ln_zco 
    74       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
    75  
     67      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   imask        ! global workspace 
     68      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, ztop   ! global workspace 
     69      REAL(wp) ::   zidom , zjdom          ! local scalars 
    7670      !!---------------------------------------------------------------------- 
    77       !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     71      !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    7872      !! $Id$ 
    79       !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     73      !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8074      !!---------------------------------------------------------------------- 
    8175 
    82       REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate 
    83       READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901) 
    84 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 
    85  
    86       REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate 
    87       READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
    88 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
    89       IF(lwm) WRITE ( numond, namzgr ) 
    90  
    9176      IF(lwp)WRITE(numout,*) 
    92       IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI' 
    93       IF(lwp)WRITE(numout,*) '~~~~~~~~' 
     77      IF(lwp)WRITE(numout,*) 'mpp_init_2 : Message Passing MPI' 
     78      IF(lwp)WRITE(numout,*) '~~~~~~~~~~' 
    9479      IF(lwp)WRITE(numout,*) ' ' 
    9580 
    96       IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 
     81      IF( jpni*jpnj < jpnij )   CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 
    9782 
    9883      ! 0. initialisation 
    9984      ! ----------------- 
    100  
    101       ! open the file 
    102       ! Remember that at this level in the code, mpp is not yet initialized, so 
    103       ! the file must be open with jpdom_unknown, and kstart and kcount forced  
    104       jstartrow = 1 
    105       IF ( ln_zco ) THEN  
    106          CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry 
    107           ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 
    108           ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 
    109          CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    110          jstartrow = MAX(1,jstartrow) 
    111          CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) 
    112       ELSE 
    113          CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
    114          IF ( ln_isfcav ) THEN 
    115              CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 
    116          ELSE 
    117              ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 
    118              ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 
    119              CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    120              jstartrow = MAX(1,jstartrow) 
    121              CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   & 
    122                 &                                                   , kcount=(/jpiglo,jpjglo/) ) 
    123          ENDIF 
    124       ENDIF 
    125       CALL iom_close (inum) 
    126        
    127       ! used to compute the land processor in case of not masked bathy file. 
    128       zdtaisf(:,:) = 0.0_wp 
    129       IF ( ln_isfcav ) THEN 
    130          CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
    131          CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 
    132       END IF 
    133       CALL iom_close (inum) 
    134  
    135       ! land/sea mask over the global/zoom domain 
    136  
    137       imask(:,:)=1 
    138       WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0 
     85      CALL iom_open( cn_domcfg, inum ) 
     86      ! 
     87      !                                   ! ocean top and bottom level 
     88      CALL iom_get( inum, jpdom_data, 'bottom_level' , zbot    )  ! nb of ocean T-points 
     89      CALL iom_get( inum, jpdom_data, 'top_level'    , ztop    )  ! nb of ocean T-points (ISF) 
     90      ! 
     91      CALL iom_close( inum ) 
     92      ! 
     93      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 
     94      WHERE( zbot(:,:) - ztop(:,:) + 1 > 0 )   ;   imask(:,:) = 1 
     95      ELSEWHERE                                ;   imask(:,:) = 0 
     96      END WHERE 
    13997 
    14098      !  1. Dimension arrays for subdomains 
    … …  
    321279         DO jj = 1+jprecj, ilj-jprecj 
    322280            DO  ji = 1+jpreci, ili-jpreci 
    323                IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 
     281               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1)   isurf = isurf+1 
    324282            END DO 
    325283         END DO 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r6140 r7277  
    298298      ! 
    299299      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    300       REAL(wp) ::   zaht, zaht_min, z1_f20       ! local scalar 
     300      REAL(wp) ::   zaht, zahf, zaht_min, z1_f20       ! local scalar 
    301301      !!---------------------------------------------------------------------- 
    302302      ! 
    … …  
    327327         DO jj = 1, jpj 
    328328            DO ji = 1, jpi 
    329                zaht = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 
     329               !!gm CAUTION : here we assume lat/lon grid in 20deg N/S band (like all ORCA cfg) 
     330               !!     ==>>>   The Coriolis value is identical for t- & u_points, and for v- and f-points 
     331               zaht = ( 1._wp -  MIN( 1._wp , ABS( ff_t(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 
     332               zahf = ( 1._wp -  MIN( 1._wp , ABS( ff_f(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 
    330333               ahtu(ji,jj,1) = (  MAX( zaht_min, ahtu(ji,jj,1) ) + zaht  ) * umask(ji,jj,1)     ! min value zaht_min 
    331                ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zaht  ) * vmask(ji,jj,1)     ! increase within 20S-20N 
     334               ahtv(ji,jj,1) = (  MAX( zaht_min, ahtv(ji,jj,1) ) + zahf  ) * vmask(ji,jj,1)     ! increase within 20S-20N 
    332335            END DO 
    333336         END DO 
    … …  
    555558      END DO 
    556559 
    557 !!gm      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2 
    558 !!gm         DO jj = 2, jpjm1 
    559 !!gm            DO ji = fs_2, fs_jpim1   ! vector opt. 
    560 !!gm               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m) 
    561 !!gm               IF( mbkt(ji,jj) <= 20 )   zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. ) 
    562 !!gm            END DO 
    563 !!gm         END DO 
    564 !!gm      ENDIF 
    565  
    566560      !                                         !==  Bound on eiv coeff.  ==! 
    567561      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
    568562      DO jj = 2, jpjm1 
    569563         DO ji = fs_2, fs_jpim1   ! vector opt. 
    570             zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease 
     564            zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)       ! tropical decrease 
    571565            zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 
    572566         END DO 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90

    r2287 r7277  
    7171 
    7272      !! * Arguments 
    73       REAL(KIND=wp) :: pft   ! in situ temperature in degrees celcius 
     73      REAL(KIND=wp) :: pft   ! in situ temperature in degrees Celsius 
    7474      REAL(KIND=wp) :: pfs   ! salinity in psu 
    7575      REAL(KIND=wp) :: pfp   ! pressure in bars 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r6140 r7277  
    1313   !!   obs_sor       : Sort the observation arrays 
    1414   !!--------------------------------------------------------------------- 
    15    !! * Modules used 
    16    USE par_kind, ONLY : & ! Precision variables 
    17       & wp    
     15   USE par_kind, ONLY : wp ! Precision variables 
    1816   USE in_out_manager     ! I/O manager 
    1917   USE obs_profiles_def   ! Definitions for storage arrays for profiles 
    … …  
    2422   USE obs_inter_sup      ! Interpolation support 
    2523   USE obs_oper           ! Observation operators 
    26    USE lib_mpp, ONLY : & 
    27       & ctl_warn, ctl_stop 
     24   USE lib_mpp, ONLY :   ctl_warn, ctl_stop 
    2825 
    2926   IMPLICIT NONE 
    30  
    31    !! * Routine accessibility 
    3227   PRIVATE 
    3328 
    34    PUBLIC & 
    35       & obs_pre_prof, &    ! First level check and screening of profile obs 
    36       & obs_pre_surf, &    ! First level check and screening of surface obs 
    37       & calc_month_len     ! Calculate the number of days in the months of a year 
     29   PUBLIC   obs_pre_prof     ! First level check and screening of profile obs 
     30   PUBLIC   obs_pre_surf     ! First level check and screening of surface obs 
     31   PUBLIC   calc_month_len   ! Calculate the number of days in the months of a year 
    3832 
    3933   !!---------------------------------------------------------------------- 
    … …  
    6357      !!        !  2015-02  (M. Martin) Combined routine for surface types. 
    6458      !!---------------------------------------------------------------------- 
    65       !! * Modules used 
    66       USE domstp              ! Domain: set the time-step 
    6759      USE par_oce             ! Ocean parameters 
    68       USE dom_oce, ONLY : &   ! Geographical information 
    69          & glamt,   & 
    70          & gphit,   & 
    71          & tmask,   & 
    72          & nproc 
     60      USE dom_oce, ONLY       :   glamt, gphit, tmask, nproc   ! Geographical information 
    7361      !! * Arguments 
    7462      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data 
    7563      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening 
    7664      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    77       !! * Local declarations 
     65      ! 
    7866      INTEGER :: iyea0        ! Initial date 
    7967      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
    … …  
    9482      INTEGER :: inlasobsmpp    !  - close to land 
    9583      INTEGER :: igrdobsmpp     !  - fail the grid search 
    96       LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    97          & llvalid            ! SLA data selection 
     84      LOGICAL, DIMENSION(:), ALLOCATABLE ::   llvalid            ! SLA data selection 
    9885      INTEGER :: jobs         ! Obs. loop variable 
    9986      INTEGER :: jstp         ! Time loop variable 
    10087      INTEGER :: inrc         ! Time index variable 
    101  
    102       IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...' 
    103       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     88      !!---------------------------------------------------------------------- 
     89 
     90      IF(lwp) WRITE(numout,*) 'obs_pre_surf : Preparing the surface observations...' 
     91      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    10492       
    10593      ! Initial date initialization (year, month, day, hour, minute) 
    … …  
    253241      !! 
    254242      !!---------------------------------------------------------------------- 
    255       !! * Modules used 
    256       USE domstp              ! Domain: set the time-step 
    257       USE par_oce             ! Ocean parameters 
    258       USE dom_oce, ONLY : &   ! Geographical information 
    259          & gdept_1d,             & 
    260          & nproc 
     243      USE par_oce           ! Ocean parameters 
     244      USE dom_oce, ONLY :   gdept_1d, nproc   ! Geographical information 
    261245 
    262246      !! * Arguments 
    … …  
    314298      INTEGER :: jstp         ! Time loop variable 
    315299      INTEGER :: inrc         ! Time index variable 
     300      !!---------------------------------------------------------------------- 
    316301 
    317302      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r6140 r7277  
    3030   !!---------------------------------------------------------------------- 
    3131   !                                   !!* namsbc namelist * 
    32    LOGICAL , PUBLIC ::   ln_ana         !: analytical boundary condition flag 
    33    LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation 
    34    LOGICAL , PUBLIC ::   ln_blk_clio    !: CLIO bulk formulation 
    35    LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation 
    36    LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation 
     32   LOGICAL , PUBLIC ::   ln_usr         !: user defined formulation 
     33   LOGICAL , PUBLIC ::   ln_flx         !: flux         formulation 
     34   LOGICAL , PUBLIC ::   ln_blk_clio    !: CLIO bulk    formulation 
     35   LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk    formulation 
     36   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk    formulation 
    3737#if defined key_oasis3 
    3838   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used 
    … …  
    7272   !!           switch definition (improve readability) 
    7373   !!---------------------------------------------------------------------- 
    74    INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical               formulation 
    75    INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical                    formulation 
     74   INTEGER , PUBLIC, PARAMETER ::   jp_usr     = 1        !: user defined                  formulation 
    7675   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation 
    7776   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk                     formulation 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r5836 r7277  
    215215      !!---------------------------------------------------------------------- 
    216216      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    217       REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
     217      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celsius] 
    218218      !! 
    219219      INTEGER  ::   ji, jj   ! dummy loop indices 
    … …  
    279279         DO ji = 1, jpi 
    280280            ! 
    281             zsst  = pst(ji,jj)              + rt0           ! converte Celcius to Kelvin the SST 
     281            zsst  = pst(ji,jj)              + rt0           ! converte Celsius to Kelvin the SST 
    282282            ztatm = sf(jp_tair)%fnow(ji,jj,1)               ! and set minimum value far above 0 K (=rt0 over land) 
    283283            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1)         ! fraction of clear sky ( 1 - cloud cover) 
    … …  
    371371      ! 
    372372      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux 
    373          &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius 
    374          &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celcius 
     373         &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celsius 
     374         &     + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec   ! add    precip. heat content at Tair in Celsius 
    375375      qns(:,:) = qns(:,:) * tmask(:,:,1) 
    376376#if defined key_lim3 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r6140 r7277  
    241241      INTEGER  , INTENT(in   )                 ::   kt    ! time step index 
    242242      TYPE(fld), INTENT(inout), DIMENSION(:)   ::   sf    ! input data 
    243       REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
     243      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pst   ! surface temperature                      [Celsius] 
    244244      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
    245245      REAL(wp) , INTENT(in)   , DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
    … …  
    267267      zcoef_qsatw = 0.98 * 640380. / rhoa 
    268268       
    269       zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
     269      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celsius to Kelvin (and set minimum value far above 0 K) 
    270270 
    271271      ! ----------------------------------------------------------------------------- ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6165 r7277  
    555555               WRITE(numout,*)'  Additional received fields from OPA component : ' 
    556556            ENDIF 
    557             WRITE(numout,*)'               sea surface temperature (Celcius) ' 
     557            WRITE(numout,*)'               sea surface temperature (Celsius) ' 
    558558            WRITE(numout,*)'               sea surface salinity '  
    559559            WRITE(numout,*)'               surface currents '  
    … …  
    710710            WRITE(numout,*) 
    711711            WRITE(numout,*)'  sent fields to SAS component ' 
    712             WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     712            WRITE(numout,*)'               sea surface temperature (T before, Celsius) ' 
    713713            WRITE(numout,*)'               sea surface salinity '  
    714714            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r6140 r7277  
    101101                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 ) 
    102102          
    103          CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celcius] 
     103         CALL eos_fzp( sss_m(:,:), fr_i(:,:) )       ! sea surface freezing temperature [Celsius] 
    104104         fr_i(:,:) = fr_i(:,:) * tmask(:,:,1) 
    105105 
    … …  
    134134               !      # qns = zqrp -2(-4) watt/m2  if climatological ice and opa ice     (zfr_obs=1, fr_i=1) 
    135135               !                                   (-2=arctic, -4=antarctic)    
    136                zqi = -3. + SIGN( 1.e0, ff(ji,jj) ) 
     136               zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) ) 
    137137               qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj)                             & 
    138138                  &          +      zfr_obs   * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1)   & 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r6140 r7277  
    536536   END SUBROUTINE sbc_isf_cav 
    537537 
     538 
    538539   SUBROUTINE sbc_isf_gammats(pgt, pgs, pqhisf, pqwisf ) 
    539540      !!---------------------------------------------------------------------- 
    … …  
    635636 
    636637                  !! compute eta* (stability parameter) 
    637                   zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff(ji,jj)) * zmols * zRc ), 0.0_wp))) 
     638                  zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp))) 
    638639 
    639640                  !! compute the sublayer thickness 
    … …  
    641642 
    642643                  !! compute gamma turb 
    643                   zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff(ji,jj)) * zhnu )) & 
     644                  zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) & 
    644645                  &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn 
    645646 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6351 r7277  
    1919   !!   sbc_init      : read namsbc namelist 
    2020   !!   sbc           : surface ocean momentum, heat and freshwater boundary conditions 
     21   !!   sbc_final     : Finalize CICE ice model (if used) 
    2122   !!---------------------------------------------------------------------- 
    2223   USE oce            ! ocean dynamics and tracers 
    … …  
    2829   USE sbcdcy         ! surface boundary condition: diurnal cycle 
    2930   USE sbcssm         ! surface boundary condition: sea-surface mean variables 
    30    USE sbcana         ! surface boundary condition: analytical formulation 
    3131   USE sbcflx         ! surface boundary condition: flux formulation 
    3232   USE sbcblk_clio    ! surface boundary condition: bulk formulation : CLIO 
    … …  
    4343   USE sbcisf         ! surface boundary condition: ice shelf 
    4444   USE sbcfwb         ! surface boundary condition: freshwater budget 
    45    USE closea         ! closed sea 
    4645   USE icbstp         ! Icebergs 
    4746   USE traqsr         ! active tracers: light penetration 
    4847   USE sbcwave        ! Wave module 
    4948   USE bdy_par        ! Require lk_bdy 
     49   USE usrdef_sbc     ! user defined: surface boundary condition 
     50   USE usrdef_closea  ! user defined: closed sea 
    5051   ! 
    5152   USE prtctl         ! Print control                    (prt_ctl routine) 
    … …  
    5556   USE timing         ! Timing 
    5657 
    57    USE diurnal_bulk, ONLY: & 
    58       & ln_diurnal_only  
     58   USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic 
    5959 
    6060   IMPLICIT NONE 
    … …  
    6767       
    6868   !!---------------------------------------------------------------------- 
    69    !! NEMO/OPA 4.0 , NEMO-consortium (2011)  
     69   !! NEMO/OPA 4.0 , NEMO-consortium (2016)  
    7070   !! $Id$ 
    7171   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8787      INTEGER ::   icpt   ! local integer 
    8888      !! 
    89       NAMELIST/namsbc/ nn_fsbc  , ln_ana   , ln_flx, ln_blk_clio, ln_blk_core, ln_blk_mfs,   & 
     89      NAMELIST/namsbc/ nn_fsbc  , ln_usr   , ln_flx, ln_blk_clio, ln_blk_core, ln_blk_mfs,   & 
    9090         &             ln_cpl   , ln_mixcpl, nn_components      , nn_limflx  ,               & 
    9191         &             ln_traqsr, ln_dm2dc ,                                                 &   
    … …  
    105105      ENDIF 
    106106      ! 
    107       REWIND( numnam_ref )              ! Namelist namsbc in reference namelist : Surface boundary 
     107      REWIND( numnam_ref )       ! Namelist namsbc in reference namelist : Surface boundary 
    108108      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901) 
    109109901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 
    110110      ! 
    111       REWIND( numnam_cfg )              ! Namelist namsbc in configuration namelist : Parameters of the run 
     111      REWIND( numnam_cfg )       ! Namelist namsbc in configuration namelist : Parameters of the run 
    112112      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    113113902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
    … …  
    120120        IF( lk_cice )   nn_ice      = 4 
    121121      ENDIF 
    122       IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration 
    123           ln_ana      = .TRUE.    
    124           nn_ice      =   0 
    125       ENDIF 
    126122      ! 
    127123      IF(lwp) THEN               ! Control print 
    128          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)' 
    129          WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc 
    130          WRITE(numout,*) '           Type of air-sea fluxes : ' 
    131          WRITE(numout,*) '              analytical formulation                     ln_ana        = ', ln_ana 
    132          WRITE(numout,*) '              flux       formulation                     ln_flx        = ', ln_flx 
    133          WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio   = ', ln_blk_clio 
    134          WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core   = ', ln_blk_core 
    135          WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs    = ', ln_blk_mfs 
    136          WRITE(numout,*) '           Type of coupling (Ocean/Ice/Atmosphere) : ' 
    137          WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
    138          WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl     = ', ln_mixcpl 
    139          WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
    140          WRITE(numout,*) '              components of your executable              nn_components = ', nn_components 
    141          WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
    142          WRITE(numout,*) '           Sea-ice : ' 
    143          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice  
    144          WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
    145          WRITE(numout,*) '           Misc. options of sbc : ' 
    146          WRITE(numout,*) '              Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
    147          WRITE(numout,*) '                 daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc  
    148          WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr 
    149          WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb 
    150          WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn 
    151          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
    152          WRITE(numout,*) '              iceshelf formulation                       ln_isf        = ', ln_isf 
    153          WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea 
    154          WRITE(numout,*) '              nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
    155          WRITE(numout,*) '              surface wave                               ln_wave       = ', ln_wave   
     124         WRITE(numout,*) '   Namelist namsbc (partly overwritten with CPP key setting)' 
     125         WRITE(numout,*) '      Frequency update of sbc (and ice)             nn_fsbc       = ', nn_fsbc 
     126         WRITE(numout,*) '      Type of air-sea fluxes : ' 
     127         WRITE(numout,*) '         user defined formulation                   ln_usr        = ', ln_usr 
     128         WRITE(numout,*) '         flux         formulation                   ln_flx        = ', ln_flx 
     129         WRITE(numout,*) '         CLIO bulk    formulation                   ln_blk_clio   = ', ln_blk_clio 
     130         WRITE(numout,*) '         CORE bulk    formulation                   ln_blk_core   = ', ln_blk_core 
     131         WRITE(numout,*) '         MFS  bulk    formulation                   ln_blk_mfs    = ', ln_blk_mfs 
     132         WRITE(numout,*) '      Type of coupling (Ocean/Ice/Atmosphere) : ' 
     133         WRITE(numout,*) '         ocean-atmosphere coupled formulation       ln_cpl        = ', ln_cpl 
     134         WRITE(numout,*) '         forced-coupled mixed formulation           ln_mixcpl     = ', ln_mixcpl 
     135         WRITE(numout,*) '         OASIS coupling (with atm or sas)           lk_oasis      = ', lk_oasis 
     136         WRITE(numout,*) '         components of your executable              nn_components = ', nn_components 
     137         WRITE(numout,*) '         Multicategory heat flux formulation (LIM3) nn_limflx     = ', nn_limflx 
     138         WRITE(numout,*) '      Sea-ice : ' 
     139         WRITE(numout,*) '         ice management in the sbc (=0/1/2/3)       nn_ice        = ', nn_ice  
     140         WRITE(numout,*) '         ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd   = ', nn_ice_embd 
     141         WRITE(numout,*) '      Misc. options of sbc : ' 
     142         WRITE(numout,*) '         Light penetration in temperature Eq.       ln_traqsr     = ', ln_traqsr 
     143         WRITE(numout,*) '            daily mean to diurnal cycle qsr            ln_dm2dc   = ', ln_dm2dc  
     144         WRITE(numout,*) '         Sea Surface Restoring on SST and/or SSS    ln_ssr        = ', ln_ssr 
     145         WRITE(numout,*) '         FreshWater Budget control  (=0/1/2)        nn_fwb        = ', nn_fwb 
     146         WRITE(numout,*) '         Patm gradient added in ocean & ice Eqs.    ln_apr_dyn    = ', ln_apr_dyn 
     147         WRITE(numout,*) '         runoff / runoff mouths                     ln_rnf        = ', ln_rnf 
     148         WRITE(numout,*) '         iceshelf formulation                       ln_isf        = ', ln_isf 
     149         WRITE(numout,*) '         closed sea (=0/1) (set in namdom)          nn_closea     = ', nn_closea 
     150         WRITE(numout,*) '         nb of iterations if land-sea-mask applied  nn_lsm        = ', nn_lsm 
     151         WRITE(numout,*) '         surface wave                               ln_wave       = ', ln_wave   
     152      ENDIF 
     153      ! 
     154      IF( .NOT.ln_usr ) THEN     ! the model calendar needs some specificities (except in user defined case) 
     155         IF( MOD( rday , rdt ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 
     156         IF( MOD( rday , 2.  ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    ) 
     157         IF( MOD( rdt  , 2.  ) /= 0. )   CALL ctl_stop( 'the time step (in second) must be an even number'           ) 
    156158      ENDIF 
    157159      ! 
    … …  
    160162         SELECT CASE ( nn_limflx )        ! LIM3 Multi-category heat flux formulation 
    161163         CASE ( -1 )   ;   WRITE(numout,*) '   LIM3: use per-category fluxes (nn_limflx = -1) ' 
    162          CASE ( 0 )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) '  
    163          CASE ( 1 )   ;   WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
    164          CASE ( 2 )   ;   WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
     164         CASE (  0 )   ;   WRITE(numout,*) '   LIM3: use average per-category fluxes (nn_limflx = 0) '  
     165         CASE (  1 )   ;   WRITE(numout,*) '   LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) ' 
     166         CASE (  2 )   ;   WRITE(numout,*) '   LIM3: Redistribute a single flux over categories (nn_limflx = 2) ' 
    165167         END SELECT 
    166168      ENDIF 
    … …  
    224226      ! 
    225227      icpt = 0 
    226       IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation 
     228      IF( ln_usr          ) THEN   ;   nsbc = jp_usr     ; icpt = icpt + 1   ;   ENDIF       ! user defined         formulation 
    227229      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation 
    228230      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation 
    … …  
    230232      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation 
    231233      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation 
    232       IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation 
    233234      IF( nn_components == jp_iam_opa )   & 
    234235         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module 
    … …  
    239240         WRITE(numout,*) 
    240241         SELECT CASE( nsbc ) 
    241          CASE( jp_gyre    )   ;   WRITE(numout,*) '   GYRE analytical formulation' 
    242          CASE( jp_ana     )   ;   WRITE(numout,*) '   analytical formulation' 
     242         CASE( jp_usr     )   ;   WRITE(numout,*) '   user defined formulation' 
    243243         CASE( jp_flx     )   ;   WRITE(numout,*) '   flux formulation' 
    244244         CASE( jp_clio    )   ;   WRITE(numout,*) '   CLIO bulk formulation' 
    … …  
    337337      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition 
    338338      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx) 
    339       CASE( jp_gyre  )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration 
    340       CASE( jp_ana   )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc 
     339      CASE( jp_usr   )   ;   CALL usr_def_sbc ( kt )                    ! user defined formulation  
    341340      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation 
    342341      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    … …  
    379378      ! (update freshwater fluxes) 
    380379      ! Should not be ran if ln_diurnal_only 
    381       IF( .NOT.(ln_diurnal_only) .AND. (nn_closea == 1) )   CALL sbc_clo( kt )    
     380      IF( .NOT.ln_diurnal_only .AND. nn_closea == 1 )   CALL sbc_clo( kt, cn_cfg, nn_cfg )    
    382381 
    383382!RBbug do not understand why see ticket 667 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r6140 r7277  
    2020   USE sbc_oce        ! surface boundary condition variables 
    2121   USE sbcisf         ! PM we could remove it I think 
    22    USE closea         ! closed seas 
    2322   USE eosbn2         ! Equation Of State 
     23   USE usrdef_closea  ! closed seas 
    2424   ! 
    2525   USE in_out_manager ! I/O manager 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r6140 r7277  
    4646      !!                 
    4747      !! ** Method  :   compute mean surface velocity (2 components at U and  
    48       !!      V-points) [m/s], temperature [Celcius] and salinity [psu] over 
     48      !!      V-points) [m/s], temperature [Celsius] and salinity [psu] over 
    4949      !!      the periode (kt - nn_fsbc) to kt 
    5050      !!         Note that the inverse barometer ssh (i.e. ssh associated with Patm) 
    … …  
    137137            !                                             ! ---------------------------------------- ! 
    138138            zcoef = 1. / REAL( nn_fsbc, wp ) 
    139             sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celcius] 
     139            sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celsius] 
    140140            sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu] 
    141141            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6140 r7277  
    195195      !! 
    196196      !!     nn_eos = -1 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 
    197       !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celcius, sa=35.5 g/kg 
     197      !!         Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg 
    198198      !! 
    199199      !!     nn_eos =  0 : polynomial EOS-80 equation of state is used for rho(t,s,z). 
    200       !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celcius, sp=35.5 psu 
     200      !!         Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu 
    201201      !! 
    202202      !!     nn_eos =  1 : simplified equation of state 
    … …  
    212212      !!                TEOS-10 Manual, 2010 
    213213      !!---------------------------------------------------------------------- 
    214       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     214      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    215215      !                                                               ! 2 : salinity               [psu] 
    216216      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd   ! in situ density            [-] 
    … …  
    307307      !! 
    308308      !!---------------------------------------------------------------------- 
    309       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
     309      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    310310      !                                                                ! 2 : salinity               [psu] 
    311311      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    … …  
    472472      !! 
    473473      !!---------------------------------------------------------------------- 
    474       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     474      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celsius] 
    475475      !                                                           ! 2 : salinity               [psu] 
    476476      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                      [m] 
    … …  
    897897      !! 
    898898      !!---------------------------------------------------------------------- 
    899       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celcius,psu] 
    900       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celcius-1,psu-1] 
     899      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pts   ! pot. temperature and salinity   [Celsius,psu] 
     900      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::  pab   ! thermal/haline expansion coef.  [Celsius-1,psu-1] 
    901901      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::  pn2   ! Brunt-Vaisala frequency squared [1/s^2] 
    902902      ! 
    … …  
    934934      !!                 ***  ROUTINE eos_pt_from_ct  *** 
    935935      !! 
    936       !! ** Purpose :   Compute pot.temp. from cons. temp. [Celcius] 
     936      !! ** Purpose :   Compute pot.temp. from cons. temp. [Celsius] 
    937937      !! 
    938938      !! ** Method  :   rational approximation (5/3th order) of TEOS-10 algorithm 
    … …  
    942942      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 
    943943      !!---------------------------------------------------------------------- 
    944       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celcius] 
    945       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
     944      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp   [Celsius] 
     945      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity     [psu] 
    946946      ! Leave result array automatic rather than making explicitly allocated 
    947       REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celcius] 
     947      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celsius] 
    948948      ! 
    949949      INTEGER  ::   ji, jj               ! dummy loop indices 
    … …  
    993993      !!                 ***  ROUTINE eos_fzp  *** 
    994994      !! 
    995       !! ** Purpose :   Compute the freezing point temperature [Celcius] 
    996       !! 
    997       !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     995      !! ** Purpose :   Compute the freezing point temperature [Celsius] 
     996      !! 
     997      !! ** Method  :   UNESCO freezing point (ptf) in Celsius is given by 
    998998      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
    999999      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
    … …  
    10031003      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )           ::   psal   ! salinity   [psu] 
    10041004      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ), OPTIONAL ::   pdep   ! depth      [m] 
    1005       REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celcius] 
     1005      REAL(wp), DIMENSION(jpi,jpj), INTENT(out  )           ::   ptf    ! freezing temperature [Celsius] 
    10061006      ! 
    10071007      INTEGER  ::   ji, jj   ! dummy loop indices 
    … …  
    10441044      !!                 ***  ROUTINE eos_fzp  *** 
    10451045      !! 
    1046       !! ** Purpose :   Compute the freezing point temperature [Celcius] 
    1047       !! 
    1048       !! ** Method  :   UNESCO freezing point (ptf) in Celcius is given by 
     1046      !! ** Purpose :   Compute the freezing point temperature [Celsius] 
     1047      !! 
     1048      !! ** Method  :   UNESCO freezing point (ptf) in Celsius is given by 
    10491049      !!       ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 
    10501050      !!       checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m 
    … …  
    10541054      REAL(wp), INTENT(in )           ::   psal         ! salinity   [psu] 
    10551055      REAL(wp), INTENT(in ), OPTIONAL ::   pdep         ! depth      [m] 
    1056       REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celcius] 
     1056      REAL(wp), INTENT(out)           ::   ptf          ! freezing temperature [Celsius] 
    10571057      ! 
    10581058      REAL(wp) :: zs   ! local scalars 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r6140 r7277  
    3737   !!---------------------------------------------------------------------- 
    3838   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    39    !! $Id: traadv_cen2.F90 5737 2015-09-13 07:42:41Z gm $ 
     39   !! $Id$ 
    4040   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4141   !!---------------------------------------------------------------------- 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r6140 r7277  
    3838   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    3939 
     40   !                                        ! tridiag solver associated indices: 
     41   INTEGER, PARAMETER ::   np_NH   = 0   ! Neumann homogeneous boundary condition 
     42   INTEGER, PARAMETER ::   np_CEN2 = 1   ! 2nd order centered  boundary condition 
     43 
    4044   !! * Substitutions 
    4145#  include "vectopt_loop_substitute.h90" 
    … …  
    149153            DO jj = 2, jpjm1 
    150154               DO ji = fs_2, fs_jpim1   ! vector opt. 
    151                   ! total intermediate advective trends 
     155                  !                             ! total intermediate advective trends 
    152156                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    153157                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    154                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    155                   ! update and guess with monotonic sheme 
    156 !!gm why tmask added in the two following lines ???    the mask is done in tranxt ! 
    157                   pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra   * tmask(ji,jj,jk) 
    158                   zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ztra ) * tmask(ji,jj,jk) 
     158                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
     159                  !                             ! update and guess with monotonic sheme 
     160                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     161                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    159162               END DO 
    160163            END DO 
    … …  
    163166         !                 
    164167         IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
    165             ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
     168            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
    166169         END IF 
    167170         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    … …  
    364367      ! 
    365368      CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    366       CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
     369      CALL wrk_alloc( jpi,jpj,jpk,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    367370      CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    368371      ! 
    … …  
    436439                  ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    437440                     &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    438                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     441                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj) 
    439442                  !                             ! update and guess with monotonic sheme 
    440                   pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra 
    441                   zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ztra ) * tmask(ji,jj,jk) 
     443                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     444                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    442445               END DO 
    443446            END DO 
    … …  
    488491         zwz_sav(:,:,:)   = zwz(:,:,:) 
    489492         ztrs   (:,:,:,1) = ptb(:,:,:,jn) 
     493         ztrs   (:,:,1,2) = ptb(:,:,1,jn) 
     494         ztrs   (:,:,1,3) = ptb(:,:,1,jn) 
    490495         zwzts  (:,:,:)   = 0._wp 
    491496         ! 
    … …  
    705710 
    706711 
    707    SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 
    708       !!---------------------------------------------------------------------- 
    709       !!                  ***  ROUTINE interp_4th_cpt  *** 
     712   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out ) 
     713      !!---------------------------------------------------------------------- 
     714      !!                  ***  ROUTINE interp_4th_cpt_org  *** 
    710715      !!  
    711716      !! **  Purpose :   Compute the interpolation of tracer at w-point 
    … …  
    738743      END DO 
    739744      ! 
    740       jk=2                                            ! Switch to second order centered at top 
    741       DO jj=1,jpj 
    742          DO ji=1,jpi 
     745      jk = 2                                          ! Switch to second order centered at top 
     746      DO jj = 1, jpj 
     747         DO ji = 1, jpi 
    743748            zwd (ji,jj,jk) = 1._wp 
    744749            zwi (ji,jj,jk) = 0._wp 
    … …  
    788793      END DO 
    789794      !     
     795   END SUBROUTINE interp_4th_cpt_org 
     796    
     797 
     798   SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 
     799      !!---------------------------------------------------------------------- 
     800      !!                  ***  ROUTINE interp_4th_cpt  *** 
     801      !!  
     802      !! **  Purpose :   Compute the interpolation of tracer at w-point 
     803      !! 
     804      !! **  Method  :   4th order compact interpolation 
     805      !!---------------------------------------------------------------------- 
     806      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point 
     807      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point 
     808      ! 
     809      INTEGER ::   ji, jj, jk   ! dummy loop integers 
     810      INTEGER ::   ikt, ikb     ! local integers 
     811      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt 
     812      !!---------------------------------------------------------------------- 
     813      ! 
     814      !                      !==  build the three diagonal matrix & the RHS  ==! 
     815      ! 
     816      DO jk = 3, jpkm1                 ! interior (from jk=3 to jpk-1) 
     817         DO jj = 2, jpjm1 
     818            DO ji = fs_2, fs_jpim1 
     819               zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal 
     820               zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal 
     821               zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal 
     822               zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS 
     823                  &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) ) 
     824            END DO 
     825         END DO 
     826      END DO 
     827      ! 
     828!!gm 
     829!      SELECT CASE( kbc )               !* boundary condition 
     830!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom 
     831!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom 
     832!      END SELECT 
     833!!gm   
     834      ! 
     835      DO jj = 2, jpjm1                 ! 2nd order centered at top & bottom 
     836         DO ji = fs_2, fs_jpim1 
     837            ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point 
     838            ikb = mbkt(ji,jj)                !     -   above the last wet point 
     839            ! 
     840            zwd (ji,jj,ikt) = 1._wp          ! top 
     841            zwi (ji,jj,ikt) = 0._wp 
     842            zws (ji,jj,ikt) = 0._wp 
     843            zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 
     844            ! 
     845            zwd (ji,jj,ikb) = 1._wp          ! bottom 
     846            zwi (ji,jj,ikb) = 0._wp 
     847            zws (ji,jj,ikb) = 0._wp 
     848            zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )             
     849         END DO 
     850      END DO    
     851      ! 
     852      !                       !==  tridiagonal solver  ==! 
     853      ! 
     854      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     855         DO ji = fs_2, fs_jpim1 
     856            zwt(ji,jj,2) = zwd(ji,jj,2) 
     857         END DO 
     858      END DO 
     859      DO jk = 3, jpkm1 
     860         DO jj = 2, jpjm1 
     861            DO ji = fs_2, fs_jpim1 
     862               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
     863            END DO 
     864         END DO 
     865      END DO 
     866      ! 
     867      DO jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     868         DO ji = fs_2, fs_jpim1 
     869            pt_out(ji,jj,2) = zwrm(ji,jj,2) 
     870         END DO 
     871      END DO 
     872      DO jk = 3, jpkm1 
     873         DO jj = 2, jpjm1 
     874            DO ji = fs_2, fs_jpim1 
     875               pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     876            END DO 
     877         END DO 
     878      END DO 
     879 
     880      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     881         DO ji = fs_2, fs_jpim1 
     882            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
     883         END DO 
     884      END DO 
     885      DO jk = jpk-2, 2, -1 
     886         DO jj = 2, jpjm1 
     887            DO ji = fs_2, fs_jpim1 
     888               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
     889            END DO 
     890         END DO 
     891      END DO 
     892      !     
    790893   END SUBROUTINE interp_4th_cpt 
    791     
     894 
     895 
     896   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev ) 
     897      !!---------------------------------------------------------------------- 
     898      !!                  ***  ROUTINE tridia_solver  *** 
     899      !!  
     900      !! **  Purpose :   solve a symmetric 3diagonal system 
     901      !! 
     902      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk ) 
     903      !!      
     904      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 ) 
     905      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 ) 
     906      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 ) 
     907      !!             (        ...          )( ... )   ( ...  ) 
     908      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k ) 
     909      !!      
     910      !!        M is decomposed in the product of an upper and lower triangular matrix. 
     911      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL  
     912      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 
     913      !!        The solution is pta. 
     914      !!        The 3d array zwt is used as a work space array. 
     915      !!---------------------------------------------------------------------- 
     916      REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pD, pU, PL    ! 3-diagonal matrix 
     917      REAL(wp),DIMENSION(:,:,:), INTENT(in   ) ::   pRHS          ! Right-Hand-Side 
     918      REAL(wp),DIMENSION(:,:,:), INTENT(  out) ::   pt_out        !!gm field at level=F(klev) 
     919      INTEGER                  , INTENT(in   ) ::   klev          ! =1 pt_out at w-level  
     920      !                                                           ! =0 pt at t-level 
     921      INTEGER ::   ji, jj, jk   ! dummy loop integers 
     922      INTEGER ::   kstart       ! local indices 
     923      REAL(wp),DIMENSION(jpi,jpj,jpk) ::   zwt   ! 3D work array 
     924      !!---------------------------------------------------------------------- 
     925      ! 
     926      kstart =  1  + klev 
     927      ! 
     928      DO jj = 2, jpjm1              !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1 
     929         DO ji = fs_2, fs_jpim1 
     930            zwt(ji,jj,kstart) = pD(ji,jj,kstart) 
     931         END DO 
     932      END DO 
     933      DO jk = kstart+1, jpkm1 
     934         DO jj = 2, jpjm1 
     935            DO ji = fs_2, fs_jpim1 
     936               zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 
     937            END DO 
     938         END DO 
     939      END DO 
     940      ! 
     941      DO jj = 2, jpjm1              !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
     942         DO ji = fs_2, fs_jpim1 
     943            pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 
     944         END DO 
     945      END DO 
     946      DO jk = kstart+1, jpkm1 
     947         DO jj = 2, jpjm1 
     948            DO ji = fs_2, fs_jpim1 
     949               pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)              
     950            END DO 
     951         END DO 
     952      END DO 
     953 
     954      DO jj = 2, jpjm1              !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk 
     955         DO ji = fs_2, fs_jpim1 
     956            pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 
     957         END DO 
     958      END DO 
     959      DO jk = jpk-2, kstart, -1 
     960         DO jj = 2, jpjm1 
     961            DO ji = fs_2, fs_jpim1 
     962               pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 
     963            END DO 
     964         END DO 
     965      END DO 
     966      ! 
     967   END SUBROUTINE tridia_solver 
     968 
    792969   !!====================================================================== 
    793970END MODULE traadv_fct 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r6140 r7277  
    329329            DO jj = 2, jpj                           ! "coriolis+ time^-1" at u- & v-points 
    330330               DO ji = fs_2, jpi   ! vector opt. 
    331                   zfu = ( ff(ji,jj) + ff(ji,jj-1) ) * 0.5_wp 
    332                   zfv = ( ff(ji,jj) + ff(ji-1,jj) ) * 0.5_wp 
     331                  zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 
     332                  zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 
    333333                  rfu(ji,jj) = SQRT(  zfu * zfu + z1_t2 ) 
    334334                  rfv(ji,jj) = SQRT(  zfv * zfv + z1_t2 ) 
    … …  
    347347         ! 
    348348         z1_t2 = 1._wp / ( rn_time * rn_time ) 
    349          r1_ft(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) ) 
    350          r1_ft(:,:) = 1._wp / SQRT(  r1_ft(:,:) * r1_ft(:,:) + z1_t2 ) 
     349         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    351350         ! 
    352351      ENDIF 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r6140 r7277  
    3737    
    3838   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
    39    !                                                           !  and in closed seas (orca 2 and 4 configurations) 
     39   !                                                           !  and in closed seas (orca 2 and 1 configurations) 
    4040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
    4141    

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r6140 r7277  
    545545      CALL wrk_dealloc( jpi, jpj, zmbk ) 
    546546 
    547                                         !* sign of grad(H) at u- and v-points 
     547      !                                 !* sign of grad(H) at u- and v-points 
    548548      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
    549549      DO jj = 1, jpjm1 
    … …  
    553553         END DO 
    554554      END DO 
    555  
     555      ! 
    556556      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    557557         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    … …  
    561561      END DO 
    562562      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions 
    563  
     563      ! 
    564564      !                             !* masked diffusive flux coefficients 
    565565      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 
    566566      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    567567 
    568  
    569       IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl 
    570          ! 
    571          SELECT CASE ( jp_cfg ) 
    572          CASE ( 2 )                          ! ORCA_R2 
    573             ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL 
    574             ii0 = 139   ;   ii1 = 140 
    575             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    576             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    577             ! 
    578             ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL 
    579             ii0 = 161   ;   ii1 = 162 
    580             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    581             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    582             ! 
    583          CASE ( 4 )                          ! ORCA_R4 
    584             ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL 
    585             ii0 =  70   ;   ii1 =  71 
    586             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    587             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    588          END SELECT 
    589          ! 
    590       ENDIF 
    591568      ! 
    592569      IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init') 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6152 r7277  
    3333   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication  
    3434   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
     35   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    3536   !!---------------------------------------------------------------------- 
    3637 
    … …  
    4546   !!---------------------------------------------------------------------- 
    4647   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
    47    USE domcfg         ! domain configuration               (dom_cfg routine) 
    48    USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    49    USE domain         ! domain initialization             (dom_init routine) 
    50 #if defined key_nemocice_decomp 
    51    USE ice_domain_size, only: nx_global, ny_global 
    52 #endif 
     48   USE phycst         ! physical constant                  (par_cst routine) 
     49   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
     50   USE usrdef_nam     ! user defined configuration 
    5351   USE tideini        ! tidal components initialization   (tide_ini routine) 
    5452   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    … …  
    6058   USE ldftra         ! lateral diffusivity setting    (ldftra_init routine) 
    6159   USE zdfini         ! vertical physics setting          (zdf_init routine) 
    62    USE phycst         ! physical constant                  (par_cst routine) 
    6360   USE trdini         ! dyn/tra trends initialization     (trd_init routine) 
    6461   USE asminc         ! assimilation increments      
    … …  
    6865   USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    6966   USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    70    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    7167   USE step           ! NEMO time-stepping                 (stp     routine) 
    7268   USE icbini         ! handle bergs, initialisation 
    … …  
    7874   USE stopar         ! Stochastic param.: ??? 
    7975   USE stopts         ! Stochastic param.: ??? 
     76   USE diurnal_bulk   ! diurnal bulk SST  
     77   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
     78   USE crsini         ! initialise grid coarsening utility 
     79   USE diatmb         ! Top,middle,bottom output 
     80   USE dia25h         ! 25h mean output 
     81   USE sbc_oce , ONLY : lk_oasis 
     82   USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    8083#if defined key_top 
    8184   USE trcini         ! passive tracer initialisation 
    8285#endif 
     86#if defined key_nemocice_decomp 
     87   USE ice_domain_size, only: nx_global, ny_global 
     88#endif 
     89   ! 
    8390   USE lib_mpp        ! distributed memory computing 
    84    USE diurnal_bulk    ! diurnal bulk SST  
    85    USE step_diu        ! diurnal bulk SST timestepping (called from here if run offline) 
     91   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     92   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     93   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    8694#if defined key_iomput 
    8795   USE xios           ! xIOserver 
    8896#endif 
    89    USE crsini         ! initialise grid coarsening utility 
    90    USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
    91    USE sbc_oce, ONLY  : lk_oasis 
    92    USE diatmb          ! Top,middle,bottom output 
    93    USE dia25h          ! 25h mean output 
    94    USE wet_dry         ! Wetting and drying setting   (wad_init routine) 
    9597 
    9698   IMPLICIT NONE 
    … …  
    104106 
    105107   !!---------------------------------------------------------------------- 
    106    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     108   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    107109   !! $Id$ 
    108110   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    124126      !!              Madec, 2008, internal report, IPSL. 
    125127      !!---------------------------------------------------------------------- 
    126       INTEGER ::   istp       ! time step index 
     128      INTEGER ::   istp   ! time step index 
    127129      !!---------------------------------------------------------------------- 
    128130      ! 
    … …  
    130132      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    131133#endif 
    132  
     134      ! 
    133135      !                            !-----------------------! 
    134136      CALL nemo_init               !==  Initialisations  ==! 
    … …  
    195197      !                            !==  finalize the run  ==! 
    196198      !                            !------------------------! 
    197       IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA 
    198       ! 
    199       IF( nstop /= 0 .AND. lwp ) THEN   ! error print 
     199      IF(lwp) WRITE(numout,cform_aaa)        ! Flag AAAAAAA 
     200      ! 
     201      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    200202         WRITE(numout,cform_err) 
    201203         WRITE(numout,*) nstop, ' error have been found' 
    … …  
    215217      ! 
    216218#if defined key_iomput 
    217       CALL xios_finalize                  ! end mpp communications with xios 
    218       IF( lk_oasis )   CALL cpl_finalize  ! end coupling and mpp communications with OASIS 
     219      CALL xios_finalize                     ! end mpp communications with xios 
     220      IF( lk_oasis )   CALL cpl_finalize     ! end coupling and mpp communications with OASIS 
    219221#else 
    220222      IF( lk_oasis ) THEN  
    221          CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     223         CALL cpl_finalize                   ! end coupling and mpp communications with OASIS 
    222224      ELSE 
    223          IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     225         IF( lk_mpp )   CALL mppstop         ! end mpp communications 
    224226      ENDIF 
    225227#endif 
    … …  
    234236      !! ** Purpose :   initialization of the NEMO GCM 
    235237      !!---------------------------------------------------------------------- 
    236       INTEGER ::   ji            ! dummy loop indices 
    237       INTEGER ::  ilocal_comm   ! local integer 
    238       INTEGER ::   ios 
    239       CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    240       ! 
    241       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    242          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    243          &             nn_bench, nn_timing, nn_diacfl 
    244       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    245          &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    246       !!---------------------------------------------------------------------- 
    247       ! 
    248       cltxt = '' 
     238      INTEGER  ::   ji                 ! dummy loop indices 
     239      INTEGER  ::   ios, ilocal_comm   ! local integer 
     240      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
     241      ! 
     242      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
     243         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
     244         &             nn_timing, nn_diacfl 
     245      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
     246      !!---------------------------------------------------------------------- 
     247      ! 
     248      cltxt  = '' 
     249      cltxt2 = '' 
     250      clnam  = ''   
    249251      cxios_context = 'nemo' 
    250252      ! 
    … …  
    253255      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    254256      ! 
    255       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     257      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    256258      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    257259901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    258  
    259       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
     260      ! 
     261      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    260262      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    261263902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    262  
    263       ! 
    264       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark 
     264      ! 
     265      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    265266      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    266267903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    … …  
    270271904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    271272 
    272 ! Force values for AGRIF zoom (cf. agrif_user.F90) 
     273      !                             !--------------------------! 
     274      !                             !  Set global domain size  !   (control print return in cltxt2) 
     275      !                             !--------------------------! 
     276      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     277         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     278         ! 
     279      ELSE                                ! user-defined namelist 
     280         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     281      ENDIF 
     282      ! 
     283      jpk = jpkglo 
     284      ! 
    273285#if defined key_agrif 
    274    IF( .NOT. Agrif_Root() ) THEN 
    275       jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    276       jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    277       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    278       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    279       jpidta  = jpiglo 
    280       jpjdta  = jpjglo 
    281       jpizoom = 1 
    282       jpjzoom = 1 
    283       nperio  = 0 
    284       jperio  = 0 
    285       ln_use_jattr = .false. 
    286    ENDIF 
     286      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
     287         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     288         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     289         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     290         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     291         nperio  = 0 
     292         jperio  = 0 
     293         ln_use_jattr = .false. 
     294      ENDIF 
    287295#endif 
    288296      ! 
    … …  
    295303      IF( Agrif_Root() ) THEN 
    296304         IF( lk_oasis ) THEN 
    297             CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis 
    298             CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     305            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
     306            CALL xios_initialize( "not used"       ,local_comm= ilocal_comm )    ! send nemo communicator to xios 
    299307         ELSE 
    300             CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     308            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    301309         ENDIF 
    302310      ENDIF 
    … …  
    306314      IF( lk_oasis ) THEN 
    307315         IF( Agrif_Root() ) THEN 
    308             CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis 
     316            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    309317         ENDIF 
    310318         ! Nodes selection (control print return in cltxt) 
    311319         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
    312320      ELSE 
    313          ilocal_comm = 0 
    314          ! Nodes selection (control print return in cltxt) 
     321         ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt) 
    315322         narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    316323      ENDIF 
    317324#endif 
     325 
    318326      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    319327 
    … …  
    321329      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    322330 
    323       IF(lwm) THEN 
    324          ! write merged namelists from earlier to output namelist now that the 
    325          ! file has been opened in call to mynode. nammpp has already been 
    326          ! written in mynode (if lk_mpp_mpi) 
     331      IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
     332         !                       ! now that the file has been opened in call to mynode.  
     333         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    327334         WRITE( numond, namctl ) 
    328335         WRITE( numond, namcfg ) 
     336         IF( .NOT.ln_read_cfg ) THEN 
     337            DO ji = 1, SIZE(clnam) 
     338               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
     339            END DO 
     340         ENDIF 
    329341      ENDIF 
    330342 
    … …  
    341353      ENDIF 
    342354 
    343       ! Calculate domain dimensions given calculated jpni and jpnj 
    344       ! This used to be done in par_oce.F90 when they were parameters rather than variables 
    345       IF( Agrif_Root() ) THEN 
     355      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    346356#if defined key_nemocice_decomp 
    347357         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
    … …  
    351361         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
    352362#endif 
    353       ENDIF          
    354          jpk = jpkdta                                             ! third dim 
     363      ENDIF 
     364 
     365!!gm ???    why here  it has already been done in line 301 ! 
     366      jpk = jpkglo                                             ! third dim 
     367!!gm end 
     368 
    355369#if defined key_agrif 
    356          ! simple trick to use same vertical grid as parent but different number of levels:  
    357          ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 
    358          ! Suppress once vertical online interpolation is ok 
    359          IF(.NOT.Agrif_Root())   jpkdta = Agrif_Parent( jpkdta ) 
    360 #endif 
    361          jpim1 = jpi-1                                            ! inner domain indices 
    362          jpjm1 = jpj-1                                            !   "           " 
    363          jpkm1 = jpk-1                                            !   "           " 
    364          jpij  = jpi*jpj                                          !  jpi x j 
     370      ! simple trick to use same vertical grid as parent but different number of levels:  
     371      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
     372      ! Suppress once vertical online interpolation is ok 
     373      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
     374#endif 
     375      jpim1 = jpi-1                                            ! inner domain indices 
     376      jpjm1 = jpj-1                                            !   "           " 
     377      jpkm1 = jpk-1                                            !   "           " 
     378      jpij  = jpi*jpj                                          !  jpi x j 
    365379 
    366380      IF(lwp) THEN                            ! open listing units 
    … …  
    372386         WRITE(numout,*) '                       NEMO team' 
    373387         WRITE(numout,*) '            Ocean General Circulation Model' 
    374          WRITE(numout,*) '                  version 3.7  (2015) ' 
     388         WRITE(numout,*) '                NEMO version 3.7  (2016) ' 
    375389         WRITE(numout,*) 
    376390         WRITE(numout,*) 
    377391         DO ji = 1, SIZE(cltxt) 
    378             IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
     392            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode 
    379393         END DO 
    380          WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
     394         WRITE(numout,*) 
     395         WRITE(numout,*) 
     396         DO ji = 1, SIZE(cltxt2) 
     397            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size 
     398         END DO 
    381399         ! 
    382       ENDIF 
    383  
    384       ! Now we know the dimensions of the grid and numout has been set we can 
    385       ! allocate arrays 
     400         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     401         ! 
     402      ENDIF 
     403 
     404      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    386405      CALL nemo_alloc() 
    387406 
    … …  
    390409      !                             !-------------------------------! 
    391410 
    392       CALL nemo_ctl                          ! Control prints & Benchmark 
     411      CALL nemo_ctl                          ! Control prints 
    393412 
    394413      !                                      ! Domain decomposition 
    … …  
    404423      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    405424                            CALL     wad_init   ! Wetting and drying options 
    406                             CALL     dom_cfg    ! Domain configuration 
    407425                            CALL     dom_init   ! Domain 
    408426      IF( ln_crs        )   CALL     crs_init   ! coarsened grid: domain initialization  
    … …  
    503521                            CALL dia_tmb_init  ! TMB outputs 
    504522                            CALL dia_25h_init  ! 25h mean  outputs 
    505  
    506523      ! 
    507524   END SUBROUTINE nemo_init 
    … …  
    519536      IF(lwp) THEN                  ! control print 
    520537         WRITE(numout,*) 
    521          WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark' 
     538         WRITE(numout,*) 'nemo_ctl: Control prints' 
    522539         WRITE(numout,*) '~~~~~~~ ' 
    523540         WRITE(numout,*) '   Namelist namctl' 
    … …  
    530547         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    531548         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    532          WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
    533549         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
    534550      ENDIF 
    … …  
    541557      isplt     = nn_isplt 
    542558      jsplt     = nn_jsplt 
    543       nbench    = nn_bench 
    544559 
    545560      IF(lwp) THEN                  ! control print 
    … …  
    548563         WRITE(numout,*) '~~~~~~~ ' 
    549564         WRITE(numout,*) '   Namelist namcfg' 
    550          WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg) 
    551          WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz) 
    552          WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg 
    553          WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta 
    554          WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta 
    555          WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta 
    556          WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo 
    557          WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo 
    558          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 
    559          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    560          WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio  = ', jperio    
    561          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
     565         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg 
     566         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg) 
     567         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg 
     568         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
     569         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    562570      ENDIF 
    563571      !                             ! Parameter control 
    … …  
    600608      ENDIF 
    601609      ! 
    602       IF( nbench == 1 ) THEN              ! Benchmark 
    603          SELECT CASE ( cp_cfg ) 
    604          CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
    605          CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
    606             &                                 ' cp_cfg = "gyre" in namelist &namcfg or set nbench = 0' ) 
    607          END SELECT 
    608       ENDIF 
    609       ! 
    610610      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    611611         &                                               'f2003 standard. '                              ,  & 
    … …  
    666666      !!---------------------------------------------------------------------- 
    667667      ! 
    668       ierr =        oce_alloc       ()          ! ocean 
     668      ierr =        oce_alloc       ()          ! ocean  
    669669      ierr = ierr + dia_wri_alloc   () 
    670670      ierr = ierr + dom_oce_alloc   ()          ! ocean domain 
    … …  
    842842                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    843843                   nsndto = nsndto + 1 
    844                      isendto(nsndto) = jn 
     844                   isendto(nsndto) = jn 
    845845                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    846846                   nsndto = nsndto + 1 
    847                      isendto(nsndto) = jn 
     847                   isendto(nsndto) = jn 
    848848                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    849849                   nsndto = nsndto + 1 
    850                      isendto(nsndto) = jn 
    851                 END IF 
     850                   isendto(nsndto) = jn 
     851                ENDIF 
    852852          END DO 
    853853          nfsloop = 1 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r6140 r7277  
    2323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity            [m/s] 
    2424   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           hdivn          !: horizontal divergence        [s-1] 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu]  
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1] 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celsius,psu]  
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    2727   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
    2828   ! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r5836 r7277  
    1414 
    1515   !!---------------------------------------------------------------------- 
     16   !!                   namcfg namelist parameters 
     17   !!---------------------------------------------------------------------- 
     18   LOGICAL       ::   ln_read_cfg      !: (=T) read the domain configuration file or (=F) not 
     19   CHARACTER(lc) ::      cn_domcfg        !: filename the configuration file to be read 
     20   LOGICAL       ::   ln_write_cfg     !: (=T) create the domain configuration file 
     21   CHARACTER(lc) ::      cn_domcfg_out    !: filename the configuration file to be read 
     22   ! 
     23   LOGICAL       ::   ln_use_jattr     !: input file read offset 
     24   !                                   !  Use file global attribute: open_ocean_jstart to determine start j-row  
     25   !                                   !  when reading input from those netcdf files that have the  
     26   !                                   !  attribute defined. This is designed to enable input files associated  
     27   !                                   !  with the extended grids used in the under ice shelf configurations to  
     28   !                                   !  be used without redundant rows when the ice shelves are not in use. 
     29   !  
     30 
     31   !!--------------------------------------------------------------------- 
     32   !! Domain Matrix size  
     33   !!--------------------------------------------------------------------- 
     34   ! configuration name & resolution   (required only in ORCA family case) 
     35   CHARACTER(lc) ::   cn_cfg           !: name of the configuration 
     36   INTEGER       ::   nn_cfg           !: resolution of the configuration  
     37 
     38   ! global domain size               !!! * total computational domain * 
     39   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i-direction 
     40   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j-direction 
     41   INTEGER       ::   jpkglo           !: 3nd    -                  -    --> k levels 
     42 
     43#if defined key_agrif 
     44 
     45!!gm  BUG ?   I'm surprised by the calculation below of nbcellsx and nbcellsy before jpiglo,jpjglo  
     46!!gm                           has been assigned to a value.... 
     47!!gm 
     48 
     49   ! global domain size for AGRIF     !!! * total AGRIF computational domain * 
     50   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells 
     51   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction 
     52   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction 
     53#endif 
     54 
     55   ! local domain size                !!! * local computational domain * 
     56   INTEGER, PUBLIC ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension 
     57   INTEGER, PUBLIC ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension 
     58   INTEGER, PUBLIC ::   jpk   ! = jpkglo 
     59   INTEGER, PUBLIC ::   jpim1 ! = jpi-1                                            !: inner domain indices 
     60   INTEGER, PUBLIC ::   jpjm1 ! = jpj-1                                            !:   -     -      - 
     61   INTEGER, PUBLIC ::   jpkm1 ! = jpk-1                                            !:   -     -      - 
     62   INTEGER, PUBLIC ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj 
     63 
     64   !!--------------------------------------------------------------------- 
     65   !! Active tracer parameters 
     66   !!--------------------------------------------------------------------- 
     67   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S ) 
     68   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity 
     70 
     71   !!---------------------------------------------------------------------- 
    1672   !!   Domain decomposition 
    1773   !!---------------------------------------------------------------------- 
    … …  
    2682 
    2783   !!---------------------------------------------------------------------- 
    28    !!                   namcfg namelist parameters 
    29    !!---------------------------------------------------------------------- 
    30    CHARACTER(lc) ::   cp_cfg           !: name of the configuration 
    31    CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration 
    32    INTEGER       ::   jp_cfg           !: resolution of the configuration 
    33  
    34    ! data size                                       !!! * size of all input files * 
    35    INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi ) 
    36    INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj ) 
    37    INTEGER       ::   jpkdta           !: number of levels      ( >= jpk ) 
    38  
    39    ! global or zoom domain size                      !!! * computational domain * 
    40    INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i 
    41    INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j 
    42  
    43    ! zoom starting position  
    44    INTEGER       ::   jpizoom          !: left bottom (i,j) indices of the zoom 
    45    INTEGER       ::   jpjzoom          !: in data domain indices 
    46  
    47    ! Domain characteristics 
    48    INTEGER       ::   jperio           !: lateral cond. type (between 0 and 6) 
    49    !                                       !  = 0 closed                 ;   = 1 cyclic East-West 
    50    !                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot 
    51    !                                       !  = 4 cyclic East-West AND North fold T-point pivot 
    52    !                                       !  = 5 North fold F-point pivot 
    53    !                                       !  = 6 cyclic East-West AND North fold F-point pivot 
    54  
    55    ! Input file read offset 
    56    LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row  
    57                                            ! when reading input from those netcdf files that have the  
    58                                            ! attribute defined. This is designed to enable input files associated  
    59                                            ! with the extended grids used in the under ice shelf configurations to  
    60                                            ! be used without redundant rows when the ice shelves are not in use. 
    61  
    62    !!  Values set to pp_not_used indicates that this parameter is not used in THIS config. 
    63    !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr 
    64    REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter 
    65    REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       - 
    66  
    67  
    68  
    69  
    70    !!--------------------------------------------------------------------- 
    71    !! Active tracer parameters 
    72    !!--------------------------------------------------------------------- 
    73    INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S ) 
    74    INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature 
    75    INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity 
    76  
    77    !!--------------------------------------------------------------------- 
    78    !! Domain Matrix size  (if AGRIF, they are not all parameters) 
    79    !!--------------------------------------------------------------------- 
    80 #if defined key_agrif 
    81    INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells 
    82    INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction 
    83    INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction 
    84    ! 
    85 #endif 
    86    INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension 
    87    INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension 
    88    INTEGER, PUBLIC  ::   jpk   ! = jpkdta 
    89    INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices 
    90    INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      - 
    91    INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      - 
    92    INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj 
    93  
    94    !!---------------------------------------------------------------------- 
    95    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     84   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    9685   !! $Id$  
    9786   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6381 r7277  
    237237      IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics 
    238238      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    239       IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    240239      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    241240      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r6140 r7277  
    8484   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine) 
    8585   USE diahth           ! thermocline depth                (dia_hth routine) 
    86    USE diafwb           ! freshwater budget                (dia_fwb routine) 
    8786   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine) 
    8887   USE diaharm 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r5600 r7277  
    44   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    7    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
    10    !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    14    !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
    17    !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    18    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    19    !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    20    !!             -   ! 2004-08  (C. Talandier) New trends organization 
    21    !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
    22    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    23    !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
    24    !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
    25    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    26    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    28    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    29    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE 
    31    !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening  
     6   !! History :  3.6  ! 2015-12  (A. Ryan) Original code   (from OPA_SRC/)  
     7   !!            4.0  ! 2016-11  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    328   !!---------------------------------------------------------------------- 
    339 
    3410   !!---------------------------------------------------------------------- 
    35    !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
    36    !!   nemo_init      : initialization of the NEMO system 
    37    !!   nemo_ctl       : initialisation of the contol print 
    38    !!   nemo_closefile : close remaining open files 
    39    !!   nemo_alloc     : dynamical allocation 
    40    !!   nemo_partition : calculate MPP domain decomposition 
    41    !!   factorise      : calculate the factors of the no. of MPI processes 
     11   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
     12   !!   nemo_init     : initialization of the NEMO system 
     13   !!   nemo_ctl      : initialisation of the contol print 
     14   !!   nemo_closefile: close remaining open files 
     15   !!   nemo_alloc    : dynamical allocation 
     16   !!   nemo_partition: calculate MPP domain decomposition 
     17   !!   factorise     : calculate the factors of the no. of MPI processes 
    4218   !!---------------------------------------------------------------------- 
    43    USE step_oce        ! module used in the ocean time stepping module 
    44    USE domcfg          ! domain configuration               (dom_cfg routine) 
    45    USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    46    USE domain          ! domain initialization             (dom_init routine) 
     19   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
     20   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
     21   USE istate         ! initial state setting          (istate_init routine) 
     22   USE phycst         ! physical constant                  (par_cst routine) 
     23   USE step           ! NEMO time-stepping                 (stp     routine) 
     24   USE cpl_oasis3     ! OASIS3 coupling 
     25   USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    4726#if defined key_nemocice_decomp 
    4827   USE ice_domain_size, only: nx_global, ny_global 
    4928#endif 
    50    USE istate          ! initial state setting          (istate_init routine) 
    51    USE phycst          ! physical constant                  (par_cst routine) 
    52    USE diaobs          ! Observation diagnostics       (dia_obs_init routine) 
    53    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    54    USE step            ! NEMO time-stepping                 (stp     routine) 
    55    USE cpl_oasis3      ! OASIS3 coupling 
    56    USE lib_mpp         ! distributed memory computing 
    57 #if defined key_iomput 
    58    USE xios 
    59 #endif 
    60    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    61  
    62    ! Stand Alone Observation operator modules 
     29   !           ! Stand Alone Observation operator modules 
    6330   USE sao_data 
    6431   USE sao_intp 
     32   ! 
     33   USE lib_mpp        ! distributed memory computing 
     34   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     35   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     36   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     37#if defined key_iomput 
     38   USE xios           ! xIOserver 
     39#endif 
    6540 
    6641   IMPLICIT NONE 
    … …  
    7449 
    7550   !!---------------------------------------------------------------------- 
    76    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     51   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    7752   !! $Id$ 
    7853   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9166         !!             3. Cycle through match ups 
    9267         !!             4. Write results to file 
    93          !! 
    9468         !!---------------------------------------------------------------------- 
    95          !! Initialise NEMO 
    96          CALL nemo_init 
    97          !! Initialise Stand Alone Observation operator data 
    98          CALL sao_data_init 
    99          !! Initialise obs_oper 
    100          CALL dia_obs_init 
    101          !! Interpolate to observation space 
    102          CALL sao_interp 
    103          !! Pipe to output files 
    104          CALL dia_obs_wri 
    105          !! Reset the obs_oper between 
    106          CALL dia_obs_dealloc 
    107          !! Safely stop MPI 
    108          IF(lk_mpp) CALL mppstop  ! end mpp communications 
     69         ! 
     70         CALL nemo_init       ! Initialise NEMO 
     71         ! 
     72         CALL sao_data_init   ! Initialise Stand Alone Observation operator data 
     73         ! 
     74         CALL dia_obs_init    ! Initialise obs_operator 
     75         ! 
     76         CALL sao_interp      ! Interpolate to observation space 
     77         ! 
     78         CALL dia_obs_wri     ! Pipe to output files 
     79         ! 
     80         CALL dia_obs_dealloc ! Reset the obs_oper between 
     81         ! 
     82         IF(lk_mpp)   CALL mppstop  ! Safely stop MPI (end mpp communications) 
     83         ! 
    10984   END SUBROUTINE nemo_gcm 
    11085 
    … …  
    11691      !! ** Purpose :   initialization of the NEMO GCM 
    11792      !!---------------------------------------------------------------------- 
    118       INTEGER ::   ji            ! dummy loop indices 
    119       INTEGER ::   ilocal_comm   ! local integer 
    120       INTEGER ::   ios 
    121       CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    122       ! 
    123       NAMELIST/namctl/ ln_ctl, nn_print, nn_ictls, nn_ictle,   & 
    124          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    125          &             nn_bench, nn_timing 
    126       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    127          &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    128       !!---------------------------------------------------------------------- 
    129       ! 
    130       cltxt = '' 
     93      INTEGER ::   ji                 ! dummy loop indices 
     94      INTEGER ::   ios, ilocal_comm   ! local integer 
     95      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
     96      ! 
     97      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
     98         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
     99         &             nn_timing, nn_diacfl 
     100      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
     101      !!---------------------------------------------------------------------- 
     102      ! 
     103      cltxt  = '' 
     104      cltxt2 = '' 
     105      clnam  = ''   
    131106      cxios_context = 'nemo' 
    132107      ! 
    … …  
    135110      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    136111      ! 
    137       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     112      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    138113      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    139114901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    140  
    141       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
     115      ! 
     116      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    142117      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    143118902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    144  
    145       ! 
    146       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark 
     119      ! 
     120      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    147121      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    148122903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    … …  
    152126904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    153127 
    154 ! Force values for AGRIF zoom (cf. agrif_user.F90) 
     128      !                             !--------------------------! 
     129      !                             !  Set global domain size  !   (control print return in cltxt2) 
     130      !                             !--------------------------! 
     131      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     132         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     133         ! 
     134      ELSE                                ! user-defined namelist 
     135         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     136      ENDIF 
     137      ! 
     138      jpk = jpkglo 
     139      ! 
    155140#if defined key_agrif 
    156    IF( .NOT. Agrif_Root() ) THEN 
    157       jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    158       jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    159       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    160       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    161       jpidta  = jpiglo 
    162       jpjdta  = jpjglo 
    163       jpizoom = 1 
    164       jpjzoom = 1 
    165       nperio  = 0 
    166       jperio  = 0 
    167       ln_use_jattr = .false. 
    168    ENDIF 
     141      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
     142         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     143         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     144         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     145         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     146         nperio  = 0 
     147         jperio  = 0 
     148         ln_use_jattr = .false. 
     149      ENDIF 
    169150#endif 
    170151      ! 
    … …  
    198179      ENDIF 
    199180#endif 
     181 
    200182      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    201183 
    … …  
    209191         WRITE( numond, namctl ) 
    210192         WRITE( numond, namcfg ) 
     193         IF( .NOT.ln_read_cfg ) THEN 
     194            DO ji = 1, SIZE(clnam) 
     195               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
     196            END DO 
     197         ENDIF 
    211198      ENDIF 
    212199 
    213200      ! If dimensions of processor grid weren't specified in the namelist file 
    214201      ! then we calculate them here now that we have our communicator size 
    215       IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
     202      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    216203#if   defined key_mpp_mpi 
    217          IF( Agrif_Root() ) CALL nemo_partition(mppsize) 
     204         IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    218205#else 
    219206         jpni  = 1 
    … …  
    221208         jpnij = jpni*jpnj 
    222209#endif 
    223       END IF 
    224  
    225       ! Calculate domain dimensions given calculated jpni and jpnj 
    226       ! This used to be done in par_oce.F90 when they were parameters rather 
    227       ! than variables 
    228       IF( Agrif_Root() ) THEN 
     210      ENDIF 
     211 
     212      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    229213#if defined key_nemocice_decomp 
    230          jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
    231          jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     214         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
     215         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.  
    232216#else 
    233          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    234          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
     217         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
     218         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
    235219#endif 
    236220      ENDIF 
    237          jpk = jpkdta                                             ! third dim 
    238          jpim1 = jpi-1                                            ! inner domain indices 
    239          jpjm1 = jpj-1                                            !   "           " 
    240          jpkm1 = jpk-1                                            !   "           " 
    241          jpij  = jpi*jpj                                          !  jpi x j 
     221 
     222!!gm ???    why here  it has already been done in line 301 ! 
     223      jpk = jpkglo                                             ! third dim 
     224!!gm end 
     225      jpim1 = jpi-1                                            ! inner domain indices 
     226      jpjm1 = jpj-1                                            !   "           " 
     227      jpkm1 = jpk-1                                            !   "           " 
     228      jpij  = jpi*jpj                                          !  jpi x j 
    242229 
    243230      IF(lwp) THEN                            ! open listing units 
    … …  
    249236         WRITE(numout,*) '                       NEMO team' 
    250237         WRITE(numout,*) '            Stand Alone Observation operator' 
    251          WRITE(numout,*) '                  version 1.0  (2015) ' 
     238         WRITE(numout,*) '                NEMO version 3.7  (2015) ' 
    252239         WRITE(numout,*) 
    253240         WRITE(numout,*) 
    254241         DO ji = 1, SIZE(cltxt) 
    255             IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
     242            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode 
    256243         END DO 
    257          WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
    258          ! 
    259       ENDIF 
    260  
    261       ! Now we know the dimensions of the grid and numout has been set we can 
    262       ! allocate arrays 
     244         WRITE(numout,*) 
     245         WRITE(numout,*) 
     246         DO ji = 1, SIZE(cltxt2) 
     247            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size 
     248         END DO 
     249         ! 
     250         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     251         ! 
     252      ENDIF 
     253 
     254      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    263255      CALL nemo_alloc() 
    264256 
    … …  
    279271                            CALL     phy_cst    ! Physical constants 
    280272                            CALL     eos_init   ! Equation of state 
    281                             CALL     dom_cfg    ! Domain configuration 
    282273                            CALL     dom_init   ! Domain 
    283274 
    … …  
    301292      IF(lwp) THEN                  ! control print 
    302293         WRITE(numout,*) 
    303          WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark' 
     294         WRITE(numout,*) 'nemo_ctl: Control prints' 
    304295         WRITE(numout,*) '~~~~~~~ ' 
    305296         WRITE(numout,*) '   Namelist namctl' 
    … …  
    312303         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    313304         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    314          WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
    315305         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
    316306      ENDIF 
    … …  
    323313      isplt     = nn_isplt 
    324314      jsplt     = nn_jsplt 
    325       nbench    = nn_bench 
    326315 
    327316      IF(lwp) THEN                  ! control print 
    … …  
    330319         WRITE(numout,*) '~~~~~~~ ' 
    331320         WRITE(numout,*) '   Namelist namcfg' 
    332          WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg) 
    333          WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz) 
    334          WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg 
    335          WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta 
    336          WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta 
    337          WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta 
    338          WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo 
    339          WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo 
    340          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 
    341          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    342          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
    343          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
     321         WRITE(numout,*) '      read domain configuration file                ln_read_cfg      = ', ln_read_cfg 
     322         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg) 
     323         WRITE(numout,*) '      write configuration definition file           ln_write_cfg     = ', ln_write_cfg 
     324         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
     325         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    344326      ENDIF 
    345327      !                             ! Parameter control 
    … …  
    382364      ENDIF 
    383365      ! 
    384       IF( nbench == 1 ) THEN              ! Benchmark 
    385          SELECT CASE ( cp_cfg ) 
    386          CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
    387          CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
    388             &                                 ' cp_cfg = "gyre" in namelist &namcfg or set nbench = 0' ) 
    389          END SELECT 
    390       ENDIF 
    391       ! 
    392366      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    393367         &                                               'f2003 standard. '                              ,  & 
    … …  
    421395      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports 
    422396      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports 
    423  
    424397      ! 
    425398      numout = 6                                     ! redefine numout in case it is used after this point... 
    … …  
    460433      !! ** Method  : 
    461434      !!---------------------------------------------------------------------- 
    462       INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
     435      INTEGER, INTENT(in) ::   num_pes  ! The number of MPI processes we have 
    463436      ! 
    464437      INTEGER, PARAMETER :: nfactmax = 20 
    … …  
    514487      INTEGER :: ifac, jl, inu 
    515488      INTEGER, PARAMETER :: ntest = 14 
    516       INTEGER :: ilfax(ntest) 
     489      INTEGER, DIMENSION(ntest) ::   ilfax 
     490      !!---------------------------------------------------------------------- 
    517491      ! 
    518492      ! lfax contains the set of allowed factors. 
    519       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    520          &                            128,   64,   32,   16,    8,   4,   2  / 
    521       !!---------------------------------------------------------------------- 
    522  
     493      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     494      ! 
    523495      ! Clear the error flag and initialise output vars 
    524       kerr = 0 
    525       kfax = 1 
     496      kerr  = 0 
     497      kfax  = 1 
    526498      knfax = 0 
    527  
     499      ! 
    528500      ! Find the factors of n. 
    529501      IF( kn == 1 )   GOTO 20 
    … …  
    533505      ! l points to the allowed factor list. 
    534506      ! ifac holds the current factor. 
    535  
     507      ! 
    536508      inu   = kn 
    537509      knfax = 0 
    538  
     510      ! 
    539511      DO jl = ntest, 1, -1 
    540512         ! 
    … …  
    560532         ! 
    561533      END DO 
    562  
     534      ! 
    563535   20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
    564536      ! 
    … …  
    568540 
    569541   SUBROUTINE nemo_northcomms 
    570       !!====================================================================== 
     542      !!---------------------------------------------------------------------- 
    571543      !!                     ***  ROUTINE  nemo_northcomms  *** 
    572       !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
    573       !!                       point-to-point messaging 
    574       !!===================================================================== 
    575       !!---------------------------------------------------------------------- 
    576       !! 
    577       !! ** Purpose :   Initialization of the northern neighbours lists. 
     544      !! ** Purpose :   Setup for north fold exchanges with explicit  
     545      !!                point-to-point messaging 
     546      !! 
     547      !! ** Method :   Initialization of the northern neighbours lists. 
    578548      !!---------------------------------------------------------------------- 
    579549      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    580550      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    581551      !!---------------------------------------------------------------------- 
    582  
    583552      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    584553      INTEGER  ::   njmppmax 
    585  
     554      !!---------------------------------------------------------------------- 
     555      ! 
    586556      njmppmax = MAXVAL( njmppt ) 
    587      
     557      ! 
    588558      !initializes the north-fold communication variables 
    589559      isendto(:) = 0 
    590       nsndto = 0 
    591  
     560      nsndto     = 0 
     561      ! 
    592562      !if I am a process in the north 
    593563      IF ( njmpp == njmppmax ) THEN 
    … …  
    611581                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    612582                   nsndto = nsndto + 1 
    613                      isendto(nsndto) = jn 
     583                   isendto(nsndto) = jn 
    614584                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    615585                   nsndto = nsndto + 1 
    616                      isendto(nsndto) = jn 
     586                   isendto(nsndto) = jn 
    617587                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    618588                   nsndto = nsndto + 1 
    619                      isendto(nsndto) = jn 
    620                 END IF 
     589                   isendto(nsndto) = jn 
     590                ENDIF 
    621591          END DO 
    622592          nfsloop = 1 
    … …  
    636606      l_north_nogather = .TRUE. 
    637607   END SUBROUTINE nemo_northcomms 
     608 
    638609#else 
    639610   SUBROUTINE nemo_northcomms      ! Dummy routine 
    … …  
    645616END MODULE nemogcm 
    646617 
    647  

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAO_SRC/sao_data.F90

    r5063 r7277  
    11MODULE sao_data 
    2    !! ================================================================= 
    3    !!                    *** MODULE sao_data *** 
    4    !! ================================================================= 
     2   !!====================================================================== 
     3   !!                       ***  MODULE sao_data  *** 
     4   !!====================================================================== 
     5   !! History :  3.6  ! 2015-12  (A. Ryan)  Original code 
     6   !!---------------------------------------------------------------------- 
    57   USE par_kind, ONLY: lc 
    68   USE lib_mpp         ! distributed memory computing 
     9   USE in_out_manager 
    710 
    811   IMPLICIT NONE 
    9  
    10    !! Public data 
    1112 
    1213   INTEGER, PARAMETER :: MaxNumFiles = 1000 
    1314 
    1415   !! Stand Alone Observation operator settings 
    15    CHARACTER(len=lc) :: & 
    16       & sao_files(MaxNumFiles)         !: model files 
    17    INTEGER            :: & 
    18       & n_files, &                     !: number of files 
    19       & nn_sao_idx(MaxNumFiles), &     !: time_counter indices 
    20       & nn_sao_freq                    !: read frequency in time steps 
     16   CHARACTER(len=lc) ::   sao_files(MaxNumFiles)   !: model files 
     17   INTEGER           ::   n_files                  !: number of files 
     18   INTEGER           :: nn_sao_idx(MaxNumFiles)    !: time_counter indices 
     19   INTEGER           :: nn_sao_freq                !: read frequency in time steps 
     20    
     21   !!---------------------------------------------------------------------- 
     22   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     23   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
     24   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     25   !!---------------------------------------------------------------------- 
    2126CONTAINS 
     27 
    2228   SUBROUTINE sao_data_init() 
    2329      !!---------------------------------------------------------------------- 
    … …  
    2733      !! 
    2834      !!---------------------------------------------------------------------- 
    29       USE in_out_manager 
    30       INTEGER            :: & 
    31          & jf                           !: file dummy loop index 
    32       LOGICAL :: lmask(MaxNumFiles)     !: Logical mask used for counting 
    33       INTEGER :: ios 
    34  
    35       ! Standard offline obs_oper information 
     35      INTEGER ::   jf                   ! file dummy loop index 
     36      LOGICAL ::   lmask(MaxNumFiles)   ! Logical mask used for counting 
     37      INTEGER ::   ios 
     38      !! 
    3639      NAMELIST/namsao/sao_files, nn_sao_idx, nn_sao_freq 
     40      !!---------------------------------------------------------------------- 
    3741 
    3842      ! Standard offline obs_oper initialisation 
    39       n_files = 0                   !: number of files to cycle through 
    40       sao_files(:) = ''             !: list of files to read in 
    41       nn_sao_idx(:) = 0             !: list of indices inside each file 
    42       nn_sao_freq = -1              !: input frequency in time steps 
     43      n_files = 0                   ! number of files to cycle through 
     44      sao_files(:) = ''             ! list of files to read in 
     45      nn_sao_idx(:) = 0             ! list of indices inside each file 
     46      nn_sao_freq = -1              ! input frequency in time steps 
    4347 
    4448      ! Standard offline obs_oper settings 
    … …  
    4650      READ  ( numnam_ref, namsao, IOSTAT = ios, ERR = 901 ) 
    4751901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in reference namelist', .TRUE. ) 
    48  
     52      ! 
    4953      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
    5054      READ  ( numnam_cfg, namsao, IOSTAT = ios, ERR = 902 ) 
    5155902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsao in configuration namelist', .TRUE. ) 
    52  
    53  
    54       ! count input files 
    55       lmask(:) = .FALSE. 
     56      
     57      lmask(:) = .FALSE.               ! count input files 
    5658      WHERE (sao_files(:) /= '') lmask(:) = .TRUE. 
    5759      n_files = COUNT(lmask) 
    58  
    59       !! Initialise sub obs window frequency 
    60       IF (nn_sao_freq == -1) THEN 
    61          !! Run length 
    62          nn_sao_freq = nitend - nit000 + 1 
     60      ! 
     61      IF(nn_sao_freq == -1) THEN      ! Initialise sub obs window frequency 
     62         nn_sao_freq = nitend - nit000 + 1      ! Run length 
    6363      ENDIF 
    64  
    65       !! Print summary of settings 
    66       IF(lwp) THEN 
     64      ! 
     65      IF(lwp) THEN                     ! Print summary of settings 
    6766         WRITE(numout,*) 
    6867         WRITE(numout,*) 'offline obs_oper : Initialization' 
    … …  
    7069         WRITE(numout,*) '   Namelist namsao : set stand alone obs_oper parameters' 
    7170         DO jf = 1, n_files 
    72             WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', & 
    73                TRIM(sao_files(jf)) 
    74             WRITE(numout,*) '   Input forecast file index        forecastindex = ', & 
    75                nn_sao_idx(jf) 
     71            WRITE(numout,'(1X,2A)') '   Input forecast file name          forecastfile = ', TRIM(sao_files(jf)) 
     72            WRITE(numout,*) '   Input forecast file index        forecastindex = ', nn_sao_idx(jf) 
    7673         END DO 
    7774      END IF 
    78  
     75      ! 
    7976   END SUBROUTINE sao_data_init 
    8077 
     78   !!====================================================================== 
    8179END MODULE sao_data 
    8280 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAO_SRC/sao_intp.F90

    r5063 r7277  
    44   !! ** Purpose : Run NEMO observation operator in offline mode 
    55   !!====================================================================== 
    6    !! NEMO modules 
     6   !! History :  3.6  ! 2015-12  (A. Ryan)  Original code 
     7   !!---------------------------------------------------------------------- 
     8   !        ! NEMO modules 
    79   USE in_out_manager 
    810   USE diaobs 
    9    !! Stand Alone Observation operator modules 
     11   !        ! Stand Alone Observation operator modules 
    1012   USE sao_read 
    1113   USE sao_data 
    … …  
    1618   PUBLIC sao_interp 
    1719 
    18    CONTAINS 
     20   !!---------------------------------------------------------------------- 
     21   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     22   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
     23   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     24   !!---------------------------------------------------------------------- 
     25CONTAINS 
    1926 
    20       SUBROUTINE sao_interp 
    21          !!---------------------------------------------------------------------- 
    22          !!                    ***  SUBROUTINE sao_interp *** 
    23          !! 
    24          !! ** Purpose : To interpolate the model as if it were running online. 
    25          !! 
    26          !! ** Method : 1. Populate model counterparts 
    27          !!             2. Call dia_obs at appropriate time steps 
    28          !!---------------------------------------------------------------------- 
    29          INTEGER :: & 
    30             & istp, & ! time step index 
    31             & ifile   ! file index 
    32          istp = nit000 - 1 
    33          nstop = 0 
    34          ifile = 1 
    35          CALL sao_rea_dri(ifile) 
    36          DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    37             IF (ifile <= n_files + 1) THEN 
    38                IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN 
    39                   CALL sao_rea_dri(ifile) 
    40                   ifile = ifile + 1 
    41                ENDIF 
    42                CALL dia_obs(istp) 
     27   SUBROUTINE sao_interp 
     28      !!---------------------------------------------------------------------- 
     29      !!                    ***  SUBROUTINE sao_interp *** 
     30      !! 
     31      !! ** Purpose : To interpolate the model as if it were running online. 
     32      !! 
     33      !! ** Method : 1. Populate model counterparts 
     34      !!             2. Call dia_obs at appropriate time steps 
     35      !!---------------------------------------------------------------------- 
     36      INTEGER ::   istp    ! time step index 
     37      INTEGER ::   ifile   ! file index 
     38      !!---------------------------------------------------------------------- 
     39      istp = nit000 - 1 
     40      nstop = 0 
     41      ifile = 1 
     42      CALL sao_rea_dri(ifile) 
     43      ! 
     44      DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
     45         IF (ifile <= n_files + 1) THEN 
     46            IF ( MOD(istp, nn_sao_freq) == nit000 ) THEN 
     47               CALL sao_rea_dri(ifile) 
     48               ifile = ifile + 1 
    4349            ENDIF 
    44             istp = istp + 1 
    45          END DO 
    46       END SUBROUTINE sao_interp 
     50            CALL dia_obs(istp) 
     51         ENDIF 
     52         istp = istp + 1 
     53      END DO 
     54      ! 
     55   END SUBROUTINE sao_interp 
    4756 
     57   !!====================================================================== 
    4858END MODULE sao_intp 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAO_SRC/sao_read.F90

    r5063 r7277  
    11MODULE sao_read 
    2    !!================================================================== 
    3    !!                    *** MODULE sao_read *** 
     2   !!====================================================================== 
     3   !!                      ***  MODULE sao_read *** 
    44   !! Read routines : I/O for Stand Alone Observation operator 
    5    !!================================================================== 
     5   !!====================================================================== 
    66   USE mppini 
    77   USE lib_mpp 
    … …  
    1212   USE dom_oce, ONLY: nlci, nlcj, nimpp, njmpp, tmask 
    1313   USE par_oce, ONLY: jpi, jpj, jpk 
     14   ! 
    1415   USE obs_fbm, ONLY: fbimdi, fbrmdi, fbsp, fbdp 
    1516   USE sao_data 
    … …  
    2021   PUBLIC sao_rea_dri 
    2122 
     23   !!---------------------------------------------------------------------- 
     24   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     25   !! $Id: trazdf_imp.F90 6140 2015-12-21 11:35:23Z timgraham $ 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!---------------------------------------------------------------------- 
    2228CONTAINS 
    23    SUBROUTINE sao_rea_dri(kfile) 
     29 
     30   SUBROUTINE sao_rea_dri( kfile ) 
    2431      !!------------------------------------------------------------------------ 
    2532      !!             *** sao_rea_dri *** 
    … …  
    3138      !! 
    3239      !!------------------------------------------------------------------------ 
    33       INTEGER, INTENT(IN) :: & 
    34               & kfile         !: File number 
    35       CHARACTER(len=lc) :: & 
    36               & cdfilename    !: File name 
    37       INTEGER :: & 
    38               & kindex        !: File index to read 
    39  
    40       cdfilename = TRIM(sao_files(kfile)) 
     40      INTEGER, INTENT(in) ::   kfile         ! File number 
     41      ! 
     42      CHARACTER(len=lc)   ::   cdfilename    ! File name 
     43      INTEGER ::   kindex        ! File index to read 
     44      !!------------------------------------------------------------------------ 
     45      ! 
     46      cdfilename = TRIM( sao_files(kfile) ) 
    4147      kindex = nn_sao_idx(kfile) 
    42       CALL sao_read_file(TRIM(cdfilename), kindex) 
    43  
     48      CALL sao_read_file( TRIM( cdfilename ), kindex ) 
     49      ! 
    4450   END SUBROUTINE sao_rea_dri 
    4551 
    46    SUBROUTINE sao_read_file(filename, ifcst) 
     52 
     53   SUBROUTINE sao_read_file( filename, ifcst ) 
    4754      !!------------------------------------------------------------------------ 
    48       !!             *** sao_read_file *** 
     55      !!                         ***  sao_read_file *** 
    4956      !! 
    5057      !! Purpose : To fill tn and sn with dailymean field from netcdf files 
    … …  
    5461      !! Author  : A. Ryan Oct 2010 
    5562      !!------------------------------------------------------------------------ 
    56  
    57       INTEGER,          INTENT(IN) :: ifcst 
    58       CHARACTER(len=*), INTENT(IN) :: filename 
    59       INTEGER                      :: ncid, & 
    60                                     & varid,& 
    61                                     & istat,& 
    62                                     & ntimes,& 
    63                                     & tdim, & 
    64                                     & xdim, & 
    65                                     & ydim, & 
    66                                     & zdim 
    67       INTEGER                      :: ii, ij, ik 
    68       INTEGER, DIMENSION(4)        :: start_n, & 
    69                                     & count_n 
    70       INTEGER, DIMENSION(3)        :: start_s, & 
    71                                     & count_s 
    72       REAL(fbdp), DIMENSION(:,:,:),ALLOCATABLE :: temp_tn, & 
    73                                               & temp_sn 
    74       REAL(fbdp), DIMENSION(:,:),  ALLOCATABLE :: temp_sshn 
    75       REAL(fbdp)                     :: fill_val 
     63      INTEGER,          INTENT(in) ::   ifcst 
     64      CHARACTER(len=*), INTENT(in) ::   filename 
     65      INTEGER                      ::   ncid, varid, istat, ntimes 
     66      INTEGER                      ::   tdim, xdim, ydim, zdim 
     67      INTEGER                      ::   ii, ij, ik 
     68      INTEGER, DIMENSION(4)        ::   start_n, count_n 
     69      INTEGER, DIMENSION(3)        ::   start_s, count_s 
     70      REAL(fbdp)                   ::   fill_val 
     71      REAL(fbdp), DIMENSION(:,:,:), ALLOCATABLE ::   temp_tn, temp_sn 
     72      REAL(fbdp), DIMENSION(:,:)  , ALLOCATABLE ::   temp_sshn 
    7673 
    7774      ! DEBUG 
    78       INTEGER :: istage 
     75      INTEGER ::   istage 
     76      !!------------------------------------------------------------------------ 
    7977 
    8078      IF (TRIM(filename) == 'nofile') THEN 
    81          tsn(:,:,:,:) = fbrmdi 
    82          sshn(:,:) = fbrmdi 
     79         tsn (:,:,:,:) = fbrmdi 
     80         sshn(:,:)     = fbrmdi 
    8381      ELSE 
    8482         WRITE(numout,*) "Opening :", TRIM(filename) 
    … …  
    169167         istat = nf90_close(ncid) 
    170168      END IF 
     169      ! 
    171170   END SUBROUTINE sao_read_file 
     171    
     172   !!------------------------------------------------------------------------ 
    172173END MODULE sao_read 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r6165 r7277  
    22   !!====================================================================== 
    33   !!                       ***  MODULE nemogcm   *** 
    4    !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 
     4   !! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats 
    55   !!====================================================================== 
    6    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
    7    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    8    !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1  
    10    !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    11    !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice  
    12    !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    14    !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    15    !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model  
    16    !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP  
    17    !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    18    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
    19    !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
    20    !!             -   ! 2004-08  (C. Talandier) New trends organization 
    21    !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
    22    !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
    23    !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
    24    !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
    25    !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    26    !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
    27    !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface  
    28    !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    29    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    30    !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE 
     6   !! History :  3.6  ! 2011-11  (S. Alderson, G. Madec) original code 
     7   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication  
     8   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla) 
     9   !!            4.0  ! 2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
    3110   !!---------------------------------------------------------------------- 
    3211 
    3312   !!---------------------------------------------------------------------- 
    34    !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
    35    !!   nemo_init      : initialization of the NEMO system 
    36    !!   nemo_ctl       : initialisation of the contol print  
    37    !!   nemo_closefile : close remaining open files 
    38    !!   nemo_alloc     : dynamical allocation 
    39    !!   nemo_partition : calculate MPP domain decomposition 
    40    !!   factorise      : calculate the factors of the no. of MPI processes 
     13   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 
     14   !!   nemo_init     : initialization of the NEMO system 
     15   !!   nemo_ctl      : initialisation of the contol print 
     16   !!   nemo_closefile: close remaining open files 
     17   !!   nemo_alloc    : dynamical allocation 
     18   !!   nemo_partition: calculate MPP domain decomposition 
     19   !!   factorise     : calculate the factors of the no. of MPI processes 
    4120   !!---------------------------------------------------------------------- 
    42    USE step_oce        ! module used in the ocean time stepping module 
    43    USE sbc_oce         ! surface boundary condition: ocean 
    44    USE domcfg          ! domain configuration               (dom_cfg routine) 
    45    USE daymod          ! calendar 
    46    USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    47    USE domain          ! domain initialization             (dom_init routine) 
    48    USE phycst          ! physical constant                  (par_cst routine) 
    49    USE step            ! NEMO time-stepping                 (stp     routine) 
    50    USE lib_mpp         ! distributed memory computing 
    51 #if defined key_nosignedzero 
    52    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    53 #endif 
     21   USE step_oce       ! module used in the ocean time stepping module 
     22   USE sbc_oce        ! surface boundary condition: ocean 
     23   USE phycst         ! physical constant                  (par_cst routine) 
     24   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
     25   USE usrdef_nam     ! user defined configuration 
     26   USE daymod         ! calendar 
     27   USE step           ! NEMO time-stepping                 (stp     routine) 
     28   USE cpl_oasis3     ! 
     29   USE sbcssm         ! 
     30   USE icbstp         ! handle bergs, calving, themodynamics and transport 
     31#if defined key_bdy 
     32   USE bdyini         ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3 
     33   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3 
     34#endif 
     35   USE bdy_par 
     36   ! 
     37   USE lib_mpp        ! distributed memory computing 
     38   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
     39   USE lbcnfd   , ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
     40   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    5441#if defined key_iomput 
    55    USE xios 
    56 #endif 
    57    USE cpl_oasis3 
    58    USE sbcssm 
    59    USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 
    60    USE icbstp          ! handle bergs, calving, themodynamics and transport 
    61 #if defined key_bdy 
    62    USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3 
    63    USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3 
    64 #endif 
    65    USE bdy_par 
     42   USE xios           ! xIOserver 
     43#endif 
    6644 
    6745   IMPLICIT NONE 
    … …  
    7452 
    7553   !!---------------------------------------------------------------------- 
    76    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     54   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    7755   !! $Id$ 
    7856   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8462      !!                     ***  ROUTINE nemo_gcm  *** 
    8563      !! 
    86       !! ** Purpose :   NEMO solves the primitive equations on an orthogonal  
     64      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal 
    8765      !!              curvilinear mesh on the sphere. 
    8866      !! 
    … …  
    9472      !!              Madec, 2008, internal report, IPSL. 
    9573      !!---------------------------------------------------------------------- 
    96       INTEGER ::   istp       ! time step index 
     74      INTEGER ::   istp   ! time step index 
    9775      !!---------------------------------------------------------------------- 
    9876      ! 
    … …  
    10078      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
    10179#endif 
    102  
     80      ! 
    10381      !                            !-----------------------! 
    10482      CALL nemo_init               !==  Initialisations  ==! 
    … …  
    124102      !                            !-----------------------! 
    125103      istp = nit000 
    126          
     104#if defined key_agrif 
     105      CALL Agrif_Regrid() 
     106#endif 
     107 
    127108      DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    128109#if defined key_agrif 
    129          CALL Agrif_Step( stp )           ! AGRIF: time stepping 
     110         CALL stp                         ! AGRIF: time stepping 
    130111#else 
    131          CALL stp( istp )                 ! standard time stepping 
     112         IF ( .NOT. ln_diurnal_only ) THEN 
     113            CALL stp( istp )                 ! standard time stepping 
     114         ELSE 
     115            CALL stp_diurnal( istp )        ! time step only the diurnal SST 
     116         ENDIF  
    132117#endif 
    133118         istp = istp + 1 
    134119         IF( lk_mpp )   CALL mpp_max( nstop ) 
    135       END DO 
     120         END DO 
    136121      ! 
    137122      IF( ln_icebergs )   CALL icb_end( nitend ) 
    … …  
    140125      !                            !==  finalize the run  ==! 
    141126      !                            !------------------------! 
    142       IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA 
    143       ! 
    144       IF( nstop /= 0 .AND. lwp ) THEN   ! error print 
     127      IF(lwp) WRITE(numout,cform_aaa)        ! Flag AAAAAAA 
     128      ! 
     129      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    145130         WRITE(numout,cform_err) 
    146          WRITE(numout,*) nstop, ' error have been found'  
     131         WRITE(numout,*) nstop, ' error have been found' 
    147132      ENDIF 
    148133      ! 
    … …  
    157142      ! 
    158143#if defined key_iomput 
    159       CALL xios_finalize                ! end mpp communications with xios 
    160       IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS 
     144      CALL xios_finalize                     ! end mpp communications with xios 
     145      IF( lk_oasis )   CALL cpl_finalize     ! end coupling and mpp communications with OASIS 
    161146#else 
    162147      IF( lk_oasis ) THEN  
    163          CALL cpl_finalize              ! end coupling and mpp communications with OASIS 
     148         CALL cpl_finalize                   ! end coupling and mpp communications with OASIS 
    164149      ELSE 
    165          IF( lk_mpp )   CALL mppstop    ! end mpp communications 
     150         IF( lk_mpp )   CALL mppstop         ! end mpp communications 
    166151      ENDIF 
    167152#endif 
    … …  
    176161      !! ** Purpose :   initialization of the NEMO GCM 
    177162      !!---------------------------------------------------------------------- 
    178       INTEGER ::   ji            ! dummy loop indices 
    179       INTEGER ::   ilocal_comm   ! local integer       
    180       INTEGER ::   ios 
    181       CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    182       CHARACTER(len=80) ::   clname 
    183       ! 
    184       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    185          &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
    186          &             nn_bench, nn_timing, nn_diacfl 
    187       NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 
    188          &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    189       !!---------------------------------------------------------------------- 
    190       ! 
    191       cltxt = '' 
     163      INTEGER  ::   ji            ! dummy loop indices 
     164      INTEGER  ::   ilocal_comm   ! local integer 
     165      INTEGER  ::   ios, inum     !   -      - 
     166      CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
     167      CHARACTER(len=80)                 ::   clname 
     168      ! 
     169      NAMELIST/namctl/ ln_ctl   , nn_print, nn_ictls, nn_ictle,   & 
     170         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,   & 
     171         &             nn_timing, nn_diacfl 
     172      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
     173      !!---------------------------------------------------------------------- 
     174      ! 
     175      cltxt  = '' 
     176      cltxt2 = '' 
     177      clnam  = ''   
     178      cxios_context = 'nemo' 
    192179      ! 
    193180      !                             ! Open reference namelist and configuration namelist files 
    … …  
    204191   ENDIF 
    205192      ! 
    206       REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark 
     193      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints 
    207194      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    208195901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    209  
    210       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark 
     196      ! 
     197      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    211198      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    212199902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    213  
    214       ! 
    215       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark 
     200      ! 
     201      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints 
    216202      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    217203903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    … …  
    221207904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    222208 
    223 ! Force values for AGRIF zoom (cf. agrif_user.F90) 
     209      !                             !--------------------------! 
     210      !                             !  Set global domain size  !   (control print return in cltxt2) 
     211      !                             !--------------------------! 
     212      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
     213         CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     214         ! 
     215      ELSE                                ! user-defined namelist 
     216         CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     217      ENDIF 
     218      ! 
     219      jpk = jpkglo 
     220      ! 
    224221#if defined key_agrif 
    225    IF( .NOT. Agrif_Root() ) THEN 
    226       jpiglo  = nbcellsx + 2 + 2*nbghostcells 
    227       jpjglo  = nbcellsy + 2 + 2*nbghostcells 
    228       jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    229       jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    230       jpidta  = jpiglo 
    231       jpjdta  = jpjglo 
    232       jpizoom = 1 
    233       jpjzoom = 1 
    234       nperio  = 0 
    235       jperio  = 0 
    236       ln_use_jattr = .false. 
    237    ENDIF 
     222      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90) 
     223         jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     224         jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     225         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     226         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     227         nperio  = 0 
     228         jperio  = 0 
     229         ln_use_jattr = .false. 
     230      ENDIF 
    238231#endif 
    239232      ! 
    … …  
    249242            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
    250243         ELSE 
    251             CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios 
     244            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    252245         ENDIF 
    253246      ENDIF 
    … …  
    264257      ENDIF 
    265258#endif 
     259 
    266260      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    267261 
    … …  
    269263      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    270264 
    271       IF(lwm) THEN 
    272          ! write merged namelists from earlier to output namelist now that the 
    273          ! file has been opened in call to mynode. nammpp has already been 
    274          ! written in mynode (if lk_mpp_mpi) 
     265      IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
     266         !                       ! now that the file has been opened in call to mynode.  
     267         !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    275268         WRITE( numond, namctl ) 
    276269         WRITE( numond, namcfg ) 
    277       ENDIF 
    278  
    279       ! If dimensions of processor grid weren't specified in the namelist file  
     270         IF( .NOT.ln_read_cfg ) THEN 
     271            DO ji = 1, SIZE(clnam) 
     272               IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
     273            END DO 
     274         ENDIF 
     275      ENDIF 
     276 
     277      ! If dimensions of processor grid weren't specified in the namelist file 
    280278      ! then we calculate them here now that we have our communicator size 
    281       IF( (jpni < 1) .OR. (jpnj < 1) )THEN 
     279      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    282280#if   defined key_mpp_mpi 
    283          IF( Agrif_Root() ) CALL nemo_partition(mppsize) 
     281         IF( Agrif_Root() )   CALL nemo_partition( mppsize ) 
    284282#else 
    285283         jpni  = 1 
    … …  
    287285         jpnij = jpni*jpnj 
    288286#endif 
    289       END IF 
    290  
    291       ! Calculate domain dimensions given calculated jpni and jpnj 
    292       ! This used to be done in par_oce.F90 when they were parameters rather 
    293       ! than variables 
    294       IF( Agrif_Root() ) THEN 
     287      ENDIF 
     288 
     289      IF( Agrif_Root() ) THEN       ! AGRIF mother: specific setting from jpni and jpnj 
    295290#if defined key_nemocice_decomp 
    296          jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
    297          jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     291         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
     292         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.  
    298293#else 
    299          jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    300          jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    301 #endif 
    302       ENDIF 
    303          jpk = jpkdta                                             ! third dim 
    304          jpim1 = jpi-1                                            ! inner domain indices 
    305          jpjm1 = jpj-1                                            !   "           " 
    306          jpkm1 = jpk-1                                            !   "           " 
    307          jpij  = jpi*jpj                                          !  jpi x j 
     294         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim. 
     295         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim. 
     296#endif 
     297      ENDIF 
     298 
     299!!gm ???    why here  it has already been done in line 301 ! 
     300      jpk = jpkglo                                             ! third dim 
     301!!gm end 
     302 
     303#if defined key_agrif 
     304      ! simple trick to use same vertical grid as parent but different number of levels:  
     305      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
     306      ! Suppress once vertical online interpolation is ok 
     307      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
     308#endif 
     309      jpim1 = jpi-1                                            ! inner domain indices 
     310      jpjm1 = jpj-1                                            !   "           " 
     311      jpkm1 = jpk-1                                            !   "           " 
     312      jpij  = jpi*jpj                                          !  jpi x j 
    308313 
    309314      IF(lwp) THEN                            ! open listing units 
    … …  
    319324         WRITE(numout,*) '                       NEMO team' 
    320325         WRITE(numout,*) '            Ocean General Circulation Model' 
    321          WRITE(numout,*) '                  version 3.6  (2015) ' 
     326         WRITE(numout,*) '                  version 3.7  (2016) ' 
    322327         WRITE(numout,*) '             StandAlone Surface version (SAS) ' 
    323328         WRITE(numout,*) 
    324329         WRITE(numout,*) 
    325          DO ji = 1, SIZE(cltxt)  
    326             IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
     330         DO ji = 1, SIZE(cltxt) 
     331            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode 
    327332         END DO 
    328          WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
     333         WRITE(numout,*) 
     334         WRITE(numout,*) 
     335         DO ji = 1, SIZE(cltxt2) 
     336            IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size 
     337         END DO 
    329338         ! 
    330       ENDIF 
    331  
    332       ! Now we know the dimensions of the grid and numout has been set we can  
    333       ! allocate arrays 
     339         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     340         ! 
     341      ENDIF 
     342 
     343      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    334344      CALL nemo_alloc() 
    335  
    336345      !                             !-------------------------------! 
    337346      !                             !  NEMO general initialization  ! 
    338347      !                             !-------------------------------! 
    339348 
    340       CALL nemo_ctl                          ! Control prints & Benchmark 
     349      CALL nemo_ctl                          ! Control prints 
    341350 
    342351      !                                      ! Domain decomposition 
    … …  
    350359                            CALL phy_cst    ! Physical constants 
    351360                            CALL eos_init   ! Equation of state 
    352                             CALL dom_cfg    ! Domain configuration 
    353361                            CALL dom_init   ! Domain 
    354362 
    … …  
    383391      IF(lwp) THEN                  ! control print 
    384392         WRITE(numout,*) 
    385          WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark' 
     393         WRITE(numout,*) 'nemo_ctl: Control prints' 
    386394         WRITE(numout,*) '~~~~~~~ ' 
    387395         WRITE(numout,*) '   Namelist namctl' 
    … …  
    394402         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    395403         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    396          WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
     404         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing 
    397405      ENDIF 
    398406      ! 
    … …  
    404412      isplt     = nn_isplt 
    405413      jsplt     = nn_jsplt 
    406       nbench    = nn_bench 
    407414 
    408415      IF(lwp) THEN                  ! control print 
    … …  
    411418         WRITE(numout,*) '~~~~~~~ ' 
    412419         WRITE(numout,*) '   Namelist namcfg' 
    413          WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg) 
    414          WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz) 
    415          WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg 
    416          WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta 
    417          WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta 
    418          WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta 
    419          WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo 
    420          WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo 
    421          WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom 
    422          WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 
    423          WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio    
    424          WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 
     420         WRITE(numout,*) '      read domain configuration files               ln_read_cfg      = ', ln_read_cfg 
     421         WRITE(numout,*) '         filename to be read                           cn_domcfg     = ', TRIM(cn_domcfg) 
     422         WRITE(numout,*) '      write  configuration definition files         ln_write_cfg     = ', ln_write_cfg 
     423         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
     424         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    425425      ENDIF 
    426426      !                             ! Parameter control 
    … …  
    441441         !                              ! indices used for the SUM control 
    442442         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    443             lsp_area = .FALSE.                         
     443            lsp_area = .FALSE. 
    444444         ELSE                                             ! print control done over a specific  area 
    445445            lsp_area = .TRUE. 
    … …  
    463463      ENDIF 
    464464      ! 
    465       IF( nbench == 1 ) THEN              ! Benchmark  
    466          SELECT CASE ( cp_cfg ) 
    467          CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
    468          CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
    469             &                                 ' cp_cfg="gyre" in namelist &namcfg or set nbench = 0' ) 
    470          END SELECT 
    471       ENDIF 
    472       ! 
    473465      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    474466         &                                               'f2003 standard. '                              ,  & 
    … …  
    521513#endif 
    522514      ! 
    523       INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8 
     515      INTEGER :: ierr, ierr1, ierr2, ierr3, ierr4, ierr5, ierr6, ierr7, ierr8 
    524516      INTEGER :: jpm 
    525517      !!---------------------------------------------------------------------- 
    … …  
    540532      ! clem: should not be needed. To be checked out 
    541533      jpm = MAX(jp_tem, jp_sal) 
    542       ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 ) 
    543       ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 ) 
    544       ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 ) 
    545       ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 
     534      ALLOCATE( tsn (jpi,jpj,1,jpm) , STAT=ierr2 ) 
     535      ALLOCATE( ub  (jpi,jpj,1)     , STAT=ierr3 ) 
     536      ALLOCATE( vb  (jpi,jpj,1)     , STAT=ierr4 ) 
     537      ALLOCATE( tsb (jpi,jpj,1,jpm) , STAT=ierr5 ) 
    546538      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
    547       ALLOCATE( un(jpi,jpj,1)       , STAT=ierr7 ) 
    548       ALLOCATE( vn(jpi,jpj,1)       , STAT=ierr8 ) 
     539      ALLOCATE( un  (jpi,jpj,1)     , STAT=ierr7 ) 
     540      ALLOCATE( vn  (jpi,jpj,1)     , STAT=ierr8 ) 
    549541      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 + ierr8 
    550542#endif 
    … …  
    564556      !! ** Method  : 
    565557      !!---------------------------------------------------------------------- 
    566       INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
     558      INTEGER, INTENT(in) ::   num_pes  ! The number of MPI processes we have 
    567559      ! 
    568560      INTEGER, PARAMETER :: nfactmax = 20 
    … …  
    608600      !! 
    609601      !! ** Purpose :   return the prime factors of n. 
    610       !!                knfax factors are returned in array kfax which is of  
     602      !!                knfax factors are returned in array kfax which is of 
    611603      !!                maximum dimension kmaxfax. 
    612604      !! ** Method  : 
    … …  
    618610      INTEGER :: ifac, jl, inu 
    619611      INTEGER, PARAMETER :: ntest = 14 
    620       INTEGER :: ilfax(ntest) 
     612      INTEGER, DIMENSION(ntest) ::   ilfax 
     613      !!---------------------------------------------------------------------- 
    621614      ! 
    622615      ! lfax contains the set of allowed factors. 
    623       data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
    624          &                            128,   64,   32,   16,    8,   4,   2  / 
    625       !!---------------------------------------------------------------------- 
    626  
     616      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 
     617      ! 
    627618      ! Clear the error flag and initialise output vars 
    628       kerr = 0 
    629       kfax = 1 
     619      kerr  = 0 
     620      kfax  = 1 
    630621      knfax = 0 
    631  
     622      ! 
    632623      ! Find the factors of n. 
    633624      IF( kn == 1 )   GOTO 20 
    … …  
    637628      ! l points to the allowed factor list. 
    638629      ! ifac holds the current factor. 
    639  
     630      ! 
    640631      inu   = kn 
    641632      knfax = 0 
    642  
     633      ! 
    643634      DO jl = ntest, 1, -1 
    644635         ! 
    … …  
    664655         ! 
    665656      END DO 
    666  
     657      ! 
    667658   20 CONTINUE      ! Label 20 is the exit point from the factor search loop. 
    668659      ! 
    … …  
    670661 
    671662#if defined key_mpp_mpi 
     663 
    672664   SUBROUTINE nemo_northcomms 
    673       !!====================================================================== 
     665      !!---------------------------------------------------------------------- 
    674666      !!                     ***  ROUTINE  nemo_northcomms  *** 
    675       !! nemo_northcomms    :  Setup for north fold exchanges with explicit  
    676       !!                       point-to-point messaging 
    677       !!===================================================================== 
    678       !!---------------------------------------------------------------------- 
    679       !! 
    680       !! ** Purpose :   Initialization of the northern neighbours lists. 
     667      !! ** Purpose :   Setup for north fold exchanges with explicit  
     668      !!                point-to-point messaging 
     669      !! 
     670      !! ** Method :   Initialization of the northern neighbours lists. 
    681671      !!---------------------------------------------------------------------- 
    682672      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
    683673      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)  
    684674      !!---------------------------------------------------------------------- 
    685  
    686675      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    687676      INTEGER  ::   njmppmax 
    688  
     677      !!---------------------------------------------------------------------- 
     678      ! 
    689679      njmppmax = MAXVAL( njmppt ) 
    690      
     680      ! 
    691681      !initializes the north-fold communication variables 
    692682      isendto(:) = 0 
    693       nsndto = 0 
    694  
     683      nsndto     = 0 
     684      ! 
    695685      !if I am a process in the north 
    696686      IF ( njmpp == njmppmax ) THEN 
    … …  
    745735   END SUBROUTINE nemo_northcomms 
    746736#endif 
     737 
    747738   !!====================================================================== 
    748739END MODULE nemogcm 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6140 r7277  
    4242   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
    4343   REAL(wp), DIMENSION(3,2) ::   sob   !    "               " 
    44    REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius 
     44   REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celsius 
    4545       
    4646   !                          ! coefficients for conversion 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r6140 r7277  
    416416      IF(lwp)  WRITE(numout,*) 
    417417 
    418       IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) ! 
    419          !                                                    ! --------------------------- ! 
     418      IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) ! 
     419         !                                                ! --------------------------- ! 
    420420         ! set total alkalinity, phosphate, nitrate & silicate 
    421421         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90

    r5725 r7277  
    225225            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic  
    226226         ENDIF 
    227          IF( cp_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations 
     227         IF( cn_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations 
    228228             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
    229229                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 
    … …  
    264264        
    265265         !-- Baltic 
    266          IF( cp_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs 
     266         IF( cn_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs 
    267267            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron)  
    268268               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r6140 r7277  
    9494      ENDIF 
    9595      !                                               !==  effective transport  ==! 
    96       DO jk = 1, jpkm1 
    97          zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    98          zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    99          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    100       END DO 
    101       ! 
    102       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    103          zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    104          zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
    105       ENDIF 
    106       ! 
    107       IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
    108          &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
    109       ! 
    110       IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
    111       ! 
    112       zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
    113       zvn(:,:,jpk) = 0._wp 
    114       zwn(:,:,jpk) = 0._wp 
    115       ! 
     96      IF( lk_offline ) THEN 
     97         zun(:,:,:) = un(:,:,:)     ! effective transport already in un/vn/wn 
     98         zvn(:,:,:) = vn(:,:,:) 
     99         zwn(:,:,:) = wn(:,:,:) 
     100      ELSE 
     101         !        
     102         DO jk = 1, jpkm1 
     103            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
     104            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     105            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     106         END DO 
     107         ! 
     108         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
     109            zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
     110            zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
     111         ENDIF 
     112         ! 
     113         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
     114            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
     115         ! 
     116         IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     117         ! 
     118         zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
     119         zvn(:,:,jpk) = 0._wp 
     120         zwn(:,:,jpk) = 0._wp 
     121         ! 
     122      ENDIF 
    116123      ! 
    117124      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r6309 r7277  
    201201      ENDIF 
    202202      ! 
    203       IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
    204203      SELECT CASE ( nn_zdmp_tr ) 
    205204      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    … …  
    253252         ! ------------------- 
    254253 
    255          IF( cp_cfg == "orca" ) THEN 
    256             ! 
    257             SELECT CASE ( jp_cfg ) 
     254         IF( cn_cfg == "orca" ) THEN 
     255            ! 
     256            SELECT CASE ( nn_cfg ) 
    258257            !                                           ! ======================= 
    259258            CASE ( 1 )                                  ! eORCA_R1 configuration 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6309 r7277  
    100100         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    101101 
    102          IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     102         IF( ln_rsttr .AND. .NOT.ln_top_euler .AND.    &                     ! Restart: read in restart  file 
    103103            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
    104104            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
    … …  
    126126      ! Coupling offline : runoff are in emp which contains E-P-R 
    127127      ! 
    128       IF( .NOT. lk_offline .AND. .NOT.ln_linssh ) THEN  ! online coupling with vvl 
     128      IF( .NOT.ln_linssh ) THEN  ! online coupling with vvl 
    129129         zsfx(:,:) = 0._wp 
    130130      ELSE                                      ! online coupling free surface or offline with free surface 
    … …  
    187187      !                                           Write in the tracer restar  file 
    188188      !                                          ******************************* 
    189       IF( lrst_trc ) THEN 
     189      IF( lrst_trc .AND. .NOT.ln_top_euler ) THEN 
    190190         IF(lwp) WRITE(numout,*) 
    191191         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   & 

  • branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    r6140 r7277  
    428428      ENDIF 
    429429 
    430       IF ( cp_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration 
    431       ! GYRE : for diagnostic fields, are needed if cyclic B.C. are present, but not for purely MPI comm.  
    432       ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.) 
     430!!gm Test removed, nothing specific to a configuration should survive out of usrdef modules 
     431!!gm      IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration 
     432!!gm      ! GYRE : for diagnostic fields, are needed if cyclic B.C. are present, but not for purely MPI comm.  
     433!!gm      ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.) 
    433434         DO jn = 1, jptra 
    434435            IF( ln_trdtrc(jn) ) THEN 
    … …  
    438439            ENDIF 
    439440         END DO 
    440       ENDIF 
     441!!gm      ENDIF 
     442       
    441443      ! ====================================================================== 
    442444      ! II. Cumulate the trends over the analysis window 
    … …  
    567569                
    568570         !-- Lateral boundary conditions 
    569                IF ( cp_cfg .NE. 'gyre' ) THEN 
     571               IF ( cn_cfg .NE. 'gyre' ) THEN 
    570572                  CALL lbc_lnk( ztmltot(:,:,jn) , 'T', 1. )   ;   CALL lbc_lnk( ztmlres(:,:,jn) , 'T', 1. ) 
    571573                  CALL lbc_lnk( ztmlatf(:,:,jn) , 'T', 1. )   ;   CALL lbc_lnk( ztmlrad(:,:,jn) , 'T', 1. ) 
    … …  
    618620 
    619621         !-- Lateral boundary conditions  
    620                IF ( cp_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration     
     622               IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration     
    621623                  CALL lbc_lnk( ztmltot2(:,:,jn), 'T', 1. ) 
    622624                  CALL lbc_lnk( ztmlres2(:,:,jn), 'T', 1. ) 
    … …  
    990992 
    991993         !-- Lateral boundary conditions 
    992          IF ( cp_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration  
     994         IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration  
    993995            ! ES_B27_CD_WARN : lbc inutile GYRE, cf. + haut 
    994996            DO jn = 1, jpdiabio 
    995997              CALL lbc_lnk( ztmltrdbio2(:,:,jn), 'T', 1. ) 
    996             ENDDO 
     998            END DO 
    997999         ENDIF 
    9981000 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/all_functions.sh

    r4316 r7277  
    197197    cd ${CONFIG_DIR} 
    198198    cd ../ 
    199     REVISION_NB=`svn info | grep -i "Revision:" | sed -e "s/ //" | cut -d ":" -f 2` 
     199    REVISION_NB=`svn info | grep -i "Last Changed Rev:" | sed -e "s/ //g" | cut -d ":" -f 2` 
    200200    if [ ${#REVISION_NB} -eq 0 ] 
    201201    then 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_AMM12.cfg

    r4261 r7277  
    1 AMM12_v3.6.tar AMM12_v3.6 
     1AMM12_v3.7.tar AMM12_v3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_ISOMIP.cfg

    r4990 r7277  
    1  
     1ISOMIP_v3.7.tar ISOMIP_v3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_ORCA2_LIM3.cfg

    r5398 r7277  
    1 ORCA2_LIM_nemo_v3.6.tar ORCA2_LIM_nemo_v3.6 
     1ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_ORCA2_LIM_AGRIF.cfg

    r4324 r7277  
    1 ORCA2_LIM_nemo_v3.6.tar ORCA2_LIM_nemo_v3.6 
     1ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_ORCA2_LIM_OBS.cfg

    r4990 r7277  
    1 ORCA2_LIM_nemo_v3.6.tar ORCA2_LIM_nemo_v3.6 
     1ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg

    r5398 r7277  
    1 ORCA2_LIM_nemo_v3.6.tar  ORCA2_LIM_PISCES_v3.6 
     1ORCA2_LIM_nemo_v3.7.tar  ORCA2_LIM_PISCES_v3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg

    r4318 r7277  
    1 INPUTS_DYNA_v3.6.tar ORCA2_OFF_PISCES 
     1ORCA2_OFF_v3.7.tar ORCA2_OFF_PISCES_3.7 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/input_SAS.cfg

    r4324 r7277  
    1 ORCA2_LIM_nemo_v3.6.tar ORCA2_LIM_nemo_v3.6 
     1ORCA2_LIM_nemo_v3.7.tar ORCA2_LIM_nemo_v3.7 
    22INPUTS_SAS_v3.5.tar SAS  

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/prepare_exe_dir.sh

    r5656 r7277  
    7070export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME} 
    7171 
    72 cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/. 
    73 cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml 
     72cp -RL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/. 
     73cp -R ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml 
    7474cd ${EXE_DIR} 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/sette.sh

    r6140 r7277  
    133133cp BATCH_TEMPLATE/${JOB_PREFIX}-${COMPILER} job_batch_template || exit 
    134134# Description of configuration tested: 
    135 # GYRE            : 1 &  2 
    136 # ORCA2_LIM_PISCES: 3 &  4 
    137 # ORCA2_OFF_PISCES: 5 &  6 
    138 # ORCA2_LIM3      : 7 &  8 
    139 # AMM12           : 9 & 10 
    140 # SAS             :11 & 12 
    141 # ISOMIP          :13 & 14 
    142 # ORCA2_LIM_OBS   :15 
    143 # ORCA2_AGRIF_LIM :16 & 17  
    144 #                  18 & 19  
    145  
    146 for config in  1 2 3 4 5 6 7 8 9 10 11 12 15 16 
     135# GYRE             : 1 &  2 
     136# ORCA2_LIM_PISCES : 3 &  4 
     137# ORCA2_OFF_PISCES : 5 &  6 
     138# ORCA2_LIM3       : 7 &  8 
     139# AMM12            : 9 & 10 
     140# SAS              : 11      fos SAS there is no solver so is useless to test REPRO 
     141# ISOMIP           : 13 & 14 
     142# ORCA2_LIM_OBS    : 15 
     143# ORCA2_AGRIF_LIM  : 16 & 17  
     144#                    18 & 19  
     145 
     146for config in 1 2 3 4 5 6 7 8 9 10 11 13 14 15 16  
    147147 
    148148do 
    … …  
    167167    set_namelist namelist_cfg nn_stock 60 
    168168    set_namelist namelist_cfg ln_clobber .true. 
    169     set_namelist namelist_cfg nn_fwb 0 
    170 #   set_namelist namelist_cfg nn_solv 2 
     169    set_namelist namelist_cfg ln_linssh .true. 
     170    set_namelist namelist_cfg ln_read_cfg .false. 
     171    set_namelist namelist_cfg nn_fwb 0 
    171172    set_namelist namelist_cfg jpni 2 
    172173    set_namelist namelist_cfg jpnj 2 
    … …  
    191192    set_namelist namelist_cfg nn_rstctl 2 
    192193    set_namelist namelist_cfg ln_clobber .true. 
    193     set_namelist namelist_cfg nn_fwb 0 
    194 #   set_namelist namelist_cfg nn_solv 2 
     194    set_namelist namelist_cfg ln_linssh .true. 
     195    set_namelist namelist_cfg ln_read_cfg .false. 
     196    set_namelist namelist_cfg nn_fwb 0 
    195197    set_namelist namelist_cfg jpni 2 
    196198    set_namelist namelist_cfg jpnj 2 
    … …  
    235237    set_namelist namelist_cfg nn_itend 60 
    236238    set_namelist namelist_cfg nn_fwb 0 
    237     set_namelist namelist_cfg nn_bench 0 
    238     set_namelist namelist_cfg ln_ctl .false. 
    239     set_namelist namelist_cfg ln_clobber .true. 
    240 #   set_namelist namelist_cfg nn_solv 2 
     239    set_namelist namelist_cfg ln_ctl .false. 
     240    set_namelist namelist_cfg ln_clobber .true. 
     241    set_namelist namelist_cfg ln_linssh .true. 
     242    set_namelist namelist_cfg ln_read_cfg .false. 
    241243    set_namelist namelist_cfg jpni 1 
    242244    set_namelist namelist_cfg jpnj 4 
    … …  
    265267    set_namelist namelist_cfg ln_ctl .false. 
    266268    set_namelist namelist_cfg ln_clobber .true. 
    267 #   set_namelist namelist_cfg nn_solv 2 
     269    set_namelist namelist_cfg ln_linssh .true. 
     270    set_namelist namelist_cfg ln_read_cfg .false. 
    268271    set_namelist namelist_cfg jpni 2 
    269272    set_namelist namelist_cfg jpnj 2 
    … …  
    300303    set_namelist namelist_cfg nn_stock 75 
    301304    set_namelist namelist_cfg ln_clobber .true. 
     305    set_namelist namelist_cfg ln_read_cfg .true. 
     306    set_namelist namelist_cfg ln_linssh .false. 
    302307    set_namelist namelist_cfg nn_fwb 0 
    303308    set_namelist namelist_cfg jpni 2 
    304309    set_namelist namelist_cfg jpnj 4 
    305310    set_namelist namelist_cfg jpnij 8 
    306 #   set_namelist namelist_cfg nn_solv 2 
    307311    set_namelist namelist_top_cfg ln_trcdta .false. 
    308312    set_namelist namelist_top_cfg ln_diatrc .false. 
    … …  
    336340    set_namelist namelist_cfg nn_rstctl 2 
    337341    set_namelist namelist_cfg ln_clobber .true. 
     342    set_namelist namelist_cfg ln_read_cfg .true. 
     343    set_namelist namelist_cfg ln_linssh .false. 
    338344    set_namelist namelist_cfg nn_fwb 0 
    339345    set_namelist namelist_cfg jpni 2 
    340346    set_namelist namelist_cfg jpnj 4 
    341347    set_namelist namelist_cfg jpnij 8 
    342 #   set_namelist namelist_cfg nn_solv 2 
    343348    set_namelist namelist_top_cfg ln_diatrc .false. 
    344349    set_namelist namelist_top_cfg ln_rsttr .true. 
    … …  
    395400    set_namelist namelist_cfg ln_ctl .false. 
    396401    set_namelist namelist_cfg ln_clobber .true. 
     402    set_namelist namelist_cfg ln_read_cfg .true. 
     403    set_namelist namelist_cfg ln_linssh .false. 
    397404    set_namelist namelist_cfg jpni 4 
    398405    set_namelist namelist_cfg jpnj 4 
    399406    set_namelist namelist_cfg jpnij 16 
    400 #   set_namelist namelist_cfg nn_solv 2 
    401407    set_namelist namelist_top_cfg ln_trcdta .false. 
    402408    set_namelist namelist_top_cfg ln_diatrc .false. 
    … …  
    482488    set_namelist namelist_cfg nn_stock 20 
    483489    set_namelist namelist_cfg ln_clobber .true. 
     490    set_namelist namelist_cfg ln_read_cfg .true. 
     491    set_namelist namelist_cfg ln_linssh .true. 
    484492    set_namelist namelist_cfg jpni 2 
    485493    set_namelist namelist_cfg jpnj 4 
    … …  
    516524    set_namelist namelist_cfg nn_stock 20 
    517525    set_namelist namelist_cfg ln_clobber .true. 
     526    set_namelist namelist_cfg ln_read_cfg .true. 
     527    set_namelist namelist_cfg ln_linssh .true. 
    518528    set_namelist namelist_cfg jpni 2 
    519529    set_namelist namelist_cfg jpnj 4 
    … …  
    568578    set_namelist namelist_cfg ln_ctl .false. 
    569579    set_namelist namelist_cfg ln_clobber .true. 
     580    set_namelist namelist_cfg ln_read_cfg .true. 
     581    set_namelist namelist_cfg ln_linssh .true. 
    570582    set_namelist namelist_cfg jpni 4 
    571583    set_namelist namelist_cfg jpnj 4 
    … …  
    606618    set_namelist namelist_cfg ln_ctl .false. 
    607619    set_namelist namelist_cfg ln_clobber .true. 
     620    set_namelist namelist_cfg ln_read_cfg .true. 
     621    set_namelist namelist_cfg ln_linssh .true. 
    608622    set_namelist namelist_cfg jpni 2 
    609623    set_namelist namelist_cfg jpnj 8 
    … …  
    654668    set_namelist namelist_cfg nn_stock 75 
    655669    set_namelist namelist_cfg ln_clobber .true. 
    656     set_namelist namelist_cfg nn_fwb 0 
     670    set_namelist namelist_cfg ln_read_cfg .true. 
     671    set_namelist namelist_cfg ln_linssh .false. 
     672    set_namelist namelist_cfg ln_hpg_sco .true. 
     673    set_namelist namelist_cfg nn_msh 1 
     674    set_namelist namelist_cfg nn_fwb 0 
     675    set_namelist namelist_cfg ln_hpg_sco .true. 
    657676    set_namelist namelist_cfg jpni 2 
    658677    set_namelist namelist_cfg jpnj 2 
    659678    set_namelist namelist_cfg jpnij 4 
    660 #   set_namelist namelist_cfg nn_solv 2 
    661679    if [ ${USING_MPMD} == "yes" ] ; then 
    662680       set_xio_using_server iodef.xml true 
    … …  
    678696    set_namelist namelist_cfg nn_rstctl 2 
    679697    set_namelist namelist_cfg ln_clobber .true. 
    680     set_namelist namelist_cfg nn_fwb 0 
     698    set_namelist namelist_cfg ln_read_cfg .true. 
     699    set_namelist namelist_cfg ln_linssh .false. 
     700    set_namelist namelist_cfg ln_hpg_sco .true. 
     701    set_namelist namelist_cfg nn_msh 1 
     702    set_namelist namelist_cfg nn_fwb 0 
     703    set_namelist namelist_cfg ln_hpg_sco .true. 
    681704    set_namelist namelist_cfg jpni 2 
    682705    set_namelist namelist_cfg jpnj 2 
    683706    set_namelist namelist_cfg jpnij 4 
    684 #   set_namelist namelist_cfg nn_solv 2 
    685707    set_namelist namelist_cfg cn_ocerst_in \"O2L3_LONG_00000075_restart\" 
    686708    set_namelist namelist_ice_cfg cn_icerst_in \"O2L3_LONG_00000075_restart_ice\" 
    … …  
    690712        ln -sf ../LONG/O2L3_LONG_00000075_restart_${L_NPROC}.nc . 
    691713        ln -sf ../LONG/O2L3_LONG_00000075_restart_ice_${L_NPROC}.nc . 
     714        ln -sf ../LONG/O2L3_LONG_icebergs_00000075_restart_${L_NPROC}.nc O2L3_LONG_00000075_restart_icebergs_${L_NPROC}.nc 
    692715    done 
    693716    if [ ${USING_MPMD} == "yes" ] ; then 
    … …  
    704727if [ ${config} -eq 8 ] ;  then 
    705728    ## Reproducibility tests for ORCA2_LIM3 
    706     export TEST_NAME="REPRO_4_4" 
    707     cd ${CONFIG_DIR} 
    708     . ./makenemo -m ${CMP_NAM} -n ORCA2LIM3_16 -r ORCA2_LIM3 -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
    709     cd ${SETTE_DIR} 
    710     . ./param.cfg 
    711     . ./all_functions.sh 
    712     . ./prepare_exe_dir.sh 
    713     JOB_FILE=${EXE_DIR}/run_job.sh 
    714     NPROC=16 
     729    export TEST_NAME="REPRO_8_4" 
     730    cd ${CONFIG_DIR} 
     731    . ./makenemo -m ${CMP_NAM} -n ORCA2LIM3_32 -r ORCA2_LIM3 -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
     732    cd ${SETTE_DIR} 
     733    . ./param.cfg 
     734    . ./all_functions.sh 
     735    . ./prepare_exe_dir.sh 
     736    JOB_FILE=${EXE_DIR}/run_job.sh 
     737    NPROC=32 
    715738    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    716739    cd ${EXE_DIR} 
    … …  
    720743    set_namelist namelist_cfg ln_ctl .false. 
    721744    set_namelist namelist_cfg ln_clobber .true. 
     745    set_namelist namelist_cfg ln_read_cfg .true. 
     746    set_namelist namelist_cfg ln_linssh .false. 
     747    set_namelist namelist_cfg ln_hpg_sco .true. 
     748    set_namelist namelist_cfg jpni 8 
     749    set_namelist namelist_cfg jpnj 4 
     750    set_namelist namelist_cfg jpnij 32 
     751    if [ ${USING_MPMD} == "yes" ] ; then 
     752       set_xio_using_server iodef.xml true 
     753    else 
     754       set_xio_using_server iodef.xml false 
     755    fi 
     756    cd ${SETTE_DIR} 
     757    . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
     758    cd ${SETTE_DIR} 
     759    . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
     760 
     761    cd ${SETTE_DIR} 
     762    export TEST_NAME="REPRO_4_8" 
     763    . ./prepare_exe_dir.sh 
     764    JOB_FILE=${EXE_DIR}/run_job.sh 
     765    NPROC=32 
     766    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
     767    cd ${EXE_DIR} 
     768    set_namelist namelist_cfg nn_it000 1 
     769    set_namelist namelist_cfg nn_itend 75 
     770    set_namelist namelist_cfg ln_clobber .true. 
     771    set_namelist namelist_cfg ln_read_cfg .true. 
     772    set_namelist namelist_cfg ln_linssh .false. 
     773    set_namelist namelist_cfg ln_hpg_sco .true. 
     774    set_namelist namelist_cfg nn_fwb 0 
    722775    set_namelist namelist_cfg jpni 4 
    723     set_namelist namelist_cfg jpnj 4 
    724     set_namelist namelist_cfg jpnij 16 
    725 #   set_namelist namelist_cfg nn_solv 2 
    726     if [ ${USING_MPMD} == "yes" ] ; then 
    727        set_xio_using_server iodef.xml true 
    728     else 
    729        set_xio_using_server iodef.xml false 
    730     fi 
    731     cd ${SETTE_DIR} 
    732     . ./prepare_job.sh input_ORCA2_LIM3.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
    733     cd ${SETTE_DIR} 
    734     . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
    735  
    736     cd ${SETTE_DIR} 
    737     export TEST_NAME="REPRO_2_8" 
    738     . ./prepare_exe_dir.sh 
    739     JOB_FILE=${EXE_DIR}/run_job.sh 
    740     NPROC=16 
    741     if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    742     cd ${EXE_DIR} 
    743     set_namelist namelist_cfg nn_it000 1 
    744     set_namelist namelist_cfg nn_itend 75 
    745     set_namelist namelist_cfg ln_clobber .true. 
    746     set_namelist namelist_cfg nn_fwb 0 
    747     set_namelist namelist_cfg jpni 2 
    748776    set_namelist namelist_cfg jpnj 8 
    749     set_namelist namelist_cfg jpnij 16 
    750 #   set_namelist namelist_cfg nn_solv 2 
     777    set_namelist namelist_cfg jpnij 32 
    751778    if [ ${USING_MPMD} == "yes" ] ; then 
    752779       set_xio_using_server iodef.xml true 
    … …  
    782809    set_namelist namelist_cfg ln_ctl .false. 
    783810    set_namelist namelist_cfg ln_clobber .true. 
     811    set_namelist namelist_cfg ln_read_cfg .true. 
     812    set_namelist namelist_cfg ln_linssh .false. 
    784813    set_namelist namelist_cfg jpni 8 
    785814    set_namelist namelist_cfg jpnj 4 
    … …  
    802831    set_namelist namelist_cfg ln_ctl .false. 
    803832    set_namelist namelist_cfg ln_clobber .true. 
     833    set_namelist namelist_cfg ln_read_cfg .true. 
     834    set_namelist namelist_cfg ln_linssh .false. 
    804835    set_namelist namelist_cfg jpni 8 
    805836    set_namelist namelist_cfg jpnj 4 
    … …  
    843874    set_namelist namelist_cfg ln_ctl .false. 
    844875    set_namelist namelist_cfg ln_clobber .true. 
     876    set_namelist namelist_cfg ln_read_cfg .true. 
     877    set_namelist namelist_cfg ln_linssh .false. 
    845878    set_namelist namelist_cfg jpni 8 
    846879    set_namelist namelist_cfg jpnj 4 
    … …  
    867900    set_namelist namelist_cfg ln_ctl .false. 
    868901    set_namelist namelist_cfg ln_clobber .true. 
     902    set_namelist namelist_cfg ln_read_cfg .true. 
     903    set_namelist namelist_cfg ln_linssh .false. 
    869904    set_namelist namelist_cfg jpni 4 
    870905    set_namelist namelist_cfg jpnj 8 
    … …  
    894929    JOB_FILE=${EXE_DIR}/run_job.sh 
    895930    NPROC=32 
    896     \rm $JOB_FILE 
     931    if [ -f ${JOB_FILE} ] ; then \rm ${JOB_FILE} ; fi 
    897932    cd ${EXE_DIR} 
    898933    set_namelist namelist_cfg cn_exp \"SAS\" 
    … …  
    902937    set_namelist namelist_cfg ln_ctl .false. 
    903938    set_namelist namelist_cfg ln_clobber .true. 
     939    set_namelist namelist_cfg ln_read_cfg .true. 
     940    set_namelist namelist_cfg ln_linssh .true. 
    904941    set_namelist namelist_cfg nn_fwb 0 
    905942    set_namelist namelist_cfg jpni 8 
    … …  
    923960    set_namelist namelist_cfg ln_ctl .false. 
    924961    set_namelist namelist_cfg ln_clobber .true. 
     962    set_namelist namelist_cfg ln_read_cfg .true. 
     963    set_namelist namelist_cfg ln_linssh .true. 
    925964    set_namelist namelist_cfg nn_fwb 0 
    926965    set_namelist namelist_cfg jpni 8 
    … …  
    928967    set_namelist namelist_cfg jpnij 32 
    929968    set_namelist namelist_cfg nn_rstctl 2 
    930     set_namelist namelist_cfg cn_ocerst_in \"SAS_00000050_restart\" 
     969    set_namelist namelist_cfg cn_ocerst_in \"SAS_00000050_restart_ice\" 
     970    if [ ${USING_MPMD} == "yes" ] ; then 
     971       set_xio_using_server iodef.xml true 
     972    else 
     973       set_xio_using_server iodef.xml false 
     974    fi 
    931975    for (( i=1; i<=$NPROC; i++)) ; do 
    932976        L_NPROC=$(( $i - 1 )) 
    933977        L_NPROC=`printf "%04d\n" ${L_NPROC}` 
    934         ln -sf ../LONG/SAS_00000050_restart_${L_NPROC}.nc . 
     978        ln -sf ../LONG/SAS_00000050_restart_ice_${L_NPROC}.nc . 
    935979    done 
    936     if [ ${USING_MPMD} == "yes" ] ; then 
    937        set_xio_using_server iodef.xml true 
    938     else 
    939        set_xio_using_server iodef.xml false 
    940     fi 
    941980    cd ${SETTE_DIR} 
    942981    . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
    … …  
    945984fi 
    946985 
    947 if [ ${config} -eq 12 ] ;  then 
    948 ## Reproducibility tests for ORCA2_SAS_LIM 
    949     export TEST_NAME="REPRO_8_4" 
    950     cd ${CONFIG_DIR} 
    951     . ./makenemo -m ${CMP_NAM} -n SAS_32 -r ORCA2_SAS_LIM -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
    952     cd ${SETTE_DIR} 
    953     . ./param.cfg 
    954     . ./all_functions.sh 
    955     . ./prepare_exe_dir.sh 
    956     JOB_FILE=${EXE_DIR}/run_job.sh 
    957     NPROC=32 
    958     \rm ${JOB_FILE} 
    959     cd ${EXE_DIR} 
    960     set_namelist namelist_cfg cn_exp \"SAS\" 
    961     set_namelist namelist_cfg nn_it000 51 
    962     set_namelist namelist_cfg nn_itend 100 
    963     set_namelist namelist_cfg ln_ctl .false. 
    964     set_namelist namelist_cfg ln_clobber .true. 
    965     set_namelist namelist_cfg nn_fwb 0 
    966     set_namelist namelist_cfg jpni 8 
    967     set_namelist namelist_cfg jpnj 4 
    968     set_namelist namelist_cfg jpnij 32 
    969     if [ ${USING_MPMD} == "yes" ] ; then 
    970        set_xio_using_server iodef.xml true 
    971     else 
    972        set_xio_using_server iodef.xml false 
    973     fi 
    974     cd ${SETTE_DIR} 
    975     . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE}  ${NUM_XIOSERVERS} 
    976     cd ${SETTE_DIR} 
    977     . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
    978     cd ${SETTE_DIR} 
    979     export TEST_NAME="REPRO_4_8" 
    980     . ./prepare_exe_dir.sh 
    981     cd ${EXE_DIR} 
    982     set_namelist namelist_cfg cn_exp \"SAS\" 
    983     set_namelist namelist_cfg nn_it000 51 
    984     set_namelist namelist_cfg nn_itend 100 
    985     set_namelist namelist_cfg ln_ctl .false. 
    986     set_namelist namelist_cfg ln_clobber .true. 
    987     set_namelist namelist_cfg nn_fwb 0 
    988     set_namelist namelist_cfg jpni 4 
    989     set_namelist namelist_cfg jpnj 8 
    990     set_namelist namelist_cfg jpnij 32 
    991     if [ ${USING_MPMD} == "yes" ] ; then 
    992        set_xio_using_server iodef.xml true 
    993     else 
    994        set_xio_using_server iodef.xml false 
    995     fi 
    996     cd ${SETTE_DIR} 
    997     . ./prepare_job.sh input_SAS.cfg $NPROC ${TEST_NAME} ${MPIRUN_FLAG} ${JOB_FILE} ${NUM_XIOSERVERS} 
    998     cd ${SETTE_DIR} 
    999     . ./fcm_job.sh $NPROC ${JOB_FILE} ${INTERACT_FLAG} ${MPIRUN_FLAG} 
    1000 fi 
    1001986# TESTS FOR ISOMIP CONFIGURATION 
    1002987if [ ${config} -eq 13 ] ;  then 
    … …  
    1004989    export TEST_NAME="LONG" 
    1005990    cd ${CONFIG_DIR} 
    1006     . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -u ISOMIP -j 8 del_key ${DEL_KEYS} 
     991    . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -r ISOMIP -j 8 del_key ${DEL_KEYS} 
    1007992    cd ${SETTE_DIR} 
    1008993    . ./param.cfg 
    … …  
    10181003    set_namelist namelist_cfg nn_stock 48 
    10191004    set_namelist namelist_cfg ln_clobber .true. 
    1020     set_namelist namelist_cfg nn_fwb 0 
    1021 #   set_namelist namelist_cfg nn_solv 2 
     1005    set_namelist namelist_cfg ln_read_cfg .true. 
     1006    set_namelist namelist_cfg ln_linssh .true. 
     1007    set_namelist namelist_cfg nn_fwb 0 
    10221008    set_namelist namelist_cfg jpni 2 
    10231009    set_namelist namelist_cfg jpnj 2 
    … …  
    10421028    set_namelist namelist_cfg nn_rstctl 2 
    10431029    set_namelist namelist_cfg ln_clobber .true. 
    1044     set_namelist namelist_cfg nn_fwb 0 
    1045 #   set_namelist namelist_cfg nn_solv 2 
     1030    set_namelist namelist_cfg ln_read_cfg .true. 
     1031    set_namelist namelist_cfg ln_linssh .true. 
     1032    set_namelist namelist_cfg nn_fwb 0 
    10461033    set_namelist namelist_cfg jpni 2 
    10471034    set_namelist namelist_cfg jpnj 2 
    … …  
    10721059    export TEST_NAME="REPRO_1_4" 
    10731060    cd ${CONFIG_DIR} 
    1074     . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -u ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
     1061    . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -r ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 
    10751062    cd ${SETTE_DIR} 
    10761063    . ./param.cfg 
    … …  
    10841071    set_namelist namelist_cfg nn_it000 1 
    10851072    set_namelist namelist_cfg nn_itend 48 
    1086     set_namelist namelist_cfg nn_fwb 0 
    1087     set_namelist namelist_cfg nn_bench 0 
    1088     set_namelist namelist_cfg ln_ctl .false. 
    1089     set_namelist namelist_cfg ln_clobber .true. 
    1090 #   set_namelist namelist_cfg nn_solv 2 
     1073    set_namelist namelist_cfg ln_ctl .false. 
     1074    set_namelist namelist_cfg ln_clobber .true. 
     1075    set_namelist namelist_cfg ln_read_cfg .true. 
     1076    set_namelist namelist_cfg ln_linssh .true. 
     1077    set_namelist namelist_cfg nn_fwb 0 
    10911078    set_namelist namelist_cfg jpni 1 
    10921079    set_namelist namelist_cfg jpnj 4 
    … …  
    11121099    set_namelist namelist_cfg nn_it000 1 
    11131100    set_namelist namelist_cfg nn_itend 48 
    1114     set_namelist namelist_cfg nn_fwb 0 
    1115     set_namelist namelist_cfg ln_ctl .false. 
    1116     set_namelist namelist_cfg ln_clobber .true. 
    1117 #   set_namelist namelist_cfg nn_solv 2 
     1101    set_namelist namelist_cfg ln_ctl .false. 
     1102    set_namelist namelist_cfg ln_clobber .true. 
     1103    set_namelist namelist_cfg ln_read_cfg .true. 
     1104    set_namelist namelist_cfg ln_linssh .true. 
     1105    set_namelist namelist_cfg nn_fwb 0 
    11181106    set_namelist namelist_cfg jpni 2 
    11191107    set_namelist namelist_cfg jpnj 2 
    … …  
    11371125    export TEST_NAME="REPRO_4_4" 
    11381126    cd ${CONFIG_DIR} 
    1139     . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM_OBS -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_asminc" del_key ${DEL_KEYS} 
     1127    . ./makenemo -m ${CMP_NAM} -n ORCA2_LIM3_OBS -r ORCA2_LIM3 -j 8 add_key "key_mpp_rep key_asminc" del_key ${DEL_KEYS} 
    11401128    cd ${SETTE_DIR} 
    11411129    . ./param.cfg 
    … …  
    11511139    set_namelist namelist_cfg ln_ctl .false. 
    11521140    set_namelist namelist_cfg ln_clobber .true. 
     1141    set_namelist namelist_cfg ln_read_cfg .true. 
     1142    set_namelist namelist_cfg ln_linssh .false. 
    11531143    set_namelist namelist_cfg jpni 4 
    11541144    set_namelist namelist_cfg jpnj 4 
    … …  
    11881178    set_namelist namelist_cfg ln_ctl .false. 
    11891179    set_namelist namelist_cfg ln_clobber .true. 
     1180    set_namelist namelist_cfg ln_read_cfg .true. 
     1181    set_namelist namelist_cfg ln_linssh .false. 
    11901182    set_namelist namelist_cfg jpni 2 
    11911183    set_namelist namelist_cfg jpnj 8 
    … …  
    12311223    set_namelist namelist_cfg ln_ctl .false. 
    12321224    set_namelist namelist_cfg ln_clobber .true. 
     1225    set_namelist namelist_cfg ln_read_cfg .true. 
     1226    set_namelist namelist_cfg ln_linssh .true. 
    12331227    set_namelist namelist_cfg nn_fwb 0 
    12341228    set_namelist namelist_cfg jpni 1 
    12351229    set_namelist namelist_cfg jpnj 2 
    12361230    set_namelist namelist_cfg jpnij 2 
    1237 # 
    12381231    set_namelist 1_namelist_cfg nn_it000 1 
    12391232    set_namelist 1_namelist_cfg nn_itend 150 
    12401233    set_namelist 1_namelist_cfg ln_ctl .false. 
    12411234    set_namelist 1_namelist_cfg ln_clobber .true. 
    1242  
     1235    set_namelist 1_namelist_cfg ln_read_cfg .true. 
     1236    set_namelist 1_namelist_cfg ln_linssh .false. 
    12431237    if [ ${USING_MPMD} == "yes" ] ; then 
    12441238       set_xio_using_server iodef.xml true 
    … …  
    12711265    set_namelist namelist_cfg ln_ctl .false. 
    12721266    set_namelist namelist_cfg ln_clobber .true. 
     1267    set_namelist namelist_cfg ln_read_cfg .true. 
     1268    set_namelist namelist_cfg ln_linssh .true. 
    12731269    set_namelist namelist_cfg nn_fwb 0 
    12741270    set_namelist namelist_cfg jpni 2 
    … …  
    13041300    set_namelist namelist_cfg ln_ctl .false. 
    13051301    set_namelist namelist_cfg ln_clobber .true. 
     1302    set_namelist namelist_cfg ln_read_cfg .true. 
     1303    set_namelist namelist_cfg ln_linssh .true. 
    13061304    set_namelist namelist_cfg nn_fwb 0 
    13071305    set_namelist namelist_cfg jpni 2 
    … …  
    13391337    set_namelist namelist_cfg nn_stock 75 
    13401338    set_namelist namelist_cfg ln_clobber .true. 
     1339    set_namelist namelist_cfg ln_read_cfg .true. 
     1340    set_namelist namelist_cfg ln_linssh .true. 
    13411341    set_namelist namelist_cfg nn_fwb 0 
    13421342    set_namelist namelist_cfg jpni 2 
    … …  
    13511351    set_namelist 1_namelist_cfg ln_ctl .false. 
    13521352    set_namelist 1_namelist_cfg ln_clobber .true. 
     1353    set_namelist 1_namelist_cfg ln_read_cfg .true. 
     1354    set_namelist 1_namelist_cfg ln_linssh .false. 
    13531355# 
    13541356    if [ ${USING_MPMD} == "yes" ] ; then 
    … …  
    13711373    set_namelist namelist_cfg nn_rstctl 2 
    13721374    set_namelist namelist_cfg ln_clobber .true. 
     1375    set_namelist namelist_cfg ln_read_cfg .true. 
     1376    set_namelist namelist_cfg ln_linssh .true. 
    13731377    set_namelist namelist_cfg nn_fwb 0 
    13741378    set_namelist namelist_cfg jpni 2 
    … …  
    13841388    set_namelist 1_namelist_cfg nn_rstctl 2 
    13851389    set_namelist 1_namelist_cfg ln_clobber .true. 
     1390    set_namelist 1_namelist_cfg ln_read_cfg .true. 
     1391    set_namelist 1_namelist_cfg ln_linssh .false. 
    13861392    set_namelist namelist_cfg cn_ocerst_in \"O2LP_LONG_00000075_restart\" 
    13871393    set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\" 
    … …  
    14241430    set_namelist namelist_cfg ln_ctl .false. 
    14251431    set_namelist namelist_cfg ln_clobber .true. 
     1432    set_namelist namelist_cfg ln_read_cfg .true. 
     1433    set_namelist namelist_cfg ln_linssh .false. 
    14261434    set_namelist namelist_cfg nn_fwb 0 
    14271435    set_namelist namelist_cfg jpni 4 
    14281436    set_namelist namelist_cfg jpnj 4 
    14291437    set_namelist namelist_cfg jpnij 16 
    1430 #   set_namelist namelist_cfg nn_solv 2 
    1431 # 
    14321438    set_namelist 1_namelist_cfg nn_it000 1 
    14331439    set_namelist 1_namelist_cfg nn_itend 150 
    14341440    set_namelist 1_namelist_cfg ln_ctl .false. 
    14351441    set_namelist 1_namelist_cfg ln_clobber .true. 
     1442    set_namelist 1_namelist_cfg ln_read_cfg .true. 
     1443    set_namelist 1_namelist_cfg ln_linssh .true. 
    14361444 
    14371445    if [ ${USING_MPMD} == "yes" ] ; then 
    … …  
    14561464    set_namelist namelist_cfg ln_ctl .false. 
    14571465    set_namelist namelist_cfg ln_clobber .true. 
     1466    set_namelist namelist_cfg ln_read_cfg .true. 
     1467    set_namelist namelist_cfg ln_linssh .false. 
    14581468    set_namelist namelist_cfg nn_fwb 0 
    14591469    set_namelist namelist_cfg jpni 2 
    14601470    set_namelist namelist_cfg jpnj 8 
    14611471    set_namelist namelist_cfg jpnij 16 
    1462 #   set_namelist namelist_cfg nn_solv 2 
    1463 # 
    14641472    set_namelist 1_namelist_cfg nn_it000 1 
    14651473    set_namelist 1_namelist_cfg nn_itend 150 
    14661474    set_namelist 1_namelist_cfg ln_ctl .false. 
    14671475    set_namelist 1_namelist_cfg ln_clobber .true. 
     1476    set_namelist 1_namelist_cfg ln_read_cfg .true. 
     1477    set_namelist 1_namelist_cfg ln_linssh .true. 
    14681478 
    14691479    if [ ${USING_MPMD} == "yes" ] ; then 

  • branches/2016/dev_CNRS_2016/NEMOGCM/SETTE/sette_rpt

    r6140 r7277  
    415415    set dorv = `ls -1rtd ./WORCA2LIM3_16/{$mach}/* | tail -1l ` 
    416416    set dorv = $dorv:t 
    417     set f1o = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_2_8/ocean.output 
    418     set f1s = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_2_8/solver.stat 
    419     set f2o = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_4_4/ocean.output 
    420     set f2s = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_4_4/solver.stat 
     417    set f1o = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_4_8/ocean.output 
     418    set f1s = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_4_8/solver.stat 
     419    set f2o = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_8_4/ocean.output 
     420    set f2s = ./WORCA2LIM3_16/{$mach}/{$dorv}/REPRO_8_4/solver.stat 
    421421 
    422422    cmp -s $f1s $f2s 

  • branches/2016/dev_CNRS_2016/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh

    r4990 r7277  
    4444# :: 
    4545# 
    46 #  $ ./Fadd_keys.sh ORCA2_LIM add_key "key_mpp_mpi key_nproci=1 key_nprocj=10" 
     46#  $ ./Fadd_keys.sh ORCA2_LIM add_key "key_mpp_rep" 
    4747# 
    4848# 
    … …  
    6565 echo "Adding keys in : ${NEW_CONF}"  
    6666 for i in ${list_add_key} ; do 
    67    if [ "$(echo ${i} | grep -c key_nproc )" -ne 0 ] ; then 
    68       sed -e "s/key_nproc[ij]=.[0-9]* //"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp 
    69             mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm 
    70       echo " " 
    71       sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp 
    72             mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm 
    73    elif [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then 
    74    echo "key $i already present in cpp_${NEW_CONF}.fcm"  
     67   if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then 
     68      echo "key $i already present in cpp_${NEW_CONF}.fcm"  
    7569   else 
    76    sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp 
    77    mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm 
    78    echo "added key $i in ${NEW_CONF}"  
     70      sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp 
     71      mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm 
     72      echo "added key $i in ${NEW_CONF}"  
    7973   fi 
    8074 done 

  • branches/2016/dev_CNRS_2016/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh

    r4162 r7277  
    166166 
    167167#- do we need xios library? 
    168 if [ "$2" != "nocpp" ]  
     168#- 2 cases:  
     169#- in CONFIG directory looking for key_iomput 
     170if [ "$1" == "arch_nemo.fcm" ] 
    169171then 
    170     use_iom=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_iomput ) 
     172    if [ "$2" != "nocpp" ]  
     173    then 
     174        use_iom=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$2 | grep -c key_iomput ) 
     175    else 
     176        use_iom=0 
     177    fi 
     178    have_lxios=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-lxios" ) 
     179    if [[ ( $use_iom -eq 0 ) && ( $have_lxios -ge 1 ) ]] 
     180    then  
     181        sed -e "s/-lxios//g" ${COMPIL_DIR}/$1 > ${COMPIL_DIR}/tmp$$ 
     182        mv -f ${COMPIL_DIR}/tmp$$ ${COMPIL_DIR}/$1 
     183    fi 
     184#- in TOOLS directory looking for USE xios 
    171185else 
    172     use_iom=0 
    173 fi 
    174 have_lxios=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-lxios" ) 
    175 if [[ ( $use_iom -eq 0 ) && ( $have_lxios -ge 1 ) ]] 
    176 then  
    177     sed -e "s/-lxios//g" ${COMPIL_DIR}/$1 > ${COMPIL_DIR}/tmp$$ 
    178     mv -f ${COMPIL_DIR}/tmp$$ ${COMPIL_DIR}/$1 
     186    use_iom=$( egrep --exclude-dir=.svn -r USE ${NEW_CONF}/src/* | grep -c xios ) 
     187    have_lxios=$( sed -e "s/#.*$//" ${COMPIL_DIR}/$1 | grep -c "\-lxios" ) 
     188    if [[ ( $use_iom -eq 0 ) || ( $have_lxios != 1 ) ]] 
     189    then  
     190        sed -e "s/-lxios//g" ${COMPIL_DIR}/$1 > ${COMPIL_DIR}/tmp$$ 
     191        mv -f ${COMPIL_DIR}/tmp$$ ${COMPIL_DIR}/$1 
     192    fi 
    179193fi 
    180194 

  • branches/2016/dev_CNRS_2016/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg

    r4865 r7277  
    2929bld::excl_dep        inc::netcdf.inc 
    3030bld::excl_dep        use::netcdf 
     31bld::excl_dep        use::xios 
    3132bld::excl_dep        h::netcdf.inc 
    3233bld::excl_dep        h::mpif.h 

  • branches/2016/dev_CNRS_2016/NEMOGCM/TOOLS/COMPILE/tools.txt

    r2281 r7277  
    1 REBUILD  
     1DOMAINcfg  
Note: See TracChangeset for help on using the changeset viewer.