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/dommsk.F90 – NEMO

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

update 2016 branch with simplif-2

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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') 
Note: See TracChangeset for help on using the changeset viewer.