Changeset 5727
- Timestamp:
- 2015-09-10T19:05:13+02:00 (9 years ago)
- Location:
- branches/UKMO/2014_Surge_Modelling/NEMOGCM
- Files:
-
- 12 edited
-
CONFIG/AMM7_SURGE/EXP00/namelist_cfg (modified) (1 diff)
-
CONFIG/AMM7_SURGE/EXP00/namelist_ref (modified) (1 diff)
-
NEMO/OPA_SRC/DOM/domvvl.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/DOM/domzgr.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynhpg.F90 (modified) (8 diffs)
-
NEMO/OPA_SRC/DYN/dynkeg.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynldf_bilap.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/DYN/dynspg.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (8 diffs)
-
NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/DYN/dynzad.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/wadlmt.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/2014_Surge_Modelling/NEMOGCM/CONFIG/AMM7_SURGE/EXP00/namelist_cfg
r5275 r5727 402 402 !----------------------------------------------------------------------- 403 403 / 404 !----------------------------------------------------------------------- 405 &namwad ! Wetting and Drying namelist 406 !----------------------------------------------------------------------- 407 ln_wd = .false. !: key to turn on/off wetting/drying (T: on, F: off) 408 rn_wdmin1=0.1 !: minimum water depth on dried cells 409 rn_wdmin2 = 0.01 !: tolerrance of minimum water depth on dried cells 410 rn_wdld = 20.0 !: land elevation below which wetting/drying will be considered 411 nn_wdit = 10 !: maximum number of iteration for W/D limiter 412 / -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/CONFIG/AMM7_SURGE/EXP00/namelist_ref
r5275 r5727 1179 1179 rn_htrmax = 200.0 ! max. depth of transition range 1180 1180 / 1181 !----------------------------------------------------------------------- 1182 &namwad ! Wetting and Drying namelist 1183 !----------------------------------------------------------------------- 1184 ln_wd = .false. !: key to turn on/off wetting/drying (T: on, F: off) 1185 rn_wdmin1=0.1 !: minimum water depth on dried cells 1186 rn_wdmin2 = 0.01 !: tolerrance of minimum water depth on dried cells 1187 rn_wdld = 20.0 !: land elevation below which wetting/drying will be considered 1188 nn_wdit = 10 !: maximum number of iteration for W/D limiter 1189 / -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5066 r5727 145 145 fse3t_a(:,:,jpk) = e3t_0(:,:,jpk) 146 146 147 IF(ln_wd) THEN 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 151 fse3t_a(ji,jj,1:2) = 0.5_wp * rn_wdmin1 152 END IF 153 ENDDO 154 ENDDO 155 END IF 147 ! IF(ln_wd) THEN 148 ! DO jj = 1, jpj 149 ! DO ji = 1, jpi 150 ! IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 151 ! fse3t_a(ji,jj,1:2) = 0.5_wp * rn_wdmin1 152 ! fse3t_n(ji,jj,1:2) = 0.5_wp * rn_wdmin1 153 ! fse3t_b(ji,jj,1:2) = 0.5_wp * rn_wdmin1 154 ! END IF 155 ! ENDDO 156 ! ENDDO 157 ! END IF 156 158 157 159 ! Reconstruction of all vertical scale factors at now and before time steps … … 703 705 DO jj = 1, jpjm1 704 706 DO ji = 1, fs_jpim1 ! vector opt. 705 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj) & 707 ! pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj) & 708 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj) & 706 709 & * ( e12t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 707 710 & + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) … … 721 724 DO jj = 1, jpjm1 722 725 DO ji = 1, fs_jpim1 ! vector opt. 723 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 724 & * ( e12t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 725 & + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 726 ! pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 727 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 728 & * ( e12t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 729 & + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 726 730 END DO 727 731 END DO … … 739 743 DO jj = 1, jpjm1 740 744 DO ji = 1, fs_jpim1 ! vector opt. 741 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) & 745 ! pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) & 746 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) & 747 & * r1_e12f(ji,jj) & 742 748 & * ( e12u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 743 749 & + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) … … 882 888 DO ji = 1, jpi 883 889 !IF(e3t_0(ji,jj,1) < 0._wp) THEN 884 IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 885 fse3t_b(ji,jj,1:2) = 0.5_wp * rn_wdmin1 886 fse3t_n(ji,jj,1:2) = 0.5_wp * rn_wdmin1 890 !IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 891 IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 892 fse3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 893 fse3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 894 fse3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 887 895 sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj) 888 896 sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj) 897 ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj) 889 898 ENDIF 890 899 ENDDO -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5066 r5727 300 300 zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d ) ! ref. depth with tolerance (10% of minimum layer thickness) 301 301 nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m 302 nlb10 = MAX(nlb10, 2) ! prevent nla10 = 0 302 303 nla10 = nlb10 - 1 ! deepest W level Above ~10m 303 304 !!gm end bug -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r5066 r5727 395 395 DO jj = 2, jpjm1 396 396 DO ji = 2, jpim1 397 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 398 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 397 IF ( tmask(ji+1,jj,1) == 0._wp) THEN 398 zcpx(ji,jj) = 1.0_wp 399 ELSE 400 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 401 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 402 & rn_wdmin1 + rn_wdmin2 403 404 IF(ll_tmp1) THEN 405 zcpx(ji,jj) = 1.0_wp 406 ELSE IF(ll_tmp2) THEN 407 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 408 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 409 & (sshn(ji+1,jj) - sshn(ji,jj))) 410 ELSE 411 zcpx(ji,jj) = 0._wp 412 END IF 413 ENDIF 414 415 IF ( tmask(ji,jj+1,1) == 0._wp) THEN 416 zcpy(ji,jj) = 1.0_wp 417 ELSE 418 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 419 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 399 420 & rn_wdmin1 + rn_wdmin2 400 421 401 IF(ll_tmp1) THEN 402 zcpx(ji,jj) = 1.0_wp 403 ELSE IF(ll_tmp2) THEN 404 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 405 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 406 & (sshn(ji+1,jj) - sshn(ji,jj))) 407 ELSE 408 zcpx(ji,jj) = 0._wp 409 END IF 410 411 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 412 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 413 & rn_wdmin1 + rn_wdmin2 414 415 IF(ll_tmp1) THEN 416 zcpy(ji,jj) = 1.0_wp 417 ELSE IF(ll_tmp2) THEN 418 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 419 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 420 & (sshn(ji,jj+1) - sshn(ji,jj))) 421 ELSE 422 zcpy(ji,jj) = 0._wp 423 END IF 422 IF(ll_tmp1) THEN 423 zcpy(ji,jj) = 1.0_wp 424 ELSE IF(ll_tmp2) THEN 425 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 426 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 427 & (sshn(ji,jj+1) - sshn(ji,jj))) 428 ELSE 429 zcpy(ji,jj) = 0._wp 430 END IF 431 ENDIF 424 432 END DO 425 433 END DO … … 450 458 451 459 ! add to the general momentum trend 452 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap453 va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap460 ua(ji,jj,1) = ua(ji,jj,1) + ( zhpi(ji,jj,1) + zuap ) * umask(ji,jj,1) 461 va(ji,jj,1) = va(ji,jj,1) + ( zhpj(ji,jj,1) + zvap ) * vmask(ji,jj,1) 454 462 END DO 455 463 END DO … … 480 488 481 489 ! add to the general momentum trend 482 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap483 va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap490 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zhpi(ji,jj,jk) + zuap ) * umask(ji,jj,jk) 491 va(ji,jj,jk) = va(ji,jj,jk) + ( zhpj(ji,jj,jk) + zvap ) * vmask(ji,jj,jk) 484 492 END DO 485 493 END DO … … 546 554 #endif 547 555 ! 556 548 557 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 549 558 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) … … 852 861 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 853 862 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 863 REAL(wp), POINTER, DIMENSION(:,:) :: sshu_n, sshv_n 854 864 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 855 865 !!---------------------------------------------------------------------- … … 857 867 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 858 868 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 869 CALL wrk_alloc( jpi,jpj, sshu_n, sshv_n ) 859 870 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 860 871 ! … … 967 978 968 979 ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 980 981 ! The following modification "sshu_n -> sshn" is a big mistake, this 982 ! should never happen here, remember to correct this in NEMO v3.6 983 ! trunk. H.L. 984 985 !prepare sshu_n and sshv_n 986 DO jj = 1, jpjm1 987 DO ji = 1, jpim1 988 sshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * & 989 & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp 990 sshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * & 991 & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 992 END DO 993 END DO 994 995 CALL lbc_lnk (sshu_n, 'U', 1.) 996 CALL lbc_lnk (sshv_n, 'V', 1.) 997 969 998 DO jj = 2, jpjm1 970 999 DO ji = 2, jpim1 971 zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad) ! probable bug: changed from sshu_n for ztilde compilation 972 zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad) ! probable bug: changed from sshv_n for ztilde compilation 1000 ! zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad) ! probable bug: changed from sshu_n for ztilde compilation 1001 ! zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad) ! probable bug: changed from sshv_n for ztilde compilation 1002 zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad) 1003 zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_n(ji,jj) * znad) 973 1004 END DO 974 1005 END DO … … 1139 1170 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 1140 1171 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 1172 CALL wrk_dealloc( jpi,jpj, sshu_n, sshv_n ) 1141 1173 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 1142 1174 ! -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r3294 r5727 99 99 DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends 100 100 DO ji = fs_2, fs_jpim1 ! vector opt. 101 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 102 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 101 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) * umask(ji,jj,jk) 102 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) * vmask(ji,jj,jk) 103 103 END DO 104 104 END DO -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r3634 r5727 144 144 145 145 ! Multiply by the eddy viscosity coef. (at u- and v-points) 146 zlu(:,:,jk) = zlu(:,:,jk) * ( fsahmu(:,:,jk) * (1-nkahm_smag) + nkahm_smag) 147 148 zlv(:,:,jk) = zlv(:,:,jk) * ( fsahmv(:,:,jk) * (1-nkahm_smag) + nkahm_smag) 146 zlu(:,:,jk) = zlu(:,:,jk) * ( fsahmu(:,:,jk) * (1-nkahm_smag) + nkahm_smag) * umask(:,:,jk) 147 148 zlv(:,:,jk) = zlv(:,:,jk) * ( fsahmv(:,:,jk) * (1-nkahm_smag) + nkahm_smag) * vmask(:,:,jk) 149 149 150 150 ! Contravariant "laplacian" … … 174 174 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 175 175 zut(ji,jj,jk) = ( zlu(ji,jj,jk) - zlu(ji-1,jj ,jk) & 176 & + zlv(ji,jj,jk) - zlv(ji ,jj-1,jk) ) / zbt 176 & + zlv(ji,jj,jk) - zlv(ji ,jj-1,jk) ) / zbt * tmask(ji,jj,jk) 177 177 END DO 178 178 END DO … … 201 201 & + ( zut(ji,jj+1,jk) - zut(ji ,jj,jk) ) / e2v(ji,jj) 202 202 ! add it to the general momentum trends 203 ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 204 va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 203 ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) * umask(ji,jj,jk) 204 va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) * vmask(ji,jj,jk) 205 205 END DO 206 206 END DO -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r4496 r5727 159 159 DO jj = 2, jpjm1 160 160 DO ji = fs_2, fs_jpim1 ! vector opt. 161 ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 162 va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 161 ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) * umask(ji,jj,jk) 162 va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) * vmask(ji,jj,jk) 163 163 END DO 164 164 END DO -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5066 r5727 371 371 ! !* Right-Hand-Side of the barotropic momentum equation 372 372 ! ! ---------------------------------------------------- 373 373 374 IF( lk_vvl ) THEN ! Variable volume : remove surface pressure gradient 374 375 IF(ln_wd) THEN ! Calculating and applying W/D gravity filters 375 376 DO jj = 2, jpjm1 376 377 DO ji = 2, jpim1 377 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 378 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) + & 378 IF ( tmask(ji+1,jj,1) == 0._wp ) THEN 379 zcpx = 1._wp 380 ELSE 381 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji+1,jj)*tmask(ji+1,jj,1)) & 382 & .and. MAX(sshn(ji,jj) + bathy(ji,jj)*tmask(ji,jj,1), sshn(ji+1,jj) + bathy(ji+1,jj)*tmask(ji+1,jj,1)) & 383 & > rn_wdmin1 + rn_wdmin2 384 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji+1,jj)*tmask(ji+1,jj,1)) + & 379 385 & rn_wdmin1 + rn_wdmin2 380 IF(ll_tmp1) THEN 381 zcpx(ji,jj) = 1.0_wp 382 ELSE IF(ll_tmp2) THEN 383 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 384 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 385 & (sshn(ji+1,jj) - sshn(ji,jj))) 386 IF(ll_tmp1) THEN 387 zcpx(ji,jj) = 1.0_wp 388 ELSE IF(ll_tmp2) THEN 389 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 390 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj)*tmask(ji+1,jj,1) - sshn(ji,jj) - bathy(ji,jj)*tmask(ji,jj,1)) /& 391 & (sshn(ji+1,jj) - sshn(ji,jj))) 392 ELSE 393 zcpx(ji,jj) = 0._wp 394 END IF 395 ENDIF 396 397 IF ( tmask(ji,jj+1,1) == 0._wp ) THEN 398 zcpy = 1._wp 386 399 ELSE 387 zcpx(ji,jj) = 0._wp388 END IF389 390 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1))391 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) + &392 & rn_wdmin1 + rn_wdmin2393 IF(ll_tmp1) THEN394 zcpy(ji,jj) = 1.0_wp395 ELSE IF(ll_tmp2) THEN396 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here397 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) + bathy(ji,jj)) /&398 & (sshn(ji,jj+1) - sshn(ji,jj)))399 ELSE400 zcpy(ji,jj) = 0._wp401 END 400 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji,jj+1)*tmask(ji,jj+1,1)) & 401 & .and. MAX(sshn(ji,jj) + bathy(ji,jj)*tmask(ji,jj,1), sshn(ji,jj+1) + bathy(ji,jj+1)*tmask(ji,jj+1,1)) & 402 & > rn_wdmin1 + rn_wdmin2 403 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji,jj+1)*tmask(ji,jj+1,1)) + & 404 & rn_wdmin1 + rn_wdmin2 405 IF(ll_tmp1) THEN 406 zcpy(ji,jj) = 1.0_wp 407 ELSE IF(ll_tmp2) THEN 408 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 409 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1)*tmask(ji,jj+1,1) - sshn(ji,jj) - bathy(ji,jj)*tmask(ji,jj,1)) /& 410 & (sshn(ji,jj+1) - sshn(ji,jj))) 411 ELSE 412 zcpy(ji,jj) = 0._wp 413 END IF 414 ENDIF 402 415 END DO 403 416 END DO … … 453 466 ! 454 467 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 455 zu_frc(:,:) = zu_frc(:,:) + hur(:,:) * bfrua(:,:) * zwx(:,:) 456 zv_frc(:,:) = zv_frc(:,:) + hvr(:,:) * bfrva(:,:) * zwy(:,:) 468 IF(ln_wd) THEN 469 zu_frc(:,:) = zu_frc(:,:) + MAX(hur(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 470 zv_frc(:,:) = zv_frc(:,:) + MAX(hvr(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 471 ELSE 472 zu_frc(:,:) = zu_frc(:,:) + hur(:,:) * bfrua(:,:) * zwx(:,:) 473 zv_frc(:,:) = zv_frc(:,:) + hvr(:,:) * bfrva(:,:) * zwy(:,:) 474 END IF 457 475 ! 458 476 IF (ln_bt_fw) THEN ! Add wind forcing … … 518 536 IF(ln_wd) THEN !preserve the positivity of water depth 519 537 !ssh[b,n,a] should have already been processed for this 520 sshbb_e(:,: ) = MAX(sshbb_e(:,:), rn_wdmin1 - bathy(:,:))521 sshb_e(:,: ) = MAX(sshb_e(:,:) , rn_wdmin1 - bathy(:,:))538 sshbb_e(:,:jj) = MAX( sshbb_e(:,:), (rn_wdmin1 - bathy(:,:)) ) *tmask(:,:,1) 539 sshb_e(:,:jj) = MAX( sshb_e(:,:) , (rn_wdmin1 - bathy(:,:)) ) *tmask(:,:,1) 522 540 ENDIF 523 541 … … 637 655 ENDIF 638 656 #endif 657 639 658 IF(ln_wd) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt) 640 659 ! … … 652 671 END DO 653 672 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1) 654 IF(ln_wd) ssha_e(:,:) = MAX(ssha_e(:,:), rn_wdmin1 - bathy(:,:))673 IF(ln_wd) ssha_e(:,:) = MAX(ssha_e(:,:), (rn_wdmin1 - bathy(:,:)) ) * tmask(:,:,1) 655 674 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 656 675 … … 785 804 ! 786 805 ! Add bottom stresses: 787 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * zun_e(:,:) * hur_e(:,:) 788 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * zvn_e(:,:) * hvr_e(:,:) 789 ! 806 IF(ln_wd) THEN 807 zu_trd(:,:) = zu_trd(:,:) + MAX(bfrua(:,:) * hur_e(:,:), -1._wp / rdtbt) * zun_e(:,:) 808 zv_trd(:,:) = zv_trd(:,:) + MAX(bfrva(:,:) * hvr_e(:,:), -1._wp / rdtbt) * zvn_e(:,:) 809 ELSE 810 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * zun_e(:,:) * hur_e(:,:) 811 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * zvn_e(:,:) * hvr_e(:,:) 812 END IF 813 790 814 IF(ln_wd) THEN ! Calculating and applying W/D gravity filters 791 815 DO jj = 2, jpjm1 792 816 DO ji = 2, jpim1 793 ll_tmp1 = MIN(zsshp2_e(ji,jj), zsshp2_e(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 794 ll_tmp2 = MAX(zsshp2_e(ji,jj), zsshp2_e(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) + & 817 IF ( tmask(ji+1,jj,1) == 0._wp ) THEN 818 zcpx = 1._wp 819 ELSE 820 ll_tmp1 = MIN(zsshp2_e(ji,jj), zsshp2_e(ji+1,jj)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji+1,jj)*tmask(ji+1,jj,1)) & 821 & .and. MAX(zsshp2_e(ji,jj) + bathy(ji,jj)*tmask(ji,jj,1), zsshp2_e(ji+1,jj) + bathy(ji+1,jj)*tmask(ji+1,jj,1)) & 822 & > rn_wdmin1 + rn_wdmin2 823 ll_tmp2 = MAX(zsshp2_e(ji,jj), zsshp2_e(ji+1,jj)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji+1,jj)*tmask(ji+1,jj,1)) + & 795 824 & rn_wdmin1 + rn_wdmin2 796 IF(ll_tmp1) THEN 797 zcpx(ji,jj) = 1.0_wp 798 ELSE IF(ll_tmp2) THEN 799 ! no worries about zsshp2_e(ji+1,jj)-zsshp2_e(ji,jj) = 0, it won't happen ! here 800 zcpx(ji,jj) = ABS((zsshp2_e(ji+1,jj) + bathy(ji+1,jj) - zsshp2_e(ji,jj) - bathy(ji,jj)) /& 801 & (zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj))) 825 IF(ll_tmp1) THEN 826 zcpx(ji,jj) = 1.0_wp 827 ELSE IF(ll_tmp2) THEN 828 ! no worries about zsshp2_e(ji+1,jj)-zsshp2_e(ji,jj) = 0, it won't happen ! here 829 zcpx(ji,jj) = ABS((zsshp2_e(ji+1,jj) + bathy(ji+1,jj)*tmask(ji+1,jj,1) - zsshp2_e(ji,jj) - bathy(ji,jj)*tmask(ji,jj,1)) /& 830 & (zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj))) 831 ELSE 832 zcpx(ji,jj) = 0._wp 833 END IF 834 ENDIF 835 836 IF ( tmask(ji,jj+1,1) == 0._wp ) THEN 837 zcpy = 1._wp 802 838 ELSE 803 zcpx(ji,jj) = 0._wp 804 END IF 805 806 ll_tmp1 = MIN(zsshp2_e(ji,jj), zsshp2_e(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 807 ll_tmp2 = MAX(zsshp2_e(ji,jj), zsshp2_e(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) + & 839 ll_tmp1 = MIN(zsshp2_e(ji,jj), zsshp2_e(ji,jj+1)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji,jj+1)*tmask(ji,jj+1,1))& 840 & .and. MAX(zsshp2_e(ji,jj) + bathy(ji,jj)*tmask(ji,jj,1), zsshp2_e(ji,jj+1) + bathy(ji,jj+1)*tmask(ji,jj+1,1)) & 841 & > rn_wdmin1 + rn_wdmin2 842 ll_tmp2 = MAX(zsshp2_e(ji,jj), zsshp2_e(ji,jj+1)) > MAX(-bathy(ji,jj)*tmask(ji,jj,1), -bathy(ji,jj+1)*tmask(ji,jj+1,1)) + & 808 843 & rn_wdmin1 + rn_wdmin2 809 IF(ll_tmp1) THEN 810 zcpy(ji,jj) = 1.0_wp 811 ELSE IF(ll_tmp2) THEN 812 ! no worries about zsshp2_e(ji,jj+1)-zsshp2_e(ji,jj) = 0, it won't happen ! here 813 zcpy(ji,jj) = ABS((zsshp2_e(ji,jj+1) + bathy(ji,jj+1) - zsshp2_e(ji,jj) - bathy(ji,jj)) /& 814 & (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj))) 815 ELSE 816 zcpy(ji,jj) = 0._wp 817 END IF 844 IF(ll_tmp1) THEN 845 zcpy(ji,jj) = 1.0_wp 846 ELSE IF(ll_tmp2) THEN 847 ! no worries about zsshp2_e(ji,jj+1)-zsshp2_e(ji,jj) = 0, it won't happen ! here 848 zcpy(ji,jj) = ABS((zsshp2_e(ji,jj+1) + bathy(ji,jj+1)*tmask(ji,jj+1,1) - zsshp2_e(ji,jj) - bathy(ji,jj)*tmask(ji,jj,1)) /& 849 & (zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj))) 850 ELSE 851 zcpy(ji,jj) = 0._wp 852 END IF 853 ENDIF 818 854 END DO 819 855 END DO … … 894 930 ! ! ---------------------------------------------- 895 931 IF(ln_wd) THEN 896 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1 )897 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1 )932 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1 * umask(:,:,1) ) 933 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1 * vmask(:,:,1) ) 898 934 ELSE 899 935 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) … … 1032 1068 CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a ) 1033 1069 CALL wrk_dealloc( jpi, jpj, zhf ) 1034 IF(ln_wd) CALL wrk_ alloc( jpi, jpj, zcpx, zcpy )1070 IF(ln_wd) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy ) 1035 1071 ! 1036 1072 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4624 r5727 288 288 zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 289 289 zx2 = zwx(ji ,jj) + zwx(ji ,jj+1) 290 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 291 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 290 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 / e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) * umask(ji,jj,jk) 291 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) * vmask(ji,jj,jk) 292 292 END DO 293 293 END DO … … 409 409 zcva =-zfact2 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 410 410 ! mixed vorticity trend added to the momentum trends 411 ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua412 va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva411 ua(ji,jj,jk) = ua(ji,jj,jk) + ( zcua + zua ) * umask(ji,jj,jk) 412 va(ji,jj,jk) = va(ji,jj,jk) + ( zcva + zva ) * vmask(ji,jj,jk) 413 413 END DO 414 414 END DO … … 529 529 zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 530 530 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 531 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 532 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) 531 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) * umask(ji,jj,jk) 532 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) * vmask(ji,jj,jk) 533 533 END DO 534 534 END DO … … 686 686 zva = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 687 687 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 688 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 689 pva(ji,jj,jk) = pva(ji,jj,jk) + zva 688 pua(ji,jj,jk) = pua(ji,jj,jk) + zua * umask(ji,jj,jk) 689 pva(ji,jj,jk) = pva(ji,jj,jk) + zva * vmask(ji,jj,jk) 690 690 END DO 691 691 END DO -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r3294 r5727 109 109 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 110 110 ! ! add the trends to the general momentum trends 111 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 112 va(ji,jj,jk) = va(ji,jj,jk) + zva 111 ua(ji,jj,jk) = ua(ji,jj,jk) + zua * umask(ji,jj,jk) 112 va(ji,jj,jk) = va(ji,jj,jk) + zva * vmask(ji,jj,jk) 113 113 END DO 114 114 END DO -
branches/UKMO/2014_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DYN/wadlmt.F90
r5066 r5727 131 131 DO ji = 2, jpim1 132 132 133 wdmask(ji,jj) = 0133 ! wdmask(ji,jj) = 0 134 134 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 135 135 IF(bathy(ji,jj) > zdepwd) CYCLE … … 148 148 IF(zdep1 > zdep2) THEN 149 149 zflag = 1 150 wdmask(ji, jj) = 1150 ! wdmask(ji, jj) = 1 151 151 zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt ) 152 152 zcoef = max(zcoef, 0._wp) … … 170 170 END DO ! jk1 loop 171 171 172 un(:,:,:) = un(:,:,:) * zwdlmtu(ji, jj) 173 vn(:,:,:) = vn(:,:,:) * zwdlmtv(ji, jj) 172 DO jk = 1, jpkm1 173 un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :) 174 vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :) 175 END DO 174 176 175 177 CALL lbc_lnk( un, 'U', -1. ) … … 213 215 REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! local 2D workspace 214 216 REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace 217 REAL(wp), POINTER, DIMENSION(:,:) :: sum_e3u, sum_e3v ! local 2D workspace 215 218 216 219 !!---------------------------------------------------------------------- … … 223 226 CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 224 227 CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv) 228 CALL wrk_alloc( jpi, jpj, sum_e3u, sum_e3v) 225 229 ! 226 230 … … 235 239 zflxp(:,:) = 0._wp 236 240 zflxn(:,:) = 0._wp 237 zflxu(:,:) = 0._wp238 zflxv(:,:) = 0._wp241 !RF bug fix! zflxu(:,:) = 0._wp 242 !RF bug fix! zflxv(:,:) = 0._wp 239 243 240 244 zwdlmtu(:,:) = 1._wp … … 243 247 ! Horizontal Flux in u and v direction 244 248 245 zflxu(:,:) = zflxu(:,:) * e2u(:,:)246 zflxv(:,:) = zflxv(:,:) * e1v(:,:)249 !RF bug fix zflxu(:,:) = zflxu(:,:) * e2u(:,:) 250 !RF bug fix zflxv(:,:) = zflxv(:,:) * e1v(:,:) 247 251 248 252 DO jj = 2, jpjm1 … … 276 280 DO ji = 2, jpim1 277 281 278 wdmask(ji,jj) = 0279 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE 280 IF(bathy(ji,jj) > zdepwd) CYCLE 282 ! wdmask(ji,jj) = 0 283 IF(tmask(ji, jj, 1) < 0.5_wp) CYCLE ! we don't care about land cells 284 IF(bathy(ji,jj) > zdepwd) CYCLE ! and cells which will unlikely go dried out 281 285 282 !ztmp = e1t(ji,jj) * e2t(ji,jj) !there must be an array ready for this283 286 ztmp = e12t(ji,jj) 284 287 … … 316 319 END DO ! jk1 loop 317 320 318 zflxu(:,:) = zflxu(:,:) * zwdlmtu( ji, jj)319 zflxv(:,:) = zflxv(:,:) * zwdlmtv( ji, jj)321 zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :) 322 zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :) 320 323 321 324 CALL lbc_lnk( zflxu, 'U', -1. ) … … 330 333 CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 ) 331 334 CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv) 335 CALL wrk_dealloc( jpi, jpj, sum_e3u, sum_e3v) 332 336 ! 333 337 END IF
Note: See TracChangeset
for help on using the changeset viewer.
