Changeset 1960 for palm/trunk/SOURCE/flow_statistics.f90
- Timestamp:
- Jul 12, 2016 4:34:24 PM (8 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/flow_statistics.f90 (modified) (36 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/flow_statistics.f90
r1919 r1960 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Separate humidity and passive scalar 22 22 ! 23 23 ! Former revisions: … … 197 197 USE arrays_3d, & 198 198 ONLY: ddzu, ddzw, e, hyp, km, kh, nr, ol, p, prho, prr, pt, q, qc, ql,& 199 qr, qs, qsws, qswst, rho, sa, saswsb, saswst, shf, td_lsa_lpt, & 200 td_lsa_q, td_sub_lpt, td_sub_q, time_vert, ts, tswst, u, ug, us,& 201 usws, uswst, vsws, v, vg, vpt, vswst, w, w_subs, zw 199 qr, qs, qsws, qswst, rho, s, sa, ss, ssws, sswst, saswsb, & 200 saswst, shf, td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, & 201 time_vert, ts, tswst, u, ug, us, usws, uswst, vsws, v, vg, vpt, & 202 vswst, w, w_subs, zw 202 203 203 204 USE cloud_parameters, & … … 360 361 361 362 DO i = 0, threads_per_task-1 362 sums_l(:,17,i) = sums_wspts_ws_l(:,i) ! w*pt* from advec_s_ws363 IF ( ocean ) sums_l(:,66,i)= sums_wssas_ws_l(:,i) ! w*sa*364 IF ( humidity .OR. passive_scalar ) sums_l(:,49,i) = &365 sums_wsqs_ws_l(:,i) !w*q*363 sums_l(:,17,i) = sums_wspts_ws_l(:,i) ! w*pt* 364 IF ( ocean ) sums_l(:,66,i) = sums_wssas_ws_l(:,i) ! w*sa* 365 IF ( humidity ) sums_l(:,49,i) = sums_wsqs_ws_l(:,i) ! w*q* 366 IF ( passive_scalar ) sums_l(:,116,i) = sums_wsss_ws_l(:,i) ! w*s* 366 367 ENDDO 367 368 … … 440 441 DO j = nys, nyn 441 442 DO k = nzb_s_inner(j,i), nzt+1 442 sums_l(k, 41,tn) = sums_l(k,41,tn) + q(k,j,i) * rmask(j,i,sr)443 sums_l(k,117,tn) = sums_l(k,117,tn) + s(k,j,i) * rmask(j,i,sr) 443 444 ENDDO 444 445 ENDDO … … 465 466 ENDIF 466 467 IF ( passive_scalar ) THEN 467 sums_l(:, 41,0) = sums_l(:,41,0) + sums_l(:,41,i)468 sums_l(:,117,0) = sums_l(:,117,0) + sums_l(:,117,i) 468 469 ENDIF 469 470 ENDDO … … 506 507 IF ( passive_scalar ) THEN 507 508 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 508 CALL MPI_ALLREDUCE( sums_l(nzb, 41,0), sums(nzb,41), nzt+2-nzb, &509 CALL MPI_ALLREDUCE( sums_l(nzb,117,0), sums(nzb,117), nzt+2-nzb, & 509 510 MPI_REAL, MPI_SUM, comm2d, ierr ) 510 511 ENDIF … … 522 523 ENDIF 523 524 ENDIF 524 IF ( passive_scalar ) sums(:, 41) = sums_l(:,41,0)525 IF ( passive_scalar ) sums(:,117) = sums_l(:,117,0) 525 526 #endif 526 527 … … 560 561 ! 561 562 !-- Passive scalar 562 IF ( passive_scalar ) hom(:,1, 41,sr) = sums(:,41) /&563 ngp_2dh_s_inner(:,sr) ! s (q)563 IF ( passive_scalar ) hom(:,1,117,sr) = sums(:,117) / & 564 ngp_2dh_s_inner(:,sr) ! s 564 565 565 566 ! … … 598 599 ( q(k,j,i)-hom(k,1,41,sr) )**2 * rmask(j,i,sr) 599 600 ENDIF 600 601 IF ( passive_scalar ) THEN 602 sums_l(k,118,tn) = sums_l(k,118,tn) + & 603 ( s(k,j,i)-hom(k,1,117,sr) )**2 * rmask(j,i,sr) 604 ENDIF 601 605 ! 602 606 !-- Higher moments … … 627 631 sums_l(nzb+12,pr_palm,tn) = sums_l(nzb+12,pr_palm,tn) + & 628 632 qs(j,i) * rmask(j,i,sr) 633 ENDIF 634 IF ( passive_scalar ) THEN 635 sums_l(nzb+13,pr_palm,tn) = sums_l(nzb+13,pr_palm,tn) + & 636 ss(j,i) * rmask(j,i,sr) 629 637 ENDIF 630 638 ENDDO … … 738 746 !-- Passive scalar flux 739 747 IF ( passive_scalar ) THEN 740 sums_l(k, 48,tn) = sums_l(k,48,tn)&748 sums_l(k,119,tn) = sums_l(k,119,tn) & 741 749 - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) )& 742 * ( q(k+1,j,i) - q(k,j,i) ) &750 * ( s(k+1,j,i) - s(k,j,i) ) & 743 751 * ddzu(k+1) * rmask(j,i,sr) 744 752 ENDIF … … 784 792 ENDIF 785 793 IF ( passive_scalar ) THEN 786 sums_l(nzb, 48,tn) = sums_l(nzb,48,tn) + &787 qsws(j,i) * rmask(j,i,sr) ! w"q" (w"qv")794 sums_l(nzb,119,tn) = sums_l(nzb,119,tn) + & 795 ssws(j,i) * rmask(j,i,sr) ! w"s" 788 796 ENDIF 789 797 ENDIF … … 863 871 ENDIF 864 872 IF ( passive_scalar ) THEN 865 sums_l(nzt, 48,tn) = sums_l(nzt,48,tn) + &866 qswst(j,i) * rmask(j,i,sr) ! w"q" (w"qv")873 sums_l(nzt,119,tn) = sums_l(nzt,119,tn) + & 874 sswst(j,i) * rmask(j,i,sr) ! w"s" 867 875 ENDIF 868 876 ENDIF … … 953 961 IF ( passive_scalar .AND. ( .NOT. ws_scheme_sca & 954 962 .OR. sr /= 0 ) ) THEN 955 pts = 0.5_wp * ( q(k,j,i) - hom(k,1,41,sr) +&956 q(k+1,j,i) - hom(k+1,1,41,sr) )957 sums_l(k, 49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) *&963 pts = 0.5_wp * ( s(k,j,i) - hom(k,1,117,sr) + & 964 s(k+1,j,i) - hom(k+1,1,117,sr) ) 965 sums_l(k,116,tn) = sums_l(k,116,tn) + pts * w(k,j,i) * & 958 966 rmask(j,i,sr) 959 967 ENDIF … … 1011 1019 q(k+1,j,i) - hom(k+1,1,41,sr) ) 1012 1020 sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * & 1021 rmask(j,i,sr) 1022 ENDIF 1023 IF ( passive_scalar ) THEN 1024 pts = 0.5_wp * ( s(k,j,i) - hom(k,1,117,sr) + & 1025 s(k+1,j,i) - hom(k+1,1,117,sr) ) 1026 sums_l(k,116,tn) = sums_l(k,116,tn) + pts * w(k,j,i) * & 1013 1027 rmask(j,i,sr) 1014 1028 ENDIF … … 1279 1293 sums(k,81:88) = sums(k,81:88) / ngp_2dh(sr) 1280 1294 sums(k,89:114) = sums(k,89:114) / ngp_2dh(sr) 1295 sums(k,116) = sums(k,116) / ngp_2dh(sr) 1296 sums(k,119) = sums(k,119) / ngp_2dh(sr) 1281 1297 IF ( ngp_2dh_s_inner(k,sr) /= 0 ) THEN 1282 1298 sums(k,8:11) = sums(k,8:11) / ngp_2dh_s_inner(k,sr) … … 1287 1303 sums(k,64) = sums(k,64) / ngp_2dh_s_inner(k,sr) 1288 1304 sums(k,70:80) = sums(k,70:80) / ngp_2dh_s_inner(k,sr) 1289 sums(k,115:pr_palm-2) = sums(k,115:pr_palm-2) / ngp_2dh_s_inner(k,sr) 1305 sums(k,118) = sums(k,118) / ngp_2dh_s_inner(k,sr) 1306 sums(k,120:pr_palm-2) = sums(k,120:pr_palm-2) / ngp_2dh_s_inner(k,sr) 1290 1307 ENDIF 1291 1308 ENDDO … … 1298 1315 ngp_2dh(sr) 1299 1316 sums(nzb+12,pr_palm) = sums(nzb+12,pr_palm) / & ! qs 1317 ngp_2dh(sr) 1318 sums(nzb+13,pr_palm) = sums(nzb+13,pr_palm) / & ! ss 1300 1319 ngp_2dh(sr) 1301 1320 !-- eges, e* … … 1443 1462 hom(:,1,114,sr) = sums(:,114) !: L 1444 1463 1464 IF ( passive_scalar ) THEN 1465 hom(:,1,119,sr) = sums(:,119) ! w"s" 1466 hom(:,1,116,sr) = sums(:,116) ! w*s* 1467 hom(:,1,120,sr) = sums(:,119) + sums(:,116) ! ws 1468 ENDIF 1469 1445 1470 hom(:,1,pr_palm,sr) = sums(:,pr_palm) 1446 1471 ! u*, w'u', w'v', t* (in last profile) … … 1589 1614 ts_value(23,sr) = hom(nzb+12,1,pr_palm,sr) ! q* 1590 1615 1616 IF ( passive_scalar ) THEN 1617 ts_value(24,sr) = hom(nzb+13,1,119,sr) ! w"s" ( to do ! ) 1618 ts_value(25,sr) = hom(nzb+13,1,pr_palm,sr) ! s* 1619 ENDIF 1620 1591 1621 ! 1592 1622 !-- Collect land surface model timeseries … … 1660 1690 USE arrays_3d, & 1661 1691 ONLY: ddzu, ddzw, e, hyp, km, kh, nr, p, prho, pt, q, qc, ql, qr, qs, & 1662 qsws, qswst, rho, sa, saswsb, saswst, shf, td_lsa_lpt, td_lsa_q,& 1663 td_sub_lpt, td_sub_q, time_vert, ts, tswst, u, ug, us, usws, & 1664 uswst, vsws, v, vg, vpt, vswst, w, w_subs, zw 1692 qsws, qswst, rho, s, sa, saswsb, saswst, shf, ss, ssws, sswst, & 1693 td_lsa_lpt, td_lsa_q, td_sub_lpt, td_sub_q, time_vert, ts, & 1694 tswst, u, ug, us, usws, uswst, vsws, v, vg, vpt, vswst, w, & 1695 w_subs, zw 1665 1696 1666 1697 … … 1833 1864 sums_l(:,17,i) = sums_wspts_ws_l(:,i) ! w*pt* from advec_s_ws 1834 1865 IF ( ocean ) sums_l(:,66,i) = sums_wssas_ws_l(:,i) ! w*sa* 1835 IF ( humidity .OR. passive_scalar ) sums_l(:,49,i) = &1836 sums_wsqs_ws_l(:,i) !w*q*1866 IF ( humidity ) sums_l(:,49,i) = sums_wsqs_ws_l(:,i) !w*q* 1867 IF ( passive_scalar ) sums_l(:,116,i) = sums_wsss_ws_l(:,i) !w*s* 1837 1868 ENDDO 1838 1869 … … 1938 1969 IF ( passive_scalar ) THEN 1939 1970 !$OMP DO 1940 !$acc parallel loop gang present( q, rflags_invers, rmask, sums_l ) create( s1 )1971 !$acc parallel loop gang present( s, rflags_invers, rmask, sums_l ) create( s1 ) 1941 1972 DO k = nzb, nzt+1 1942 1973 s1 = 0 … … 1944 1975 DO i = nxl, nxr 1945 1976 DO j = nys, nyn 1946 s1 = s1 + q(k,j,i) * rmask(j,i,sr) * rflags_invers(j,i,k+1)1947 ENDDO 1948 ENDDO 1949 sums_l(k, 41,tn) = s11977 s1 = s1 + s(k,j,i) * rmask(j,i,sr) * rflags_invers(j,i,k+1) 1978 ENDDO 1979 ENDDO 1980 sums_l(k,117,tn) = s1 1950 1981 ENDDO 1951 1982 !$acc end parallel loop … … 1981 2012 IF ( passive_scalar ) THEN 1982 2013 !$acc parallel present( sums_l ) 1983 sums_l(:, 41,0) = sums_l(:,41,0) + sums_l(:,41,i)2014 sums_l(:,117,0) = sums_l(:,117,0) + sums_l(:,117,i) 1984 2015 !$acc end parallel 1985 2016 ENDIF … … 2024 2055 IF ( passive_scalar ) THEN 2025 2056 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 2026 CALL MPI_ALLREDUCE( sums_l(nzb, 41,0), sums(nzb,41), nzt+2-nzb,&2057 CALL MPI_ALLREDUCE( sums_l(nzb,117,0), sums(nzb,117), nzt+2-nzb, & 2027 2058 MPI_REAL, MPI_SUM, comm2d, ierr ) 2028 2059 ENDIF … … 2053 2084 IF ( passive_scalar ) THEN 2054 2085 !$acc parallel present( sums, sums_l ) 2055 sums(:, 41) = sums_l(:,41,0)2086 sums(:,117) = sums_l(:,117,0) 2056 2087 !$acc end parallel 2057 2088 ENDIF … … 2102 2133 IF ( passive_scalar ) THEN 2103 2134 !$acc parallel present( hom, ngp_2dh_s_inner, sums ) 2104 sums(:, 41) = sums(:,41) / ngp_2dh_s_inner(:,sr)2105 hom(:,1, 41,sr) = sums(:,41) ! s (q)2135 sums(:,117) = sums(:,117) / ngp_2dh_s_inner(:,sr) 2136 hom(:,1,117,sr) = sums(:,117) ! s 2106 2137 !$acc end parallel 2107 2138 ENDIF … … 2230 2261 ENDDO 2231 2262 sums_l(nzb+12,pr_palm,tn) = s1 2263 !$acc end parallel 2264 ENDIF 2265 2266 IF ( passive_scalar ) THEN 2267 !$acc parallel present( ss, rmask, sums_l ) create( s1 ) 2268 s1 = 0 2269 !$acc loop vector collapse( 2 ) reduction( +: s1 ) 2270 DO i = nxl, nxr 2271 DO j = nys, nyn 2272 s1 = s1 + ss(j,i) * rmask(j,i,sr) 2273 ENDDO 2274 ENDDO 2275 sums_l(nzb+13,pr_palm,tn) = s1 2232 2276 !$acc end parallel 2233 2277 ENDIF … … 2411 2455 IF ( passive_scalar ) THEN 2412 2456 2413 !$acc parallel loop gang present( ddzu, kh, q, rflags_invers, rmask, sums_l ) create( s1 )2457 !$acc parallel loop gang present( ddzu, kh, s, rflags_invers, rmask, sums_l ) create( s1 ) 2414 2458 DO k = nzb, nzt_diff 2415 2459 s1 = 0 … … 2418 2462 DO j = nys, nyn 2419 2463 s1 = s1 - 0.5_wp * ( kh(k,j,i) + kh(k+1,j,i) ) & 2420 * ( q(k+1,j,i) - q(k,j,i) ) &2464 * ( s(k+1,j,i) - s(k,j,i) ) & 2421 2465 * ddzu(k+1) * rmask(j,i,sr) & 2422 2466 * rflags_invers(j,i,k+1) 2423 2467 ENDDO 2424 2468 ENDDO 2425 sums_l(k, 48,tn) = s12469 sums_l(k,119,tn) = s1 2426 2470 ENDDO 2427 2471 !$acc end parallel loop … … 2532 2576 2533 2577 !$OMP DO 2534 !$acc parallel present( qsws, rmask, sums_l ) create( s1 )2578 !$acc parallel present( ssws, rmask, sums_l ) create( s1 ) 2535 2579 s1 = 0 2536 2580 !$acc loop vector collapse( 2 ) reduction( +: s1 ) 2537 2581 DO i = nxl, nxr 2538 2582 DO j = nys, nyn 2539 s1 = s1 + qsws(j,i) * rmask(j,i,sr) ! w"q" (w"qv")2540 ENDDO 2541 ENDDO 2542 sums_l(nzb, 48,tn) = s12583 s1 = s1 + ssws(j,i) * rmask(j,i,sr) ! w"s" 2584 ENDDO 2585 ENDDO 2586 sums_l(nzb,119,tn) = s1 2543 2587 !$acc end parallel 2544 2588 … … 2651 2695 2652 2696 !$OMP DO 2653 !$acc parallel present( qswst, rmask, sums_l ) create( s1 )2697 !$acc parallel present( sswst, rmask, sums_l ) create( s1 ) 2654 2698 s1 = 0 2655 2699 !$acc loop vector collapse( 2 ) reduction( +: s1 ) 2656 2700 DO i = nxl, nxr 2657 2701 DO j = nys, nyn 2658 s1 = s1 + qswst(j,i) * rmask(j,i,sr) ! w"q" (w"qv")2659 ENDDO 2660 ENDDO 2661 sums_l(nzt, 48,tn) = s12702 s1 = s1 + sswst(j,i) * rmask(j,i,sr) ! w"s" 2703 ENDDO 2704 ENDDO 2705 sums_l(nzt,119,tn) = s1 2662 2706 !$acc end parallel 2663 2707 … … 2890 2934 IF ( passive_scalar .AND. ( .NOT. ws_scheme_sca .OR. sr /= 0 ) ) THEN 2891 2935 2892 !$acc parallel loop gang present( hom, q, rflags_invers, rmask, sums_l, w ) create( s1 )2936 !$acc parallel loop gang present( hom, s, rflags_invers, rmask, sums_l, w ) create( s1 ) 2893 2937 DO k = nzb, nzt_diff 2894 2938 s1 = 0 … … 2896 2940 DO i = nxl, nxr 2897 2941 DO j = nys, nyn 2898 s1 = s1 + 0.5_wp * ( q(k,j,i) - hom(k,1,41,sr) + &2899 q(k+1,j,i) - hom(k+1,1,41,sr) ) &2942 s1 = s1 + 0.5_wp * ( s(k,j,i) - hom(k,1,117,sr) + & 2943 s(k+1,j,i) - hom(k+1,1,117,sr) ) & 2900 2944 * w(k,j,i) * rmask(j,i,sr) & 2901 2945 * rflags_invers(j,i,k+1) … … 2981 3025 ENDDO 2982 3026 sums_l(k,49,tn) = s1 3027 ENDDO 3028 !$acc end parallel loop 3029 3030 ENDIF 3031 3032 IF ( passive_scalar ) THEN 3033 3034 !$acc parallel loop gang present( hom, s, rflags_invers, rmask, sums_l, w ) create( s1 ) 3035 DO k = nzb, nzt_diff 3036 s1 = 0 3037 !$acc loop vector collapse( 2 ) reduction( +: s1 ) 3038 DO i = nxl, nxr 3039 DO j = nys, nyn 3040 s1 = s1 + 0.5_wp * ( s(k,j,i) - hom(k,1,117,sr) + & 3041 s(k+1,j,i) - hom(k+1,1,117,sr) ) & 3042 * w(k,j,i) * rmask(j,i,sr) & 3043 * rflags_invers(j,i,k+1) 3044 ENDDO 3045 ENDDO 3046 sums_l(k,116,tn) = s1 2983 3047 ENDDO 2984 3048 !$acc end parallel loop
Note: See TracChangeset
for help on using the changeset viewer.
