Changeset 2444 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
- Timestamp:
- 2010-11-29T15:30:48+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
r2287 r2444 1 1 MODULE dommsk 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE dommsk *** 4 !! Ocean initialization : domain land/sea mask 5 !!============================================================================== 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 !!---------------------------------------------------------------------- 6 8 7 9 !!---------------------------------------------------------------------- 8 10 !! dom_msk : compute land/ocean mask 9 11 !!---------------------------------------------------------------------- 10 !! * Modules used11 12 USE oce ! ocean dynamics and tracers 12 13 USE dom_oce ! ocean space and time domain 13 14 USE in_out_manager ! I/O manager 14 USE lbclnk ! ocean lateral boundary conditions (or mpp link)15 USE lib_mpp16 15 17 16 IMPLICIT NONE 18 17 PRIVATE 19 18 20 !! * Routine accessibility 21 PUBLIC dom_msk ! routine called by inidom.F90 19 PUBLIC dom_msk ! routine called by inidom.F90 22 20 23 !! * Module variables24 21 #if defined key_degrad 25 22 !! ------------------------------------------------ 26 23 !! Degradation method 27 24 !! -------------------------------------------------- 28 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 29 facvol !! volume for degraded regions 25 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: facvol !! volume for degraded regions 30 26 #endif 27 31 28 !! * Substitutions 32 29 # include "vectopt_loop_substitute.h90" … … 34 31 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 35 32 !! $Id$ 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 34 !!---------------------------------------------------------------------- 38 39 35 CONTAINS 40 36 … … 43 39 !! *** ROUTINE dom_msk *** 44 40 !! 45 !! ** Purpose : Compute land/ocean mask arrays at tracer points, hori- 46 !! zontal velocity points (u & v), vorticity points (f) and baro- 47 !! tropic stream function points (b). 48 !! Set mbathy to the number of non-zero w-levels of a water column 49 !! (if island in the domain (lk_isl=T), this is done latter in 50 !! routine solver_init) 41 !! ** Purpose : Off-line case: defines the interior domain T-mask. 51 42 !! 52 !! ** Method : The ocean/land mask is computed from the basin bathy-53 !! metry in level (mbathy) which is defined or read in dommba.54 !! mbathy equals 0 over continental T-point, -n over the nth55 !! island T-point, and the number of ocean level over the ocean.43 !! ** Method : The interior ocean/land mask is computed from tmask 44 !! setting to zero the duplicated row and lines due to 45 !! MPP exchange halos, est-west cyclic and north fold 46 !! boundary conditions. 56 47 !! 57 !! At a given position (ji,jj,jk) the ocean/land mask is given by: 58 !! t-point : 0. IF mbathy( ji ,jj) =< 0 59 !! 1. IF mbathy( ji ,jj) >= jk 60 !! u-point : 0. IF mbathy( ji ,jj) or mbathy(ji+1, jj ) =< 0 61 !! 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 62 !! v-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) =< 0 63 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 64 !! f-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) 65 !! or mbathy(ji+1,jj) or mbathy(ji+1,jj+1) =< 0 66 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 67 !! and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 68 !! b-point : the same definition as for f-point of the first ocean 69 !! level (surface level) but with 0 along coastlines. 70 !! 71 !! The lateral friction is set through the value of fmask along 72 !! the coast and topography. This value is defined by shlat, a 73 !! namelist parameter: 74 !! shlat = 0, free slip (no shear along the coast) 75 !! shlat = 2, no slip (specified zero velocity at the coast) 76 !! 0 < shlat < 2, partial slip | non-linear velocity profile 77 !! 2 < shlat, strong slip | in the lateral boundary layer 78 !! 79 !! N.B. If nperio not equal to 0, the land/ocean mask arrays 80 !! are defined with the proper value at lateral domain boundaries, 81 !! but bmask. indeed, bmask defined the domain over which the 82 !! barotropic stream function is computed. this domain cannot 83 !! contain identical columns because the matrix associated with 84 !! the barotropic stream function equation is then no more inverti- 85 !! ble. therefore bmask is set to 0 along lateral domain boundaries 86 !! even IF nperio is not zero. 87 !! 88 !! In case of open boundaries (lk_obc=T): 89 !! - tmask is set to 1 on the points to be computed bay the open 90 !! boundaries routines. 91 !! - bmask is set to 0 on the open boundaries. 92 !! 93 !! Set mbathy to the number of non-zero w-levels of a water column 94 !! mbathy = min( mbathy, 1 ) + 1 95 !! (note that the minimum value of mbathy is 2). 96 !! 97 !! ** Action : 98 !! tmask : land/ocean mask at t-point (=0. or 1.) 99 !! umask : land/ocean mask at u-point (=0. or 1.) 100 !! vmask : land/ocean mask at v-point (=0. or 1.) 101 !! fmask : land/ocean mask at f-point (=0. or 1.) 102 !! =shlat along lateral boundaries 103 !! bmask : land/ocean mask at barotropic stream 104 !! function point (=0. or 1.) and set to 105 !! 0 along lateral boundaries 106 !! mbathy : number of non-zero w-levels 107 !! 108 !! History : 109 !! ! 87-07 (G. Madec) Original code 110 !! ! 91-12 (G. Madec) 111 !! ! 92-06 (M. Imbard) 112 !! ! 93-03 (M. Guyon) symetrical conditions (M. Guyon) 113 !! ! 96-01 (G. Madec) suppression of common work arrays 114 !! ! 96-05 (G. Madec) mask computed from tmask and sup- 115 !! pression of the double computation of bmask 116 !! ! 97-02 (G. Madec) mesh information put in domhgr.F 117 !! ! 97-07 (G. Madec) modification of mbathy and fmask 118 !! ! 98-05 (G. Roullet) free surface 119 !! ! 00-03 (G. Madec) no slip accurate 120 !! ! 01-09 (J.-M. Molines) Open boundaries 121 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 48 !! ** Action : tmask_i : interiorland/ocean mask at t-point 49 !! tpol : ??? 122 50 !!---------------------------------------------------------------------- 123 !! *Local declarations 124 INTEGER :: ji, jk ! dummy loop indices 125 INTEGER :: iif, iil, ijf, ijl 126 INTEGER, DIMENSION(jpi,jpj) :: imsk 127 51 INTEGER :: ji, jk ! dummy loop indices 52 INTEGER :: iif, iil, ijf, ijl ! local integers 53 INTEGER, DIMENSION(jpi,jpj) :: imsk ! 2D workspace 128 54 !!--------------------------------------------------------------------- 129 130 131 55 ! 132 56 ! Interior domain mask (used for global sum) 133 57 ! -------------------- 134 135 58 tmask_i(:,:) = tmask(:,:,1) 136 iif = jpreci ! ???59 iif = jpreci ! thickness of exchange halos in i-axis 137 60 iil = nlci - jpreci + 1 138 ijf = jprecj ! ???61 ijf = jprecj ! thickness of exchange halos in j-axis 139 62 ijl = nlcj - jprecj + 1 140 141 tmask_i( 1 :iif, : ) = 0.e0 ! first columns 142 tmask_i(iil:jpi, : ) = 0.e0 ! last columns (including mpp extra columns) 143 tmask_i( : , 1 :ijf) = 0.e0 ! first rows 144 tmask_i( : ,ijl:jpj) = 0.e0 ! last rows (including mpp extra rows) 145 146 147 ! north fold mask 148 tpol(1:jpiglo) = 1.e0 149 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot 150 tpol(jpiglo/2+1:jpiglo) = 0.e0 151 ENDIF 152 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 153 tpol( 1 :jpiglo) = 0.e0 154 ENDIF 155 63 ! 64 tmask_i( 1 :iif, : ) = 0._wp ! first columns 65 tmask_i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns) 66 tmask_i( : , 1 :ijf) = 0._wp ! first rows 67 tmask_i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows) 68 ! 69 ! ! north fold mask 70 tpol(1:jpiglo) = 1._wp 71 ! 72 IF( jperio == 3 .OR. jperio == 4 ) tpol(jpiglo/2+1:jpiglo) = 0._wp ! T-point pivot 73 IF( jperio == 5 .OR. jperio == 6 ) tpol( 1 :jpiglo) = 0._wp ! F-point pivot 156 74 IF( jperio == 3 .OR. jperio == 4 ) THEN ! T-point pivot: only half of the nlcj-1 row 157 if (mjg(ijl-1) == jpjglo-1) then158 DO ji = iif+1, iil-1159 tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))160 END DO161 endif75 IF( mjg(ijl-1) == jpjglo-1 ) THEN 76 DO ji = iif+1, iil-1 77 tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 78 END DO 79 ENDIF 162 80 ENDIF 163 164 ! Control print 165 ! ------------- 166 IF( nprint == 1 .AND. lwp ) THEN 81 ! 82 IF( nprint == 1 .AND. lwp ) THEN ! Control print 167 83 imsk(:,:) = INT( tmask_i(:,:) ) 168 84 WRITE(numout,*) ' tmask_i : ' 169 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, & 170 & 1, jpj, 1, 1, numout) 85 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 171 86 WRITE (numout,*) 172 87 WRITE (numout,*) ' dommsk: tmask for each level' … … 174 89 DO jk = 1, jpk 175 90 imsk(:,:) = INT( tmask(:,:,jk) ) 176 177 91 WRITE(numout,*) 178 92 WRITE(numout,*) ' level = ',jk 179 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, & 180 & 1, jpj, 1, 1, numout) 93 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 181 94 END DO 182 95 ENDIF 183 96 ! 184 97 END SUBROUTINE dom_msk 185 98 99 !!====================================================================== 186 100 END MODULE dommsk
Note: See TracChangeset
for help on using the changeset viewer.
