- Timestamp:
- 2016-10-04T17:46:55+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6152 r6986 416 416 IF(lwp) WRITE(numout,*) ' Depth = rn_bathy read in namelist' 417 417 zdta(:,:) = rn_bathy 418 ! 419 IF( cp_cfg == 'wad' ) THEN 420 SELECT CASE ( jp_cfg ) 421 ! ! ==================== 422 CASE ( 1 ) ! WAD 1 configuration 423 ! ! ==================== 424 ! 425 IF(lwp) WRITE(numout,*) 426 IF(lwp) WRITE(numout,*) 'zgr_bat : Closed box with EW linear bottom slope' 427 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 428 ! 429 zdta = 1.5_wp 430 DO ji = 10, jpidta 431 zi = MIN(FLOAT(ji - 10)/FLOAT(jpidta - 10), 1.0 ) 432 zdta(ji,:) = MAX(rn_bathy*zi, 1.5) 433 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 434 END DO 435 !!DO ji = 1, jpidta 436 !! zi = 1.0-EXP(-0.045*(ji-25.0)**2) 437 !! zdta(ji,:) = MAX(rn_bathy*zi, 1.5) 438 !! IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 439 !!END DO 440 zdta(1:2,:) = -2._wp 441 zdta(jpidta-1:jpidta,:) = -2._wp 442 zdta(:,1) = -2._wp 443 zdta(:,jpjdta) = -2._wp 444 zdta(:,1:3) = -2._wp 445 zdta(:,jpjdta-2:jpjdta) = -2._wp 446 ! ! ==================== 447 CASE ( 2, 3 ) ! WAD 2 or 3 configuration 448 ! ! ==================== 449 ! 450 IF(lwp) WRITE(numout,*) 451 IF(lwp) WRITE(numout,*) 'zgr_bat : Parobolic EW channel' 452 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 453 ! 454 DO ji = 1, jpidta 455 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, 0.0 ) 456 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, -2.0 ) 457 zdta(ji,:) = MAX(rn_bathy*zi, -20.0) 458 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 459 END DO 460 zdta(1:2,:) = -2._wp 461 zdta(jpidta-1:jpidta,:) = -2._wp 462 zdta(:,1) = -2._wp 463 zdta(:,jpjdta) = -2._wp 464 zdta(:,1:3) = -2._wp 465 zdta(:,jpjdta-2:jpjdta) = -2._wp 466 ! ! ==================== 467 CASE ( 4 ) ! WAD 4 configuration 468 ! ! ==================== 469 ! 470 IF(lwp) WRITE(numout,*) 471 IF(lwp) WRITE(numout,*) 'zgr_bat : Parobolic bowl' 472 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 473 ! 474 DO ji = 1, jpidta 475 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, 0.0 ) 476 DO jj = 1, jpjdta 477 zj = MAX(1.0-FLOAT((jj-17)**2)/196.0, 0.0 ) 478 zdta(ji,jj) = MAX(rn_bathy*zi*zj, 0.0) 479 END DO 480 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 481 END DO 482 zdta(1:2,:) = -2._wp 483 zdta(jpidta-1:jpidta,:) = -2._wp 484 zdta(:,1) = -2._wp 485 zdta(:,jpjdta) = -2._wp 486 zdta(:,1:3) = -2._wp 487 zdta(:,jpjdta-2:jpjdta) = -2._wp 488 ! ! =========================== 489 CASE ( 5 ) ! WAD 5 configuration 490 ! ! ==================== 491 ! 492 IF(lwp) WRITE(numout,*) 493 IF(lwp) WRITE(numout,*) 'zgr_bat : Double slope with shelf' 494 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 495 ! 496 DO ji = 1, jpidta 497 zi = MIN(FLOAT(ji)/FLOAT(jpidta - 5), 1.0 ) 498 zdta(ji,:) = MAX(rn_bathy*zi, 0.5) 499 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 500 END DO 501 DO ji = jpidta,46,-1 502 zdta(ji,:) = 10.0 503 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 504 END DO 505 DO ji = 46,20,-1 506 zi = 7.5/25. 507 zdta(ji,:) = MAX(10. - zi*(47.-ji),2.5) 508 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 509 END DO 510 DO ji = 19,15,-1 511 zdta(ji,:) = 2.5 512 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 513 END DO 514 DO ji = 15,4,-1 515 zi = 2.0/11.0 516 zdta(ji,:) = MAX(2.5 - zi*(16-ji), 0.5) 517 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 518 END DO 519 DO ji = 4,1,-1 520 zdta(ji,:) = 0.5 521 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 522 END DO 523 ! ! =========================== 524 CASE DEFAULT 525 ! ! =========================== 526 WRITE(ctmp1,*) 'WAD test with a ', jp_cfg,' option is not coded' 527 ! 528 CALL ctl_stop( ctmp1 ) 529 ! 530 END SELECT 531 END IF 532 ! 418 533 IF( ln_sco ) THEN ! s-coordinate (zsc ): idta()=jpk 419 534 idta(:,:) = jpkm1 … … 2185 2300 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 2186 2301 ! 2187 IF( .NOT.ln_wd ) THEN 2188 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2189 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2190 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2191 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2192 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2193 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2194 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2195 END IF 2302 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2303 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2304 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2305 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2306 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2307 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2308 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2196 2309 2197 2310 #if defined key_agrif … … 2295 2408 DO jk = 1, mbathy(ji,jj) 2296 2409 ! check coordinate is monotonically increasing 2297 IF (e3w_ n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN2410 IF (e3w_0(ji,jj,jk) <= 0._wp .OR. e3t_0(ji,jj,jk) <= 0._wp ) THEN 2298 2411 WRITE(ctmp1,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2299 2412 WRITE(numout,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2300 WRITE(numout,*) 'e3w',e3w_ n(ji,jj,:)2301 WRITE(numout,*) 'e3t',e3t_ n(ji,jj,:)2413 WRITE(numout,*) 'e3w',e3w_0(ji,jj,:) 2414 WRITE(numout,*) 'e3t',e3t_0(ji,jj,:) 2302 2415 CALL ctl_stop( ctmp1 ) 2303 2416 ENDIF 2304 2417 ! and check it has never gone negative 2305 IF( gdepw_ n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN2418 IF( gdepw_0(ji,jj,jk) < 0._wp .OR. gdept_0(ji,jj,jk) < 0._wp ) THEN 2306 2419 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2307 2420 WRITE(numout,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2308 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2309 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2421 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2422 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2310 2423 CALL ctl_stop( ctmp1 ) 2311 2424 ENDIF 2312 2425 ! and check it never exceeds the total depth 2313 IF( gdepw_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2426 IF( gdepw_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2314 2427 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2315 2428 WRITE(numout,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2316 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2429 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2317 2430 CALL ctl_stop( ctmp1 ) 2318 2431 ENDIF … … 2321 2434 DO jk = 1, mbathy(ji,jj)-1 2322 2435 ! and check it never exceeds the total depth 2323 IF( gdept_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2436 IF( gdept_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2324 2437 WRITE(ctmp1,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2325 2438 WRITE(numout,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2326 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2439 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2327 2440 CALL ctl_stop( ctmp1 ) 2328 2441 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
