New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7277 for branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

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

update 2016 branch with simplif-2

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

Legend:

Unmodified
Added
Removed

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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