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

source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90 @ 5836

Last change on this file since 5836 was 5836, checked in by cetlod, 8 years ago

merge the simplification branch onto the trunk, see ticket #1612

  • Property svn:keywords set to Id
File size: 22.2 KB
Line 
1MODULE dommsk
2   !!======================================================================
3   !!                       ***  MODULE dommsk   ***
4   !! Ocean initialization : domain land/sea mask
5   !!======================================================================
6   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
7   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
8   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
9   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask and sup-
10   !!                 !                      pression of the double computation of bmask
11   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
12   !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask
13   !!             -   ! 1998-05  (G. Roullet)  free surface
14   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
15   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
16   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
17   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
18   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
19   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
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 in_out_manager  ! I/O manager
28   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
29   USE lib_mpp
30   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
31   USE wrk_nemo        ! Memory allocation
32   USE timing          ! Timing
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   dom_msk         ! routine called by inidom.F90
38
39   !                            !!* Namelist namlbc : lateral boundary condition *
40   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
41   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition
42   !                                            with analytical eqs.
43
44   !! * Substitutions
45#  include "vectopt_loop_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
48   !! $Id$
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE dom_msk
54      !!---------------------------------------------------------------------
55      !!                 ***  ROUTINE dom_msk  ***
56      !!
57      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
58      !!      zontal velocity points (u & v), vorticity points (f) and baro-
59      !!      tropic stream function  points (b).
60      !!
61      !! ** Method  :   The ocean/land mask is computed from the basin bathy-
62      !!      metry in level (mbathy) which is defined or read in dommba.
63      !!      mbathy equals 0 over continental T-point
64      !!      and the number of ocean level over the ocean.
65      !!
66      !!      At a given position (ji,jj,jk) the ocean/land mask is given by:
67      !!      t-point : 0. IF mbathy( ji ,jj) =< 0
68      !!                1. IF mbathy( ji ,jj) >= jk
69      !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
70      !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
71      !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
72      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
73      !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1)
74      !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0
75      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
76      !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
77      !!      b-point : the same definition as for f-point of the first ocean
78      !!                level (surface level) but with 0 along coastlines.
79      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
80      !!                rows/lines due to cyclic or North Fold boundaries as well
81      !!                as MPP halos.
82      !!
83      !!        The lateral friction is set through the value of fmask along
84      !!      the coast and topography. This value is defined by rn_shlat, a
85      !!      namelist parameter:
86      !!         rn_shlat = 0, free slip  (no shear along the coast)
87      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
88      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
89      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
90      !!
91      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays
92      !!      are defined with the proper value at lateral domain boundaries,
93      !!      but bmask. indeed, bmask defined the domain over which the
94      !!      barotropic stream function is computed. this domain cannot
95      !!      contain identical columns because the matrix associated with
96      !!      the barotropic stream function equation is then no more inverti-
97      !!      ble. therefore bmask is set to 0 along lateral domain boundaries
98      !!      even IF nperio is not zero.
99      !!
100      !!      In case of open boundaries (lk_bdy=T):
101      !!        - tmask is set to 1 on the points to be computed bay the open
102      !!          boundaries routines.
103      !!        - bmask is  set to 0 on the open boundaries.
104      !!
105      !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.)
106      !!               umask    : land/ocean mask at u-point (=0. or 1.)
107      !!               vmask    : land/ocean mask at v-point (=0. or 1.)
108      !!               fmask    : land/ocean mask at f-point (=0. or 1.)
109      !!                          =rn_shlat along lateral boundaries
110      !!               bmask    : land/ocean mask at barotropic stream
111      !!                          function point (=0. or 1.) and set to 0 along lateral boundaries
112      !!               tmask_i  : interior ocean mask
113      !!----------------------------------------------------------------------
114      INTEGER  ::   ji, jj, jk               ! dummy loop indices
115      INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers
116      INTEGER  ::   ijf, ijl, ij0, ij1       !   -       -
117      INTEGER  ::   ios
118      INTEGER  ::   isrow                    ! index for ORCA1 starting row
119      INTEGER , POINTER, DIMENSION(:,:) ::  imsk
120      REAL(wp), POINTER, DIMENSION(:,:) ::  zwf
121      !!
122      NAMELIST/namlbc/ rn_shlat, ln_vorlat
123      !!---------------------------------------------------------------------
124      !
125      IF( nn_timing == 1 )  CALL timing_start('dom_msk')
126      !
127      CALL wrk_alloc( jpi, jpj, imsk )
128      CALL wrk_alloc( jpi, jpj, zwf  )
129      !
130      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
131      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
132901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
133
134      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
135      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
136902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
137      IF(lwm) WRITE ( numond, namlbc )
138     
139      IF(lwp) THEN                  ! control print
140         WRITE(numout,*)
141         WRITE(numout,*) 'dommsk : ocean mask '
142         WRITE(numout,*) '~~~~~~'
143         WRITE(numout,*) '   Namelist namlbc'
144         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
145         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
146      ENDIF
147
148      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  free-slip '
149      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip '
150      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip '
151      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  strong-slip '
152      ELSE
153         WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat
154         CALL ctl_stop( ctmp1 )
155      ENDIF
156
157      ! 1. Ocean/land mask at t-point (computed from mbathy)
158      ! -----------------------------
159      ! N.B. tmask has already the right boundary conditions since mbathy is ok
160      !
161      tmask(:,:,:) = 0._wp
162      DO jk = 1, jpk
163         DO jj = 1, jpj
164            DO ji = 1, jpi
165               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp
166            END DO 
167         END DO 
168      END DO 
169     
170      ! (ISF) define barotropic mask and mask the ice shelf point
171      ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked
172     
173      DO jk = 1, jpk
174         DO jj = 1, jpj
175            DO ji = 1, jpi
176               IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp )   THEN
177                  tmask(ji,jj,jk) = 0._wp
178               END IF
179            END DO 
180         END DO 
181      END DO 
182
183      ! Interior domain mask (used for global sum)
184      ! --------------------
185      tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf
186      iif = jpreci                         ! ???
187      iil = nlci - jpreci + 1
188      ijf = jprecj                         ! ???
189      ijl = nlcj - jprecj + 1
190
191      tmask_i( 1 :iif,   :   ) = 0._wp      ! first columns
192      tmask_i(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
193      tmask_i(   :   , 1 :ijf) = 0._wp      ! first rows
194      tmask_i(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
195
196      ! north fold mask
197      ! ---------------
198      tpol(1:jpiglo) = 1._wp 
199      fpol(1:jpiglo) = 1._wp
200      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
201         tpol(jpiglo/2+1:jpiglo) = 0._wp
202         fpol(     1    :jpiglo) = 0._wp
203         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row
204            DO ji = iif+1, iil-1
205               tmask_i(ji,nlej-1) = tmask_i(ji,nlej-1) * tpol(mig(ji))
206            END DO
207         ENDIF
208      ENDIF
209      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
210         tpol(     1    :jpiglo) = 0._wp
211         fpol(jpiglo/2+1:jpiglo) = 0._wp
212      ENDIF
213
214      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
215      ! -------------------------------------------
216      DO jk = 1, jpk
217         DO jj = 1, jpjm1
218            DO ji = 1, fs_jpim1   ! vector loop
219               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
220               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
221            END DO
222            DO ji = 1, jpim1      ! NO vector opt.
223               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
224                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
225            END DO
226         END DO
227      END DO
228      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet u point
229      DO jj = 1, jpjm1
230         DO ji = 1, fs_jpim1   ! vector loop
231            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:)))
232            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:)))
233         END DO
234         DO ji = 1, jpim1      ! NO vector opt.
235            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   &
236               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:)))
237         END DO
238      END DO
239      CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions
240      CALL lbc_lnk( vmask, 'V', 1._wp )
241      CALL lbc_lnk( fmask, 'F', 1._wp )
242      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions
243      CALL lbc_lnk( vmask_i, 'V', 1._wp )
244      CALL lbc_lnk( fmask_i, 'F', 1._wp )
245
246      ! 3. Ocean/land mask at wu-, wv- and w points
247      !----------------------------------------------
248      wmask (:,:,1) = tmask(:,:,1)     ! surface
249      wumask(:,:,1) = umask(:,:,1)
250      wvmask(:,:,1) = vmask(:,:,1)
251      DO jk = 2, jpk                   ! interior values
252         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
253         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)   
254         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1)
255      END DO
256
257      ! 4. ocean/land mask for the elliptic equation
258      ! --------------------------------------------
259      bmask(:,:) = ssmask(:,:)       ! elliptic equation is written at t-point
260      !
261      !                               ! Boundary conditions
262      !                                    ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi
263      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
264         bmask( 1 ,:) = 0._wp
265         bmask(jpi,:) = 0._wp
266      ENDIF
267      IF( nperio == 2 ) THEN               ! south symmetric :  bmask must be set to 0. on row 1
268         bmask(:, 1 ) = 0._wp
269      ENDIF
270      !                                    ! north fold :
271      IF( nperio == 3 .OR. nperio == 4 ) THEN   ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row
272         DO ji = 1, jpi                     
273            ii = ji + nimpp - 1
274            bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)
275            bmask(ji,jpj  ) = 0._wp
276         END DO
277      ENDIF
278      IF( nperio == 5 .OR. nperio == 6 ) THEN   ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
279         bmask(:,jpj) = 0._wp
280      ENDIF
281      !
282      IF( lk_mpp ) THEN                    ! mpp specificities
283         !                                      ! bmask is set to zero on the overlap region
284         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0._wp
285         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0._wp
286         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0._wp
287         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0._wp
288         !
289         IF( npolj == 3 .OR. npolj == 4 ) THEN  ! north fold : bmask must be set to 0. on rows jpj-1 and jpj
290            DO ji = 1, nlci
291               ii = ji + nimpp - 1
292               bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)
293               bmask(ji,nlcj  ) = 0._wp
294            END DO
295         ENDIF
296         IF( npolj == 5 .OR. npolj == 6 ) THEN  ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
297            DO ji = 1, nlci
298               bmask(ji,nlcj  ) = 0._wp
299            END DO
300         ENDIF
301      ENDIF
302
303      ! Lateral boundary conditions on velocity (modify fmask)
304      ! ---------------------------------------     
305      DO jk = 1, jpk
306         zwf(:,:) = fmask(:,:,jk)         
307         DO jj = 2, jpjm1
308            DO ji = fs_2, fs_jpim1   ! vector opt.
309               IF( fmask(ji,jj,jk) == 0._wp ) THEN
310                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
311                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
312               ENDIF
313            END DO
314         END DO
315         DO jj = 2, jpjm1
316            IF( fmask(1,jj,jk) == 0._wp ) THEN
317               fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
318            ENDIF
319            IF( fmask(jpi,jj,jk) == 0._wp ) THEN
320               fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
321            ENDIF
322         END DO         
323         DO ji = 2, jpim1
324            IF( fmask(ji,1,jk) == 0._wp ) THEN
325               fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
326            ENDIF
327            IF( fmask(ji,jpj,jk) == 0._wp ) THEN
328               fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
329            ENDIF
330         END DO
331      END DO
332      !
333      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
334         !                                                 ! Increased lateral friction near of some straits
335         !                                ! Gibraltar strait  : partial slip (fmask=0.5)
336         ij0 = 101   ;   ij1 = 101
337         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
338         ij0 = 102   ;   ij1 = 102
339         ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
340         !
341         !                                ! Bab el Mandeb : partial slip (fmask=1)
342         ij0 =  87   ;   ij1 =  88
343         ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
344         ij0 =  88   ;   ij1 =  88
345         ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
346         !
347         !                                ! Danish straits  : strong slip (fmask > 2)
348! We keep this as an example but it is instable in this case
349!         ij0 = 115   ;   ij1 = 115
350!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
351!         ij0 = 116   ;   ij1 = 116
352!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
353         !
354      ENDIF
355      !
356      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration
357         !                                                 ! Increased lateral friction near of some straits
358         ! This dirty section will be suppressed by simplification process:
359         ! all this will come back in input files
360         ! Currently these hard-wired indices relate to configuration with
361         ! extend grid (jpjglo=332)
362         !
363         isrow = 332 - jpjglo
364         !
365         IF(lwp) WRITE(numout,*)
366         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
367         IF(lwp) WRITE(numout,*) '      Gibraltar '
368         ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait
369         ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
370
371         IF(lwp) WRITE(numout,*) '      Bhosporus '
372         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait
373         ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
374
375         IF(lwp) WRITE(numout,*) '      Makassar (Top) '
376         ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)
377         ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
378
379         IF(lwp) WRITE(numout,*) '      Lombok '
380         ii0 =  44           ;   ii1 =  44        ! Lombok Strait
381         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
382
383         IF(lwp) WRITE(numout,*) '      Ombai '
384         ii0 =  53           ;   ii1 =  53        ! Ombai Strait
385         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
386
387         IF(lwp) WRITE(numout,*) '      Timor Passage '
388         ii0 =  56           ;   ii1 =  56        ! Timor Passage
389         ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 
390
391         IF(lwp) WRITE(numout,*) '      West Halmahera '
392         ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait
393         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
394
395         IF(lwp) WRITE(numout,*) '      East Halmahera '
396         ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait
397         ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 
398         !
399      ENDIF
400      !
401      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
402
403      ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 )
404           
405      IF( nprint == 1 .AND. lwp ) THEN      ! Control print
406         imsk(:,:) = INT( tmask_i(:,:) )
407         WRITE(numout,*) ' tmask_i : '
408         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
409               &                           1, jpj, 1, 1, numout)
410         WRITE (numout,*)
411         WRITE (numout,*) ' dommsk: tmask for each level'
412         WRITE (numout,*) ' ----------------------------'
413         DO jk = 1, jpk
414            imsk(:,:) = INT( tmask(:,:,jk) )
415
416            WRITE(numout,*)
417            WRITE(numout,*) ' level = ',jk
418            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
419               &                              1, jpj, 1, 1, numout)
420         END DO
421         WRITE(numout,*)
422         WRITE(numout,*) ' dom_msk: vmask for each level'
423         WRITE(numout,*) ' -----------------------------'
424         DO jk = 1, jpk
425            imsk(:,:) = INT( vmask(:,:,jk) )
426            WRITE(numout,*)
427            WRITE(numout,*) ' level = ',jk
428            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
429               &                              1, jpj, 1, 1, numout)
430         END DO
431         WRITE(numout,*)
432         WRITE(numout,*) ' dom_msk: fmask for each level'
433         WRITE(numout,*) ' -----------------------------'
434         DO jk = 1, jpk
435            imsk(:,:) = INT( fmask(:,:,jk) )
436            WRITE(numout,*)
437            WRITE(numout,*) ' level = ',jk
438            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
439               &                              1, jpj, 1, 1, numout )
440         END DO
441         WRITE(numout,*)
442         WRITE(numout,*) ' dom_msk: bmask '
443         WRITE(numout,*) ' ---------------'
444         WRITE(numout,*)
445         imsk(:,:) = INT( bmask(:,:) )
446         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
447            &                              1, jpj, 1, 1, numout )
448      ENDIF
449      !
450      CALL wrk_dealloc( jpi, jpj, imsk )
451      CALL wrk_dealloc( jpi, jpj, zwf  )
452      !
453      IF( nn_timing == 1 )  CALL timing_stop('dom_msk')
454      !
455   END SUBROUTINE dom_msk
456   
457   !!======================================================================
458END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.