- Timestamp:
- 2022-01-19T19:34:39+01:00 (2 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/DOM/dommsk.F90
r14075 r15658 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 … … 93 95 INTEGER :: ios, inum 94 96 !! 95 NAMELIST/namlbc/ rn_shlat, ln_vorlat 97 REAL(wp) :: zshlat !: locally modified shlat for some strait 98 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zshlat2d 99 LOGICAL :: ln_shlat2d 100 CHARACTER(len = 256) :: cn_shlat2d_file, cn_shlat2d_var 101 !! 102 NAMELIST/namlbc/ rn_shlat, ln_vorlat, ln_shlat2d, cn_shlat2d_file, cn_shlat2d_var 96 103 NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file, & 97 104 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & … … 120 127 ! 121 128 IF(lwp) WRITE(numout,*) 122 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral free-slip' 123 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral no-slip' 124 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral partial-slip' 125 ELSEIF ( 2. < rn_shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral strong-slip' 129 130 IF ( ln_shlat2d ) THEN 131 IF(lwp) WRITE(numout,*) ' READ shlat as a 2D coefficient in a file ' 132 ALLOCATE( zshlat2d(jpi,jpj) ) 133 CALL iom_open(TRIM(cn_shlat2d_file), inum) 134 CALL iom_get (inum, jpdom_data, TRIM(cn_shlat2d_var), zshlat2d, 1) ! 135 CALL iom_close(inum) 126 136 ELSE 127 CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 137 IF ( rn_shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral free-slip' 138 ELSEIF ( rn_shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral no-slip' 139 ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral partial-slip' 140 ELSEIF ( 2. < rn_shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ==>>> ocean lateral strong-slip' 141 ELSE 142 CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' ) 143 ENDIF 128 144 ENDIF 129 145 … … 240 256 ! Lateral boundary conditions on velocity (modify fmask) 241 257 ! --------------------------------------- 242 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition258 IF( rn_shlat /= 0 .or. ln_shlat2d ) THEN ! Not free-slip lateral boundary condition everywhere 243 259 ! 244 260 DO jk = 1, jpk 245 DO jj = 2, jpjm1 246 DO ji = fs_2, fs_jpim1 ! vector opt. 247 IF( fmask(ji,jj,jk) == 0._wp ) THEN 248 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 249 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 250 ENDIF 261 IF ( ln_shlat2d ) THEN 262 DO jj = 2, jpjm1 263 DO ji = fs_2, fs_jpim1 ! vector opt. 264 IF( fmask(ji,jj,jk) == 0._wp ) THEN 265 fmask(ji,jj,jk) = zshlat2d(ji,jj) * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 266 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 267 ENDIF 268 END DO 251 269 END DO 252 END DO 270 ELSE 271 DO jj = 2, jpjm1 272 DO ji = fs_2, fs_jpim1 ! vector opt. 273 IF( fmask(ji,jj,jk) == 0._wp ) THEN 274 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( umask(ji,jj,jk), umask(ji,jj+1,jk), & 275 & vmask(ji,jj,jk), vmask(ji+1,jj,jk) ) ) 276 ENDIF 277 END DO 278 END DO 279 ENDIF 253 280 DO jj = 2, jpjm1 254 281 IF( fmask(1,jj,jk) == 0._wp ) THEN … … 277 304 END DO 278 305 ! 306 IF( ln_shlat2d ) DEALLOCATE( zshlat2d ) 307 ! 279 308 CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 280 309 ! … … 284 313 285 314 ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 315 ! Only call if we are not using the shlat2d option. 286 316 ! -------------------------------- 287 317 ! 288 CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 318 IF ( .not. ln_shlat2d ) THEN 319 CALL usr_def_fmask( cn_cfg, nn_cfg, fmask ) 320 ENDIF 289 321 ! 290 322 END SUBROUTINE dom_msk
Note: See TracChangeset
for help on using the changeset viewer.