Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r4624 r5965 134 134 INTEGER :: ijf, ijl, ij0, ij1 ! - - 135 135 INTEGER :: ios 136 INTEGER :: isrow ! index for ORCA1 starting row 136 137 INTEGER , POINTER, DIMENSION(:,:) :: imsk 137 138 REAL(wp), POINTER, DIMENSION(:,:) :: zwf … … 181 182 DO ji = 1, jpi 182 183 IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp ) tmask(ji,jj,jk) = 1._wp 184 END DO 185 END DO 186 END DO 187 188 ! (ISF) define barotropic mask and mask the ice shelf point 189 ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked 190 191 DO jk = 1, jpk 192 DO jj = 1, jpj 193 DO ji = 1, jpi 194 IF( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp >= 0._wp ) THEN 195 tmask(ji,jj,jk) = 0._wp 196 END IF 183 197 END DO 184 198 END DO … … 207 221 ! Interior domain mask (used for global sum) 208 222 ! -------------------- 209 tmask_i(:,:) = tmask(:,:,1)223 tmask_i(:,:) = ssmask(:,:) ! (ISH) tmask_i = 1 even on the ice shelf 210 224 iif = jpreci ! ??? 211 225 iil = nlci - jpreci + 1 … … 250 264 END DO 251 265 END DO 266 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet u point 267 DO jj = 1, jpjm1 268 DO ji = 1, fs_jpim1 ! vector loop 269 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:))) 270 vmask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:))) 271 END DO 272 DO ji = 1, jpim1 ! NO vector opt. 273 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 274 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 275 END DO 276 END DO 252 277 CALL lbc_lnk( umask, 'U', 1._wp ) ! Lateral boundary conditions 253 278 CALL lbc_lnk( vmask, 'V', 1._wp ) 254 279 CALL lbc_lnk( fmask, 'F', 1._wp ) 255 280 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions 281 CALL lbc_lnk( vmask_i, 'V', 1._wp ) 282 CALL lbc_lnk( fmask_i, 'F', 1._wp ) 283 284 ! 3. Ocean/land mask at wu-, wv- and w points 285 !---------------------------------------------- 286 wmask (:,:,1) = tmask(:,:,1) ! ???????? 287 wumask(:,:,1) = umask(:,:,1) ! ???????? 288 wvmask(:,:,1) = vmask(:,:,1) ! ???????? 289 DO jk=2,jpk 290 wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 291 wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1) 292 wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 293 END DO 256 294 257 295 ! 4. ocean/land mask for the elliptic equation 258 296 ! -------------------------------------------- 259 bmask(:,:) = tmask(:,:,1) ! elliptic equation is written at t-point297 bmask(:,:) = ssmask(:,:) ! elliptic equation is written at t-point 260 298 ! 261 299 ! ! Boundary conditions … … 364 402 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 365 403 ! ! Increased lateral friction near of some straits 404 ! This dirty section will be suppressed by simplification process: 405 ! all this will come back in input files 406 ! Currently these hard-wired indices relate to configuration with 407 ! extend grid (jpjglo=332) 408 ! 409 isrow = 332 - jpjglo 410 ! 366 411 IF(lwp) WRITE(numout,*) 367 412 IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : ' 368 413 IF(lwp) WRITE(numout,*) ' Gibraltar ' 369 ii0 = 28 3 ; ii1 = 284! Gibraltar Strait370 ij0 = 20 0 ; ij1 = 200 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =2._wp414 ii0 = 282 ; ii1 = 283 ! Gibraltar Strait 415 ij0 = 201 + isrow ; ij1 = 241 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 371 416 372 417 IF(lwp) WRITE(numout,*) ' Bhosporus ' 373 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait374 ij0 = 208 ; ij1 = 208 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =2._wp418 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait 419 ij0 = 208 + isrow ; ij1 = 248 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 375 420 376 421 IF(lwp) WRITE(numout,*) ' Makassar (Top) ' 377 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top)378 ij0 = 149 ; ij1 = 150 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =3._wp422 ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top) 423 ij0 = 149 + isrow ; ij1 = 190 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 379 424 380 425 IF(lwp) WRITE(numout,*) ' Lombok ' 381 ii0 = 44 ; ii1 = 44 ! Lombok Strait382 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =2._wp426 ii0 = 44 ; ii1 = 44 ! Lombok Strait 427 ij0 = 124 + isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 383 428 384 429 IF(lwp) WRITE(numout,*) ' Ombai ' 385 ii0 = 53 ; ii1 = 53 ! Ombai Strait386 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1),1:jpk ) = 2._wp430 ii0 = 53 ; ii1 = 53 ! Ombai Strait 431 ij0 = 124 + isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 387 432 388 433 IF(lwp) WRITE(numout,*) ' Timor Passage ' 389 ii0 = 56 ; ii1 = 56 ! Timor Passage390 ij0 = 124 ; ij1 = 125 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1),1:jpk ) = 2._wp434 ii0 = 56 ; ii1 = 56 ! Timor Passage 435 ij0 = 124 + isrow ; ij1 = 165 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp 391 436 392 437 IF(lwp) WRITE(numout,*) ' West Halmahera ' 393 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait394 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1),1:jpk ) = 3._wp438 ii0 = 58 ; ii1 = 58 ! West Halmahera Strait 439 ij0 = 141 + isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 395 440 396 441 IF(lwp) WRITE(numout,*) ' East Halmahera ' 397 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait398 ij0 = 141 ; ij1 = 142 ; fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1),1:jpk ) = 3._wp442 ii0 = 55 ; ii1 = 55 ! East Halmahera Strait 443 ij0 = 141 + isrow ; ij1 = 182 - isrow ; fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp 399 444 ! 400 445 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
