Changeset 1365 for palm/trunk/SOURCE/flow_statistics.f90
- Timestamp:
- Apr 22, 2014 3:03:56 PM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/flow_statistics.f90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/flow_statistics.f90
r1354 r1365 21 21 ! Current revisions: 22 22 ! ----------------- 23 ! 23 ! Output of large scale advection, large scale subsidence and nudging tendencies 24 ! +sums_ls_l, ngp_sums_ls, use_subsidence_tendencies 24 25 ! 25 26 ! Former revisions: … … 95 96 96 97 USE arrays_3d, & 97 ONLY : ddzu, ddzw, e, hyp, km, kh,nr, p, prho, pt, q, qc, ql, qr, & 98 qs, qsws, qswst, rho, sa, saswsb, saswst, shf, ts, tswst, u, & 99 ug, us, usws, uswst, vsws, v, vg, vpt, vswst, w, w_subs, zw 98 ONLY: ddzu, ddzw, e, hyp, km, kh, nr, p, prho, pt, pt_lsa, pt_subs, q,& 99 qc, ql, qr, qs, qsws, qswst, q_lsa, q_subs, rho, sa, saswsb, & 100 saswst, shf, time_vert, ts, tswst, u, ug, us, usws, uswst, vsws,& 101 v, vg, vpt, vswst, w, w_subs, zw 100 102 101 103 USE cloud_parameters, & … … 104 106 USE control_parameters, & 105 107 ONLY : average_count_pr, cloud_droplets, cloud_physics, do_sum, & 106 dt_3d, g, humidity, icloud_scheme, kappa, max_pr_user, & 107 message_string, ocean, passive_scalar, precipitation, & 108 use_surface_fluxes, use_top_fluxes, ws_scheme_mom, ws_scheme_sca 108 dt_3d, g, humidity, icloud_scheme, kappa, large_scale_forcing, & 109 large_scale_subsidence, max_pr_user, message_string, ocean, & 110 passive_scalar, precipitation, simulated_time, & 111 use_subsidence_tendencies, use_surface_fluxes, use_top_fluxes, & 112 ws_scheme_mom, ws_scheme_sca 109 113 110 114 USE cpulog, & … … 115 119 116 120 USE indices, & 117 ONLY : ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, ngp_sums, nxl, & 118 nxr, nyn, nys, nzb, nzb_diff_s_inner, nzb_s_inner, nzt, nzt_diff 121 ONLY : ngp_2dh, ngp_2dh_s_inner, ngp_3d, ngp_3d_inner, ngp_sums, & 122 ngp_sums_ls, nxl, nxr, nyn, nys, nzb, nzb_diff_s_inner, & 123 nzb_s_inner, nzt, nzt_diff 119 124 120 125 USE kinds … … 129 134 INTEGER(iwp) :: j !: 130 135 INTEGER(iwp) :: k !: 136 INTEGER(iwp) :: nt !: 131 137 INTEGER(iwp) :: omp_get_thread_num !: 132 138 INTEGER(iwp) :: sr !: … … 136 142 137 143 REAL(wp) :: dptdz_threshold !: 144 REAL(wp) :: fac !: 138 145 REAL(wp) :: height !: 139 146 REAL(wp) :: pts !: … … 982 989 983 990 ! 991 !-- Collect current large scale advection and subsidence tendencies for 992 !-- data output 993 IF ( large_scale_forcing ) THEN 994 ! 995 !-- Interpolation in time of LSF_DATA 996 nt = 1 997 DO WHILE ( simulated_time > time_vert(nt) ) 998 nt = nt + 1 999 ENDDO 1000 IF ( simulated_time /= time_vert(nt) ) THEN 1001 nt = nt - 1 1002 ENDIF 1003 1004 fac = ( simulated_time-time_vert(nt) ) & 1005 / ( time_vert(nt+1)-time_vert(nt) ) 1006 1007 1008 DO k = nzb, nzt 1009 sums_ls_l(k,0) = pt_lsa(k,nt) & 1010 + fac * ( pt_lsa(k,nt+1) - pt_lsa(k,nt) ) 1011 sums_ls_l(k,1) = q_lsa(k,nt) & 1012 + fac * ( q_lsa(k,nt+1) - q_lsa(k,nt) ) 1013 ENDDO 1014 1015 IF ( large_scale_subsidence .AND. use_subsidence_tendencies ) THEN 1016 1017 DO k = nzb, nzt 1018 sums_ls_l(k,2) = pt_subs(k,nt) & 1019 + fac * ( pt_subs(k,nt+1) - pt_subs(k,nt) ) 1020 sums_ls_l(k,3) = q_subs(k,nt) & 1021 + fac * ( q_subs(k,nt+1) - q_subs(k,nt) ) 1022 ENDDO 1023 1024 ENDIF 1025 1026 ENDIF 1027 1028 ! 984 1029 !-- Calculate the user-defined profiles 985 1030 CALL user_statistics( 'profiles', sr, tn ) … … 1007 1052 !-- Compute total sum from local sums 1008 1053 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 1009 CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, &1054 CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, & 1010 1055 MPI_SUM, comm2d, ierr ) 1056 IF ( large_scale_forcing ) THEN 1057 CALL MPI_ALLREDUCE( sums_ls_l(nzb,2), sums(nzb,83), ngp_sums_ls, & 1058 MPI_REAL, MPI_SUM, comm2d, ierr ) 1059 ENDIF 1011 1060 #else 1012 1061 sums = sums_l(:,:,0) 1062 IF ( large_scale_forcing ) THEN 1063 sums(:,81:88) = sums_ls_l 1064 ENDIF 1013 1065 #endif 1014 1066 … … 1031 1083 sums(k,64) = sums(k,64) / ngp_2dh_s_inner(k,sr) 1032 1084 sums(k,65:69) = sums(k,65:69) / ngp_2dh(sr) 1033 sums(k,70:pr_palm-2) = sums(k,70:pr_palm-2)/ ngp_2dh_s_inner(k,sr) 1085 sums(k,70:80) = sums(k,70:80) / ngp_2dh_s_inner(k,sr) 1086 sums(k,81:88) = sums(k,81:88) / ngp_2dh(sr) 1087 sums(k,89:pr_palm-2) = sums(k,89:pr_palm-2)/ ngp_2dh_s_inner(k,sr) 1034 1088 ENDDO 1035 1089 … … 1130 1184 hom(:,1,80,sr) = w_subs ! w_subs 1131 1185 1186 IF ( large_scale_forcing ) THEN 1187 hom(:,1,81,sr) = sums_ls_l(:,0) ! pt_lsa 1188 hom(:,1,82,sr) = sums_ls_l(:,1) ! q_lsa 1189 IF ( use_subsidence_tendencies ) THEN 1190 hom(:,1,83,sr) = sums_ls_l(:,2) ! pt_subs 1191 hom(:,1,84,sr) = sums_ls_l(:,3) ! q_subs 1192 ELSE 1193 hom(:,1,83,sr) = sums(:,83) ! pt_subs 1194 hom(:,1,84,sr) = sums(:,84) ! q_subs 1195 ENDIF 1196 hom(:,1,85,sr) = sums(:,85) ! pt_nudge 1197 hom(:,1,86,sr) = sums(:,86) ! q_nudge 1198 hom(:,1,87,sr) = sums(:,87) ! u_nudge 1199 hom(:,1,88,sr) = sums(:,88) ! v_nudge 1200 ENDIF 1201 1132 1202 hom(:,1,pr_palm-1,sr) = sums(:,pr_palm-1) 1133 1203 ! upstream-parts u_x, u_y, u_z, v_x, … … 1309 1379 1310 1380 USE arrays_3d, & 1311 ONLY: ddzu, ddzw, e, hyp, km, kh,nr, p, prho, pt, q, qc, ql, qr, & 1312 qs, qsws, qswst, rho, sa, saswsb, saswst, shf, ts, tswst, u, & 1313 ug, us, usws, uswst, vsws, v, vg, vpt, vswst, w, w_subs, zw 1381 ONLY: ddzu, ddzw, e, hyp, km, kh, nr, p, prho, pt, pt_lsa, pt_subs, q,& 1382 qc, ql, qr, qs, qsws, qswst, q_lsa, q_subs, rho, sa, saswsb, & 1383 saswst, shf, time_vert, ts, tswst, u, ug, us, usws, uswst, vsws,& 1384 v, vg, vpt, vswst, w, w_subs, zw 1385 1314 1386 1315 1387 USE cloud_parameters, & … … 1317 1389 1318 1390 USE control_parameters, & 1319 ONLY: average_count_pr, cloud_droplets, cloud_physics, do_sum, & 1320 dt_3d, g, humidity, icloud_scheme, kappa, max_pr_user, & 1321 message_string, ocean, passive_scalar, precipitation, & 1322 use_surface_fluxes, use_top_fluxes, ws_scheme_mom, ws_scheme_sca 1391 ONLY : average_count_pr, cloud_droplets, cloud_physics, do_sum, & 1392 dt_3d, g, humidity, icloud_scheme, kappa, large_scale_forcing, & 1393 large_scale_subsidence, max_pr_user, message_string, ocean, & 1394 passive_scalar, precipitation, simulated_time, & 1395 use_subsidence_tendencies, use_surface_fluxes, use_top_fluxes, & 1396 ws_scheme_mom, ws_scheme_sca 1323 1397 1324 1398 USE cpulog, & … … 1343 1417 INTEGER(iwp) :: j !: 1344 1418 INTEGER(iwp) :: k !: 1419 INTEGER(iwp) :: nt !: 1345 1420 INTEGER(iwp) :: omp_get_thread_num !: 1346 1421 INTEGER(iwp) :: sr !: … … 1350 1425 1351 1426 REAL(wp) :: dptdz_threshold !: 1427 REAL(wp) :: fac !: 1352 1428 REAL(wp) :: height !: 1353 1429 REAL(wp) :: pts !: … … 2661 2737 2662 2738 ! 2739 !-- Collect current large scale advection and subsidence tendencies for 2740 !-- data output 2741 IF ( large_scale_forcing ) THEN 2742 ! 2743 !-- Interpolation in time of LSF_DATA 2744 nt = 1 2745 DO WHILE ( simulated_time > time_vert(nt) ) 2746 nt = nt + 1 2747 ENDDO 2748 IF ( simulated_time /= time_vert(nt) ) THEN 2749 nt = nt - 1 2750 ENDIF 2751 2752 fac = ( simulated_time-time_vert(nt) ) & 2753 / ( time_vert(nt+1)-time_vert(nt) ) 2754 2755 2756 DO k = nzb, nzt 2757 sums_ls_l(k,0) = pt_lsa(k,nt) & 2758 + fac * ( pt_lsa(k,nt+1) - pt_lsa(k,nt) ) 2759 sums_ls_l(k,1) = q_lsa(k,nt) & 2760 + fac * ( q_lsa(k,nt+1) - q_lsa(k,nt) ) 2761 ENDDO 2762 2763 IF ( large_scale_subsidence .AND. use_subsidence_tendencies ) THEN 2764 2765 DO k = nzb, nzt 2766 sums_ls_l(k,2) = pt_subs(k,nt) & 2767 + fac * ( pt_subs(k,nt+1) - pt_subs(k,nt) ) 2768 sums_ls_l(k,3) = q_subs(k,nt) & 2769 + fac * ( q_subs(k,nt+1) - q_subs(k,nt) ) 2770 ENDDO 2771 2772 ENDIF 2773 2774 ENDIF 2775 2776 ! 2663 2777 !-- Calculate the user-defined profiles 2664 2778 CALL user_statistics( 'profiles', sr, tn ) … … 2691 2805 CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, & 2692 2806 MPI_SUM, comm2d, ierr ) 2807 IF ( large_scale_forcing ) THEN 2808 CALL MPI_ALLREDUCE( sums_ls_l(nzb,2), sums(nzb,83), ngp_sums_ls, & 2809 MPI_REAL, MPI_SUM, comm2d, ierr ) 2810 ENDIF 2693 2811 #else 2694 2812 sums = sums_l(:,:,0) 2813 IF ( large_scale_forcing ) THEN 2814 sums(:,81:88) = sums_ls_l 2815 ENDIF 2695 2816 #endif 2696 2817 … … 2712 2833 sums(k,55:63) = sums(k,55:63) / ngp_2dh(sr) 2713 2834 sums(k,64) = sums(k,64) / ngp_2dh_s_inner(k,sr) 2714 sums(k,65:69) = sums(k,65:69) / ngp_2dh(sr) 2715 sums(k,70:pr_palm-2) = sums(k,70:pr_palm-2)/ ngp_2dh_s_inner(k,sr) 2835 sums(k,70:80) = sums(k,70:80) / ngp_2dh_s_inner(k,sr) 2836 sums(k,81:88) = sums(k,81:88) / ngp_2dh(sr) 2837 sums(k,89:pr_palm-2) = sums(k,89:pr_palm-2)/ ngp_2dh_s_inner(k,sr) 2716 2838 ENDDO 2717 2839 … … 2812 2934 hom(:,1,80,sr) = w_subs ! w_subs 2813 2935 2936 IF ( large_scale_forcing ) THEN 2937 hom(:,1,81,sr) = sums_ls_l(:,0) ! pt_lsa 2938 hom(:,1,82,sr) = sums_ls_l(:,1) ! q_lsa 2939 IF ( use_subsidence_tendencies ) THEN 2940 hom(:,1,83,sr) = sums_ls_l(:,2) ! pt_subs 2941 hom(:,1,84,sr) = sums_ls_l(:,3) ! q_subs 2942 ELSE 2943 hom(:,1,83,sr) = sums(:,83) ! pt_subs 2944 hom(:,1,84,sr) = sums(:,84) ! q_subs 2945 ENDIF 2946 hom(:,1,85,sr) = sums(:,85) ! pt_nudge 2947 hom(:,1,86,sr) = sums(:,86) ! q_nudge 2948 hom(:,1,87,sr) = sums(:,87) ! u_nudge 2949 hom(:,1,88,sr) = sums(:,88) ! v_nudge 2950 END IF 2951 2814 2952 hom(:,1,pr_palm-1,sr) = sums(:,pr_palm-1) 2815 2953 ! upstream-parts u_x, u_y, u_z, v_x,
Note: See TracChangeset
for help on using the changeset viewer.
