source: vendor/nemo/v3.4_r_3220_dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OFF_SRC/dommsk.F90 @ 86

Last change on this file since 86 was 1, checked in by cholod, 13 years ago

importing initial nemo vendor drop (v3.4_r_3220)

File size: 4.5 KB
Line 
1MODULE dommsk
2   !!======================================================================
3   !!                       ***  MODULE dommsk   ***
4   !! Ocean initialization : domain land/sea masks, off-line case
5   !!======================================================================
6   !! History :  3.3  ! 2010-10  (C. Ethe)  adapted from OPA_SRC/DOM/dommsk
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   dom_msk        : compute land/ocean mask
11   !!----------------------------------------------------------------------
12   USE oce             ! ocean dynamics and tracers
13   USE dom_oce         ! ocean space and time domain
14   USE lib_mpp         ! MPP library
15   USE in_out_manager  ! I/O manager
16   USE wrk_nemo 
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   dom_msk    ! routine called by inidom.F90
22
23   REAL(wp)        :: rn_shlat   = 2.   ! type of lateral boundary condition on velocity
24   LOGICAL, PUBLIC :: ln_vorlat  = .false.   !  consistency of vorticity boundary condition
25
26   !! * Substitutions
27#  include "vectopt_loop_substitute.h90"
28   !!----------------------------------------------------------------------
29   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
30   !! $Id: dommsk.F90 3186 2011-11-27 08:16:19Z smasson $
31   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE dom_msk
36      !!---------------------------------------------------------------------
37      !!                 ***  ROUTINE dom_msk  ***
38      !!
39      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
40      !!
41      !! ** Method  :   The interior ocean/land mask is computed from tmask
42      !!              setting to zero the duplicated row and lines due to
43      !!              MPP exchange halos, est-west cyclic and north fold
44      !!              boundary conditions.
45      !!
46      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
47      !!               tpol     : ???
48      !!----------------------------------------------------------------------
49      !
50      INTEGER  ::   ji, jk                   ! dummy loop indices
51      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
52      INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
53      !
54      !!---------------------------------------------------------------------
55     
56      CALL wrk_alloc( jpi, jpj, imsk )
57      !
58      ! Interior domain mask (used for global sum)
59      ! --------------------
60      tmask_i(:,:) = tmask(:,:,1)
61      iif = jpreci                        ! thickness of exchange halos in i-axis
62      iil = nlci - jpreci + 1
63      ijf = jprecj                        ! thickness of exchange halos in j-axis
64      ijl = nlcj - jprecj + 1
65      !
66      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
67      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
68      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
69      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
70      !
71      !                                   ! north fold mask
72      tpol(1:jpiglo) = 1._wp
73      !                               
74      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
75      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
76      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
77         IF( mjg(ijl-1) == jpjglo-1 ) THEN
78            DO ji = iif+1, iil-1
79               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
80            END DO
81         ENDIF
82      ENDIF 
83      !
84      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
85         imsk(:,:) = INT( tmask_i(:,:) )
86         WRITE(numout,*) ' tmask_i : '
87         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
88         WRITE (numout,*)
89         WRITE (numout,*) ' dommsk: tmask for each level'
90         WRITE (numout,*) ' ----------------------------'
91         DO jk = 1, jpk
92            imsk(:,:) = INT( tmask(:,:,jk) )
93            WRITE(numout,*)
94            WRITE(numout,*) ' level = ',jk
95            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
96         END DO
97      ENDIF
98      !
99      CALL wrk_dealloc( jpi, jpj, imsk )
100      !
101   END SUBROUTINE dom_msk
102   !!======================================================================
103END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.