<p><b>croesch@ucar.edu</b> 2012-03-13 16:50:01 -0600 (Tue, 13 Mar 2012)</p><p>BRANCH COMMIT<br>
<br>
update halo layer exhange parameter name to haloLayers, fix memory leaks, remove block loops surrounding halo exhange calls<br>
<br>
M src/core_hyd_atmos/mpas_atmh_time_integration.F<br>
M src/core_sw/mpas_sw_time_integration.F<br>
M src/core_nhyd_atmos/mpas_atm_time_integration.F<br>
M src/core_ocean/mpas_ocn_time_integration_rk4.F<br>
M src/core_ocean/mpas_ocn_time_integration_split.F<br>
M src/framework/mpas_dmpar.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/halo/src/core_hyd_atmos/mpas_atmh_time_integration.F
===================================================================
--- branches/omp_blocks/halo/src/core_hyd_atmos/mpas_atmh_time_integration.F 2012-03-13 22:23:45 UTC (rev 1631)
+++ branches/omp_blocks/halo/src/core_hyd_atmos/mpas_atmh_time_integration.F 2012-03-13 22:50:01 UTC (rev 1632)
@@ -114,21 +114,17 @@
if(debug) write(0,*) ' rk substep ', rk_step
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % mesh % qtot)
- call mpas_dmpar_exch_halo_field(block % mesh % cqu)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % h)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % pressure)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % geopotential)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % alpha)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % pv_edge)
- if (config_h_mom_eddy_visc4 > 0.0) then
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % divergence)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % vorticity)
- end if
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % mesh % qtot)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % mesh % cqu)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % h)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % pressure)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % geopotential)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % alpha)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % pv_edge)
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % divergence)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % vorticity)
+ end if
if(debug) write(0,*) ' rk substep ', rk_step
@@ -143,12 +139,8 @@
!
! --- update halos for tendencies
!
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % tend % u)
- call mpas_dmpar_exch_halo_field(block % tend % theta)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % theta)
! --- advance over sub_steps
@@ -186,24 +178,20 @@
!
! --- update halos for prognostic variables
!
- block => domain % blocklist
- do while (associated(block))
-!! call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % u)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % h_edge)
-!! call mpas_dmpar_exch_halo_field(block % mesh % uhAvg)
-!! call mpas_dmpar_exch_halo_field(block % mesh % wwAvg)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % theta)
-!! call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % h)
-!! call mpas_dmpar_exch_halo_field(block % tend % h)
- call mpas_dmpar_exch_halo_field(block % mesh % dpsdt)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % surface_pressure)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % alpha)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % ww)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % pressure)
-!! call mpas_dmpar_exch_halo_field(block % mesh % pressure_old)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % geopotential)
- block => block % next
- end do
+!! call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % u)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % h_edge)
+!! call mpas_dmpar_exch_halo_field(domain % blocklist % mesh % uhAvg)
+!! call mpas_dmpar_exch_halo_field(domain % blocklist % mesh % wwAvg)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % theta)
+!! call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % h)
+!! call mpas_dmpar_exch_halo_field(domain % blocklist % tend % h)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % mesh % dpsdt)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % surface_pressure)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % alpha)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % ww)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % pressure)
+!! call mpas_dmpar_exch_halo_field(domain % blocklist % mesh % pressure_old)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % geopotential)
end do
@@ -231,12 +219,8 @@
block => block % next
end do
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % tend % scalars)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % scalars)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % scalars)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % scalars)
if(debug) write(0,*) ' advance scalars complete '
Modified: branches/omp_blocks/halo/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- branches/omp_blocks/halo/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-03-13 22:23:45 UTC (rev 1631)
+++ branches/omp_blocks/halo/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-03-13 22:50:01 UTC (rev 1632)
@@ -98,6 +98,10 @@
real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
+ integer :: iDeleteMe, jDeleteMe, kDeleteMe
+ type (exchange_list), pointer :: deleteMePtr
+
+
!
! Initialize RK weights
!
@@ -122,25 +126,21 @@
! the so-called owned edges?
- block => domain % blocklist
- do while (associated(block))
! WCS-parallel: first three and rtheta_p arise from scalar transport and microphysics update (OK). Others come from where?
! theta_m
- call mpas_dmpar_exch_halo_field(block % state % time_levs(1) % state % theta_m)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(1) % state % theta_m)
! scalars
- call mpas_dmpar_exch_halo_field(block % state % time_levs(1) % state % scalars)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(1) % state % scalars)
! pressure_p
- call mpas_dmpar_exch_halo_field(block % diag % pressure_p)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % pressure_p)
! rtheta_p
- call mpas_dmpar_exch_halo_field(block % diag % rtheta_p)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rtheta_p)
- block => block % next
- end do
block => domain % blocklist
do while (associated(block))
@@ -198,12 +198,8 @@
! because we are solving for all edges of owned cells
!***********************************
- block => domain % blocklist
- do while (associated(block))
! tend_u
- call mpas_dmpar_exch_halo_field(block % tend % u, (/ 1 /))
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u, (/ 1 /))
block => domain % blocklist
do while (associated(block))
@@ -230,18 +226,12 @@
! WCS-parallel: is this a candidate for a smaller stencil? we need only communicate cells that share edges with owned cells.
- block => domain % blocklist
- do while (associated(block))
! rtheta_pp
- call mpas_dmpar_exch_halo_field(block % diag % rtheta_pp, (/ 1 /))
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rtheta_pp, (/ 1 /))
end do ! end of small stimestep loop
! will need communications here for rho_pp
- block => domain % blocklist
- do while (associated(block))
! WCS-parallel: is communication of rw_p and rho_pp because of limiter (pd or mono scheme?),
! or is it needed for the large-step variable recovery (to get decoupled variables)?
@@ -253,22 +243,20 @@
! MGD seems necessary
! rw_p
- !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % diag % rw_p, (/ 1 /))
- call mpas_dmpar_exch_halo_field(block % diag % rw_p)
+ !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % diag % rw_p, (/ 1 /))
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rw_p)
! MGD seems necessary
! ru_p
- !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % diag % ru_p, (/ 2 /))
- call mpas_dmpar_exch_halo_field(block % diag % ru_p)
+ !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % diag % ru_p, (/ 2 /))
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % ru_p)
! rho_pp
- call mpas_dmpar_exch_halo_field(block % diag % rho_pp)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rho_pp)
- ! the second layer of halo cells must be exchanged before calling atm_recover_large_step_variables
- call mpas_dmpar_exch_halo_field(block % diag % rtheta_pp, (/ 2 /))
+ ! the second layer of halo cells must be exchanged before calling atm_recover_large_step_variables
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rtheta_pp, (/ 2 /))
- block => block % next
- end do
block => domain % blocklist
do while (associated(block))
@@ -280,17 +268,11 @@
! ************ advection of moist variables here...
- block => domain % blocklist
- do while (associated(block))
! u
- !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % u, (/ 3 /))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % u)
+ !CR: SMALLER STENCIL?: call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % u, (/ 3 /))
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % u)
- block => block % next
- end do
-
-
if (config_scalar_advection) then
block => domain % blocklist
@@ -350,31 +332,26 @@
! need communications here to fill out u, w, theta_m, p, and pp, scalars, etc
! so that they are available for next RK step or the first rk substep of the next timestep
- block => domain % blocklist
- do while (associated(block))
!MGD seems necessary
! w
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % w)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % w)
! pv_edge
- call mpas_dmpar_exch_halo_field(block % diag % pv_edge)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % pv_edge)
! rho_edge
- call mpas_dmpar_exch_halo_field(block % diag % rho_edge)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % diag % rho_edge)
! **** this will always be needed - perhaps we can cover this with compute_solve_diagnostics
! scalars
- if(rk_step < 3) then
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % scalars)
- end if
+ if(rk_step < 3) then
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % scalars)
+ end if
- block => block % next
- end do
+ end do ! rk_step loop
- end do ! rk_step loop
-
!... compute full velocity vectors at cell centers:
block => domain % blocklist
do while (associated(block))
Modified: branches/omp_blocks/halo/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- branches/omp_blocks/halo/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-03-13 22:23:45 UTC (rev 1631)
+++ branches/omp_blocks/halo/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-03-13 22:50:01 UTC (rev 1632)
@@ -78,7 +78,7 @@
integer :: iCell, k, i, err
type (block_type), pointer :: block
- type (state_type) :: provis
+ type (state_type), target :: provis
type (state_type), pointer :: provis_ptr
integer :: rk_step, iEdge, cell1, cell2
@@ -146,17 +146,11 @@
! --- update halos for diagnostic variables
call mpas_timer_start("RK4-diagnostic halo update")
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(provis % pv_edge)
-
- if (config_h_mom_eddy_visc4 > 0.0) then
- call mpas_dmpar_exch_halo_field(provis % divergence)
- call mpas_dmpar_exch_halo_field(provis % vorticity)
- end if
-
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(provis % pv_edge)
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call mpas_dmpar_exch_halo_field(provis % divergence)
+ call mpas_dmpar_exch_halo_field(provis % vorticity)
+ end if
call mpas_timer_stop("RK4-diagnostic halo update")
! --- compute tendencies
@@ -188,13 +182,9 @@
! --- update halos for prognostic variables
call mpas_timer_start("RK4-pronostic halo update")
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % tend % u)
- call mpas_dmpar_exch_halo_field(block % tend % h)
- call mpas_dmpar_exch_halo_field(block % tend % tracers)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % h)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % tracers)
call mpas_timer_stop("RK4-pronostic halo update")
! --- compute next substep state
Modified: branches/omp_blocks/halo/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- branches/omp_blocks/halo/src/core_ocean/mpas_ocn_time_integration_split.F 2012-03-13 22:23:45 UTC (rev 1631)
+++ branches/omp_blocks/halo/src/core_ocean/mpas_ocn_time_integration_split.F 2012-03-13 22:50:01 UTC (rev 1632)
@@ -163,18 +163,11 @@
! --- update halos for diagnostic variables
call mpas_timer_start("se halo diag", .false., timer_halo_diagnostic)
- block => domain % blocklist
- do while (associated(block))
-
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % pv_edge)
-
- if (config_h_mom_eddy_visc4 > 0.0) then
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % divergence)
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % vorticity)
- end if
-
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % pv_edge)
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % divergence)
+ call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % vorticity)
+ end if
call mpas_timer_stop("se halo diag", timer_halo_diagnostic)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -263,11 +256,7 @@
end do
call mpas_timer_start("se halo ubcl", .false., timer_halo_ubcl)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % uBcl)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % uBcl)
call mpas_timer_stop("se halo ubcl", timer_halo_ubcl)
end do ! do j=1,config_n_bcl_iter
@@ -379,11 +368,7 @@
! boundary update on uBtrNew
call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle)
- block => block % next
- end do ! block
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle)
call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
endif ! config_btr_gam1_uWt1>1.0e-12
@@ -442,11 +427,7 @@
! boundary update on SSHnew
call mpas_timer_start("se halo ssh", .false., timer_halo_ssh)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle)
- block => block % next
- end do ! block
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle)
call mpas_timer_stop("se halo ssh", timer_halo_ssh)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -489,11 +470,7 @@
! boundary update on uBtrNew
call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle)
- block => block % next
- end do ! block
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle)
call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
end do !do BtrCorIter=1,config_n_btr_cor_iter
@@ -546,12 +523,8 @@
! boundary update on SSHnew
call mpas_timer_start("se halo ssh", .false., timer_halo_ssh)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle)
- block => block % next
- end do ! block
- call mpas_timer_stop("se halo ssh", timer_halo_ssh)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle)
+ call mpas_timer_stop("se halo ssh", timer_halo_ssh)
endif ! config_btr_solve_SSH2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -602,11 +575,7 @@
! boundary update on F
call mpas_timer_start("se halo F", .false., timer_halo_f)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(1) % state % FBtr)
- block => block % next
- end do ! block
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(1) % state % FBtr)
call mpas_timer_stop("se halo F", timer_halo_f)
@@ -698,11 +667,7 @@
! update halo for thickness and tracer tendencies
call mpas_timer_start("se halo h", .false., timer_halo_h)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % tend % h)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % h)
call mpas_timer_stop("se halo h", timer_halo_h)
block => domain % blocklist
@@ -817,11 +782,7 @@
! on tend % tracers as in RK4, because I needed to update
! afterwards for the del4 diffusion operator.
call mpas_timer_start("se halo tracers", .false., timer_halo_tracers)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % state % time_levs(2) % state % tracers)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % state % time_levs(2) % state % tracers)
call mpas_timer_stop("se halo tracers", timer_halo_tracers)
Modified: branches/omp_blocks/halo/src/core_sw/mpas_sw_time_integration.F
===================================================================
--- branches/omp_blocks/halo/src/core_sw/mpas_sw_time_integration.F 2012-03-13 22:23:45 UTC (rev 1631)
+++ branches/omp_blocks/halo/src/core_sw/mpas_sw_time_integration.F 2012-03-13 22:50:01 UTC (rev 1632)
@@ -120,19 +120,13 @@
! --- update halos for diagnostic variables
- block => domain % blocklist
- do while (associated(block))
-
- call mpas_dmpar_exch_halo_field(provis % pv_edge)
+ call mpas_dmpar_exch_halo_field(provis % pv_edge)
- if (config_h_mom_eddy_visc4 > 0.0) then
- call mpas_dmpar_exch_halo_field(provis % divergence)
- call mpas_dmpar_exch_halo_field(provis % vorticity)
- end if
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call mpas_dmpar_exch_halo_field(provis % divergence)
+ call mpas_dmpar_exch_halo_field(provis % vorticity)
+ end if
- block => block % next
- end do
-
! --- compute tendencies
block => domain % blocklist
@@ -145,13 +139,9 @@
! --- update halos for prognostic variables
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field(block % tend % u)
- call mpas_dmpar_exch_halo_field(block % tend % h)
- call mpas_dmpar_exch_halo_field(block % tend % tracers)
- block => block % next
- end do
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % u)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % h)
+ call mpas_dmpar_exch_halo_field(domain % blocklist % tend % tracers)
! --- compute next substep state
Modified: branches/omp_blocks/halo/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/halo/src/framework/mpas_dmpar.F 2012-03-13 22:23:45 UTC (rev 1631)
+++ branches/omp_blocks/halo/src/framework/mpas_dmpar.F 2012-03-13 22:50:01 UTC (rev 1632)
@@ -1485,12 +1485,12 @@
end subroutine mpas_unpack_recv_buf3d_integer
- subroutine mpas_dmpar_exch_halo_field1d_integer(field, haloIndices)
+ subroutine mpas_dmpar_exch_halo_field1d_integer(field, haloLayers)
implicit none
type (field1DInteger), intent(inout) :: field
- integer, dimension(:), intent(in), optional :: haloIndices
+ integer, dimension(:), intent(in), optional :: haloLayers
type (dm_info) :: dminfo
type (exchange_list), pointer :: sendList, recvList
@@ -1504,7 +1504,7 @@
dminfo = field % block % domain % dminfo
dims = field % dims
- call AggregateExchangeLists(dminfo % my_proc_id, haloIndices, field % sendList, field % recvList, sendList, recvList)
+ call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
recvListPtr => recvList
do while (associated(recvListPtr))
@@ -1546,17 +1546,20 @@
sendListPtr => sendListPtr % next
end do
+ call DestroyExchangeList(sendList)
+ call DestroyExchangeList(recvList)
+
#endif
end subroutine mpas_dmpar_exch_halo_field1d_integer
- subroutine mpas_dmpar_exch_halo_field2d_integer(field, haloIndices)
+ subroutine mpas_dmpar_exch_halo_field2d_integer(field, haloLayers)
implicit none
type (field2DInteger), intent(inout) :: field
- integer, dimension(:), intent(in), optional :: haloIndices
+ integer, dimension(:), intent(in), optional :: haloLayers
type (dm_info) :: dminfo
type (exchange_list), pointer :: sendList, recvList
@@ -1571,7 +1574,7 @@
dminfo = field % block % domain % dminfo
dims = field % dims
- call AggregateExchangeLists(dminfo % my_proc_id, haloIndices, field % sendList, field % recvList, sendList, recvList)
+ call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
recvListPtr => recvList
do while (associated(recvListPtr))
@@ -1616,17 +1619,20 @@
sendListPtr => sendListPtr % next
end do
+ call DestroyExchangeList(sendList)
+ call DestroyExchangeList(recvList)
+
#endif
end subroutine mpas_dmpar_exch_halo_field2d_integer
- subroutine mpas_dmpar_exch_halo_field3d_integer(field, haloIndices)
+ subroutine mpas_dmpar_exch_halo_field3d_integer(field, haloLayers)
implicit none
type (field3DInteger), intent(inout) :: field
- integer, dimension(:), intent(in), optional :: haloIndices
+ integer, dimension(:), intent(in), optional :: haloLayers
type (dm_info) :: dminfo
type (exchange_list), pointer :: sendList, recvList
@@ -1641,7 +1647,7 @@
dminfo = field % block % domain % dminfo
dims = field % dims
- call AggregateExchangeLists(dminfo % my_proc_id, haloIndices, field % sendList, field % recvList, sendList, recvList)
+ call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
recvListPtr => recvList
do while (associated(recvListPtr))
@@ -1688,6 +1694,9 @@
sendListPtr => sendListPtr % next
end do
+ call DestroyExchangeList(sendList)
+ call DestroyExchangeList(recvList)
+
#endif
end subroutine mpas_dmpar_exch_halo_field3d_integer
@@ -1783,12 +1792,12 @@
end subroutine mpas_unpack_recv_buf3d_real
- subroutine mpas_dmpar_exch_halo_field1d_real(field, haloIndices)
+ subroutine mpas_dmpar_exch_halo_field1d_real(field, haloLayers)
implicit none
type (field1DReal), intent(inout) :: field
- integer, dimension(:), intent(in), optional :: haloIndices
+ integer, dimension(:), intent(in), optional :: haloLayers
type (dm_info) :: dminfo
type (exchange_list), pointer :: sendList, recvList
@@ -1802,7 +1811,7 @@
dminfo = field % block % domain % dminfo
dims = field % dims
- call AggregateExchangeLists(dminfo % my_proc_id, haloIndices, field % sendList, field % recvList, sendList, recvList)
+ call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
recvListPtr => recvList
do while (associated(recvListPtr))
@@ -1844,17 +1853,20 @@
sendListPtr => sendListPtr % next
end do
+ call DestroyExchangeList(sendList)
+ call DestroyExchangeList(recvList)
+
#endif
end subroutine mpas_dmpar_exch_halo_field1d_real
- subroutine mpas_dmpar_exch_halo_field2d_real(field, haloIndices)
+ subroutine mpas_dmpar_exch_halo_field2d_real(field, haloLayers)
implicit none
type (field2DReal), intent(inout) :: field
- integer, dimension(:), intent(in), optional :: haloIndices
+ integer, dimension(:), intent(in), optional :: haloLayers
type (dm_info) :: dminfo
type (exchange_list), pointer :: sendList, recvList
@@ -1870,7 +1882,7 @@
dminfo = field % block % domain % dminfo
dims = field % dims
- call AggregateExchangeLists(dminfo % my_proc_id, haloIndices, field % sendList, field % recvList, sendList, recvList)
+ call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
recvListPtr => recvList
do while (associated(recvListPtr))
@@ -1915,17 +1927,20 @@
sendListPtr => sendListPtr % next
end do
+ call DestroyExchangeList(sendList)
+ call DestroyExchangeList(recvList)
+
#endif
end subroutine mpas_dmpar_exch_halo_field2d_real
- subroutine mpas_dmpar_exch_halo_field3d_real(field, haloIndices)
+ subroutine mpas_dmpar_exch_halo_field3d_real(field, haloLayers)
implicit none
type (field3DReal), intent(inout) :: field
- integer, dimension(:), intent(in), optional :: haloIndices
+ integer, dimension(:), intent(in), optional :: haloLayers
type (dm_info) :: dminfo
type (exchange_list), pointer :: sendList, recvList
@@ -1940,7 +1955,7 @@
dminfo = field % block % domain % dminfo
dims = field % dims
- call AggregateExchangeLists(dminfo % my_proc_id, haloIndices, field % sendList, field % recvList, sendList, recvList)
+ call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
recvListPtr => recvList
do while (associated(recvListPtr))
@@ -1987,18 +2002,21 @@
sendListPtr => sendListPtr % next
end do
+ call DestroyExchangeList(sendList)
+ call DestroyExchangeList(recvList)
+
#endif
end subroutine mpas_dmpar_exch_halo_field3d_real
- subroutine AggregateExchangeLists(myProcID, haloIndicesIn, sendListArray, recvListArray, aggregateSendList, aggregateRecvList)
+ subroutine AggregateExchangeLists(myProcID, haloLayersIn, sendListArray, recvListArray, aggregateSendList, aggregateRecvList)
implicit none
!--- in variables ---!
integer, intent(in) :: myProcID
- integer, dimension(:), intent(in), target, optional :: haloIndicesIn
+ integer, dimension(:), intent(in), target, optional :: haloLayersIn
type (exchange_list), dimension(:), pointer :: sendListArray, recvListArray
!--- out variabls ---!
@@ -2006,26 +2024,26 @@
!--- local variables ---!
integer :: i, j
- integer, dimension(:), pointer :: haloIndices
+ integer, dimension(:), pointer :: haloLayers
type (exchange_list), pointer :: inListPtr, aggListPtr
logical :: blockAdded
logical :: listInitilized
- if (present(haloIndicesIn)) then
- haloIndices => haloIndicesIn
+ if (present(haloLayersIn)) then
+ haloLayers => haloLayersIn
else
- allocate(haloIndices(size(sendListArray)))
- do i=1, size(haloIndices)
- haloIndices(i) = i
+ allocate(haloLayers(size(sendListArray)))
+ do i=1, size(haloLayers)
+ haloLayers(i) = i
end do
end if
nullify(aggregateSendList)
nullify(aggregateRecvList)
- do i=1, size(haloIndices)
+ do i=1, size(haloLayers)
- inListPtr => sendListArray(haloIndices(i)) % next
+ inListPtr => sendListArray(haloLayers(i)) % next
do while(associated(inListPtr))
blockAdded = .false.
@@ -2071,7 +2089,7 @@
end do
- inListPtr => recvListArray(haloIndices(i)) % next
+ inListPtr => recvListArray(haloLayers(i)) % next
do while(associated(inListPtr))
blockAdded = .false.
@@ -2118,9 +2136,34 @@
end do
+ if (.not. present(haloLayersIn)) then
+ deallocate(haloLayers)
+ end if
+
end subroutine AggregateExchangeLists
+ subroutine DestroyExchangeList(exchangeList)
+
+ implicit none
+
+ !--- in variables ---!
+ type (exchange_list), pointer :: exchangeList
+
+ !--- local variables ---!
+ type (exchange_list), pointer :: exchangeListPtr
+
+ do while (associated(exchangeList))
+ exchangeListPtr => exchangeList % next
+
+ deallocate(exchangeList % list)
+ deallocate(exchangeList)
+ exchangeList => exchangeListPtr
+ end do
+
+ end subroutine DestroyExchangeList
+
+
subroutine MergeIntegerArrays(mergeArray, nMergeArray, dataToAppend)
implicit none
</font>
</pre>