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 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90 – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6140 r7646  
    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 
    26    ! 
    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 
     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 
     28   USE bdy_oce       
     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       !   -       - 
    104       INTEGER  ::   ios 
    105       INTEGER  ::   isrow                    ! index for ORCA1 starting row 
    106       INTEGER , POINTER, DIMENSION(:,:) ::  imsk 
    107       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
     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   !   -       - 
     93      INTEGER  ::   ios, inum 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    10895      !! 
    10996      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
     97      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         & 
     98         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
     99         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             & 
     100         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
     101         &             cn_ice_lim, nn_ice_lim_dta,                           & 
     102         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
     103         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 
    110104      !!--------------------------------------------------------------------- 
    111105      ! 
    112106      IF( nn_timing == 1 )  CALL timing_start('dom_msk') 
    113       ! 
    114       CALL wrk_alloc( jpi, jpj, imsk ) 
    115       CALL wrk_alloc( jpi, jpj, zwf  ) 
    116107      ! 
    117108      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
     
    142133      ENDIF 
    143134 
    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 
     135 
     136      !  Ocean/land mask at t-point  (computed from ko_top and ko_bot) 
     137      ! ---------------------------- 
    147138      ! 
    148139      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   
     140      DO jj = 1, jpj 
     141         DO ji = 1, jpi 
     142            iktop = k_top(ji,jj) 
     143            ikbot = k_bot(ji,jj) 
     144            IF( iktop /= 0 ) THEN       ! water in the column 
     145               tmask(ji,jj,iktop:ikbot  ) = 1._wp 
     146            ENDIF 
    154147         END DO   
    155148      END DO   
    156        
    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       ! ------------------------------------------- 
     149!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 
     150!!gm I don't understand why...   
     151      CALL lbc_lnk( tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
     152 
     153     ! Mask corrections for bdy (read in mppini2) 
     154      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
     155      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
     156903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     157 
     158      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
     159      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
     160904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     161      ! ------------------------ 
     162      IF ( ln_bdy .AND. ln_mask_file ) THEN 
     163         DO jk = 1, jpkm1 
     164            DO jj = 1, jpj 
     165               DO ji = 1, jpi 
     166                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj) 
     167               END DO 
     168            END DO 
     169         END DO 
     170      ENDIF 
     171          
     172      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask) 
     173      ! ---------------------------------------- 
     174      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
    208175      DO jk = 1, jpk 
    209176         DO jj = 1, jpjm1 
     
    218185         END DO 
    219186      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 
    231187      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
    232188      CALL lbc_lnk( vmask  , 'V', 1._wp ) 
    233189      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       !---------------------------------------------- 
     190 
     191  
     192      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
     193      !----------------------------------------- 
    240194      wmask (:,:,1) = tmask(:,:,1)     ! surface 
    241195      wumask(:,:,1) = umask(:,:,1) 
     
    247201      END DO 
    248202 
     203 
     204      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
     205      ! ---------------------------------------------- 
     206      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 ) 
     207      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 
     208      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
     209 
     210 
     211      ! Interior domain mask  (used for global sum) 
     212      ! -------------------- 
     213      ! 
     214      iif = jpreci   ;   iil = nlci - jpreci + 1 
     215      ijf = jprecj   ;   ijl = nlcj - jprecj + 1 
     216      ! 
     217      !                          ! halo mask : 0 on the halo and 1 elsewhere 
     218      tmask_h(:,:) = 1._wp                   
     219      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
     220      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
     221      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
     222      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
     223      ! 
     224      !                          ! north fold mask 
     225      tpol(1:jpiglo) = 1._wp  
     226      fpol(1:jpiglo) = 1._wp 
     227      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
     228         tpol(jpiglo/2+1:jpiglo) = 0._wp 
     229         fpol(     1    :jpiglo) = 0._wp 
     230         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h 
     231            DO ji = iif+1, iil-1 
     232               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
     233            END DO 
     234         ENDIF 
     235      ENDIF 
     236      ! 
     237      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
     238         tpol(     1    :jpiglo) = 0._wp 
     239         fpol(jpiglo/2+1:jpiglo) = 0._wp 
     240      ENDIF 
     241      ! 
     242      !                          ! interior mask : 2D ocean mask x halo mask  
     243      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
     244 
     245 
    249246      ! 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)  )  ) 
     247      ! ---------------------------------------   
     248      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
     249         ! 
     250         CALL wrk_alloc( jpi,jpj,   zwf ) 
     251         ! 
     252         DO jk = 1, jpk 
     253            zwf(:,:) = fmask(:,:,jk)          
     254            DO jj = 2, jpjm1 
     255               DO ji = fs_2, fs_jpim1   ! vector opt. 
     256                  IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     257                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     258                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     259                  ENDIF 
     260               END DO 
     261            END DO 
     262            DO jj = 2, jpjm1 
     263               IF( fmask(1,jj,jk) == 0._wp ) THEN 
     264                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     265               ENDIF 
     266               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
     267                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     268               ENDIF 
     269            END DO          
     270            DO ji = 2, jpim1 
     271               IF( fmask(ji,1,jk) == 0._wp ) THEN 
     272                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     273               ENDIF 
     274               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
     275                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    258276               ENDIF 
    259277            END DO 
    260278         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  ) 
     279         ! 
     280         CALL wrk_dealloc( jpi,jpj,   zwf ) 
     281         ! 
     282         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
     283         ! 
     284         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat 
     285         ! 
     286      ENDIF 
     287       
     288      ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 
     289      ! --------------------------------  
     290      ! 
     291      CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 
     292      ! 
    353293      ! 
    354294      IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 
Note: See TracChangeset for help on using the changeset viewer.