Changeset 4329 for palm/trunk/SOURCE/turbulence_closure_mod.f90
- Timestamp:
- Dec 10, 2019 3:46:36 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/turbulence_closure_mod.f90 (modified) (69 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/turbulence_closure_mod.f90
r4182 r4329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Renamed wall_flags_0 to wall_flags_static_0 28 ! 29 ! 4182 2019-08-22 15:20:23Z scharf 27 30 ! Corrected "Former revisions" section 28 31 ! … … 137 140 nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt, & 138 141 topo_top_ind, & 139 wall_flags_ 0142 wall_flags_static_0 140 143 141 144 USE kinds … … 923 926 local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), & 924 927 REAL( fill_value, KIND = wp ), & 925 BTEST( wall_flags_ 0(k,j,i), flag_nr ) )928 BTEST( wall_flags_static_0(k,j,i), flag_nr ) ) 926 929 ENDDO 927 930 ENDDO … … 1019 1022 to_be_resorted(k,j,i), & 1020 1023 REAL( fill_value, KIND = wp ), & 1021 BTEST( wall_flags_ 0(k,j,i), flag_nr ) )1024 BTEST( wall_flags_static_0(k,j,i), flag_nr ) ) 1022 1025 ENDDO 1023 1026 ENDDO … … 1308 1311 DO k = nzb, nzt 1309 1312 e(k,j,i) = MERGE( e(k,j,i), 0.0_wp, & 1310 BTEST( wall_flags_ 0(k,j,i), 0 ) )1313 BTEST( wall_flags_static_0(k,j,i), 0 ) ) 1311 1314 ENDDO 1312 1315 ENDDO … … 1318 1321 DO k = nzb, nzt 1319 1322 diss(k,j,i) = MERGE( diss(k,j,i), 0.0_wp, & 1320 BTEST( wall_flags_ 0(k,j,i), 0 ) )1323 BTEST( wall_flags_static_0(k,j,i), 0 ) ) 1321 1324 ENDDO 1322 1325 ENDDO … … 1364 1367 USE indices, & 1365 1368 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, & 1366 nzt, wall_flags_ 01369 nzt, wall_flags_static_0 1367 1370 1368 1371 USE kinds … … 1438 1441 ! 1439 1442 !-- Check if current gridpoint belongs to the atmosphere 1440 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) ) THEN1443 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) ) THEN 1441 1444 ! 1442 1445 !-- Check for neighbouring grid-points. 1443 1446 !-- Vertical distance, down 1444 IF ( .NOT. BTEST( wall_flags_ 0(k-1,j,i), 0 ) ) &1447 IF ( .NOT. BTEST( wall_flags_static_0(k-1,j,i), 0 ) ) & 1445 1448 l_wall(k,j,i) = MIN( l_grid(k), zu(k) - zw(k-1) ) 1446 1449 ! 1447 1450 !-- Vertical distance, up 1448 IF ( .NOT. BTEST( wall_flags_ 0(k+1,j,i), 0 ) ) &1451 IF ( .NOT. BTEST( wall_flags_static_0(k+1,j,i), 0 ) ) & 1449 1452 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), zw(k) - zu(k) ) 1450 1453 ! 1451 1454 !-- y-distance 1452 IF ( .NOT. BTEST( wall_flags_ 0(k,j-1,i), 0 ) .OR. &1453 .NOT. BTEST( wall_flags_ 0(k,j+1,i), 0 ) ) &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 ) ) & 1454 1457 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dy ) 1455 1458 ! 1456 1459 !-- x-distance 1457 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i-1), 0 ) .OR. &1458 .NOT. BTEST( wall_flags_ 0(k,j,i+1), 0 ) ) &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 ) ) & 1459 1462 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dx ) 1460 1463 ! 1461 1464 !-- yz-distance (vertical edges, down) 1462 IF ( .NOT. BTEST( wall_flags_ 0(k-1,j-1,i), 0 ) .OR. &1463 .NOT. BTEST( wall_flags_ 0(k-1,j+1,i), 0 ) ) &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 ) ) & 1464 1467 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1465 1468 SQRT( 0.25_wp * dy**2 + & … … 1467 1470 ! 1468 1471 !-- yz-distance (vertical edges, up) 1469 IF ( .NOT. BTEST( wall_flags_ 0(k+1,j-1,i), 0 ) .OR. &1470 .NOT. BTEST( wall_flags_ 0(k+1,j+1,i), 0 ) ) &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 ) ) & 1471 1474 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1472 1475 SQRT( 0.25_wp * dy**2 + & … … 1474 1477 ! 1475 1478 !-- xz-distance (vertical edges, down) 1476 IF ( .NOT. BTEST( wall_flags_ 0(k-1,j,i-1), 0 ) .OR. &1477 .NOT. BTEST( wall_flags_ 0(k-1,j,i+1), 0 ) ) &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 ) ) & 1478 1481 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1479 1482 SQRT( 0.25_wp * dx**2 + & … … 1481 1484 ! 1482 1485 !-- xz-distance (vertical edges, up) 1483 IF ( .NOT. BTEST( wall_flags_ 0(k+1,j,i-1), 0 ) .OR. &1484 .NOT. BTEST( wall_flags_ 0(k+1,j,i+1), 0 ) ) &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 ) ) & 1485 1488 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1486 1489 SQRT( 0.25_wp * dx**2 + & … … 1488 1491 ! 1489 1492 !-- xy-distance (horizontal edges) 1490 IF ( .NOT. BTEST( wall_flags_ 0(k,j-1,i-1), 0 ) .OR. &1491 .NOT. BTEST( wall_flags_ 0(k,j+1,i-1), 0 ) .OR. &1492 .NOT. BTEST( wall_flags_ 0(k,j-1,i+1), 0 ) .OR. &1493 .NOT. BTEST( wall_flags_ 0(k,j+1,i+1), 0 ) ) &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 ) ) & 1494 1497 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1495 1498 SQRT( 0.25_wp * ( dx**2 + dy**2 ) ) ) 1496 1499 ! 1497 1500 !-- xyz distance (vertical and horizontal edges, down) 1498 IF ( .NOT. BTEST( wall_flags_ 0(k-1,j-1,i-1), 0 ) .OR. &1499 .NOT. BTEST( wall_flags_ 0(k-1,j+1,i-1), 0 ) .OR. &1500 .NOT. BTEST( wall_flags_ 0(k-1,j-1,i+1), 0 ) .OR. &1501 .NOT. BTEST( wall_flags_ 0(k-1,j+1,i+1), 0 ) ) &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 ) ) & 1502 1505 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1503 1506 SQRT( 0.25_wp * ( dx**2 + dy**2 ) & … … 1505 1508 ! 1506 1509 !-- xyz distance (vertical and horizontal edges, up) 1507 IF ( .NOT. BTEST( wall_flags_ 0(k+1,j-1,i-1), 0 ) .OR. &1508 .NOT. BTEST( wall_flags_ 0(k+1,j+1,i-1), 0 ) .OR. &1509 .NOT. BTEST( wall_flags_ 0(k+1,j-1,i+1), 0 ) .OR. &1510 .NOT. BTEST( wall_flags_ 0(k+1,j+1,i+1), 0 ) ) &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 ) ) & 1511 1514 l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), & 1512 1515 SQRT( 0.25_wp * ( dx**2 + dy**2 ) & … … 1550 1553 DO j = nysg, nyng 1551 1554 DO k = nzb+1, nzt-1 1552 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &1555 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 1553 1556 k > k_max_topo ) & 1554 1557 k_max_topo = k … … 1616 1619 ! 1617 1620 !-- Start search only if (i/j/k) belongs to atmosphere 1618 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) ) THEN1621 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) ) THEN 1619 1622 ! 1620 1623 !-- Reset topography within vicinity … … 1836 1839 ! ------------ 1837 1840 !> Copy a subarray of size (kb:kt,js:jn,il:ir) centered around grid point 1838 !> (kp,jp,ip) containing the first bit of wall_flags_ 0 into the array1841 !> (kp,jp,ip) containing the first bit of wall_flags_static_0 into the array 1839 1842 !> 'vicinity'. Only copy first bit as this indicates the presence of topography. 1840 1843 !------------------------------------------------------------------------------! … … 1861 1864 DO k = kb, kt 1862 1865 vicinity(k,j,i) = MERGE( 0, 1, & 1863 BTEST( wall_flags_ 0(kp+k,jp+j,ip+i), 0 ) )1866 BTEST( wall_flags_static_0(kp+k,jp+j,ip+i), 0 ) ) 1864 1867 ENDDO 1865 1868 ENDDO … … 2260 2263 !-- value is reduced by 90%. 2261 2264 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 2262 !$ACC PRESENT(e, tend, te_m, wall_flags_ 0) &2265 !$ACC PRESENT(e, tend, te_m, wall_flags_static_0) & 2263 2266 !$ACC PRESENT(tsc(3:3)) & 2264 2267 !$ACC PRESENT(e_p) … … 2270 2273 ) & 2271 2274 * MERGE( 1.0_wp, 0.0_wp, & 2272 BTEST( wall_flags_ 0(k,j,i), 0 ) &2275 BTEST( wall_flags_static_0(k,j,i), 0 ) & 2273 2276 ) 2274 2277 IF ( e_p(k,j,i) < 0.0_wp ) e_p(k,j,i) = 0.1_wp * e(k,j,i) … … 2377 2380 ) & 2378 2381 * MERGE( 1.0_wp, 0.0_wp, & 2379 BTEST( wall_flags_ 0(k,j,i), 0 ) &2382 BTEST( wall_flags_static_0(k,j,i), 0 ) & 2380 2383 ) 2381 2384 IF ( diss_p(k,j,i) < 0.0_wp ) & … … 2492 2495 ) & 2493 2496 * MERGE( 1.0_wp, 0.0_wp, & 2494 BTEST( wall_flags_ 0(k,j,i), 0 ) &2497 BTEST( wall_flags_static_0(k,j,i), 0 ) & 2495 2498 ) 2496 2499 IF ( e_p(k,j,i) <= 0.0_wp ) e_p(k,j,i) = 0.1_wp * e(k,j,i) … … 2559 2562 ) & 2560 2563 * MERGE( 1.0_wp, 0.0_wp, & 2561 BTEST( wall_flags_ 0(k,j,i), 0 )&2564 BTEST( wall_flags_static_0(k,j,i), 0 )& 2562 2565 ) 2563 2566 ENDDO … … 2654 2657 !$ACC PRIVATE(surf_s, surf_e) & 2655 2658 !$ACC PRIVATE(dudx(:), dudy(:), dudz(:), dvdx(:), dvdy(:), dvdz(:), dwdx(:), dwdy(:), dwdz(:)) & 2656 !$ACC PRESENT(e, u, v, w, diss, dd2zu, ddzw, km, wall_flags_ 0) &2659 !$ACC PRESENT(e, u, v, w, diss, dd2zu, ddzw, km, wall_flags_static_0) & 2657 2660 !$ACC PRESENT(tend) & 2658 2661 !$ACC PRESENT(surf_def_h(0:1), surf_def_v(0:3)) & … … 2714 2717 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2715 2718 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2716 BTEST( wall_flags_ 0(k,j-1,i), flag_nr ) )2719 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) ) 2717 2720 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 2718 2721 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 2733 2736 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2734 2737 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2735 BTEST( wall_flags_ 0(k,j-1,i), flag_nr ) )2738 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) ) 2736 2739 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 2737 2740 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 2752 2755 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2753 2756 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2754 BTEST( wall_flags_ 0(k,j-1,i), flag_nr ) )2757 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) ) 2755 2758 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 2756 2759 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 2773 2776 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2774 2777 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2775 BTEST( wall_flags_ 0(k,j,i-1), flag_nr ) )2778 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) ) 2776 2779 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 2777 2780 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 2792 2795 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2793 2796 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2794 BTEST( wall_flags_ 0(k,j,i-1), flag_nr ) )2797 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) ) 2795 2798 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 2796 2799 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 2811 2814 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 2812 2815 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 2813 BTEST( wall_flags_ 0(k,j,i-1), flag_nr ) )2816 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) ) 2814 2817 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 2815 2818 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 2886 2889 IF ( def < 0.0_wp ) def = 0.0_wp 2887 2890 2888 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),flag_nr) )2891 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),flag_nr) ) 2889 2892 2890 2893 IF ( .NOT. diss_production ) THEN … … 2950 2953 !-- Compute tendency for TKE-production from shear 2951 2954 DO k = nzb+1, nzt 2952 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )2955 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 2953 2956 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 2954 2957 MERGE( rho_reference, prho(k,j,i), & … … 2960 2963 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 2961 2964 DO k = nzb+1, nzt 2962 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )2965 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 2963 2966 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 2964 2967 MERGE( rho_reference, prho(k,j,i), & … … 2978 2981 !$ACC PRIVATE(surf_s, surf_e) & 2979 2982 !$ACC PRIVATE(tmp_flux(nzb+1:nzt)) & 2980 !$ACC PRESENT(e, diss, kh, pt, dd2zu, drho_air_zw, wall_flags_ 0) &2983 !$ACC PRESENT(e, diss, kh, pt, dd2zu, drho_air_zw, wall_flags_static_0) & 2981 2984 !$ACC PRESENT(tend) & 2982 2985 !$ACC PRESENT(surf_def_h(0:2)) & … … 3038 3041 !$ACC LOOP PRIVATE(k, flag) 3039 3042 DO k = nzb+1, nzt 3040 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3043 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3041 3044 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3042 3045 MERGE( pt_reference, pt(k,j,i), & … … 3048 3051 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3049 3052 DO k = nzb+1, nzt 3050 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3053 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3051 3054 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3052 3055 MERGE( pt_reference, pt(k,j,i), & … … 3253 3256 !-- Compute tendency for TKE-production from shear 3254 3257 DO k = nzb+1, nzt 3255 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3258 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3256 3259 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3257 3260 MERGE( vpt_reference, vpt(k,j,i), & … … 3263 3266 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3264 3267 DO k = nzb+1, nzt 3265 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3268 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3266 3269 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3267 3270 MERGE( vpt_reference, vpt(k,j,i), & … … 3398 3401 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3399 3402 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3400 BTEST( wall_flags_ 0(k,j-1,i), flag_nr ) )3403 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) ) 3401 3404 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 3402 3405 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 3416 3419 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3417 3420 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3418 BTEST( wall_flags_ 0(k,j-1,i), flag_nr ) )3421 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) ) 3419 3422 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 3420 3423 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 3434 3437 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3435 3438 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3436 BTEST( wall_flags_ 0(k,j-1,i), flag_nr ) )3439 BTEST( wall_flags_static_0(k,j-1,i), flag_nr ) ) 3437 3440 dudy(k) = sign_dir * usvs / ( km_neutral + 1E-10_wp ) 3438 3441 dwdy(k) = sign_dir * wsvs / ( km_neutral + 1E-10_wp ) … … 3454 3457 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3455 3458 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3456 BTEST( wall_flags_ 0(k,j,i-1), flag_nr ) )3459 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) ) 3457 3460 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 3458 3461 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 3472 3475 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3473 3476 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3474 BTEST( wall_flags_ 0(k,j,i-1), flag_nr ) )3477 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) ) 3475 3478 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 3476 3479 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 3490 3493 !-- -1.0 for right-facing wall, 1.0 for left-facing wall 3491 3494 sign_dir = MERGE( 1.0_wp, -1.0_wp, & 3492 BTEST( wall_flags_ 0(k,j,i-1), flag_nr ) )3495 BTEST( wall_flags_static_0(k,j,i-1), flag_nr ) ) 3493 3496 dvdx(k) = sign_dir * vsus / ( km_neutral + 1E-10_wp ) 3494 3497 dwdx(k) = sign_dir * wsus / ( km_neutral + 1E-10_wp ) … … 3558 3561 IF ( def < 0.0_wp ) def = 0.0_wp 3559 3562 3560 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),flag_nr) )3563 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),flag_nr) ) 3561 3564 3562 3565 IF ( .NOT. diss_production ) THEN … … 3615 3618 !-- Compute tendency for TKE-production from shear 3616 3619 DO k = nzb+1, nzt 3617 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3620 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3618 3621 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3619 3622 MERGE( rho_reference, prho(k,j,i), & … … 3625 3628 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3626 3629 DO k = nzb+1, nzt 3627 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3630 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3628 3631 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3629 3632 MERGE( rho_reference, prho(k,j,i), & … … 3684 3687 !-- Compute tendency for TKE-production from shear 3685 3688 DO k = nzb+1, nzt 3686 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3689 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3687 3690 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3688 3691 MERGE( pt_reference, pt(k,j,i), & … … 3694 3697 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3695 3698 DO k = nzb+1, nzt 3696 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3699 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3697 3700 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3698 3701 MERGE( pt_reference, pt(k,j,i), & … … 3893 3896 !-- Compute tendency for TKE-production from shear 3894 3897 DO k = nzb+1, nzt 3895 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3898 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3896 3899 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3897 3900 MERGE( vpt_reference, vpt(k,j,i), & … … 3903 3906 !-- RANS mode: Compute tendency for dissipation-rate-production from shear 3904 3907 DO k = nzb+1, nzt 3905 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_ 0(k,j,i),0) )3908 flag = MERGE( 1.0_wp, 0.0_wp, BTEST(wall_flags_static_0(k,j,i),0) ) 3906 3909 tend(k,j,i) = tend(k,j,i) + flag * tmp_flux(k) * ( g / & 3907 3910 MERGE( vpt_reference, vpt(k,j,i), & … … 3969 3972 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 3970 3973 !$ACC PRIVATE(l, l_stable, dvar_dz) & 3971 !$ACC PRESENT(diss, e, var, wall_flags_ 0) &3974 !$ACC PRESENT(diss, e, var, wall_flags_static_0) & 3972 3975 !$ACC PRESENT(dd2zu, l_grid, l_wall) 3973 3976 DO i = nxl, nxr … … 3999 4002 diss(k,j,i) = ( 0.19_wp + 0.74_wp * l / l_wall(k,j,i) ) & 4000 4003 * e(k,j,i) * SQRT( e(k,j,i) ) / l & 4001 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4004 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4002 4005 4003 4006 ENDDO … … 4010 4013 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4011 4014 !$ACC PRIVATE(l_stable, duv2_dz2, rif, dvar_dz) & 4012 !$ACC PRESENT(diss, e, u, v, var, wall_flags_ 0) &4015 !$ACC PRESENT(diss, e, u, v, var, wall_flags_static_0) & 4013 4016 !$ACC PRESENT(dd2zu, l_black, l_wall) 4014 4017 DO i = nxl, nxr … … 4057 4060 4058 4061 diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) ) / l_stable(k) & 4059 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4062 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4060 4063 4061 4064 ENDDO … … 4069 4072 4070 4073 !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) & 4071 !$ACC PRESENT(diss, e, km, tend, wall_flags_ 0) &4074 !$ACC PRESENT(diss, e, km, tend, wall_flags_static_0) & 4072 4075 !$ACC PRESENT(ddzu, ddzw, rho_air_zw, drho_air) 4073 4076 DO i = nxl, nxr … … 4092 4095 ) * dsig_e & 4093 4096 * MERGE( 1.0_wp, 0.0_wp, & 4094 BTEST( wall_flags_ 0(k,j,i), 0 ) ) &4097 BTEST( wall_flags_static_0(k,j,i), 0 ) ) & 4095 4098 - diss(k,j,i) 4096 4099 … … 4198 4201 diss(k,j,i) = ( 0.19_wp + 0.74_wp * l / l_wall(k,j,i) ) & 4199 4202 * e(k,j,i) * SQRT( e(k,j,i) ) / l & 4200 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4203 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4201 4204 ENDDO 4202 4205 … … 4242 4245 DO k = nzb+1, nzt 4243 4246 diss(k,j,i) = c_0**3 * e(k,j,i) * SQRT( e(k,j,i) ) / l_stable(k) & 4244 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4247 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4245 4248 ENDDO 4246 4249 … … 4271 4274 ) * dsig_e & 4272 4275 * MERGE( 1.0_wp, 0.0_wp, & 4273 BTEST( wall_flags_ 0(k,j,i), 0 ) )&4276 BTEST( wall_flags_static_0(k,j,i), 0 ) )& 4274 4277 - diss(k,j,i) 4275 4278 … … 4334 4337 ! 4335 4338 !-- Predetermine flag to mask topography 4336 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4339 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4337 4340 4338 4341 tend(k,j,i) = tend(k,j,i) + & … … 4390 4393 ! 4391 4394 !-- Predetermine flag to mask topography 4392 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4395 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4393 4396 4394 4397 ! … … 4451 4454 DO k = nzb+1, nzt 4452 4455 e(k,j,i) = MAX( e(k,j,i), e_min ) * & 4453 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4456 MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4454 4457 ENDDO 4455 4458 ENDDO … … 4662 4665 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4663 4666 !$ACC PRIVATE(dvar_dz, l, l_stable, l_v) & 4664 !$ACC PRESENT(wall_flags_ 0, var, dd2zu, e, l_wall, l_grid, rmask) &4667 !$ACC PRESENT(wall_flags_static_0, var, dd2zu, e, l_wall, l_grid, rmask) & 4665 4668 !$ACC PRESENT(kh, km, sums_l_l) 4666 4669 DO i = nxlg, nxrg … … 4694 4697 4695 4698 l_v(k) = MIN( l_wall(k,j,i), l_stable(k) ) & 4696 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4699 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4697 4700 l = l_v(k) 4698 4701 ! … … 4719 4722 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4720 4723 !$ACC PRIVATE(dvar_dz, duv2_dz2, l_stable, l_v, rif) & 4721 !$ACC PRESENT(wall_flags_ 0, var, dd2zu, e, u, v, l_wall, l_black, rmask) &4724 !$ACC PRESENT(wall_flags_static_0, var, dd2zu, e, u, v, l_wall, l_black, rmask) & 4722 4725 !$ACC PRESENT(kh, km, sums_l_l) 4723 4726 DO i = nxlg, nxrg … … 4767 4770 !DIR$ IVDEP 4768 4771 DO k = nzb+1, nzt 4769 l_v(k) = l_stable(k) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4772 l_v(k) = l_stable(k) * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4770 4773 km(k,j,i) = c_0 * l_v(k) * SQRT( e(k,j,i) ) 4771 4774 kh(k,j,i) = km(k,j,i) / prandtl_number … … 4788 4791 !$ACC PARALLEL LOOP COLLAPSE(2) PRIVATE(i, j) & 4789 4792 !$ACC PRIVATE(l_v) & 4790 !$ACC PRESENT(wall_flags_ 0, e, diss, rmask) &4793 !$ACC PRESENT(wall_flags_static_0, e, diss, rmask) & 4791 4794 !$ACC PRESENT(kh, km, sums_l_l) 4792 4795 DO i = nxlg, nxrg … … 4799 4802 4800 4803 l_v(k) = c_0**3 * e(k,j,i) * SQRT(e(k,j,i)) / ( diss(k,j,i) + 1.0E-30_wp ) & 4801 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4804 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4802 4805 4803 4806 km(k,j,i) = c_0 * SQRT( e(k,j,i) ) * l_v(k) … … 4936 4939 DO k = nzb+1, nzt 4937 4940 4938 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_ 0(k,j,i), 0 ) )4941 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_static_0(k,j,i), 0 ) ) 4939 4942 4940 4943 !
Note: See TracChangeset
for help on using the changeset viewer.
