- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r5930 r7351 7 7 !! 6.0 ! 1993-03 (M. Guyon) symetrical conditions (M. Guyon) 8 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 9 !! - ! 1996-05 (G. Madec) mask computed from tmask 11 10 !! 8.0 ! 1997-02 (G. Madec) mesh information put in domhgr.F 12 11 !! 8.1 ! 1997-07 (G. Madec) modification of mbathy and fmask … … 25 24 USE oce ! ocean dynamics and tracers 26 25 USE dom_oce ! ocean space and time domain 26 ! 27 27 USE in_out_manager ! I/O manager 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE lib_mpp 29 USE lib_mpp ! 30 30 USE wrk_nemo ! Memory allocation 31 31 USE timing ! Timing … … 34 34 PRIVATE 35 35 36 PUBLIC dom_msk 36 PUBLIC dom_msk ! routine called by inidom.F90 37 37 38 38 ! !!* Namelist namlbc : lateral boundary condition * … … 55 55 !! 56 56 !! ** Purpose : Compute land/ocean mask arrays at tracer points, hori- 57 !! zontal velocity points (u & v), vorticity points (f) and baro- 58 !! tropic stream function points (b). 57 !! zontal velocity points (u & v), vorticity points (f) points. 59 58 !! 60 59 !! ** Method : The ocean/land mask is computed from the basin bathy- … … 74 73 !! 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 75 74 !! and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 76 !! b-point : the same definition as for f-point of the first ocean77 !! level (surface level) but with 0 along coastlines.78 75 !! tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 79 76 !! rows/lines due to cyclic or North Fold boundaries as well … … 89 86 !! 90 87 !! N.B. If nperio not equal to 0, the land/ocean mask arrays 91 !! are defined with the proper value at lateral domain boundaries, 92 !! but bmask. indeed, bmask defined the domain over which the 93 !! barotropic stream function is computed. this domain cannot 94 !! contain identical columns because the matrix associated with 95 !! the barotropic stream function equation is then no more inverti- 96 !! ble. therefore bmask is set to 0 along lateral domain boundaries 97 !! even IF nperio is not zero. 88 !! are defined with the proper value at lateral domain boundaries. 98 89 !! 99 90 !! In case of open boundaries (lk_bdy=T): 100 91 !! - tmask is set to 1 on the points to be computed bay the open 101 92 !! boundaries routines. 102 !! - bmask is set to 0 on the open boundaries.103 93 !! 104 94 !! ** Action : tmask : land/ocean mask at t-point (=0. or 1.) … … 107 97 !! fmask : land/ocean mask at f-point (=0. or 1.) 108 98 !! =rn_shlat along lateral boundaries 109 !! bmask : land/ocean mask at barotropic stream110 !! function point (=0. or 1.) and set to 0 along lateral boundaries111 99 !! tmask_i : interior ocean mask 112 100 !!---------------------------------------------------------------------- … … 183 171 ! -------------------- 184 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 185 175 iif = jpreci ! ??? 186 176 iil = nlci - jpreci + 1 … … 188 178 ijl = nlcj - jprecj + 1 189 179 190 tmask_ i( 1 :iif, : ) = 0._wp ! first columns191 tmask_ i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns)192 tmask_ i( : , 1 :ijf) = 0._wp ! first rows193 tmask_ i( : ,ijl:jpj) = 0._wp ! last rows (including mpp extra rows)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) 194 184 195 185 ! north fold mask … … 202 192 IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row 203 193 DO ji = iif+1, iil-1 204 tmask_ i(ji,nlej-1) = tmask_i(ji,nlej-1) * tpol(mig(ji))194 tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 205 195 END DO 206 196 ENDIF 207 197 ENDIF 198 199 tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:) 200 208 201 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 209 202 tpol( 1 :jpiglo) = 0._wp … … 225 218 END DO 226 219 END DO 227 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet u point220 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 228 221 DO jj = 1, jpjm1 229 222 DO ji = 1, fs_jpim1 ! vector loop 230 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:)))231 vmask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:)))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,:))) 232 225 END DO 233 226 DO ji = 1, jpim1 ! NO vector opt. 234 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) &227 ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 235 228 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 236 229 END DO 237 230 END DO 238 CALL lbc_lnk( umask , 'U', 1._wp ) ! Lateral boundary conditions239 CALL lbc_lnk( vmask , 'V', 1._wp )240 CALL lbc_lnk( fmask , 'F', 1._wp )241 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions242 CALL lbc_lnk( vmask_i, 'V', 1._wp )243 CALL lbc_lnk( fmask_i, 'F', 1._wp )231 CALL lbc_lnk( umask , 'U', 1._wp ) ! Lateral boundary conditions 232 CALL lbc_lnk( vmask , 'V', 1._wp ) 233 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 ) 244 237 245 238 ! 3. Ocean/land mask at wu-, wv- and w points … … 253 246 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 254 247 END DO 255 256 ! 4. ocean/land mask for the elliptic equation257 ! --------------------------------------------258 bmask(:,:) = ssmask(:,:) ! elliptic equation is written at t-point259 !260 ! ! Boundary conditions261 ! ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi262 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN263 bmask( 1 ,:) = 0._wp264 bmask(jpi,:) = 0._wp265 ENDIF266 IF( nperio == 2 ) THEN ! south symmetric : bmask must be set to 0. on row 1267 bmask(:, 1 ) = 0._wp268 ENDIF269 ! ! north fold :270 IF( nperio == 3 .OR. nperio == 4 ) THEN ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row271 DO ji = 1, jpi272 ii = ji + nimpp - 1273 bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)274 bmask(ji,jpj ) = 0._wp275 END DO276 ENDIF277 IF( nperio == 5 .OR. nperio == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj278 bmask(:,jpj) = 0._wp279 ENDIF280 !281 IF( lk_mpp ) THEN ! mpp specificities282 ! ! bmask is set to zero on the overlap region283 IF( nbondi /= -1 .AND. nbondi /= 2 ) bmask( 1 :jpreci,:) = 0._wp284 IF( nbondi /= 1 .AND. nbondi /= 2 ) bmask(nlci:jpi ,:) = 0._wp285 IF( nbondj /= -1 .AND. nbondj /= 2 ) bmask(:, 1 :jprecj) = 0._wp286 IF( nbondj /= 1 .AND. nbondj /= 2 ) bmask(:,nlcj:jpj ) = 0._wp287 !288 IF( npolj == 3 .OR. npolj == 4 ) THEN ! north fold : bmask must be set to 0. on rows jpj-1 and jpj289 DO ji = 1, nlci290 ii = ji + nimpp - 1291 bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)292 bmask(ji,nlcj ) = 0._wp293 END DO294 ENDIF295 IF( npolj == 5 .OR. npolj == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj296 DO ji = 1, nlci297 bmask(ji,nlcj ) = 0._wp298 END DO299 ENDIF300 ENDIF301 248 302 249 ! Lateral boundary conditions on velocity (modify fmask) … … 399 346 ! 400 347 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 401 348 ! 402 349 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 403 404 IF( nprint == 1 .AND. lwp ) THEN ! Control print405 imsk(:,:) = INT( tmask_i(:,:) )406 WRITE(numout,*) ' tmask_i : '407 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &408 & 1, jpj, 1, 1, numout)409 WRITE (numout,*)410 WRITE (numout,*) ' dommsk: tmask for each level'411 WRITE (numout,*) ' ----------------------------'412 DO jk = 1, jpk413 imsk(:,:) = INT( tmask(:,:,jk) )414 415 WRITE(numout,*)416 WRITE(numout,*) ' level = ',jk417 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &418 & 1, jpj, 1, 1, numout)419 END DO420 WRITE(numout,*)421 WRITE(numout,*) ' dom_msk: vmask for each level'422 WRITE(numout,*) ' -----------------------------'423 DO jk = 1, jpk424 imsk(:,:) = INT( vmask(:,:,jk) )425 WRITE(numout,*)426 WRITE(numout,*) ' level = ',jk427 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &428 & 1, jpj, 1, 1, numout)429 END DO430 WRITE(numout,*)431 WRITE(numout,*) ' dom_msk: fmask for each level'432 WRITE(numout,*) ' -----------------------------'433 DO jk = 1, jpk434 imsk(:,:) = INT( fmask(:,:,jk) )435 WRITE(numout,*)436 WRITE(numout,*) ' level = ',jk437 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &438 & 1, jpj, 1, 1, numout )439 END DO440 WRITE(numout,*)441 WRITE(numout,*) ' dom_msk: bmask '442 WRITE(numout,*) ' ---------------'443 WRITE(numout,*)444 imsk(:,:) = INT( bmask(:,:) )445 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &446 & 1, jpj, 1, 1, numout )447 ENDIF448 350 ! 449 351 CALL wrk_dealloc( jpi, jpj, imsk )
Note: See TracChangeset
for help on using the changeset viewer.
