Changeset 6986
- Timestamp:
- 2016-10-04T17:46:55+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6393_NOC_WAD/NEMOGCM
- Files:
-
- 18 added
- 9 edited
-
ARCH/arch-THALASSA.fcm (added)
-
CONFIG/WAD_TEST_CASES (added)
-
CONFIG/WAD_TEST_CASES/EXP00 (added)
-
CONFIG/WAD_TEST_CASES/EXP00/README.py (added)
-
CONFIG/WAD_TEST_CASES/EXP00/domain_def.xml (added)
-
CONFIG/WAD_TEST_CASES/EXP00/field_def.xml (added)
-
CONFIG/WAD_TEST_CASES/EXP00/iodef.xml (added)
-
CONFIG/WAD_TEST_CASES/EXP00/matpoly2.py (added)
-
CONFIG/WAD_TEST_CASES/EXP00/namelist_cfg (added)
-
CONFIG/WAD_TEST_CASES/EXP00/namelist_ref (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC/domwri.F90 (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC/dynadv_cen2.F90 (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC/dynadv_ubs.F90 (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC/dynzdf_imp.F90 (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC/iom.F90 (added)
-
CONFIG/WAD_TEST_CASES/MY_SRC/traadv_fct.F90 (added)
-
CONFIG/WAD_TEST_CASES/cpp_WAD_TEST_CASES.fcm (added)
-
CONFIG/cfg.txt (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domain.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DOM/domvvl.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DOM/istate.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DYN/dynspg.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DYN/sshwzv.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/wet_dry.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/CONFIG/cfg.txt
r6140 r6986 11 11 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 12 12 GYRE OPA_SRC 13 WAD_TEST_CASES OPA_SRC -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r6140 r6986 105 105 IF( ln_linssh ) THEN ! Fix in time : set to the reference one for all 106 106 ! before ! now ! after ! 107 ;gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points108 ;gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- !109 ; ;gde3w_n = gde3w_0 ! --- !107 gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points 108 gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- ! 109 gde3w_n = gde3w_0 ! --- ! 110 110 ! 111 ;e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors112 ;e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 !113 ;e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 !114 ; ;e3f_n = e3f_0 ! --- !115 ;e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- !116 ;e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- !117 ;e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- !111 e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors 112 e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! 113 e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 ! 114 e3f_n = e3f_0 ! --- ! 115 e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 116 e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 117 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 118 118 ! 119 119 CALL wrk_alloc( jpi,jpj, z1_hu_0, z1_hv_0 ) … … 123 123 ! 124 124 ! before ! now ! after ! 125 ; ;ht_n = ht_0 ! ! water column thickness126 ;hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 !127 ;hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 !128 ;r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness129 ;r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 !125 ht_n = ht_0 ! ! water column thickness 126 hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 ! 127 hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 ! 128 r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness 129 r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 ! 130 130 ! 131 131 CALL wrk_dealloc( jpi,jpj, z1_hu_0, z1_hv_0 ) -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6351 r6986 874 874 ! 875 875 ELSE !* Initialize at "rest" 876 e3t_b(:,:,:) = e3t_0(:,:,:) 877 e3t_n(:,:,:) = e3t_0(:,:,:) 878 sshn(:,:) = 0.0_wp 879 880 IF( ln_wd ) THEN 876 ! 877 IF( ln_wd .AND. ( cp_cfg == 'wad' ) ) THEN 878 ! 879 CALL wad_istate ! WAD test configuration : start from 880 ! uniform T-S fields and initial ssh slope 881 ! needs to be called here and in istate which is called later. 882 ! Adjust vertical metrics 883 DO jk = 1, jpk 884 e3t_n(:,:,jk) = e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 885 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 886 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 887 END DO 888 e3t_b(:,:,:) = e3t_n(:,:,:) 889 ! 890 ELSEIF( ln_wd ) THEN 891 ! 881 892 DO jj = 1, jpj 882 893 DO ji = 1, jpi 883 894 IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1 ) THEN 884 e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 885 e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 886 e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 895 e3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 896 e3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 897 e3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 887 898 sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj) 888 899 sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj) … … 891 902 ENDDO 892 903 ENDDO 904 ! 905 ELSE 906 ! 907 e3t_b(:,:,:) = e3t_0(:,:,:) 908 e3t_n(:,:,:) = e3t_0(:,:,:) 909 sshn(:,:) = 0.0_wp 910 ! 893 911 END IF 894 912 -
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 -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r6140 r6986 36 36 USE domvvl ! varying vertical mesh 37 37 USE iscplrst ! ice sheet coupling 38 USE wet_dry ! wetting and drying (needed for wad_istate) 38 39 ! 39 40 USE in_out_manager ! I/O manager … … 105 106 ELSEIF( cp_cfg == 'gyre' ) THEN 106 107 CALL istate_gyre ! GYRE configuration : start from pre-defined T-S fields 108 ELSEIF( cp_cfg == 'wad' ) THEN 109 CALL wad_istate ! WAD test configuration : start from pre-defined T-S fields and initial ssh slope 107 110 ELSE ! Initial T-S, U-V fields read in files 108 111 IF ( ln_tsd_init ) THEN ! read 3D T and S data at nit000 -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r6140 r6986 205 205 ENDIF 206 206 ! ! Control of surface pressure gradient scheme options 207 ;nspg = np_NO ; ioptio = 0207 nspg = np_NO ; ioptio = 0 208 208 IF( ln_dynspg_exp ) THEN ; nspg = np_EXP ; ioptio = ioptio + 1 ; ENDIF 209 209 IF( ln_dynspg_ts ) THEN ; nspg = np_TS ; ioptio = ioptio + 1 ; ENDIF -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r6678 r6986 705 705 706 706 IF(ln_wd) THEN 707 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) * wdmask(:,:) 708 & + (1._wd - wdmask(:,:)) * (sshai(:,:) - sshn_e(:,:))) * ssmask(:,:)707 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) * wdmask(:,:) & 708 & + ( 1._wp - wdmask(:,:) ) * ( sshai(:,:) - sshn_e(:,:) ) ) * ssmask(:,:) 709 709 ELSE 710 710 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) … … 1008 1008 ! ! Sum sea level 1009 1009 ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 1010 IF(ln_wd) ssha(:,:) = ssha(:,:) * (1 - wdmask(:,:)) + sshai(:,:) * wdmask(:,:)1010 IF(ln_wd) ssha(:,:) = ssha(:,:) * wdmask(:,:) + (1._wp - wdmask(:,:)) * sshai(:,:) 1011 1011 ! ! ==================== ! 1012 1012 END DO ! end loop ! -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r6604 r6986 88 88 ENDIF 89 89 ! 90 90 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 91 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 92 zcoef = 0.5_wp * r1_rau0 93 94 ! !------------------------------! 95 ! ! After Sea Surface Height ! 96 ! !------------------------------! 91 97 IF(ln_wd) THEN 92 zcoef = 0.5_wp * r1_rau0 93 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 94 END IF 95 96 CALL div_hor( kt ) ! Horizontal divergence 97 ! 98 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 99 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 100 101 ! !------------------------------! 102 ! ! After Sea Surface Height ! 103 ! !------------------------------! 98 CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 99 ENDIF 100 101 CALL div_hor( kt ) ! Horizontal divergence 102 ! 104 103 zhdiv(:,:) = 0._wp 105 104 DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports -
branches/2016/dev_r6393_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/wet_dry.F90
r6678 r6986 46 46 PUBLIC wad_lmt ! routine called by sshwzv.F90 47 47 PUBLIC wad_lmt_bt ! routine called by dynspg_ts.F90 48 PUBLIC wad_istate ! routine called by istate.F90 and domvvl.F90 48 49 49 50 !! * Substitutions … … 132 133 133 134 zflag = 0 134 zdepwd = 150._wp !maximum depth on which that W/D could possibly happen135 zdepwd = 50._wp !maximum depth on which that W/D could possibly happen 135 136 136 137 … … 156 157 zflxv(:,:) = zflxv(:,:) * e1v(:,:) 157 158 159 wdmask(:,:) = 1 158 160 DO jj = 2, jpjm1 159 161 DO ji = 2, jpim1 … … 168 170 169 171 zdep2 = bathy(ji,jj) + sshb1(ji,jj) - rn_wdmin1 170 IF(zdep2 <0._wp) THEN !add more safty, but not necessary172 IF(zdep2 .le. 0._wp) THEN !add more safty, but not necessary 171 173 !zdep2 = 0._wp 172 174 sshb1(ji,jj) = rn_wdmin1 - bathy(ji,jj) 175 wdmask(ji,jj) = 0._wp 173 176 END IF 174 177 ENDDO … … 186 189 DO ji = 2, jpim1 187 190 188 wdmask(ji,jj) = 0189 191 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 190 192 IF(bathy(ji,jj) > zdepwd) CYCLE … … 201 203 202 204 IF(zdep1 > zdep2) THEN 203 IF(jk1 .eq. 1) wdmask(ji,jj) = 1204 205 zflag = 1 206 wdmask(ji, jj) = 0 205 207 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 206 208 zcoef = max(zcoef, 0._wp) … … 231 233 CALL lbc_lnk( un, 'U', -1. ) 232 234 CALL lbc_lnk( vn, 'V', -1. ) 235 ! 236 un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 237 vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 238 CALL lbc_lnk( un_b, 'U', -1. ) 239 CALL lbc_lnk( vn_b, 'V', -1. ) 233 240 234 241 IF(zflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!' … … 390 397 IF( nn_timing == 1 ) CALL timing_stop('wad_lmt') 391 398 END SUBROUTINE wad_lmt_bt 399 400 SUBROUTINE wad_istate 401 !!---------------------------------------------------------------------- 402 !! *** ROUTINE wad_istate *** 403 !! 404 !! ** Purpose : Initialization of the dynamics and tracers for WAD test 405 !! configurations (channels or bowls with initial ssh gradients) 406 !! 407 !! ** Method : - set temperature field 408 !! - set salinity field 409 !! - set ssh slope (needs to be repeated in domvvl_rst_init to 410 !! set vertical metrics ) 411 !!---------------------------------------------------------------------- 412 ! 413 INTEGER :: ji, jj ! dummy loop indices 414 !!---------------------------------------------------------------------- 415 ! 416 ! Uniform T & S in all test cases 417 tsn(:,:,:,jp_tem) = 10._wp 418 tsb(:,:,:,jp_tem) = 10._wp 419 tsn(:,:,:,jp_sal) = 35._wp 420 tsb(:,:,:,jp_sal) = 35._wp 421 SELECT CASE ( jp_cfg ) 422 ! ! ==================== 423 CASE ( 1 ) ! WAD 1 configuration 424 ! ! ==================== 425 ! 426 IF(lwp) WRITE(numout,*) 427 IF(lwp) WRITE(numout,*) 'istate_wad : Closed box with EW linear bottom slope' 428 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 429 ! 430 do ji = 1,jpi 431 sshn(ji,:) = ( -5.5_wp + 5.5_wp*FLOAT(mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 432 end do 433 ! ! ==================== 434 CASE ( 2 ) ! WAD 2 configuration 435 ! ! ==================== 436 ! 437 IF(lwp) WRITE(numout,*) 438 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, mid-range initial ssh slope' 439 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 440 ! 441 do ji = 1,jpi 442 sshn(ji,:) = ( -5.5_wp + 3.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 443 end do 444 ! ! ==================== 445 CASE ( 3 ) ! WAD 3 configuration 446 ! ! ==================== 447 ! 448 IF(lwp) WRITE(numout,*) 449 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic EW channel, extreme initial ssh slope' 450 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 451 ! 452 do ji = 1,jpi 453 sshn(ji,:) = ( -7.5_wp + 6.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 454 end do 455 456 ! 457 ! ! ==================== 458 CASE ( 4 ) ! WAD 4 configuration 459 ! ! ==================== 460 ! 461 IF(lwp) WRITE(numout,*) 462 IF(lwp) WRITE(numout,*) 'istate_wad : Parobolic bowl, mid-range initial ssh slope' 463 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 464 ! 465 do ji = 1,jpi 466 sshn(ji,:) = ( -5.5_wp + 3.9_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 467 ! very small displacement test: 468 !sshn(ji,:) = ( -0.05_wp + 0.05_wp*FLOAT(jpidta - mig(ji))/FLOAT(jpidta-1))*tmask(ji,:,1) 469 end do 470 471 ! 472 ! ! =========================== 473 CASE DEFAULT ! NONE existing configuration 474 ! ! =========================== 475 WRITE(ctmp1,*) 'WAD test with a ', jp_cfg,' option is not coded' 476 ! 477 CALL ctl_stop( ctmp1 ) 478 ! 479 END SELECT 480 ! 481 ! Apply minimum wetdepth criterion 482 ! 483 do jj = 1,jpj 484 do ji = 1,jpi 485 IF( bathy(ji,jj) + sshn(ji,jj) < 0.4_wp) THEN 486 sshn(ji,jj) = tmask(ji,jj,1)*(0.4_wp - bathy(ji,jj)) 487 ENDIF 488 end do 489 end do 490 sshb = sshn 491 ssha = sshn 492 ! 493 END SUBROUTINE wad_istate 494 495 !!===================================================================== 392 496 END MODULE wet_dry
Note: See TracChangeset
for help on using the changeset viewer.
