Changeset 4346 for palm/trunk/SOURCE/turbulence_closure_mod.f90
- Timestamp:
- Dec 18, 2019 11:55:56 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/turbulence_closure_mod.f90 (modified) (64 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/turbulence_closure_mod.f90
r4329 r4346 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 ! topography information used in wall_flags_static_0 29 ! 30 ! 4329 2019-12-10 15:46:36Z motisi 27 31 ! Renamed wall_flags_0 to wall_flags_static_0 28 32 ! … … 140 144 nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 141 145 topo_top_ind, & 142 wall_flags_ static_0146 wall_flags_total_0 143 147 144 148 USE kinds … … 925 929 DO k = nzb_do, nzt_do 926 930 local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & 927 REAL( fill_value, KIND = wp ),&928 BTEST( wall_flags_static_0(k,j,i), flag_nr ) )931 REAL( fill_value, KIND = wp ), & 932 BTEST( wall_flags_total_0(k,j,i), flag_nr ) ) 929 933 ENDDO 930 934 ENDDO … … 1022 1026 to_be_resorted(k,j,i), & 1023 1027 REAL( fill_value, KIND = wp ), & 1024 BTEST( wall_flags_ static_0(k,j,i), flag_nr ) )1028 BTEST( wall_flags_total_0(k,j,i), flag_nr ) ) 1025 1029 ENDDO 1026 1030 ENDDO … … 1311 1315 DO k = nzb, nzt 1312 1316 e(k,j,i) = MERGE( e(k,j,i), 0.0_wp, & 1313 BTEST( wall_flags_ static_0(k,j,i), 0 ) )1317 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1314 1318 ENDDO 1315 1319 ENDDO … … 1321 1325 DO k = nzb, nzt 1322 1326 diss(k,j,i) = MERGE( diss(k,j,i), 0.0_wp, & 1323 BTEST( wall_flags_static_0(k,j,i), 0 ) )1327 BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1324 1328 ENDDO 1325 1329 ENDDO … … 1367 1371 USE indices, & 1368 1372 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, & 1369 nzt, wall_flags_ static_01373 nzt, wall_flags_total_0 1370 1374 1371 1375 USE kinds … … 1441 1445 ! 1442 1446 !-- Check if current gridpoint belongs to the atmosphere 1443 IF ( BTEST( wall_flags_ static_0(k,j,i), 0 ) ) THEN1447 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 1444 1448 ! 1445 1449 !-- Check for neighbouring grid-points. 1446 1450 !-- Vertical distance, down 1447 IF ( .NOT. BTEST( wall_flags_ static_0(k-1,j,i), 0 ) ) &1451 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) & 1448 1452 l_wall(k,j,i) = MIN( l_grid(k), zu(k) - zw(k-1) ) 1449 1453 ! 1450 1454 !-- Vertical distance, up 1451 IF ( .NOT. BTEST( wall_flags_ static_0(k+1,j,i), 0 ) ) &1455 IF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) & 1452 1456 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), zw(k) - zu(k) ) 1453 1457 ! 1454 1458 !-- y-distance 1455 IF ( .NOT. BTEST( wall_flags_ static_0(k,j-1,i), 0 ) .OR. &1456 .NOT. BTEST( wall_flags_ static_0(k,j+1,i), 0 ) ) &1459 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) .OR. & 1460 .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) & 1457 1461 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dy ) 1458 1462 ! 1459 1463 !-- x-distance 1460 IF ( .NOT. BTEST( wall_flags_ static_0(k,j,i-1), 0 ) .OR. &1461 .NOT. BTEST( wall_flags_ static_0(k,j,i+1), 0 ) ) &1464 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) .OR. & 1465 .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) & 1462 1466 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dx ) 1463 1467 ! 1464 1468 !-- yz-distance (vertical edges, down) 1465 IF ( .NOT. BTEST( wall_flags_ static_0(k-1,j-1,i), 0 ) .OR. &1466 .NOT. BTEST( wall_flags_ static_0(k-1,j+1,i), 0 ) ) &1467 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1468 SQRT( 0.25_wp * dy**2 + &1469 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i), 0 ) .OR. & 1470 .NOT. BTEST( wall_flags_total_0(k-1,j+1,i), 0 ) ) & 1471 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1472 SQRT( 0.25_wp * dy**2 + & 1469 1473 ( zu(k) - zw(k-1) )**2 ) ) 1470 1474 ! 1471 1475 !-- yz-distance (vertical edges, up) 1472 IF ( .NOT. BTEST( wall_flags_ static_0(k+1,j-1,i), 0 ) .OR. &1473 .NOT. BTEST( wall_flags_ static_0(k+1,j+1,i), 0 ) ) &1474 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1475 SQRT( 0.25_wp * dy**2 + &1476 IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i), 0 ) .OR. & 1477 .NOT. BTEST( wall_flags_total_0(k+1,j+1,i), 0 ) ) & 1478 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1479 SQRT( 0.25_wp * dy**2 + & 1476 1480 ( zw(k) - zu(k) )**2 ) ) 1477 1481 ! 1478 1482 !-- xz-distance (vertical edges, down) 1479 IF ( .NOT. BTEST( wall_flags_ static_0(k-1,j,i-1), 0 ) .OR. &1480 .NOT. BTEST( wall_flags_ static_0(k-1,j,i+1), 0 ) ) &1481 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1482 SQRT( 0.25_wp * dx**2 + &1483 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i-1), 0 ) .OR. & 1484 .NOT. BTEST( wall_flags_total_0(k-1,j,i+1), 0 ) ) & 1485 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1486 SQRT( 0.25_wp * dx**2 + & 1483 1487 ( zu(k) - zw(k-1) )**2 ) ) 1484 1488 ! 1485 1489 !-- xz-distance (vertical edges, up) 1486 IF ( .NOT. BTEST( wall_flags_ static_0(k+1,j,i-1), 0 ) .OR. &1487 .NOT. BTEST( wall_flags_ static_0(k+1,j,i+1), 0 ) ) &1488 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1489 SQRT( 0.25_wp * dx**2 + &1490 ( zw(k) - zu(k) )**2 ) ) 1490 IF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i-1), 0 ) .OR. & 1491 .NOT. BTEST( wall_flags_total_0(k+1,j,i+1), 0 ) ) & 1492 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1493 SQRT( 0.25_wp * dx**2 + & 1494 ( zw(k) - zu(k) )**2 ) ) 1491 1495 ! 1492 1496 !-- xy-distance (horizontal edges) 1493 IF ( .NOT. BTEST( wall_flags_ static_0(k,j-1,i-1), 0 ) .OR. &1494 .NOT. BTEST( wall_flags_ static_0(k,j+1,i-1), 0 ) .OR. &1495 .NOT. BTEST( wall_flags_ static_0(k,j-1,i+1), 0 ) .OR. &1496 .NOT. BTEST( wall_flags_ static_0(k,j+1,i+1), 0 ) ) &1497 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1497 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i-1), 0 ) .OR. & 1498 .NOT. BTEST( wall_flags_total_0(k,j+1,i-1), 0 ) .OR. & 1499 .NOT. BTEST( wall_flags_total_0(k,j-1,i+1), 0 ) .OR. & 1500 .NOT. BTEST( wall_flags_total_0(k,j+1,i+1), 0 ) ) & 1501 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1498 1502 SQRT( 0.25_wp * ( dx**2 + dy**2 ) ) ) 1499 1503 ! 1500 1504 !-- xyz distance (vertical and horizontal edges, down) 1501 IF ( .NOT. BTEST( wall_flags_ static_0(k-1,j-1,i-1), 0 ) .OR. &1502 .NOT. BTEST( wall_flags_ static_0(k-1,j+1,i-1), 0 ) .OR. &1503 .NOT. BTEST( wall_flags_ static_0(k-1,j-1,i+1), 0 ) .OR. &1504 .NOT. BTEST( wall_flags_ static_0(k-1,j+1,i+1), 0 ) ) &1505 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1506 SQRT( 0.25_wp * ( dx**2 + dy**2 ) &1505 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j-1,i-1), 0 ) .OR. & 1506 .NOT. BTEST( wall_flags_total_0(k-1,j+1,i-1), 0 ) .OR. & 1507 .NOT. BTEST( wall_flags_total_0(k-1,j-1,i+1), 0 ) .OR. & 1508 .NOT. BTEST( wall_flags_total_0(k-1,j+1,i+1), 0 ) ) & 1509 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1510 SQRT( 0.25_wp * ( dx**2 + dy**2 ) & 1507 1511 + ( zu(k) - zw(k-1) )**2 ) ) 1508 1512 ! 1509 1513 !-- xyz distance (vertical and horizontal edges, up) 1510 IF ( .NOT. BTEST( wall_flags_ static_0(k+1,j-1,i-1), 0 ) .OR. &1511 .NOT. BTEST( wall_flags_ static_0(k+1,j+1,i-1), 0 ) .OR. &1512 .NOT. BTEST( wall_flags_ static_0(k+1,j-1,i+1), 0 ) .OR. &1513 .NOT. BTEST( wall_flags_ static_0(k+1,j+1,i+1), 0 ) ) &1514 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), &1515 SQRT( 0.25_wp * ( dx**2 + dy**2 ) &1514 IF ( .NOT. BTEST( wall_flags_total_0(k+1,j-1,i-1), 0 ) .OR. & 1515 .NOT. BTEST( wall_flags_total_0(k+1,j+1,i-1), 0 ) .OR. & 1516 .NOT. BTEST( wall_flags_total_0(k+1,j-1,i+1), 0 ) .OR. & 1517 .NOT. BTEST( wall_flags_total_0(k+1,j+1,i+1), 0 ) ) & 1518 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1519 SQRT( 0.25_wp * ( dx**2 + dy**2 ) & 1516 1520 + ( zw(k) - zu(k) )**2 ) ) 1517 1521 … … 1553 1557 DO j = nysg, nyng 1554 1558 DO k = nzb+1, nzt-1 1555 IF ( .NOT. BTEST( wall_flags_ static_0(k,j,i), 0 ) .AND. &1559 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i), 0 ) .AND. & 1556 1560 k > k_max_topo ) & 1557 1561 k_max_topo = k … … 1619 1623 ! 1620 1624 !-- Start search only if (i/j/k) belongs to atmosphere 1621 IF ( BTEST( wall_flags_ static_0(k,j,i), 0 ) ) THEN1625 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 1622 1626 ! 1623 1627 !-- Reset topography within vicinity … … 1839 1843 ! ------------ 1840 1844 !> Copy a subarray of size (kb:kt,js:jn,il:ir) centered around grid point 1841 !> (kp,jp,ip) containing the first bit of wall_flags_ static_0 into the array1845 !> (kp,jp,ip) containing the first bit of wall_flags_total_0 into the array 1842 1846 !> 'vicinity'. Only copy first bit as this indicates the presence of topography. 1843 1847 !------------------------------------------------------------------------------! … … 1864 1868 DO k = kb, kt 1865 1869 vicinity(k,j,i) = MERGE( 0, 1, & 1866 BTEST( wall_flags_ static_0(kp+k,jp+j,ip+i), 0 ) )1870 BTEST( wall_flags_total_0(kp+k,jp+j,ip+i), 0 ) ) 1867 1871 ENDDO 1868 1872 ENDDO … … 2263 2267 !-- value is reduced by 90%. 2264 2268 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 2265 !$ACC PRESENT(e, tend, te_m, wall_flags_ static_0) &2269 !$ACC PRESENT(e, tend, te_m, wall_flags_total_0) & 2266 2270 !$ACC PRESENT(tsc(3:3)) & 2267 2271 !$ACC PRESENT(e_p) … … 2273 2277 ) & 2274 2278 * MERGE( 1.0_wp, 0.0_wp, & 2275 BTEST( wall_flags_static_0(k,j,i), 0 ) &2279 BTEST( wall_flags_total_0(k,j,i), 0 ) & 2276 2280 ) 2277 2281 IF ( e_p(k,j,i) < 0.0_wp ) e_p(k,j,i) = 0.1_wp * e(k,j,i) … … 2380 2384 ) & 2381 2385 * MERGE( 1.0_wp, 0.0_wp, & 2382 BTEST( wall_flags_static_0(k,j,i), 0 ) &2386 BTEST( wall_flags_total_0(k,j,i), 0 ) & 2383 2387 ) 2384 2388 IF ( diss_p(k,j,i) < 0.0_wp ) & … … 2495 2499 ) & 2496 2500 * MERGE( 1.0_wp, 0.0_wp, & 2497 BTEST( wall_flags_static_0(k,j,i), 0 ) &2501 BTEST( wall_flags_total_0(k,j,i), 0 ) & 2498 2502 ) 2499 2503 IF ( e_p(k,j,i) <= 0.0_wp ) e_p(k,j,i) = 0.1_wp * e(k,j,i) … … 2562 2566 ) & 2563 2567 * MERGE( 1.0_wp, 0.0_wp, & 2564 BTEST( wall_flags_static_0(k,j,i), 0 )&2568 BTEST( wall_flags_total_0(k,j,i), 0 )& 2565 2569 ) 2566 2570 ENDDO … … 2657 2661 !$ACC PRIVATE(surf_s, surf_e) & 2658 2662 !$ACC PRIVATE(dudx(:), dudy(:), dudz(:), dvdx(:), dvdy(:), dvdz(:), dwdx(:), dwdy(:), dwdz(:)) & 2659 !$ACC PRESENT(e, u, v, w, diss, dd2zu, ddzw, km, wall_flags_ static_0) &2663 !$ACC PRESENT(e, u, v, w, diss, dd2zu, ddzw, km, wall_flags_total_0) & 2660 2664 !$ACC PRESENT(tend) & 2661 2665 !$ACC PRESENT(surf_def_h(0:1), surf_def_v(0:3)) & … … 2717 2721 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2718 2722 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2719 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) )2723 BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) ) 2720 2724 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 2721 2725 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 2736 2740 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2737 2741 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2738 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) )2742 BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) ) 2739 2743 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 2740 2744 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 2755 2759 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2756 2760 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2757 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) )2761 BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) ) 2758 2762 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 2759 2763 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 2776 2780 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2777 2781 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2778 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) )2782 BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) ) 2779 2783 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 2780 2784 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 2795 2799 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2796 2800 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2797 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) )2801 BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) ) 2798 2802 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 2799 2803 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 2814 2818 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2815 2819 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2816 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) )2820 BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) ) 2817 2821 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 2818 2822 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 2889 2893 IF ( def < 0.0_wp ) def = 0.0_wp 2890 2894 2891 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),flag_nr) )2895 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),flag_nr) ) 2892 2896 2893 2897 IF ( .NOT. diss_production ) THEN … … 2953 2957 !-- Compute tendency for TKE-production from shear 2954 2958 DO k = nzb+1, nzt 2955 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )2959 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 2956 2960 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 2957 2961 MERGE( rho_reference, prho(k,j,i), & … … 2963 2967 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 2964 2968 DO k = nzb+1, nzt 2965 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )2969 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 2966 2970 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 2967 2971 MERGE( rho_reference, prho(k,j,i), & … … 2981 2985 !$ACC PRIVATE(surf_s, surf_e) & 2982 2986 !$ACC PRIVATE(tmp_flux(nzb+1:nzt)) & 2983 !$ACC PRESENT(e, diss, kh, pt, dd2zu, drho_air_zw, wall_flags_ static_0) &2987 !$ACC PRESENT(e, diss, kh, pt, dd2zu, drho_air_zw, wall_flags_total_0) & 2984 2988 !$ACC PRESENT(tend) & 2985 2989 !$ACC PRESENT(surf_def_h(0:2)) & … … 3041 3045 !$ACC LOOP PRIVATE(k, flag) 3042 3046 DO k = nzb+1, nzt 3043 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3047 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3044 3048 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3045 3049 MERGE( pt_reference, pt(k,j,i), & … … 3051 3055 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3052 3056 DO k = nzb+1, nzt 3053 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3057 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3054 3058 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3055 3059 MERGE( pt_reference, pt(k,j,i), & … … 3256 3260 !-- Compute tendency for TKE-production from shear 3257 3261 DO k = nzb+1, nzt 3258 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3262 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3259 3263 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3260 3264 MERGE( vpt_reference, vpt(k,j,i), & … … 3266 3270 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3267 3271 DO k = nzb+1, nzt 3268 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3272 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3269 3273 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3270 3274 MERGE( vpt_reference, vpt(k,j,i), & … … 3401 3405 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3402 3406 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3403 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) )3407 BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) ) 3404 3408 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 3405 3409 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 3419 3423 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3420 3424 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3421 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) )3425 BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) ) 3422 3426 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 3423 3427 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 3437 3441 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3438 3442 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3439 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) )3443 BTEST( wall_flags_total_0(k,j-1,i), flag_nr ) ) 3440 3444 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 3441 3445 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 3457 3461 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3458 3462 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3459 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) )3463 BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) ) 3460 3464 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 3461 3465 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 3475 3479 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3476 3480 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3477 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) )3481 BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) ) 3478 3482 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 3479 3483 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 3493 3497 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3494 3498 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3495 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) )3499 BTEST( wall_flags_total_0(k,j,i-1), flag_nr ) ) 3496 3500 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 3497 3501 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 3561 3565 IF ( def < 0.0_wp ) def = 0.0_wp 3562 3566 3563 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),flag_nr) )3567 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),flag_nr) ) 3564 3568 3565 3569 IF ( .NOT. diss_production ) THEN … … 3618 3622 !-- Compute tendency for TKE-production from shear 3619 3623 DO k = nzb+1, nzt 3620 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3624 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3621 3625 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3622 3626 MERGE( rho_reference, prho(k,j,i), & … … 3628 3632 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3629 3633 DO k = nzb+1, nzt 3630 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3634 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3631 3635 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3632 3636 MERGE( rho_reference, prho(k,j,i), & … … 3687 3691 !-- Compute tendency for TKE-production from shear 3688 3692 DO k = nzb+1, nzt 3689 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3693 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3690 3694 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3691 3695 MERGE( pt_reference, pt(k,j,i), & … … 3697 3701 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3698 3702 DO k = nzb+1, nzt 3699 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3703 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3700 3704 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3701 3705 MERGE( pt_reference, pt(k,j,i), & … … 3896 3900 !-- Compute tendency for TKE-production from shear 3897 3901 DO k = nzb+1, nzt 3898 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3902 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3899 3903 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3900 3904 MERGE( vpt_reference, vpt(k,j,i), & … … 3906 3910 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3907 3911 DO k = nzb+1, nzt 3908 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ static_0(k,j,i),0) )3912 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_total_0(k,j,i),0) ) 3909 3913 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3910 3914 MERGE( vpt_reference, vpt(k,j,i), & … … 3972 3976 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 3973 3977 !$ACC PRIVATE(l, l_stable, dvar_dz) & 3974 !$ACC PRESENT(diss, e, var, wall_flags_ static_0) &3978 !$ACC PRESENT(diss, e, var, wall_flags_total_0) & 3975 3979 !$ACC PRESENT(dd2zu, l_grid, l_wall) 3976 3980 DO i = nxl, nxr … … 4002 4006 diss(k,j,i) = ( 0.19_wp + 0.74_wp * l / l_wall(k,j,i) ) & 4003 4007 * e(k,j,i) * SQRT( e(k,j,i) ) / l & 4004 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4008 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4005 4009 4006 4010 ENDDO … … 4013 4017 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4014 4018 !$ACC PRIVATE(l_stable, duv2_dz2, rif, dvar_dz) & 4015 !$ACC PRESENT(diss, e, u, v, var, wall_flags_ static_0) &4019 !$ACC PRESENT(diss, e, u, v, var, wall_flags_total_0) & 4016 4020 !$ACC PRESENT(dd2zu, l_black, l_wall) 4017 4021 DO i = nxl, nxr … … 4060 4064 4061 4065 diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) ) / l_stable(k) & 4062 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4066 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4063 4067 4064 4068 ENDDO … … 4072 4076 4073 4077 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 4074 !$ACC PRESENT(diss, e, km, tend, wall_flags_ static_0) &4078 !$ACC PRESENT(diss, e, km, tend, wall_flags_total_0) & 4075 4079 !$ACC PRESENT(ddzu, ddzw, rho_air_zw, drho_air) 4076 4080 DO i = nxl, nxr … … 4095 4099 ) * dsig_e & 4096 4100 * MERGE( 1.0_wp, 0.0_wp, & 4097 BTEST( wall_flags_static_0(k,j,i), 0 ) )&4101 BTEST( wall_flags_total_0(k,j,i), 0 ) ) & 4098 4102 - diss(k,j,i) 4099 4103 … … 4201 4205 diss(k,j,i) = ( 0.19_wp + 0.74_wp * l / l_wall(k,j,i) ) & 4202 4206 * e(k,j,i) * SQRT( e(k,j,i) ) / l & 4203 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4207 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4204 4208 ENDDO 4205 4209 … … 4245 4249 DO k = nzb+1, nzt 4246 4250 diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) ) / l_stable(k) & 4247 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4251 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4248 4252 ENDDO 4249 4253 … … 4274 4278 ) * dsig_e & 4275 4279 * MERGE( 1.0_wp, 0.0_wp, & 4276 BTEST( wall_flags_static_0(k,j,i), 0 ) )&4280 BTEST( wall_flags_total_0(k,j,i), 0 ) )& 4277 4281 - diss(k,j,i) 4278 4282 … … 4337 4341 ! 4338 4342 !-- Predetermine flag to mask topography 4339 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4343 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4340 4344 4341 4345 tend(k,j,i) = tend(k,j,i) + & … … 4393 4397 ! 4394 4398 !-- Predetermine flag to mask topography 4395 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4399 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4396 4400 4397 4401 ! … … 4454 4458 DO k = nzb+1, nzt 4455 4459 e(k,j,i) = MAX( e(k,j,i), e_min ) * & 4456 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4460 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4457 4461 ENDDO 4458 4462 ENDDO … … 4665 4669 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4666 4670 !$ACC PRIVATE(dvar_dz, l, l_stable, l_v) & 4667 !$ACC PRESENT(wall_flags_ static_0, var, dd2zu, e, l_wall, l_grid, rmask) &4671 !$ACC PRESENT(wall_flags_total_0, var, dd2zu, e, l_wall, l_grid, rmask) & 4668 4672 !$ACC PRESENT(kh, km, sums_l_l) 4669 4673 DO i = nxlg, nxrg … … 4697 4701 4698 4702 l_v(k) = MIN( l_wall(k,j,i), l_stable(k) ) & 4699 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4703 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4700 4704 l = l_v(k) 4701 4705 ! … … 4722 4726 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4723 4727 !$ACC PRIVATE(dvar_dz, duv2_dz2, l_stable, l_v, rif) & 4724 !$ACC PRESENT(wall_flags_ static_0, var, dd2zu, e, u, v, l_wall, l_black, rmask) &4728 !$ACC PRESENT(wall_flags_total_0, var, dd2zu, e, u, v, l_wall, l_black, rmask) & 4725 4729 !$ACC PRESENT(kh, km, sums_l_l) 4726 4730 DO i = nxlg, nxrg … … 4770 4774 !DIR$ IVDEP 4771 4775 DO k = nzb+1, nzt 4772 l_v(k) = l_stable(k) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4776 l_v(k) = l_stable(k) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4773 4777 km(k,j,i) = c_0 * l_v(k) * SQRT( e(k,j,i) ) 4774 4778 kh(k,j,i) = km(k,j,i) / prandtl_number … … 4791 4795 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4792 4796 !$ACC PRIVATE(l_v) & 4793 !$ACC PRESENT(wall_flags_ static_0, e, diss, rmask) &4797 !$ACC PRESENT(wall_flags_total_0, e, diss, rmask) & 4794 4798 !$ACC PRESENT(kh, km, sums_l_l) 4795 4799 DO i = nxlg, nxrg … … 4802 4806 4803 4807 l_v(k) = c_0**3 * e(k,j,i) * SQRT(e(k,j,i)) / ( diss(k,j,i) + 1.0E-30_wp ) & 4804 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4808 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4805 4809 4806 4810 km(k,j,i) = c_0 * SQRT( e(k,j,i) ) * l_v(k) … … 4939 4943 DO k = nzb+1, nzt 4940 4944 4941 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ static_0(k,j,i), 0 ) )4945 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4942 4946 4943 4947 !
Note: See TracChangeset
for help on using the changeset viewer.
