- Timestamp:
- 2015-09-10T19:05:13+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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 !
Note: See TracChangeset
for help on using the changeset viewer.
