- Timestamp:
- 2016-12-01T11:30:29+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6492 r7412 421 421 IF(lwp) WRITE(numout,*) ' Depth = rn_bathy read in namelist' 422 422 zdta(:,:) = rn_bathy 423 ! 424 IF( cp_cfg == 'wad' ) THEN 425 SELECT CASE ( jp_cfg ) 426 ! ! ==================== 427 CASE ( 1 ) ! WAD 1 configuration 428 ! ! ==================== 429 ! 430 IF(lwp) WRITE(numout,*) 431 IF(lwp) WRITE(numout,*) 'zgr_bat : Closed box with EW linear bottom slope' 432 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 433 ! 434 zdta = 1.5_wp 435 DO ji = 10, jpidta 436 zi = MIN(FLOAT(ji - 10)/FLOAT(jpidta - 10), 1.0 ) 437 zdta(ji,:) = MAX(rn_bathy*zi, 1.5) 438 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 439 END DO 440 !!DO ji = 1, jpidta 441 !! zi = 1.0-EXP(-0.045*(ji-25.0)**2) 442 !! zdta(ji,:) = MAX(rn_bathy*zi, 1.5) 443 !! IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 444 !!END DO 445 zdta(1:2,:) = -2._wp 446 zdta(jpidta-1:jpidta,:) = -2._wp 447 zdta(:,1) = -2._wp 448 zdta(:,jpjdta) = -2._wp 449 zdta(:,1:3) = -2._wp 450 zdta(:,jpjdta-2:jpjdta) = -2._wp 451 ! ! ==================== 452 CASE ( 2, 3 ) ! WAD 2 or 3 configuration 453 ! ! ==================== 454 ! 455 IF(lwp) WRITE(numout,*) 456 IF(lwp) WRITE(numout,*) 'zgr_bat : Parobolic EW channel' 457 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 458 ! 459 DO ji = 1, jpidta 460 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, 0.0 ) 461 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, -2.0 ) 462 zdta(ji,:) = MAX(rn_bathy*zi, -20.0) 463 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 464 END DO 465 zdta(1:2,:) = -2._wp 466 zdta(jpidta-1:jpidta,:) = -2._wp 467 zdta(:,1) = -2._wp 468 zdta(:,jpjdta) = -2._wp 469 zdta(:,1:3) = -2._wp 470 zdta(:,jpjdta-2:jpjdta) = -2._wp 471 ! ! ==================== 472 CASE ( 4 ) ! WAD 4 configuration 473 ! ! ==================== 474 ! 475 IF(lwp) WRITE(numout,*) 476 IF(lwp) WRITE(numout,*) 'zgr_bat : Parobolic bowl' 477 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 478 ! 479 DO ji = 1, jpidta 480 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, -2.0 ) 481 DO jj = 1, jpjdta 482 zj = MAX(1.0-FLOAT((jj-17)**2)/196.0, -2.0 ) 483 zdta(ji,jj) = MAX(rn_bathy*zi*zj, -2.0) 484 END DO 485 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 486 END DO 487 zdta(1:2,:) = -2._wp 488 zdta(jpidta-1:jpidta,:) = -2._wp 489 zdta(:,1) = -2._wp 490 zdta(:,jpjdta) = -2._wp 491 zdta(:,1:3) = -2._wp 492 zdta(:,jpjdta-2:jpjdta) = -2._wp 493 ! ! =========================== 494 CASE ( 5 ) ! WAD 5 configuration 495 ! ! ==================== 496 ! 497 IF(lwp) WRITE(numout,*) 498 IF(lwp) WRITE(numout,*) 'zgr_bat : Double slope with shelf' 499 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 500 ! 501 DO ji = 1, jpidta 502 zi = MIN(FLOAT(ji)/FLOAT(jpidta - 5), 1.0 ) 503 zdta(ji,:) = MAX(rn_bathy*zi, 0.5) 504 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 505 END DO 506 DO ji = jpidta,46,-1 507 zdta(ji,:) = 10.0 508 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 509 END DO 510 DO ji = 46,20,-1 511 zi = 7.5/25. 512 zdta(ji,:) = MAX(10. - zi*(47.-ji),2.5) 513 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 514 END DO 515 DO ji = 19,15,-1 516 zdta(ji,:) = 2.5 517 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 518 END DO 519 DO ji = 15,4,-1 520 zi = 2.0/11.0 521 zdta(ji,:) = MAX(2.5 - zi*(16-ji), 0.5) 522 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 523 END DO 524 DO ji = 4,1,-1 525 zdta(ji,:) = 0.5 526 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 527 END DO 528 ! ! =========================== 529 zdta(1:2,:) = -4._wp 530 zdta(jpidta-1:jpidta,:) = -4._wp 531 zdta(:,1) = -4._wp 532 zdta(:,jpjdta) = -4._wp 533 zdta(:,1:3) = -4._wp 534 zdta(:,jpjdta-2:jpjdta) = -4._wp 535 ! ! =========================== 536 CASE ( 6 ) ! WAD 6 configuration 537 ! ! ==================== 538 ! 539 IF(lwp) WRITE(numout,*) 540 IF(lwp) WRITE(numout,*) 'zgr_bat : Parabolic channel with gaussian ridge' 541 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 542 ! 543 DO ji = 1, jpidta 544 zi = MAX(1.0-FLOAT((ji-25)**2)/484.0, -2.0 ) 545 zj = 0.95*MAX(EXP(-1.0*FLOAT((ji-25)**2)/32.0) , 0.0 ) 546 zdta(ji,:) = MAX(rn_bathy*(zi-zj), -2.0) 547 IF(lwp)write(numout,*) 'ZDTA ',ji,zi,zdta(ji,1) 548 END DO 549 zdta(1:2,:) = -4._wp 550 zdta(jpidta-1:jpidta,:) = -4._wp 551 zdta(:,1) = -4._wp 552 zdta(:,jpjdta) = -4._wp 553 zdta(:,1:3) = -4._wp 554 zdta(:,jpjdta-2:jpjdta) = -4._wp 555 ! ! =========================== 556 CASE DEFAULT 557 ! ! =========================== 558 WRITE(ctmp1,*) 'WAD test with a ', jp_cfg,' option is not coded' 559 ! 560 CALL ctl_stop( ctmp1 ) 561 ! 562 END SELECT 563 END IF 564 ! 423 565 IF( ln_sco ) THEN ! s-coordinate (zsc ): idta()=jpk 424 566 idta(:,:) = jpkm1 … … 2193 2335 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 2194 2336 ! 2195 IF( .NOT.ln_wd ) THEN 2196 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2197 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2198 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2199 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2200 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2201 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2202 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2203 END IF 2337 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp 2338 WHERE( e3u_0 (:,:,:) == 0._wp ) e3u_0 (:,:,:) = 1._wp 2339 WHERE( e3v_0 (:,:,:) == 0._wp ) e3v_0 (:,:,:) = 1._wp 2340 WHERE( e3f_0 (:,:,:) == 0._wp ) e3f_0 (:,:,:) = 1._wp 2341 WHERE( e3w_0 (:,:,:) == 0._wp ) e3w_0 (:,:,:) = 1._wp 2342 WHERE( e3uw_0(:,:,:) == 0._wp ) e3uw_0(:,:,:) = 1._wp 2343 WHERE( e3vw_0(:,:,:) == 0._wp ) e3vw_0(:,:,:) = 1._wp 2204 2344 2205 2345 #if defined key_agrif … … 2303 2443 DO jk = 1, mbathy(ji,jj) 2304 2444 ! check coordinate is monotonically increasing 2305 IF (e3w_ n(ji,jj,jk) <= 0._wp .OR. e3t_n(ji,jj,jk) <= 0._wp ) THEN2445 IF (e3w_0(ji,jj,jk) <= 0._wp .OR. e3t_0(ji,jj,jk) <= 0._wp ) THEN 2306 2446 WRITE(ctmp1,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2307 2447 WRITE(numout,*) 'ERROR zgr_sco : e3w or e3t =< 0 at point (i,j,k)= ', ji, jj, jk 2308 WRITE(numout,*) 'e3w',e3w_ n(ji,jj,:)2309 WRITE(numout,*) 'e3t',e3t_ n(ji,jj,:)2448 WRITE(numout,*) 'e3w',e3w_0(ji,jj,:) 2449 WRITE(numout,*) 'e3t',e3t_0(ji,jj,:) 2310 2450 CALL ctl_stop( ctmp1 ) 2311 2451 ENDIF 2312 2452 ! and check it has never gone negative 2313 IF( gdepw_ n(ji,jj,jk) < 0._wp .OR. gdept_n(ji,jj,jk) < 0._wp ) THEN2453 IF( gdepw_0(ji,jj,jk) < 0._wp .OR. gdept_0(ji,jj,jk) < 0._wp ) THEN 2314 2454 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2315 2455 WRITE(numout,*) 'ERROR zgr_sco : gdepw or gdept =< 0 at point (i,j,k)= ', ji, jj, jk 2316 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2317 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2456 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2457 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2318 2458 CALL ctl_stop( ctmp1 ) 2319 2459 ENDIF 2320 2460 ! and check it never exceeds the total depth 2321 IF( gdepw_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2461 IF( gdepw_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2322 2462 WRITE(ctmp1,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2323 2463 WRITE(numout,*) 'ERROR zgr_sco : gdepw > hbatt at point (i,j,k)= ', ji, jj, jk 2324 WRITE(numout,*) 'gdepw',gdepw_ n(ji,jj,:)2464 WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:) 2325 2465 CALL ctl_stop( ctmp1 ) 2326 2466 ENDIF … … 2329 2469 DO jk = 1, mbathy(ji,jj)-1 2330 2470 ! and check it never exceeds the total depth 2331 IF( gdept_ n(ji,jj,jk) > hbatt(ji,jj) ) THEN2471 IF( gdept_0(ji,jj,jk) > hbatt(ji,jj) ) THEN 2332 2472 WRITE(ctmp1,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2333 2473 WRITE(numout,*) 'ERROR zgr_sco : gdept > hbatt at point (i,j,k)= ', ji, jj, jk 2334 WRITE(numout,*) 'gdept',gdept_ n(ji,jj,:)2474 WRITE(numout,*) 'gdept',gdept_0(ji,jj,:) 2335 2475 CALL ctl_stop( ctmp1 ) 2336 2476 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
