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 7421 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

Ignore:
Timestamp:
2016-12-01T18:10:41+01:00 (8 years ago)
Author:
flavoni
Message:

#1811 merge dev_CNRS_MERATOR_2016 with dev_merge_2016 branch

Location:
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM
Files:
3 deleted
15 edited
1 copied

Legend:

Unmodified
Added
Removed

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

    r6140 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r7412 r7421  
    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] 
    169  
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f, ff_t                      !: coriolis factor at f- and t-point         [1/s] 
    170127   !!---------------------------------------------------------------------- 
    171128   !! vertical coordinate and scale factors 
    172129   !! --------------------------------------------------------------------- 
    173    !                                !!* Namelist namzgr : vertical coordinate * 
    174130   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step 
    175131   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step 
    176132   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate 
    177133   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
    178    LOGICAL, PUBLIC ::   ln_linssh    !: variable grid flag 
    179  
    180134   !                                                        !  ref.   ! before  !   now   ! after  ! 
    181135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    … …  
    207161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m) 
    208162   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 
     163 
     164 
     165   !!---------------------------------------------------------------------- 
     166   !! masks, top and bottom ocean point position 
    229167   !! --------------------------------------------------------------------- 
    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) 
     168!!gm Proposition of new name for top/bottom vertical indices 
     169!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top first wet T-, U-, V-, F-level (ISF) 
     170!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last wet T-, U- and V-level 
     171!!gm 
     172   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level 
    234173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask 
    235174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book) 
    236175 
    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 
     176   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF) 
     177   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF) 
     178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF) 
     179 
     180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts 
    242181   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    243182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    … …  
    280219   !!---------------------------------------------------------------------- 
    281220   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    282    !! $Id$ 
     221   !! $Id$  
    283222   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    284223   !!---------------------------------------------------------------------- 
    … …  
    300239   INTEGER FUNCTION dom_oce_alloc() 
    301240      !!---------------------------------------------------------------------- 
    302       INTEGER, DIMENSION(13) :: ierr 
     241      INTEGER, DIMENSION(12) :: ierr 
    303242      !!---------------------------------------------------------------------- 
    304243      ierr(:) = 0 
    … …  
    310249         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    311250         &                                      nleit(jpnij) , nlejt(jpnij) ,     & 
    312          &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta),      & 
    313          &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) ) 
     251         &      mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
     252         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
    314253         ! 
    315254      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 
    … …  
    323262         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
    324263         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
    325          &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
    326          ! 
    327       ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,     & 
     264         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) ) 
     265         ! 
     266      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,      & 
    328267         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             & 
    329268         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) ) 
    … …  
    344283         ! 
    345284         ! 
    346       ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     & 
    347          &      e3t_1d  (jpk) , e3w_1d  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     & 
    348          &      gsigt   (jpk) , gsigw   (jpk) , gsi3w(jpk)    ,                     & 
    349          &      esigt   (jpk) , esigw   (jpk)                                 , STAT=ierr(7) ) 
    350          ! 
    351       ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     & 
    352          &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     & 
    353          &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
    354          &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
    355          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 
    356  
    357       ALLOCATE( mbathy(jpi,jpj) , bathy  (jpi,jpj) ,                                       & 
    358          &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       &  
    359          &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 
    360          &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    361  
    362 ! (ISF) Allocation of basic array    
    363       ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj),     & 
    364          &     mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) ,           & 
    365          &     mikf(jpi,jpj), STAT=ierr(10) ) 
    366  
    367       ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     &  
    368          &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) ) 
    369  
     285      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(7) ) 
     286         ! 
     287      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        &  
     288         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     & 
     289         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
     290         ! 
     291      ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) ,     & 
     292         &      risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(10) ) 
     293         ! 
     294      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     &  
     295         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , STAT=ierr(11) ) 
     296         ! 
    370297      ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) ) 
    371298      ! 

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

    r6981 r7421  
    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 
    93       ! 
    94       ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness 
    95       hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1) 
    96       hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1) 
    97       DO jk = 2, jpk 
     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 
     140      ! 
     141      ht_0(:,:) = 0._wp  ! Reference ocean thickness 
     142      hu_0(:,:) = 0._wp 
     143      hv_0(:,:) = 0._wp 
     144      DO jk = 1, jpk 
    98145         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    99146         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
    … …  
    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_index' , ldstop = .FALSE. ) > 0    ) THEN 
     526         ! 
     527         cd_cfg = 'ORCA' 
     528         CALL iom_get( inum, 'ORCA_index', 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_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6140 r7421  
    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      ! 
     130      !                             !==  associated horizontal metrics  ==! 
    332131      ! 
    333132      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
    … …  
    338137      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
    339138      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(:,:)    
     139      IF( ie1e2u_v == 0 ) THEN               ! u- & v-surfaces have not been defined 
     140         IF(lwp) WRITE(numout,*) '          u- & v-surfaces calculated as e1 e2 product' 
     141         e1e2u (:,:) = e1u(:,:) * e2u(:,:)         ! compute them 
    342142         e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
    343       ENDIF 
    344       r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases 
     143      ELSE 
     144         IF(lwp) WRITE(numout,*) '          u- & v-surfaces have been read in "mesh_mask" file:' 
     145         IF(lwp) WRITE(numout,*) '                     grid size reduction in strait(s) is used' 
     146      ENDIF 
     147      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in any cases 
    345148      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
    346149      !    
    347150      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    348151      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 
     152      ! 
    449153      ! 
    450154      IF( nn_timing == 1 )  CALL timing_stop('dom_hgr') 
    … …  
    453157 
    454158 
    455    SUBROUTINE hgr_read( ke1e2u_v ) 
     159   SUBROUTINE hgr_read( plamt , plamu , plamv  , plamf  ,   &    ! gridpoints position (required) 
     160      &                 pphit , pphiu , pphiv  , pphif  ,   &      
     161      &                 kff   , pff_f , pff_t  ,            &    ! Coriolis parameter  (if not on the sphere) 
     162      &                 pe1t  , pe1u  , pe1v   , pe1f   ,   &    ! scale factors       (required) 
     163      &                 pe2t  , pe2u  , pe2v   , pe2f   ,   & 
     164      &                 ke1e2u_v      , pe1e2u , pe1e2v     )    ! u- & v-surfaces (if gridsize reduction in some straits) 
    456165      !!--------------------------------------------------------------------- 
    457166      !!              ***  ROUTINE hgr_read  *** 
    458167      !! 
    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 
     168      !! ** Purpose :   Read a mesh_mask file in NetCDF format using IOM 
     169      !! 
     170      !!---------------------------------------------------------------------- 
     171      REAL(wp), DIMENSION(:,:), INTENT(out) ::   plamt, plamu, plamv, plamf   ! longitude outputs  
     172      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pphit, pphiu, pphiv, pphif   ! latitude outputs 
     173      INTEGER                 , INTENT(out) ::   kff                          ! =1 Coriolis parameter read here, =0 otherwise 
     174      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pff_f, pff_t                 ! Coriolis factor at f-point (if found in file) 
     175      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1t, pe1u, pe1v, pe1f       ! i-scale factors  
     176      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe2t, pe2u, pe2v, pe2f       ! j-scale factors 
     177      INTEGER                 , INTENT(out) ::   ke1e2u_v                     ! =1 u- & v-surfaces read here, =0 otherwise  
     178      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v              ! u- & v-surfaces (if found in file) 
     179      ! 
     180      INTEGER  ::   inum                  ! logical unit 
    467181      !!---------------------------------------------------------------------- 
    468182      ! 
    469183      IF(lwp) THEN 
    470184         WRITE(numout,*) 
    471          WRITE(numout,*) 'hgr_read : read the horizontal coordinates' 
     185         WRITE(numout,*) 'hgr_read : read the horizontal coordinates in mesh_mask' 
    472186         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    473187      ENDIF 
    474188      ! 
    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 ) 
     189      CALL iom_open( cn_domcfg, inum ) 
     190      ! 
     191      CALL iom_get( inum, jpdom_data, 'glamt', plamt, lrowattr=ln_use_jattr ) 
     192      CALL iom_get( inum, jpdom_data, 'glamu', plamu, lrowattr=ln_use_jattr ) 
     193      CALL iom_get( inum, jpdom_data, 'glamv', plamv, lrowattr=ln_use_jattr ) 
     194      CALL iom_get( inum, jpdom_data, 'glamf', plamf, lrowattr=ln_use_jattr ) 
     195      ! 
     196      CALL iom_get( inum, jpdom_data, 'gphit', pphit, lrowattr=ln_use_jattr ) 
     197      CALL iom_get( inum, jpdom_data, 'gphiu', pphiu, lrowattr=ln_use_jattr ) 
     198      CALL iom_get( inum, jpdom_data, 'gphiv', pphiv, lrowattr=ln_use_jattr ) 
     199      CALL iom_get( inum, jpdom_data, 'gphif', pphif, lrowattr=ln_use_jattr ) 
     200      ! 
     201      CALL iom_get( inum, jpdom_data, 'e1t'  , pe1t  , lrowattr=ln_use_jattr ) 
     202      CALL iom_get( inum, jpdom_data, 'e1u'  , pe1u  , lrowattr=ln_use_jattr ) 
     203      CALL iom_get( inum, jpdom_data, 'e1v'  , pe1v  , lrowattr=ln_use_jattr ) 
     204      CALL iom_get( inum, jpdom_data, 'e1f'  , pe1f  , lrowattr=ln_use_jattr ) 
     205      ! 
     206      CALL iom_get( inum, jpdom_data, 'e2t'  , pe2t  , lrowattr=ln_use_jattr ) 
     207      CALL iom_get( inum, jpdom_data, 'e2u'  , pe2u  , lrowattr=ln_use_jattr ) 
     208      CALL iom_get( inum, jpdom_data, 'e2v'  , pe2v  , lrowattr=ln_use_jattr ) 
     209      CALL iom_get( inum, jpdom_data, 'e2f'  , pe2f  , lrowattr=ln_use_jattr ) 
     210      ! 
     211      IF(  iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0  .AND.  & 
     212         & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0    ) THEN 
     213         IF(lwp) WRITE(numout,*) '           Coriolis factor at f- and t-points read in ', TRIM( cn_domcfg ), ' file' 
     214         CALL iom_get( inum, jpdom_data, 'ff_f'  , pff_f  , lrowattr=ln_use_jattr ) 
     215         CALL iom_get( inum, jpdom_data, 'ff_t'  , pff_t  , lrowattr=ln_use_jattr ) 
     216         kff = 1 
     217      ELSE 
     218         kff = 0 
     219      ENDIF 
    496220      ! 
    497221      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 ) 
     222         IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file' 
     223         CALL iom_get( inum, jpdom_data, 'e1e2u'  , pe1e2u  , lrowattr=ln_use_jattr ) 
     224         CALL iom_get( inum, jpdom_data, 'e1e2v'  , pe1e2v  , lrowattr=ln_use_jattr ) 
    501225         ke1e2u_v = 1 
    502226      ELSE 
    … …  
    505229      ! 
    506230      CALL iom_close( inum ) 
    507        
    508     END SUBROUTINE hgr_read 
     231      ! 
     232   END SUBROUTINE hgr_read 
    509233     
    510234   !!====================================================================== 

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

    r7412 r7421  
    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   USE bdy_oce       
    27    USE in_out_manager  ! I/O manager 
    28    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    29    USE lib_mpp         ! 
    30    USE iom 
    31    USE wrk_nemo        ! Memory allocation 
    32    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 
    3334 
    3435   IMPLICIT NONE 
    … …  
    5152CONTAINS 
    5253 
    53    SUBROUTINE dom_msk 
     54   SUBROUTINE dom_msk( k_top, k_bot ) 
    5455      !!--------------------------------------------------------------------- 
    5556      !!                 ***  ROUTINE dom_msk  *** 
    … …  
    5859      !!      zontal velocity points (u & v), vorticity points (f) points. 
    5960      !! 
    60       !! ** Method  :   The ocean/land mask is computed from the basin bathy- 
    61       !!      metry in level (mbathy) which is defined or read in dommba. 
    62       !!      mbathy equals 0 over continental T-point  
    63       !!      and the number of ocean level over the ocean. 
    64       !! 
    65       !!      At a given position (ji,jj,jk) the ocean/land mask is given by: 
    66       !!      t-point : 0. IF mbathy( ji ,jj) =< 0 
    67       !!                1. IF mbathy( ji ,jj) >= jk 
    68       !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0 
    69       !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 
    70       !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0 
    71       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 
    72       !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) 
    73       !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0 
    74       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 
    75       !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 
    76       !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 
    77       !!                rows/lines due to cyclic or North Fold boundaries as well 
    78       !!                as MPP halos. 
    79       !! 
    80       !!        The lateral friction is set through the value of fmask along 
    81       !!      the coast and topography. This value is defined by rn_shlat, a 
    82       !!      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) : 
    8368      !!         rn_shlat = 0, free slip  (no shear along the coast) 
    8469      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast) 
    … …  
    8671      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer 
    8772      !! 
    88       !!      N.B. If nperio not equal to 0, the land/ocean mask arrays 
    89       !!      are defined with the proper value at lateral domain boundaries. 
    90       !! 
    91       !!      In case of open boundaries (ln_bdy=T): 
    92       !!        - tmask is set to 1 on the points to be computed bay the open 
    93       !!          boundaries routines. 
    94       !! 
    95       !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.) 
    96       !!               umask    : land/ocean mask at u-point (=0. or 1.) 
    97       !!               vmask    : land/ocean mask at v-point (=0. or 1.) 
    98       !!               fmask    : land/ocean mask at f-point (=0. or 1.) 
    99       !!                          =rn_shlat along lateral boundaries 
    100       !!               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 
    10186      !!---------------------------------------------------------------------- 
    102       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    103       INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers 
    104       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   !   -       - 
    10593      INTEGER  ::   ios, inum 
    106       INTEGER  ::   isrow                    ! index for ORCA1 starting row 
    107       INTEGER , POINTER, DIMENSION(:,:) ::  imsk 
    108       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    10995      !! 
    11096      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    119105      ! 
    120106      IF( nn_timing == 1 )  CALL timing_start('dom_msk') 
    121       ! 
    122       CALL wrk_alloc( jpi, jpj, imsk ) 
    123       CALL wrk_alloc( jpi, jpj, zwf  ) 
    124107      ! 
    125108      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    … …  
    150133      ENDIF 
    151134 
    152       ! 1. Ocean/land mask at t-point (computed from mbathy) 
    153       ! ----------------------------- 
    154       ! N.B. tmask has already the right boundary conditions since mbathy is ok 
     135 
     136      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot) 
     137      ! ---------------------------- 
    155138      ! 
    156139      tmask(:,:,:) = 0._wp 
    157       DO jk = 1, jpk 
    158          DO jj = 1, jpj 
    159             DO ji = 1, jpi 
    160                IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp 
    161             END DO   
     140      DO jj = 1, jpj 
     141         DO ji = 1, jpi 
     142            iktop = k_top(ji,jj) 
     143            ikbot = k_bot(ji,jj) 
     144            IF( iktop /= 0 ) THEN       ! water in the column 
     145               tmask(ji,jj,iktop:ikbot  ) = 1._wp 
     146            ENDIF 
    162147         END DO   
    163148      END DO   
     149!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 
     150!!gm I don't understand why...   
     151   CALL lbc_lnk( tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
    164152       
    165       REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries   
    166       READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    167 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    168  
    169       REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    170       READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
    171 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    172       IF(lwm) WRITE ( numond, nambdy ) 
    173  
    174      IF( ln_bdy .AND. ln_mask_file ) THEN ! correct for bdy mask 
    175          CALL iom_open( cn_mask_file, inum ) 
    176          CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 
    177          CALL iom_close( inum ) 
    178  
    179          ! Mask corrections 
    180          ! ---------------- 
    181          DO jk = 1, jpkm1 
    182             DO jj = 1, jpj 
    183                DO ji = 1, jpi 
    184                   tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) 
    185                END DO 
    186             END DO 
    187          END DO 
    188       ENDIF 
    189  
    190       ! (ISF) define barotropic mask and mask the ice shelf point 
    191       ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked 
    192        
    193       DO jk = 1, jpk 
    194          DO jj = 1, jpj 
    195             DO ji = 1, jpi 
    196                IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp )   THEN 
    197                   tmask(ji,jj,jk) = 0._wp 
    198                END IF 
    199             END DO   
    200          END DO   
    201       END DO   
    202  
    203       ! Interior domain mask (used for global sum) 
    204       ! -------------------- 
    205       tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf 
    206  
    207       tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere 
    208       iif = jpreci                         ! ??? 
    209       iil = nlci - jpreci + 1 
    210       ijf = jprecj                         ! ??? 
    211       ijl = nlcj - jprecj + 1 
    212  
    213       tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    214       tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    215       tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
    216       tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    217  
    218       ! north fold mask 
    219       ! --------------- 
    220       tpol(1:jpiglo) = 1._wp  
    221       fpol(1:jpiglo) = 1._wp 
    222       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    223          tpol(jpiglo/2+1:jpiglo) = 0._wp 
    224          fpol(     1    :jpiglo) = 0._wp 
    225          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row 
    226             DO ji = iif+1, iil-1 
    227                tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
    228             END DO 
    229          ENDIF 
    230       ENDIF 
    231       
    232       tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:) 
    233  
    234       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    235          tpol(     1    :jpiglo) = 0._wp 
    236          fpol(jpiglo/2+1:jpiglo) = 0._wp 
    237       ENDIF 
    238  
    239       ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask) 
    240       ! ------------------------------------------- 
     153      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask) 
     154      ! ---------------------------------------- 
     155      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
    241156      DO jk = 1, jpk 
    242157         DO jj = 1, jpjm1 
    … …  
    251166         END DO 
    252167      END DO 
    253       ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 
    254       DO jj = 1, jpjm1 
    255          DO ji = 1, fs_jpim1   ! vector loop 
    256             ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    257             ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    258          END DO 
    259          DO ji = 1, jpim1      ! NO vector opt. 
    260             ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    261                &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    262          END DO 
    263       END DO 
    264168      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
    265169      CALL lbc_lnk( vmask  , 'V', 1._wp ) 
    266170      CALL lbc_lnk( fmask  , 'F', 1._wp ) 
    267       CALL lbc_lnk( ssumask, 'U', 1._wp )      ! Lateral boundary conditions 
    268       CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
    269       CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    270  
    271       ! 3. Ocean/land mask at wu-, wv- and w points  
    272       !---------------------------------------------- 
     171 
     172  
     173      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
     174      !----------------------------------------- 
    273175      wmask (:,:,1) = tmask(:,:,1)     ! surface 
    274176      wumask(:,:,1) = umask(:,:,1) 
    … …  
    280182      END DO 
    281183 
     184 
     185      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
     186      ! ---------------------------------------------- 
     187      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 ) 
     188      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 
     189      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
     190 
     191 
     192      ! Interior domain mask  (used for global sum) 
     193      ! -------------------- 
     194      ! 
     195      iif = jpreci   ;   iil = nlci - jpreci + 1 
     196      ijf = jprecj   ;   ijl = nlcj - jprecj + 1 
     197      ! 
     198      !                          ! halo mask : 0 on the halo and 1 elsewhere 
     199      tmask_h(:,:) = 1._wp                   
     200      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
     201      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
     202      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
     203      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
     204      ! 
     205      !                          ! north fold mask 
     206      tpol(1:jpiglo) = 1._wp  
     207      fpol(1:jpiglo) = 1._wp 
     208      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
     209         tpol(jpiglo/2+1:jpiglo) = 0._wp 
     210         fpol(     1    :jpiglo) = 0._wp 
     211         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h 
     212            DO ji = iif+1, iil-1 
     213               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
     214            END DO 
     215         ENDIF 
     216      ENDIF 
     217      ! 
     218      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
     219         tpol(     1    :jpiglo) = 0._wp 
     220         fpol(jpiglo/2+1:jpiglo) = 0._wp 
     221      ENDIF 
     222      ! 
     223      !                          ! interior mask : 2D ocean mask x halo mask  
     224      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
     225 
     226 
    282227      ! Lateral boundary conditions on velocity (modify fmask) 
    283       ! ---------------------------------------      
    284       DO jk = 1, jpk 
    285          zwf(:,:) = fmask(:,:,jk)          
    286          DO jj = 2, jpjm1 
    287             DO ji = fs_2, fs_jpim1   ! vector opt. 
    288                IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    289                   fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    290                      &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     228      ! ---------------------------------------   
     229      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
     230         ! 
     231         CALL wrk_alloc( jpi,jpj,   zwf ) 
     232         ! 
     233         DO jk = 1, jpk 
     234            zwf(:,:) = fmask(:,:,jk)          
     235            DO jj = 2, jpjm1 
     236               DO ji = fs_2, fs_jpim1   ! vector opt. 
     237                  IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     238                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     239                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     240                  ENDIF 
     241               END DO 
     242            END DO 
     243            DO jj = 2, jpjm1 
     244               IF( fmask(1,jj,jk) == 0._wp ) THEN 
     245                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     246               ENDIF 
     247               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
     248                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     249               ENDIF 
     250            END DO          
     251            DO ji = 2, jpim1 
     252               IF( fmask(ji,1,jk) == 0._wp ) THEN 
     253                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     254               ENDIF 
     255               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
     256                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    291257               ENDIF 
    292258            END DO 
    293259         END DO 
    294          DO jj = 2, jpjm1 
    295             IF( fmask(1,jj,jk) == 0._wp ) THEN 
    296                fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
    297             ENDIF 
    298             IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    299                fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    300             ENDIF 
    301          END DO          
    302          DO ji = 2, jpim1 
    303             IF( fmask(ji,1,jk) == 0._wp ) THEN 
    304                fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
    305             ENDIF 
    306             IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    307                fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    308             ENDIF 
    309          END DO 
    310       END DO 
    311       ! 
    312       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration 
    313          !                                                 ! Increased lateral friction near of some straits 
    314          !                                ! Gibraltar strait  : partial slip (fmask=0.5) 
    315          ij0 = 101   ;   ij1 = 101 
    316          ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    317          ij0 = 102   ;   ij1 = 102 
    318          ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    319          ! 
    320          !                                ! Bab el Mandeb : partial slip (fmask=1) 
    321          ij0 =  87   ;   ij1 =  88 
    322          ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    323          ij0 =  88   ;   ij1 =  88 
    324          ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    325          ! 
    326          !                                ! Danish straits  : strong slip (fmask > 2) 
    327 ! We keep this as an example but it is instable in this case  
    328 !         ij0 = 115   ;   ij1 = 115 
    329 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    330 !         ij0 = 116   ;   ij1 = 116 
    331 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    332          ! 
    333       ENDIF 
    334       ! 
    335       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
    336          !                                                 ! Increased lateral friction near of some straits 
    337          ! This dirty section will be suppressed by simplification process: 
    338          ! all this will come back in input files 
    339          ! Currently these hard-wired indices relate to configuration with 
    340          ! extend grid (jpjglo=332) 
    341          ! 
    342          isrow = 332 - jpjglo 
    343          ! 
    344          IF(lwp) WRITE(numout,*) 
    345          IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
    346          IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    347          ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait  
    348          ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    349  
    350          IF(lwp) WRITE(numout,*) '      Bhosporus ' 
    351          ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait  
    352          ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    353  
    354          IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
    355          ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)  
    356          ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    357  
    358          IF(lwp) WRITE(numout,*) '      Lombok ' 
    359          ii0 =  44           ;   ii1 =  44        ! Lombok Strait  
    360          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    361  
    362          IF(lwp) WRITE(numout,*) '      Ombai ' 
    363          ii0 =  53           ;   ii1 =  53        ! Ombai Strait  
    364          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    365  
    366          IF(lwp) WRITE(numout,*) '      Timor Passage ' 
    367          ii0 =  56           ;   ii1 =  56        ! Timor Passage  
    368          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    369  
    370          IF(lwp) WRITE(numout,*) '      West Halmahera ' 
    371          ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait  
    372          ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    373  
    374          IF(lwp) WRITE(numout,*) '      East Halmahera ' 
    375          ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait  
    376          ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    377          ! 
    378       ENDIF 
    379       ! 
    380       CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    381       ! 
    382       ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 
    383       ! 
    384       CALL wrk_dealloc( jpi, jpj, imsk ) 
    385       CALL wrk_dealloc( jpi, jpj, zwf  ) 
     260         ! 
     261         CALL wrk_dealloc( jpi,jpj,   zwf ) 
     262         ! 
     263         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
     264         ! 
     265         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat 
     266         ! 
     267      ENDIF 
     268       
     269      ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 
     270      ! --------------------------------  
     271      ! 
     272      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 
     273      ! 
    386274      ! 
    387275      IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 

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

    r6140 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7412 r7421  
    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   ;    
    … …  
    896896                     e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 
    897897                     e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 
    898                      sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
    899                      sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
    900                      ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj) 
     898                     sshb(ji,jj) = rn_wdmin1 - ht_0(ji,jj)           !!gm I don't understand that ! 
     899                     sshn(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
     900                     ssha(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    901901                  ENDIF 
    902902                ENDDO 
    … …  
    912912 
    913913            IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 
    914                tilde_e3t_b(:,:,:) = 0.0_wp 
    915                tilde_e3t_n(:,:,:) = 0.0_wp 
    916                IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0.0_wp 
     914               tilde_e3t_b(:,:,:) = 0._wp 
     915               tilde_e3t_n(:,:,:) = 0._wp 
     916               IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 
    917917            END IF 
    918918         ENDIF 

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

    r6689 r7421  
    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_r8 )     !    ! latitude 
    74       CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r8 ) 
    75       CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r8 ) 
    76       CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r8 ) 
    77        
    78       CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude 
    79       CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r8 ) 
    80       CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r8 ) 
    81       CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r8 ) 
    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_r8 )     !    ! latitude 
    232       CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r8 ) 
    233       CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r8 ) 
    234       CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r8 ) 
    235        
    236       CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude 
    237       CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r8 ) 
    238       CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r8 ) 
    239       CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r8 ) 
    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_r8 )       !    ! nb of ocean T-points 
    260              
    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_r8 )      
    282          CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 
    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_r8 )      
    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_r8 ) 
    315             CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r8 ) 
    316             CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 
    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_r8 )      
    325             CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r8 )  
    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   ) 
     182      CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 )   !    ! nb of ocean T-points 
     183      !                                                         ! vertical mesh 
     184      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8  )    !    ! scale factors 
     185      CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0, ktype = jp_r8  ) 
     186      CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0, ktype = jp_r8  ) 
     187      CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0, ktype = jp_r8  ) 
     188      ! 
     189      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 )  ! stretched system 
     190      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 ) 
     191      CALL iom_rstput( 0, 0, inum, 'gdept_0'  , gdept_0  , ktype = jp_r8 ) 
     192      CALL iom_rstput( 0, 0, inum, 'gdepw_0'  , gdepw_0  , ktype = jp_r8 ) 
     193      ! 
     194      IF( ln_sco ) THEN                                         ! s-coordinate stiffness 
     195         CALL dom_stiff( zprt ) 
     196         CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )      !    ! Max. grid stiffness ratio 
    340197      ENDIF 
    341198      !                                     ! ============================ 
    342       !                                     !        close the files  
     199      CALL iom_close( inum )                !        close the files  
    343200      !                                     ! ============================ 
    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 
    355201      ! 
    356202      CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    … …  
    371217      !!                2) check which elements have been changed 
    372218      !!---------------------------------------------------------------------- 
    373       ! 
    374219      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    375220      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    … …  
    405250   END SUBROUTINE dom_uniq 
    406251 
     252 
     253   SUBROUTINE dom_stiff( px1 ) 
     254      !!---------------------------------------------------------------------- 
     255      !!                  ***  ROUTINE dom_stiff  *** 
     256      !!                      
     257      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency 
     258      !! 
     259      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio 
     260      !!                Save the maximum in the vertical direction 
     261      !!                (this number is only relevant in s-coordinates) 
     262      !! 
     263      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619. 
     264      !!---------------------------------------------------------------------- 
     265      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness 
     266      ! 
     267      INTEGER  ::   ji, jj, jk  
     268      REAL(wp) ::   zrxmax 
     269      REAL(wp), DIMENSION(4) ::   zr1 
     270      REAL(wp), DIMENSION(jpi,jpj) ::   zx1 
     271      !!---------------------------------------------------------------------- 
     272      zx1(:,:) = 0._wp 
     273      zrxmax   = 0._wp 
     274      zr1(:)   = 0._wp 
     275      ! 
     276      DO ji = 2, jpim1 
     277         DO jj = 2, jpjm1 
     278            DO jk = 1, jpkm1 
     279!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation.... 
     280!!             especially since it is gde3w which is used to compute the pressure gradient 
     281!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator 
     282!!             so that the ratio is computed at the same point (i.e. uw and vw) .... 
     283               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               &  
     284                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             & 
     285                    &       / ( 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) + rsmall )  ) * umask(ji-1,jj,jk) 
     287               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               & 
     288                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             & 
     289                    &       / ( 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) + rsmall )  ) * umask(ji  ,jj,jk) 
     291               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               & 
     292                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             & 
     293                    &       / ( 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) + rsmall )  ) * vmask(ji,jj  ,jk) 
     295               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               & 
     296                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             & 
     297                    &       / ( 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) + rsmall )  ) * vmask(ji,jj-1,jk) 
     299               zrxmax = MAXVAL( zr1(1:4) ) 
     300               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax ) 
     301            END DO 
     302         END DO 
     303      END DO 
     304      CALL lbc_lnk( zx1, 'T', 1. ) 
     305      ! 
     306      IF( PRESENT( px1 ) )    px1 = zx1 
     307      ! 
     308      zrxmax = MAXVAL( zx1 ) 
     309      ! 
     310      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain 
     311      ! 
     312      IF(lwp) THEN 
     313         WRITE(numout,*) 
     314         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax 
     315         WRITE(numout,*) '~~~~~~~~~' 
     316      ENDIF 
     317      ! 
     318   END SUBROUTINE dom_stiff 
     319 
    407320   !!====================================================================== 
    408321END MODULE domwri 

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

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

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

    r6140 r7421  
    5353      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used 
    5454      ! 
    55       INTEGER ::   ierr0, ierr1, ierr2, ierr3   ! temporary integers 
    56       ! 
     55      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers 
     56      !! 
    5757      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files 
    5858      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read 
    … …  
    6060      !! 
    6161      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 
    62       INTEGER  ::   ios 
    6362      !!---------------------------------------------------------------------- 
    6463      ! 
    … …  
    117116         !                         ! fill sf_tsd with sn_tem & sn_sal and control print 
    118117         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal 
    119          CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' ) 
     118         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print ) 
    120119         ! 
    121120      ENDIF 
    … …  
    155154      ! 
    156155      ! 
     156!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed 
     157      ! 
    157158      !                                   !==   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 
     159      IF( cn_cfg == "orca" .AND. nn_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations 
    159160         ! 
    160161         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea 
    … …  
    178179         sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 
    179180      ENDIF 
     181!!gm end 
    180182      ! 
    181183      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 

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

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

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

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

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

    r6140 r7421  
    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_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

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

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

    r5147 r7421  
    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' 
    109       IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     106      IF(lwp) WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants' 
     107      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' 
Note: See TracChangeset for help on using the changeset viewer.