- Timestamp:
- 2015-10-30T16:34:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r5224 r5842 17 17 !! ! (A. Coward) suppression of hel, wdj and rot options 18 18 !! 3.6 ! 2014-11 (P. Mathiot) hpg_isf: original code for ice shelf cavity 19 !! 3.6? ! 2015-11 (H. Liu) add Wetting/Drying pressure filter 19 20 !!---------------------------------------------------------------------- 20 21 … … 378 379 INTEGER, INTENT(in) :: kt ! ocean time-step index 379 380 !! 380 INTEGER :: ji, jj, jk ! dummy loop indices 381 REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars 381 INTEGER :: ji, jj, jk, jii, jjj ! dummy loop indices 382 REAL(wp) :: zcoef0, zuap, zvap, znad, ztmp ! temporary scalars 383 LOGICAL :: ll_tmp1, ll_tmp2, ll_tmp3 ! local logical variables 382 384 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 385 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 383 386 !!---------------------------------------------------------------------- 384 387 ! 385 388 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj ) 389 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 386 390 ! 387 391 IF( kt == nit000 ) THEN … … 397 401 ELSE ; znad = 0._wp ! Fixed volume 398 402 ENDIF 403 404 IF(ln_wd) THEN 405 DO jj = 2, jpjm1 406 DO ji = 2, jpim1 407 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) 408 ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) > rn_wdmin1 + rn_wdmin2 409 ll_tmp3 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) + & 410 & rn_wdmin1 + rn_wdmin2 411 412 IF(ll_tmp1.AND.ll_tmp2) THEN 413 zcpx(ji,jj) = 1.0_wp 414 wduflt(ji,jj) = 1.0_wp 415 ELSE IF(ll_tmp3) THEN 416 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 417 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) / & 418 & (sshn(ji+1,jj) - sshn(ji,jj))) 419 wduflt(ji,jj) = 1.0_wp 420 ELSE 421 zcpx(ji,jj) = 0._wp 422 wduflt(ji,jj) = 0.0_wp 423 END IF 424 425 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) 426 ll_tmp2 = MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) > rn_wdmin1 + rn_wdmin2 427 ll_tmp3 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) + & 428 & rn_wdmin1 + rn_wdmin2 429 430 IF(ll_tmp1.AND.ll_tmp2) THEN 431 zcpy(ji,jj) = 1.0_wp 432 wdvflt(ji,jj) = 1.0_wp 433 ELSE IF(ll_tmp3) THEN 434 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 435 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) / & 436 & (sshn(ji,jj+1) - sshn(ji,jj))) 437 wdvflt(ji,jj) = 1.0_wp 438 ELSE 439 zcpy(ji,jj) = 0._wp 440 wdvflt(ji,jj) = 0.0_wp 441 END IF 442 END DO 443 END DO 444 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 445 ENDIF 446 447 448 !jii=jidbg-nimpp+1;jjj=jjdbg-njmpp+1 399 449 400 450 ! Surface value … … 411 461 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad ) & 412 462 & * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 463 464 465 IF(ln_wd) THEN 466 467 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 468 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 469 zuap = zuap * zcpx(ji,jj) 470 zvap = zvap * zcpy(ji,jj) 471 ENDIF 472 413 473 ! add to the general momentum trend 414 474 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap … … 433 493 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 434 494 & * ( fsde3w(ji ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 495 496 IF(ln_wd) THEN 497 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 498 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 499 zuap = zuap * zcpx(ji,jj) 500 zvap = zvap * zcpy(ji,jj) 501 ENDIF 502 435 503 ! add to the general momentum trend 436 504 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap … … 441 509 ! 442 510 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj ) 511 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 443 512 ! 444 513 END SUBROUTINE hpg_sco … … 719 788 REAL(wp) :: z1_10, cffu, cffx ! " " 720 789 REAL(wp) :: z1_12, cffv, cffy ! " " 790 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 721 791 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zhpj 722 792 REAL(wp), POINTER, DIMENSION(:,:,:) :: dzx, dzy, dzz, dzu, dzv, dzw 723 793 REAL(wp), POINTER, DIMENSION(:,:,:) :: drhox, drhoy, drhoz, drhou, drhov, drhow 724 794 REAL(wp), POINTER, DIMENSION(:,:,:) :: rho_i, rho_j, rho_k 795 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 725 796 !!---------------------------------------------------------------------- 726 797 ! … … 728 799 CALL wrk_alloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 729 800 CALL wrk_alloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 730 ! 801 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 802 ! 803 !!---------------------------------------------------------------------- 804 ! 805 ! 806 IF(ln_wd) THEN 807 DO jj = 2, jpjm1 808 DO ji = 2, jpim1 809 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 810 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 811 & > rn_wdmin1 + rn_wdmin2 812 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 813 & rn_wdmin1 + rn_wdmin2 814 815 IF(ll_tmp1) THEN 816 zcpx(ji,jj) = 1.0_wp 817 ELSE IF(ll_tmp2) THEN 818 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 819 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 820 & (sshn(ji+1,jj) - sshn(ji,jj))) 821 ELSE 822 zcpx(ji,jj) = 0._wp 823 END IF 824 825 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 826 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 827 & > rn_wdmin1 + rn_wdmin2 828 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 829 & rn_wdmin1 + rn_wdmin2 830 831 IF(ll_tmp1) THEN 832 zcpy(ji,jj) = 1.0_wp 833 ELSE IF(ll_tmp2) THEN 834 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 835 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 836 & (sshn(ji,jj+1) - sshn(ji,jj))) 837 ELSE 838 zcpy(ji,jj) = 0._wp 839 END IF 840 END DO 841 END DO 842 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 843 ENDIF 844 731 845 732 846 IF( kt == nit000 ) THEN … … 899 1013 zhpi(ji,jj,1) = ( rho_k(ji+1,jj ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) / e1u(ji,jj) 900 1014 zhpj(ji,jj,1) = ( rho_k(ji ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / e2v(ji,jj) 1015 IF(ln_wd) THEN 1016 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 1017 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 1018 ENDIF 901 1019 ! add to the general momentum trend 902 1020 ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) … … 918 1036 & + ( ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk ) ) & 919 1037 & -( rho_j(ji,jj ,jk) - rho_j(ji,jj,jk-1) ) ) / e2v(ji,jj) 1038 IF(ln_wd) THEN 1039 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 1040 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 1041 ENDIF 920 1042 ! add to the general momentum trend 921 1043 ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) … … 928 1050 CALL wrk_dealloc( jpi, jpj, jpk, drhox, drhoy, drhoz, drhou, drhov, drhow ) 929 1051 CALL wrk_dealloc( jpi, jpj, jpk, rho_i, rho_j, rho_k, zhpi, zhpj ) 1052 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 930 1053 ! 931 1054 END SUBROUTINE hpg_djc … … 951 1074 !! The local variables for the correction term 952 1075 INTEGER :: jk1, jis, jid, jjs, jjd 1076 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 953 1077 REAL(wp) :: zuijk, zvijk, zpwes, zpwed, zpnss, zpnsd, zdeps 954 1078 REAL(wp) :: zrhdt1 … … 957 1081 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 958 1082 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_n, zsshv_n 1083 REAL(wp), POINTER, DIMENSION(:,:) :: zcpx, zcpy !W/D pressure filter 959 1084 !!---------------------------------------------------------------------- 960 1085 ! … … 962 1087 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 963 1088 CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n ) 1089 IF(ln_wd) CALL wrk_alloc( jpi,jpj, zcpx, zcpy ) 964 1090 ! 965 1091 IF( kt == nit000 ) THEN … … 974 1100 znad = 0.0_wp 975 1101 IF( lk_vvl ) znad = 1._wp 1102 1103 IF(ln_wd) THEN 1104 DO jj = 2, jpjm1 1105 DO ji = 2, jpim1 1106 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 1107 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 1108 & > rn_wdmin1 + rn_wdmin2 1109 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) +& 1110 & rn_wdmin1 + rn_wdmin2 1111 1112 IF(ll_tmp1) THEN 1113 zcpx(ji,jj) = 1.0_wp 1114 ELSE IF(ll_tmp2) THEN 1115 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen ! here 1116 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) /& 1117 & (sshn(ji+1,jj) - sshn(ji,jj))) 1118 ELSE 1119 zcpx(ji,jj) = 0._wp 1120 END IF 1121 1122 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 1123 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 1124 & > rn_wdmin1 + rn_wdmin2 1125 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) +& 1126 & rn_wdmin1 + rn_wdmin2 1127 1128 IF(ll_tmp1.OR.ll_tmp2) THEN 1129 zcpy(ji,jj) = 1.0_wp 1130 ELSE IF(ll_tmp2) THEN 1131 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen ! here 1132 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) /& 1133 & (sshn(ji,jj+1) - sshn(ji,jj))) 1134 ELSE 1135 zcpy(ji,jj) = 0._wp 1136 END IF 1137 END DO 1138 END DO 1139 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 1140 ENDIF 976 1141 977 1142 ! Clean 3-D work arrays … … 1052 1217 END DO 1053 1218 END DO 1219 1220 CALL lbc_lnk (zsshu_n, 'U', 1.) 1221 CALL lbc_lnk (zsshv_n, 'V', 1.) 1054 1222 1055 1223 DO jj = 2, jpjm1 … … 1150 1318 ENDIF 1151 1319 1152 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * & 1153 & umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 1320 IF(ln_wd) THEN 1321 zdpdx1 = zdpdx1 * zcpx(ji,jj) 1322 zdpdx2 = zdpdx2 * zcpx(ji,jj) 1323 ENDIF 1324 ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 1154 1325 ENDIF 1155 1326 … … 1207 1378 ENDIF 1208 1379 1209 va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*& 1210 & vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 1380 IF(ln_wd) THEN 1381 zdpdy1 = zdpdy1 * zcpy(ji,jj) 1382 zdpdy2 = zdpdy2 * zcpy(ji,jj) 1383 ENDIF 1384 1385 va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk) 1211 1386 ENDIF 1212 1387 … … 1219 1394 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 1220 1395 CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n ) 1396 IF(ln_wd) CALL wrk_dealloc( jpi,jpj, zcpx, zcpy ) 1221 1397 ! 1222 1398 END SUBROUTINE hpg_prj
Note: See TracChangeset
for help on using the changeset viewer.
