source: trunk/NEMOGCM/NEMO/OFF_SRC/dommsk.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 10 years ago

First attempt to put dynamic allocation on the trunk

  • Property svn:keywords set to Id
File size: 5.1 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
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC   dom_msk    ! routine called by inidom.F90
21
22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   facvol   !: volume for degraded regions
23
24   !! * Substitutions
25#  include "vectopt_loop_substitute.h90"
26   !!----------------------------------------------------------------------
27   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
28   !! $Id$
29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE dom_msk
34      !!---------------------------------------------------------------------
35      !!                 ***  ROUTINE dom_msk  ***
36      !!
37      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
38      !!
39      !! ** Method  :   The interior ocean/land mask is computed from tmask
40      !!              setting to zero the duplicated row and lines due to
41      !!              MPP exchange halos, est-west cyclic and north fold
42      !!              boundary conditions.
43      !!
44      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
45      !!               tpol     : ???
46      !!----------------------------------------------------------------------
47      USE wrk_nemo, ONLY:   iwrk_in_use, iwrk_not_released
48      USE wrk_nemo, ONLY:   imsk => iwrk_2d_1
49      !
50      INTEGER  ::   ji, jk                   ! dummy loop indices
51      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
52      !!---------------------------------------------------------------------
53      !
54      IF( iwrk_in_use(2, 1) ) THEN
55         CALL ctl_stop('dom_msk: requested workspace arrays unavailable')   ;   RETURN
56      END IF
57      !
58#if defined key_degrad
59      IF( dom_msk_alloc() /= 0 )   CALL ctl_stop('STOP','dom_msk: unable to allocate arrays')
60#endif
61
62      ! Interior domain mask (used for global sum)
63      ! --------------------
64      tmask_i(:,:) = tmask(:,:,1)
65      iif = jpreci                        ! thickness of exchange halos in i-axis
66      iil = nlci - jpreci + 1
67      ijf = jprecj                        ! thickness of exchange halos in j-axis
68      ijl = nlcj - jprecj + 1
69      !
70      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
71      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
72      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
73      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
74      !
75      !                                   ! north fold mask
76      tpol(1:jpiglo) = 1._wp
77      !                               
78      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
79      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
80      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
81         IF( mjg(ijl-1) == jpjglo-1 ) THEN
82            DO ji = iif+1, iil-1
83               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
84            END DO
85         ENDIF
86      ENDIF 
87      !
88      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
89         imsk(:,:) = INT( tmask_i(:,:) )
90         WRITE(numout,*) ' tmask_i : '
91         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
92         WRITE (numout,*)
93         WRITE (numout,*) ' dommsk: tmask for each level'
94         WRITE (numout,*) ' ----------------------------'
95         DO jk = 1, jpk
96            imsk(:,:) = INT( tmask(:,:,jk) )
97            WRITE(numout,*)
98            WRITE(numout,*) ' level = ',jk
99            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
100         END DO
101      ENDIF
102      !
103      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('dom_msk: failed to release workspace arrays')
104      !
105   END SUBROUTINE dom_msk
106
107
108   INTEGER FUNCTION dom_msk_alloc()
109      !!---------------------------------------------------------------------
110      !!                 ***  FUNCTION dom_msk_alloc  ***
111      !!---------------------------------------------------------------------
112      ALLOCATE( facvol(jpi,jpj,jpk) , STAT=dom_msk_alloc )
113      IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc : failed to allocate facvol array')
114      !
115   END FUNCTION dom_msk_alloc
116
117   !!======================================================================
118END MODULE dommsk
Note: See TracBrowser for help on using the repository browser.