Changeset 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
- Timestamp:
- 2015-12-21T12:35:23+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r6125 r6140 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 * … … 171 171 ! -------------------- 172 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 173 175 iif = jpreci ! ??? 174 176 iil = nlci - jpreci + 1 … … 176 178 ijl = nlcj - jprecj + 1 177 179 178 tmask_ i( 1 :iif, : ) = 0._wp ! first columns179 tmask_ i(iil:jpi, : ) = 0._wp ! last columns (including mpp extra columns)180 tmask_ i( : , 1 :ijf) = 0._wp ! first rows181 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) 182 184 183 185 ! north fold mask … … 190 192 IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row 191 193 DO ji = iif+1, iil-1 192 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)) 193 195 END DO 194 196 ENDIF 195 197 ENDIF 198 199 tmask_i(:,:) = tmask_i(:,:) * tmask_h(:,:) 200 196 201 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 197 202 tpol( 1 :jpiglo) = 0._wp … … 213 218 END DO 214 219 END DO 215 ! (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 216 221 DO jj = 1, jpjm1 217 222 DO ji = 1, fs_jpim1 ! vector loop 218 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:)))219 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,:))) 220 225 END DO 221 226 DO ji = 1, jpim1 ! NO vector opt. 222 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) &227 ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 223 228 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 224 229 END DO 225 230 END DO 226 CALL lbc_lnk( umask , 'U', 1._wp ) ! Lateral boundary conditions227 CALL lbc_lnk( vmask , 'V', 1._wp )228 CALL lbc_lnk( fmask , 'F', 1._wp )229 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions230 CALL lbc_lnk( vmask_i, 'V', 1._wp )231 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 ) 232 237 233 238 ! 3. Ocean/land mask at wu-, wv- and w points … … 341 346 ! 342 347 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 343 348 ! 344 349 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 345 346 IF( nprint == 1 .AND. lwp ) THEN ! Control print347 imsk(:,:) = INT( tmask_i(:,:) )348 WRITE(numout,*) ' tmask_i : '349 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &350 & 1, jpj, 1, 1, numout)351 WRITE (numout,*)352 WRITE (numout,*) ' dommsk: tmask for each level'353 WRITE (numout,*) ' ----------------------------'354 DO jk = 1, jpk355 imsk(:,:) = INT( tmask(:,:,jk) )356 357 WRITE(numout,*)358 WRITE(numout,*) ' level = ',jk359 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &360 & 1, jpj, 1, 1, numout)361 END DO362 WRITE(numout,*)363 WRITE(numout,*) ' dom_msk: vmask for each level'364 WRITE(numout,*) ' -----------------------------'365 DO jk = 1, jpk366 imsk(:,:) = INT( vmask(:,:,jk) )367 WRITE(numout,*)368 WRITE(numout,*) ' level = ',jk369 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &370 & 1, jpj, 1, 1, numout)371 END DO372 WRITE(numout,*)373 WRITE(numout,*) ' dom_msk: fmask for each level'374 WRITE(numout,*) ' -----------------------------'375 DO jk = 1, jpk376 imsk(:,:) = INT( fmask(:,:,jk) )377 WRITE(numout,*)378 WRITE(numout,*) ' level = ',jk379 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, &380 & 1, jpj, 1, 1, numout )381 END DO382 ENDIF383 350 ! 384 351 CALL wrk_dealloc( jpi, jpj, imsk )
Note: See TracChangeset
for help on using the changeset viewer.