- Timestamp:
- 2019-02-06T15:32:39+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/dev_r10037_shlat2d/src/OCE/DOM/dommsk.F90
r9950 r10642 32 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 33 USE lib_mpp ! Massively Parallel Processing library 34 USE iom ! For shlat2d 35 USE fldread ! for sn_shlat2d 34 36 35 37 IMPLICIT NONE … … 94 96 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zwf ! 2D workspace 95 97 !! 96 NAMELIST/namlbc/ rn_shlat, ln_vorlat 98 INTEGER :: inum ! logical unit for shlat2d 99 REAL(wp) :: zshlat !: locally modified shlat for some strait 100 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zshlat2d 101 LOGICAL :: ln_shlat2d 102 CHARACTER(len = 256) :: cn_shlat2d_file, cn_shlat2d_var 103 !! 104 NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, cn_shlat2d_file, cn_shlat2d_var 97 105 NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file, & 98 106 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & … … 128 136 ELSE 129 137 CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 138 ENDIF 139 140 IF ( ln_shlat2d ) THEN 141 IF(lwp) WRITE(numout,*) ' READ shlat as a 2D coefficient in a file ' 142 ALLOCATE( zshlat2d(jpi,jpj) ) 143 CALL iom_open(TRIM(cn_shlat2d_file), inum) 144 CALL iom_get (inum, jpdom_data, TRIM(cn_shlat2d_var), zshlat2d, 1) ! 145 CALL iom_close(inum) 130 146 ENDIF 131 147 … … 241 257 ! Lateral boundary conditions on velocity (modify fmask) 242 258 ! --------------------------------------- 243 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition259 IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN ! Not free-slip lateral boundary condition everywhere 244 260 ! 245 261 ALLOCATE( zwf(jpi,jpj) ) … … 247 263 DO jk = 1, jpk 248 264 zwf(:,:) = fmask(:,:,jk) 249 DO jj = 2, jpjm1 250 DO ji = fs_2, fs_jpim1 ! vector opt. 251 IF( fmask(ji,jj,jk) == 0._wp ) THEN 252 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 253 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 254 ENDIF 265 IF ( ln_shlat2d ) THEN 266 DO jj = 2, jpjm1 267 DO ji = fs_2, fs_jpim1 ! vector opt. 268 IF( fmask(ji,jj,jk) == 0._wp ) THEN 269 fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 270 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 271 ENDIF 272 END DO 255 273 END DO 256 END DO 274 ELSE 275 DO jj = 2, jpjm1 276 DO ji = fs_2, fs_jpim1 ! vector opt. 277 IF( fmask(ji,jj,jk) == 0._wp ) THEN 278 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 279 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 280 ENDIF 281 END DO 282 END DO 283 ENDIF 257 284 DO jj = 2, jpjm1 258 285 IF( fmask(1,jj,jk) == 0._wp ) THEN … … 282 309 ! 283 310 DEALLOCATE( zwf ) 311 IF( ln_shlat2d ) DEALLOCATE( zshlat2d ) 284 312 ! 285 313 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask
Note: See TracChangeset
for help on using the changeset viewer.