Changeset 801 for palm/trunk/SOURCE/advec_ws.f90
- Timestamp:
- Jan 10, 2012 5:30:36 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r744 r801 4 4 ! Current revisions: 5 5 ! ------------------ 6 ! Bugfix concerning OpenMP parallelization. Summation of sums_wsus_ws_l, 7 ! sums_wsvs_ws_l, sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wspts_ws_l, 8 ! sums_wsqs_ws_l, sums_wssas_ws_l is now thread-safe by adding an additional 9 ! dimension. 6 10 ! 7 11 ! Former revisions: … … 135 139 IF ( ws_scheme_mom ) THEN 136 140 137 ALLOCATE( sums_wsus_ws_l(nzb:nzt+1), sums_wsvs_ws_l(nzb:nzt+1), & 138 sums_us2_ws_l(nzb:nzt+1), sums_vs2_ws_l(nzb:nzt+1), & 139 sums_ws2_ws_l(nzb:nzt+1) ) 141 ALLOCATE( sums_wsus_ws_l(nzb:nzt+1,0:threads_per_task-1), & 142 sums_wsvs_ws_l(nzb:nzt+1,0:threads_per_task-1), & 143 sums_us2_ws_l(nzb:nzt+1,0:threads_per_task-1), & 144 sums_vs2_ws_l(nzb:nzt+1,0:threads_per_task-1), & 145 sums_ws2_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 140 146 141 147 sums_wsus_ws_l = 0.0 … … 149 155 IF ( ws_scheme_sca ) THEN 150 156 151 ALLOCATE( sums_wspts_ws_l(nzb:nzt+1 ) )157 ALLOCATE( sums_wspts_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 152 158 sums_wspts_ws_l = 0.0 153 159 154 160 IF ( humidity .OR. passive_scalar ) THEN 155 ALLOCATE( sums_wsqs_ws_l(nzb:nzt+1 ) )161 ALLOCATE( sums_wsqs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 156 162 sums_wsqs_ws_l = 0.0 157 163 ENDIF 158 164 159 165 IF ( ocean ) THEN 160 ALLOCATE( sums_wssas_ws_l(nzb:nzt+1 ) )166 ALLOCATE( sums_wssas_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 161 167 sums_wssas_ws_l = 0.0 162 168 ENDIF … … 643 649 644 650 DO k = nzb_s_inner(j,i), nzt 645 sums_wspts_ws_l(k ) = sums_wspts_ws_l(k) + &651 sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) + & 646 652 ( flux_t(k) + diss_t(k) ) & 647 653 * weight_substep(intermediate_timestep_count) … … 651 657 652 658 DO k = nzb_s_inner(j,i), nzt 653 sums_wssas_ws_l(k ) = sums_wssas_ws_l(k) + &659 sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) + & 654 660 ( flux_t(k) + diss_t(k) ) & 655 661 * weight_substep(intermediate_timestep_count) … … 659 665 660 666 DO k = nzb_s_inner(j,i), nzt 661 sums_wsqs_ws_l(k ) = sums_wsqs_ws_l(k) + &667 sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn) + & 662 668 ( flux_t(k) + diss_t(k) ) & 663 669 * weight_substep(intermediate_timestep_count) … … 905 911 !-- Statistical Evaluation of u'u'. The factor has to be applied for 906 912 !-- right evaluation when gallilei_trans = .T. . 907 sums_us2_ws_l(k ) = sums_us2_ws_l(k) &913 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 908 914 + ( flux_r(k) * & 909 915 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) & … … 914 920 * weight_substep(intermediate_timestep_count) 915 921 ENDDO 916 sums_us2_ws_l(nzb_u_inner(j,i) ) = sums_us2_ws_l(nzb_u_inner(j,i)+1)922 sums_us2_ws_l(nzb_u_inner(j,i),tn) = sums_us2_ws_l(nzb_u_inner(j,i)+1,tn) 917 923 918 924 … … 1000 1006 !-- sum up the vertical momentum fluxes 1001 1007 DO k = nzb_u_inner(j,i), nzt 1002 sums_wsus_ws_l(k ) = sums_wsus_ws_l(k) &1008 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn) & 1003 1009 + ( flux_t(k) + diss_t(k) ) & 1004 1010 * weight_substep(intermediate_timestep_count) … … 1243 1249 !-- right evaluation when gallilei_trans = .T. . 1244 1250 1245 sums_vs2_ws_l(k ) = sums_vs2_ws_l(k) &1251 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 1246 1252 + ( flux_n(k) & 1247 1253 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) & … … 1253 1259 1254 1260 ENDDO 1255 sums_vs2_ws_l(nzb_v_inner(j,i) ) = sums_vs2_ws_l(nzb_v_inner(j,i)+1)1261 sums_vs2_ws_l(nzb_v_inner(j,i),tn) = sums_vs2_ws_l(nzb_v_inner(j,i)+1,tn) 1256 1262 1257 1263 ! … … 1335 1341 1336 1342 DO k = nzb_v_inner(j,i), nzt 1337 sums_wsvs_ws_l(k ) = sums_wsvs_ws_l(k) &1343 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) & 1338 1344 + ( flux_t(k) + diss_t(k) ) & 1339 1345 * weight_substep(intermediate_timestep_count) … … 1667 1673 1668 1674 DO k = nzb_w_inner(j,i), nzt 1669 sums_ws2_ws_l(k ) = sums_ws2_ws_l(k) &1675 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) & 1670 1676 + ( flux_t(k) + diss_t(k) ) & 1671 1677 * weight_substep(intermediate_timestep_count) … … 1689 1695 IMPLICIT NONE 1690 1696 1691 INTEGER :: i, j, k 1692 1697 INTEGER :: i, j, k, tn = 0 1693 1698 REAL, DIMENSION(:,:,:), POINTER :: sk 1694 1699 REAL :: flux_d, diss_d, u_comp, v_comp … … 2039 2044 CASE ( 'pt' ) 2040 2045 DO k = nzb_s_inner(j,i), nzt 2041 sums_wspts_ws_l(k ) = sums_wspts_ws_l(k) &2046 sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) & 2042 2047 + ( flux_t(k) + diss_t(k) ) & 2043 2048 * weight_substep(intermediate_timestep_count) … … 2045 2050 CASE ( 'sa' ) 2046 2051 DO k = nzb_s_inner(j,i), nzt 2047 sums_wssas_ws_l(k ) = sums_wssas_ws_l(k) &2052 sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) & 2048 2053 + ( flux_t(k) + diss_t(k) ) & 2049 2054 * weight_substep(intermediate_timestep_count) … … 2051 2056 CASE ( 'q' ) 2052 2057 DO k = nzb_s_inner(j,i), nzt 2053 sums_wsqs_ws_l(k ) = sums_wsqs_ws_l(k) &2058 sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn) & 2054 2059 + ( flux_t(k) + diss_t(k) ) & 2055 2060 * weight_substep(intermediate_timestep_count) … … 2078 2083 IMPLICIT NONE 2079 2084 2080 INTEGER :: i, j, k 2085 INTEGER :: i, j, k, tn = 0 2081 2086 REAL :: gu, gv, flux_d, diss_d, v_comp, w_comp 2082 2087 REAL, DIMENSION(nzb+1:nzt) :: swap_flux_y_local_u, swap_diss_y_local_u … … 2332 2337 swap_diss_y_local_u(k) = diss_n(k) 2333 2338 2334 sums_us2_ws_l(k ) = sums_us2_ws_l(k) &2339 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 2335 2340 + ( flux_r(k) & 2336 2341 * ( u_comp(k) - 2.0 * hom(k,1,1,0) ) & … … 2341 2346 * weight_substep(intermediate_timestep_count) 2342 2347 ENDDO 2343 sums_us2_ws_l(nzb_u_inner(j,i) ) = sums_us2_ws_l(nzb_u_inner(j,i)+1)2348 sums_us2_ws_l(nzb_u_inner(j,i),tn) = sums_us2_ws_l(nzb_u_inner(j,i)+1,tn) 2344 2349 ENDDO 2345 2350 ENDDO … … 2434 2439 !-- at last vertical momentum flux is accumulated 2435 2440 DO k = nzb_u_inner(j,i), nzt 2436 sums_wsus_ws_l(k ) = sums_wsus_ws_l(k) &2441 sums_wsus_ws_l(k,tn) = sums_wsus_ws_l(k,tn) & 2437 2442 + ( flux_t(k) + diss_t(k) ) & 2438 2443 * weight_substep(intermediate_timestep_count) … … 2460 2465 2461 2466 2462 INTEGER :: i, j, k 2467 INTEGER :: i, j, k, tn = 0 2463 2468 REAL :: gu, gv, flux_l, flux_s, flux_d, diss_l, diss_s, diss_d, & 2464 2469 u_comp, w_comp … … 2711 2716 swap_diss_y_local_v(k) = diss_n(k) 2712 2717 2713 sums_vs2_ws_l(k ) = sums_vs2_ws_l(k) &2718 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 2714 2719 + ( flux_n(k) * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 2715 2720 / ( v_comp(k) - gv + 1.0E-20 ) & … … 2718 2723 * weight_substep(intermediate_timestep_count) 2719 2724 ENDDO 2720 sums_vs2_ws_l(nzb_v_inner(j,i) ) = sums_vs2_ws_l(nzb_v_inner(j,i)+1)2725 sums_vs2_ws_l(nzb_v_inner(j,i),tn) = sums_vs2_ws_l(nzb_v_inner(j,i)+1,tn) 2721 2726 ENDDO 2722 2727 ENDDO … … 2808 2813 !- At last vertical momentum flux is accumulated. 2809 2814 DO k = nzb_v_inner(j,i), nzt 2810 sums_wsvs_ws_l(k ) = sums_wsvs_ws_l(k) &2815 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) & 2811 2816 + ( flux_t(k) + diss_t(k) ) & 2812 2817 * weight_substep(intermediate_timestep_count) 2813 2818 ENDDO 2814 sums_vs2_ws_l(nzb_v_inner(j,i) ) = sums_vs2_ws_l(nzb_v_inner(j,i)+1)2819 sums_vs2_ws_l(nzb_v_inner(j,i),tn) = sums_vs2_ws_l(nzb_v_inner(j,i)+1,tn) 2815 2820 ENDDO 2816 2821 ENDDO … … 2833 2838 IMPLICIT NONE 2834 2839 2835 INTEGER :: i, j, k 2840 INTEGER :: i, j, k, tn = 0 2836 2841 REAL :: gu, gv, flux_d, diss_d, u_comp, v_comp, w_comp 2837 2842 REAL :: flux_t(nzb:nzt+1), diss_t(nzb:nzt+1) … … 3184 3189 !-- at last vertical momentum flux is accumulated 3185 3190 DO k = nzb_w_inner(j,i), nzt 3186 sums_ws2_ws_l(k ) = sums_ws2_ws_l(k) &3191 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) & 3187 3192 + ( flux_t(k) + diss_t(k) ) & 3188 3193 * weight_substep(intermediate_timestep_count)
Note: See TracChangeset
for help on using the changeset viewer.