- Timestamp:
- 2016-06-17T12:00:46+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r6667 r6717 17 17 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 18 18 !! 3.6 ! 2015-05 (P. Mathiot) ISF: add wmask,wumask and wvmask 19 !!---------------------------------------------------------------------- 20 21 !!---------------------------------------------------------------------- 22 !! dom_msk : compute land/ocean mask 23 !!---------------------------------------------------------------------- 24 USE oce ! ocean dynamics and tracers 25 USE dom_oce ! ocean space and time domain 19 !! 4.0 ! 2016-06 (G. Madec, S. Flavoni) domain configuration / user defined interface 20 !!---------------------------------------------------------------------- 21 22 !!---------------------------------------------------------------------- 23 !! dom_msk : compute land/ocean mask 24 !!---------------------------------------------------------------------- 25 USE oce ! ocean dynamics and tracers 26 USE dom_oce ! ocean space and time domain 27 USE usrdef_fmask ! user defined fmask 26 28 ! 27 USE in_out_manager 28 USE lbclnk 29 USE lib_mpp !30 USE wrk_nemo 31 USE timing 29 USE in_out_manager ! I/O manager 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE lib_mpp ! Massively Parallel Processing library 32 USE wrk_nemo ! Memory allocation 33 USE timing ! Timing 32 34 33 35 IMPLICIT NONE … … 73 75 !! as MPP halos. 74 76 !! tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines 75 !! due to cyclic or North Fold boundaries as well 76 !! as MPP halos. 77 !! 78 !! In case of open boundaries (lk_bdy=T): 79 !! - tmask is set to 1 on the points to be computed by the open 80 !! boundaries routines. 77 !! due to cyclic or North Fold boundaries as well as MPP halos. 81 78 !! 82 79 !! ** Action : tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask … … 90 87 INTEGER, DIMENSION(:,:), INTENT(in) :: k_top, k_bot ! first and last ocean level 91 88 ! 92 INTEGER :: ji, jj, jk 93 INTEGER :: iif, iil , ii0, ii1, ii! local integers94 INTEGER :: ijf, ijl , ij0, ij1! - -95 INTEGER :: iktop, ikbot 89 INTEGER :: ji, jj, jk ! dummy loop indices 90 INTEGER :: iif, iil ! local integers 91 INTEGER :: ijf, ijl ! - - 92 INTEGER :: iktop, ikbot ! - - 96 93 INTEGER :: ios 97 INTEGER :: isrow ! index for ORCA1 starting row 98 REAL(wp), POINTER, DIMENSION(:,:) :: zwf 94 REAL(wp), POINTER, DIMENSION(:,:) :: zwf ! 2D workspace 99 95 !! 100 96 NAMELIST/namlbc/ rn_shlat, ln_vorlat … … 144 140 END DO 145 141 146 ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)147 WHERE( k_bot(:,:) > 0 ) ; ssmask(:,:) = 1._wp148 ELSEWHERE ; ssmask(:,:) = 0._wp149 END WHERE150 142 151 143 ! Ocean/land mask at u-, v-, and f-points (computed from tmask) 144 ! ---------------------------------------- 145 ! NB: at this point, fmask is designed for free slip lateral boundary condition 146 DO jk = 1, jpk 147 DO jj = 1, jpjm1 148 DO ji = 1, fs_jpim1 ! vector loop 149 umask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) 150 vmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji ,jj+1,jk) 151 END DO 152 DO ji = 1, jpim1 ! NO vector opt. 153 fmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) & 154 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 155 END DO 156 END DO 157 END DO 158 CALL lbc_lnk( umask , 'U', 1._wp ) ! Lateral boundary conditions 159 CALL lbc_lnk( vmask , 'V', 1._wp ) 160 CALL lbc_lnk( fmask , 'F', 1._wp ) 161 162 163 ! Ocean/land mask at wu-, wv- and w points (computed from tmask) 164 !----------------------------------------- 165 wmask (:,:,1) = tmask(:,:,1) ! surface 166 wumask(:,:,1) = umask(:,:,1) 167 wvmask(:,:,1) = vmask(:,:,1) 168 DO jk = 2, jpk ! interior values 169 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 170 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 171 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 172 END DO 173 174 175 ! Ocean/land column mask at t-, u-, and v-points (i.e. at least 1 wet cell in the vertical) 176 ! ---------------------------------------------- 177 ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 ) 178 ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 179 ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 180 181 152 182 ! Interior domain mask (used for global sum) 153 183 ! -------------------- … … 185 215 186 216 187 ! Ocean/land mask at u-, v-, and z-points (computed from tmask) 188 ! ---------------------------------------- 189 DO jk = 1, jpk 190 DO jj = 1, jpjm1 191 DO ji = 1, fs_jpim1 ! vector loop 192 umask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) 193 vmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji ,jj+1,jk) 194 END DO 195 DO ji = 1, jpim1 ! NO vector opt. 196 fmask(ji,jj,jk) = tmask(ji,jj ,jk) * tmask(ji+1,jj ,jk) & 197 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 217 ! Lateral boundary conditions on velocity (modify fmask) 218 ! --------------------------------------- 219 IF( rn_shlat /= 0 ) THEN ! Not free-slip lateral boundary condition 220 ! 221 CALL wrk_alloc( jpi,jpj, zwf ) 222 ! 223 DO jk = 1, jpk 224 zwf(:,:) = fmask(:,:,jk) 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 IF( fmask(ji,jj,jk) == 0._wp ) THEN 228 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 229 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 230 ENDIF 231 END DO 232 END DO 233 DO jj = 2, jpjm1 234 IF( fmask(1,jj,jk) == 0._wp ) THEN 235 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 236 ENDIF 237 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 238 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 239 ENDIF 240 END DO 241 DO ji = 2, jpim1 242 IF( fmask(ji,1,jk) == 0._wp ) THEN 243 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 244 ENDIF 245 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 246 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 247 ENDIF 198 248 END DO 199 249 END DO 200 END DO 201 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 202 DO jj = 1, jpjm1 203 DO ji = 1, fs_jpim1 ! vector loop 204 !!gm simpler : 205 ! ssumask(ji,jj) = MIN( 1._wp , SUM( umask(ji,jj,:) ) ) 206 ! ssvmask(ji,jj) = MIN( 1._wp , SUM( vmask(ji,jj,:) ) ) 207 !!gm 208 !!gm faster : 209 ! ssumask(ji,jj) = ssmask(ji,jj) * tmask(ji+1,jj ) 210 ! ssvmask(ji,jj) = ssmask(ji,jj) * tmask(ji ,jj+1) 211 !!gm 212 ssumask(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:))) 213 ssvmask(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:))) 214 !!end 215 END DO 216 DO ji = 1, jpim1 ! NO vector opt. 217 !!gm faster 218 ! ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 219 ! & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) 220 !!gm 221 ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 222 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 223 !!gm 224 END DO 225 END DO 226 CALL lbc_lnk( umask , 'U', 1._wp ) ! Lateral boundary conditions 227 CALL lbc_lnk( vmask , 'V', 1._wp ) 228 ! CALL lbc_lnk( fmask , 'F', 1._wp ) ! applied after the specification of lateral b.c. 229 CALL lbc_lnk( ssumask, 'U', 1._wp ) 230 CALL lbc_lnk( ssvmask, 'V', 1._wp ) 231 CALL lbc_lnk( ssfmask, 'F', 1._wp ) 232 233 234 ! Ocean/land mask at wu-, wv- and w points 235 !---------------------------------------------- 236 wmask (:,:,1) = tmask(:,:,1) ! surface 237 wumask(:,:,1) = umask(:,:,1) 238 wvmask(:,:,1) = vmask(:,:,1) 239 DO jk = 2, jpk ! interior values 240 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 241 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 242 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 243 END DO 244 245 246 ! Lateral boundary conditions on velocity (modify fmask) 247 ! --------------------------------------- 248 CALL wrk_alloc( jpi,jpj, zwf ) 249 ! 250 DO jk = 1, jpk 251 zwf(:,:) = fmask(:,:,jk) 252 DO jj = 2, jpjm1 253 DO ji = fs_2, fs_jpim1 ! vector opt. 254 IF( fmask(ji,jj,jk) == 0._wp ) THEN 255 fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), & 256 & zwf(ji-1,jj), zwf(ji,jj-1) ) ) 257 ENDIF 258 END DO 259 END DO 260 DO jj = 2, jpjm1 261 IF( fmask(1,jj,jk) == 0._wp ) THEN 262 fmask(1 ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 263 ENDIF 264 IF( fmask(jpi,jj,jk) == 0._wp ) THEN 265 fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 266 ENDIF 267 END DO 268 DO ji = 2, jpim1 269 IF( fmask(ji,1,jk) == 0._wp ) THEN 270 fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 271 ENDIF 272 IF( fmask(ji,jpj,jk) == 0._wp ) THEN 273 fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 274 ENDIF 275 END DO 276 END DO 277 ! 278 CALL wrk_dealloc( jpi,jpj, zwf ) 279 ! 280 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 281 ! ! Increased lateral friction near of some straits 282 ! ! Gibraltar strait : partial slip (fmask=0.5) 283 ij0 = 101 ; ij1 = 101 284 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 285 ij0 = 102 ; ij1 = 102 286 ii0 = 139 ; ii1 = 140 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp 287 ! 288 ! ! Bab el Mandeb : partial slip (fmask=1) 289 ij0 = 87 ; ij1 = 88 290 ii0 = 160 ; ii1 = 160 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 291 ij0 = 88 ; ij1 = 88 292 ii0 = 159 ; ii1 = 159 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp 293 ! 294 ! ! Danish straits : strong slip (fmask > 2) 295 ! We keep this as an example but it is instable in this case 296 ! ij0 = 115 ; ij1 = 115 297 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 298 ! ij0 = 116 ; ij1 = 116 299 ! ii0 = 145 ; ii1 = 146 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 300 ! 301 ENDIF 302 ! 303 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 304 ! ! Increased lateral friction near of some straits 305 ! This dirty section will be suppressed by simplification process: 306 ! all this will come back in input files 307 ! Currently these hard-wired indices relate to configuration with 308 ! extend grid (jpjglo=332) 309 ! 310 isrow = 332 - jpjglo 311 ! 312 IF(lwp) WRITE(numout,*) 313 IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : ' 314 IF(lwp) WRITE(numout,*) ' Gibraltar ' 315 ii0 = 282 ; ii1 = 283 ! Gibraltar Strait 316 ij0 = 241 - isrow ; ij1 = 241 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 317 318 IF(lwp) WRITE(numout,*) ' Bhosporus ' 319 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait 320 ij0 = 248 - isrow ; ij1 = 248 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 321 322 IF(lwp) WRITE(numout,*) ' Makassar (Top) ' 323 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) 324 ij0 = 189 - isrow ; ij1 = 190 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 325 326 IF(lwp) WRITE(numout,*) ' Lombok ' 327 ii0 = 44 ; ii1 = 44 ! Lombok Strait 328 ij0 = 164 - isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 329 330 IF(lwp) WRITE(numout,*) ' Ombai ' 331 ii0 = 53 ; ii1 = 53 ! Ombai Strait 332 ij0 = 164 - isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 333 334 IF(lwp) WRITE(numout,*) ' Timor Passage ' 335 ii0 = 56 ; ii1 = 56 ! Timor Passage 336 ij0 = 164 - isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 337 338 IF(lwp) WRITE(numout,*) ' West Halmahera ' 339 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait 340 ij0 = 181 - isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 341 342 IF(lwp) WRITE(numout,*) ' East Halmahera ' 343 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait 344 ij0 = 181 - isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 345 ! 346 ENDIF 347 ! 348 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 349 ! 350 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 250 ! 251 CALL wrk_dealloc( jpi,jpj, zwf ) 252 ! 253 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 254 ! 255 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat 256 ! 257 ENDIF 258 259 ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 260 ! -------------------------------- 261 ! 262 CALL usr_def_fmask( cp_cfg, jp_cfg, fmask ) 263 ! 351 264 ! 352 265 IF( nn_timing == 1 ) CALL timing_stop('dom_msk')
Note: See TracChangeset
for help on using the changeset viewer.
