Changeset 13461 for NEMO/trunk/src/OCE/DOM
- Timestamp:
- 2020-09-14T09:19:33+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/dommsk.F90
r13305 r13461 92 92 INTEGER :: iktop, ikbot ! - - 93 93 INTEGER :: ios, inum 94 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zwf ! 2D workspace95 94 !! 96 95 NAMELIST/namlbc/ rn_shlat, ln_vorlat … … 195 194 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition 196 195 ! 197 ALLOCATE( zwf(jpi,jpj) )198 !199 196 DO jk = 1, jpk 200 zwf(:,:) = fmask(:,:,jk)201 197 DO_2D( 0, 0, 0, 0 ) 202 198 IF( fmask(ji,jj,jk) == 0._wp ) THEN 203 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),&204 & zwf(ji-1,jj), zwf(ji,jj-1) ))199 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 200 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 205 201 ENDIF 206 202 END_2D 207 203 DO jj = 2, jpjm1 208 204 IF( fmask(1,jj,jk) == 0._wp ) THEN 209 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )205 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(2,jj,jk), umask(1,jj+1,jk), umask(1,jj,jk) ) ) 210 206 ENDIF 211 207 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 212 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )208 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(jpi,jj+1,jk), vmask(jpim1,jj,jk), umask(jpi,jj-1,jk) ) ) 213 209 ENDIF 214 210 END DO 215 211 DO ji = 2, jpim1 216 212 IF( fmask(ji,1,jk) == 0._wp ) THEN 217 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )213 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,1,jk), umask(ji,2,jk), vmask(ji,1,jk) ) ) 218 214 ENDIF 219 215 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 220 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )216 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,jk), vmask(ji-1,jpj,jk), umask(ji,jpjm1,jk) ) ) 221 217 ENDIF 222 218 END DO 223 219 END DO 224 !225 DEALLOCATE( zwf )226 220 ! 227 221 CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask
Note: See TracChangeset
for help on using the changeset viewer.