<p><b>dwj07@fsu.edu</b> 2012-08-27 11:33:04 -0600 (Mon, 27 Aug 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
4th cut at openmp element loops.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/openmp_test/src/core_sw_elements/mpas_sw_time_integration.F
===================================================================
--- branches/omp_blocks/openmp_test/src/core_sw_elements/mpas_sw_time_integration.F 2012-08-27 17:16:34 UTC (rev 2126)
+++ branches/omp_blocks/openmp_test/src/core_sw_elements/mpas_sw_time_integration.F 2012-08-27 17:33:04 UTC (rev 2127)
@@ -71,8 +71,11 @@
real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
+ !$omp parallel
+ !$omp single
call mpas_timer_start('computations')
call mpas_setup_provis_states(domain % blocklist)
+ !$omp end single
!
! Initialize time_levs(2) with state at current time
@@ -83,19 +86,25 @@
block => domain % blocklist
do while (associated(block))
+ !$omp workshare
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+ !$omp end workshare
+ !$omp do private(iCell, k)
do iCell=1,block % mesh % nCells ! couple tracers to h
do k=1,block % mesh % nVertLevels
block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
* block % state % time_levs(1) % state % h % array(k,iCell)
end do
end do
+ !$omp end do
+ !$omp single
call mpas_copy_state(block % provis, block % state % time_levs(1) % state)
block => block % next
+ !$omp end single
end do
rk_weights(1) = dt/6.
@@ -107,7 +116,9 @@
rk_substep_weights(2) = dt/2.
rk_substep_weights(3) = dt
rk_substep_weights(4) = 0.
+ !$omp single
call mpas_timer_stop('computations')
+ !$omp end single
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! BEGIN RK loop
@@ -115,7 +126,8 @@
do rk_step = 1, 4
! --- update halos for diagnostic variables
-
+ !$omp barrier
+ !$omp single
call mpas_timer_start('communications')
call mpas_dmpar_exch_halo_field(domain % blocklist % provis % pv_edge)
@@ -125,25 +137,37 @@
end if
call mpas_timer_stop('communications')
call mpas_timer_start('computations')
+ !$omp end single
! --- compute tendencies
block => domain % blocklist
do while (associated(block))
+ !$omp single
call mpas_timer_start('sw_compute_tend')
+ !$omp end single
call sw_compute_tend(block % tend, block % provis, block % mesh)
+ !$omp single
call mpas_timer_stop('sw_compute_tend')
call mpas_timer_start('sw_compute_scalar_tend')
+ !$omp end single
call sw_compute_scalar_tend(block % tend, block % provis, block % mesh)
+ !$omp single
call mpas_timer_stop('sw_compute_scalar_tend')
call mpas_timer_start('sw_enforce_boundary')
+ !$omp end single
call sw_enforce_boundary_edge(block % tend, block % mesh)
+ !$omp single
call mpas_timer_stop('sw_enforce_boundary')
block => block % next
+ !$omp end single
end do
! --- update halos for prognostic variables
+ !$omp barrier
+
+ !$omp single
call mpas_timer_stop('computations')
call mpas_timer_start('communications')
call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u)
@@ -151,17 +175,21 @@
call mpas_dmpar_exch_halo_field(domain % blocklist % tend % tracers)
call mpas_timer_stop('communications')
call mpas_timer_start('computations')
+ !$omp end single
! --- compute next substep state
if (rk_step < 4) then
block => domain % blocklist
do while (associated(block))
+ !$omp workshare
block % provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
+ rk_substep_weights(rk_step) * block % tend % u % array(:,:)
block % provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
+ rk_substep_weights(rk_step) * block % tend % h % array(:,:)
+ !$omp end workshare
+ !$omp do private(iCell, k)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
block % provis % tracers % array(:,k,iCell) = ( block % state % time_levs(1) % state % h % array(k,iCell) * &
@@ -170,25 +198,36 @@
) / block % provis % h % array(k,iCell)
end do
end do
+ !$omp end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
+ !$omp workshare
block % provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ !$omp end workshare
end if
+ !$omp single
call mpas_timer_start('sw_compute_solve_diagnostics')
+ !$omp end single
call sw_compute_solve_diagnostics(dt, block % provis, block % mesh)
+ !$omp single
call mpas_timer_stop('sw_compute_solve_diagnostics')
block => block % next
+ !$omp end single
end do
end if
-
!--- accumulate update (for RK4)
+ !$omp barrier
+
block => domain % blocklist
do while (associated(block))
+ !$omp workshare
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
+ rk_weights(rk_step) * block % tend % u % array(:,:)
block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
+ rk_weights(rk_step) * block % tend % h % array(:,:)
+ !$omp end workshare
+ !$omp do private(iCell, k)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
@@ -196,10 +235,17 @@
+ rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
end do
end do
+ !$omp end do
+
+ !$omp single
block => block % next
+ !$omp end single
end do
+ !$omp single
call mpas_timer_stop('computations')
+ !$omp end single
+
end do
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END RK loop
@@ -209,9 +255,12 @@
!
! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
!
+ !$omp single
call mpas_timer_start('computations')
+ !$omp end single
block => domain % blocklist
do while (associated(block))
+ !$omp do private(iCell, k)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
@@ -219,13 +268,17 @@
/ block % state % time_levs(2) % state % h % array(k,iCell)
end do
end do
+ !$omp end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
+ !$omp workshare
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ !$omp end workshare
end if
call sw_compute_solve_diagnostics(dt, block % state % time_levs(2) % state, block % mesh)
+ !$omp single
call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
block % state % time_levs(2) % state % uReconstructX % array, &
block % state % time_levs(2) % state % uReconstructY % array, &
@@ -235,11 +288,16 @@
)
block => block % next
+ !$omp end single
end do
+ !$omp single
call mpas_deallocate_provis_states(domain % blocklist)
call mpas_timer_stop('computations')
+ !$omp end single
+ !$omp end parallel
+
end subroutine sw_rk4
@@ -329,8 +387,6 @@
meshScalingDel2 => grid % meshScalingDel2 % array
meshScalingDel4 => grid % meshScalingDel4 % array
- !$omp parallel
-
!
! Compute height tendency for each cell
!
@@ -559,7 +615,6 @@
end do
!$omp end do
endif
- !$omp end parallel
end subroutine sw_compute_tend
@@ -616,8 +671,6 @@
if (config_tracer_adv_order == 3) coef_3rd_order = 1.0
if (config_tracer_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
- !$omp parallel
-
tracer_tend(:,:,:) = 0.0
if (config_tracer_adv_order == 2) then
@@ -884,8 +937,6 @@
!$omp end do
end if
- !$omp end parallel
-
end subroutine sw_compute_scalar_tend
@@ -969,8 +1020,6 @@
boundaryEdge => grid % boundaryEdge % array
boundaryCell => grid % boundaryCell % array
- !$omp parallel
-
!
! Find those cells that have an edge on the boundary
!
@@ -1364,8 +1413,6 @@
enddo
!$omp end do
- !$omp end parallel
-
!
! set pv_edge = fEdge / h_edge at boundary points
!
@@ -1422,9 +1469,7 @@
boundaryEdge => grid % boundaryEdge % array
tend_u => tend % u % array
- if(maxval(boundaryEdge).le.0) return
-
- !$omp parallel do private(iEdge, k)
+ !$omp do private(iEdge, k)
do iEdge = 1,nEdges
do k = 1,nVertLevels
@@ -1434,7 +1479,7 @@
enddo
enddo
- !$omp end parallel do
+ !$omp end do
end subroutine sw_enforce_boundary_edge
</font>
</pre>