<p><b>dwj07@fsu.edu</b> 2012-04-30 12:44:34 -0600 (Mon, 30 Apr 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Fixing some issues with multiple dimensions all to all communication routines.<br>
Fixing an issue with indexing of reciving elements.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_block_decomp.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_block_decomp.F 2012-04-30 17:32:38 UTC (rev 1841)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_block_decomp.F 2012-04-30 18:44:34 UTC (rev 1842)
@@ -555,7 +555,7 @@
type (field1dInteger), pointer :: field_ptr
type (exchange_list), pointer :: exchListPtr, exchListPtr2
- integer :: i, j, k, n, iBlock, iElement, elementShift
+ integer :: i, j, k, n, iBlock, iElement, iElementInBlock, elementShift
integer :: nBlocksNeeded, nBlocksOwned
integer :: nBlocksNeededMax, nBlocksOwnedMax
integer :: totalBlocksOwned, totalBlocksNeeded
@@ -812,11 +812,15 @@
allocate(exchListPtr % list(numToRecv(iBlock)))
iElement = 0
+ iElementInBlock = 0
do i = 1, nMesgRecv
+ if(ownerBlockListIn(i) == field_ptr % block % blockID) then
+ iElementInBlock = iElementInBlock + 1
+ end if
if(ownerBlockListIn(i) == field_ptr % block % blockID .and. abs(ownerListIn(i)) == iBlock-1) then
iElement = iElement + 1
- exchListPtr % list(iElement) = iElement
+ exchListPtr % list(iElement) = iElementInBlock
end if
end do
end if
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-04-30 17:32:38 UTC (rev 1841)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-04-30 18:44:34 UTC (rev 1842)
@@ -841,6 +841,7 @@
type (field2dInteger), pointer :: fieldInPtr, fieldOutPtr
type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+ integer :: nBuffer
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: i
@@ -853,8 +854,9 @@
recvListPtr => fieldOutPtr % recvList(1) % next
do while(associated(recvListPtr))
- allocate(recvListPtr % ibuffer(recvListPtr % nlist))
- call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
+ allocate(recvListPtr % ibuffer(nBuffer))
+ call MPI_Irecv(recvListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &
recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
recvListPtr => recvListPtr % next
@@ -885,11 +887,12 @@
fieldOutPtr => fieldOutPtr % next
end do
else ! mpi_isend
- allocate(sendListPtr % ibuffer(sendListPtr % nlist))
- call mpas_pack_send_buf2d_integer(1, fieldInPtr % dimSizes(1), fieldInPtr % dimSizes(2), fieldInPtr % array, sendListPtr, 1, sendListPtr % nList, &
+ nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1)
+ allocate(sendListPtr % ibuffer(nBuffer))
+ call mpas_pack_send_buf2d_integer(1, fieldInPtr % dimSizes(1), fieldInPtr % dimSizes(2), fieldInPtr % array, sendListPtr, 1, nBuffer, &
sendListPtr % ibuffer, nPacked, lastPackedIdx)
- call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &
+ call MPI_Isend(sendListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &
sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
end if
sendListPtr => sendListPtr % next
@@ -905,7 +908,9 @@
do while (associated(recvListPtr))
call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
- call mpas_unpack_recv_buf2d_integer(1, fieldOutPtr % dimSizes(1), fieldOutPtr % dimSizes(2), fieldOutPtr % array, recvListPtr, 1, recvListPtr % nlist, &
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
+
+ call mpas_unpack_recv_buf2d_integer(1, fieldOutPtr % dimSizes(1), fieldOutPtr % dimSizes(2), fieldOutPtr % array, recvListPtr, 1, nBuffer, &
recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
deallocate(recvListPtr % ibuffer)
recvListPtr => recvListPtr % next
@@ -967,6 +972,7 @@
type (field3dInteger), pointer :: fieldInPtr, fieldOutPtr
type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+ integer :: nBuffer
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: i
@@ -979,8 +985,9 @@
recvListPtr => fieldOutPtr % recvList(1) % next
do while(associated(recvListPtr))
- allocate(recvListPtr % ibuffer(recvListPtr % nlist))
- call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+ allocate(recvListPtr % ibuffer(nBuffer))
+ call MPI_Irecv(recvListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &
recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
recvListPtr => recvListPtr % next
@@ -1002,7 +1009,7 @@
do while(associated(copyListPtr))
if(copyListPtr % blockID == fieldInPtr % block % blockID) then
do i = 1, copyListPtr % nList
- fieldOutPtr % array(:, :, copyListPtr % list(i)) = fieldInPtr % array(:, :, sendListPtr % list(i))
+ fieldOutPtr % array(:,:,copyListPtr % list(i)) = fieldInPtr % array(:,:,sendListPtr % list(i))
end do
end if
copyListPtr => copyListPtr % next
@@ -1011,12 +1018,13 @@
fieldOutPtr => fieldOutPtr % next
end do
else ! mpi_isend
- allocate(sendListPtr % ibuffer(sendListPtr % nlist))
- call mpas_pack_send_buf3d_integer(1, fieldInPtr % dimSizes(1), 1, fieldInPtr % dimSizes(2), fieldInPtr % dimSizes(3), fieldInPtr % array, &
- sendListPtr, 1, sendListPtr % nList, &
+ nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
+ allocate(sendListPtr % ibuffer(nBuffer))
+ call mpas_pack_send_buf3d_integer(1, fieldInPtr % dimSizes(1), 1, fieldInPtr % dimSizes(2), fieldInPtr % dimSizes(3), &
+ fieldInPtr % array, sendListPtr, 1, nBuffer, &
sendListPtr % ibuffer, nPacked, lastPackedIdx)
- call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &
+ call MPI_Isend(sendListPtr % ibuffer, nBuffer, MPI_INTEGERKIND, &
sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
end if
sendListPtr => sendListPtr % next
@@ -1032,8 +1040,10 @@
do while (associated(recvListPtr))
call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+
call mpas_unpack_recv_buf3d_integer(1, fieldOutPtr % dimSizes(1), 1, fieldOutPtr % dimSizes(2), fieldOutPtr % dimSizes(3), &
- fieldOutPtr % array, recvListPtr, 1, recvListPtr % nlist, &
+ fieldOutPtr % array, recvListPtr, 1, nBuffer, &
recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
deallocate(recvListPtr % ibuffer)
recvListPtr => recvListPtr % next
@@ -1219,6 +1229,7 @@
type (field2dReal), pointer :: fieldInPtr, fieldOutPtr
type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+ integer :: nBuffer
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: i
@@ -1231,8 +1242,9 @@
recvListPtr => fieldOutPtr % recvList(1) % next
do while(associated(recvListPtr))
- allocate(recvListPtr % rbuffer(recvListPtr % nlist))
- call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_realKIND, &
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
+ allocate(recvListPtr % rbuffer(nBuffer))
+ call MPI_Irecv(recvListPtr % rbuffer, nBuffer, MPI_realKIND, &
recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
recvListPtr => recvListPtr % next
@@ -1263,11 +1275,12 @@
fieldOutPtr => fieldOutPtr % next
end do
else ! mpi_isend
- allocate(sendListPtr % rbuffer(sendListPtr % nlist))
- call mpas_pack_send_buf2d_real(1, fieldInPtr % dimSizes(1), fieldInPtr % dimSizes(2), fieldInPtr % array, sendListPtr, 1, sendListPtr % nList, &
+ nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1)
+ allocate(sendListPtr % rbuffer(nBuffer))
+ call mpas_pack_send_buf2d_real(1, fieldInPtr % dimSizes(1), fieldInPtr % dimSizes(2), fieldInPtr % array, sendListPtr, 1, nBuffer, &
sendListPtr % rbuffer, nPacked, lastPackedIdx)
- call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_realKIND, &
+ call MPI_Isend(sendListPtr % rbuffer, nBuffer, MPI_realKIND, &
sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
end if
sendListPtr => sendListPtr % next
@@ -1283,7 +1296,9 @@
do while (associated(recvListPtr))
call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
- call mpas_unpack_recv_buf2d_real(1, fieldOutPtr % dimSizes(1), fieldOutPtr % dimSizes(2), fieldOutPtr % array, recvListPtr, 1, recvListPtr % nlist, &
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1)
+
+ call mpas_unpack_recv_buf2d_real(1, fieldOutPtr % dimSizes(1), fieldOutPtr % dimSizes(2), fieldOutPtr % array, recvListPtr, 1, nBuffer, &
recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
deallocate(recvListPtr % rbuffer)
recvListPtr => recvListPtr % next
@@ -1345,6 +1360,7 @@
type (field3dReal), pointer :: fieldInPtr, fieldOutPtr
type (exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
+ integer :: nBuffer
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: i
@@ -1357,8 +1373,9 @@
recvListPtr => fieldOutPtr % recvList(1) % next
do while(associated(recvListPtr))
- allocate(recvListPtr % rbuffer(recvListPtr % nlist))
- call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_realKIND, &
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+ allocate(recvListPtr % rbuffer(nBuffer))
+ call MPI_Irecv(recvListPtr % rbuffer, nBuffer, MPI_realKIND, &
recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
recvListPtr => recvListPtr % next
@@ -1380,7 +1397,7 @@
do while(associated(copyListPtr))
if(copyListPtr % blockID == fieldInPtr % block % blockID) then
do i = 1, copyListPtr % nList
- fieldOutPtr % array(:, :, copyListPtr % list(i)) = fieldInPtr % array(:, :, sendListPtr % list(i))
+ fieldOutPtr % array(:,:,copyListPtr % list(i)) = fieldInPtr % array(:,:,sendListPtr % list(i))
end do
end if
copyListPtr => copyListPtr % next
@@ -1389,12 +1406,13 @@
fieldOutPtr => fieldOutPtr % next
end do
else ! mpi_isend
- allocate(sendListPtr % rbuffer(sendListPtr % nlist))
- call mpas_pack_send_buf3d_real(1, fieldInPtr % dimSizes(1), 1, fieldInPtr % dimSizes(2), fieldInPtr % dimSizes(3), fieldInPtr % array, &
- sendListPtr, 1, sendListPtr % nList, &
+ nBuffer = sendLisTPtr % nList * fieldInPtr % dimSizes(1) * fieldInPtr % dimSizes(2)
+ allocate(sendListPtr % rbuffer(nBuffer))
+ call mpas_pack_send_buf3d_real(1, fieldInPtr % dimSizes(1), 1, fieldInPtr % dimSizes(2), fieldInPtr % dimSizes(3), &
+ fieldInPtr % array, sendListPtr, 1, nBuffer, &
sendListPtr % rbuffer, nPacked, lastPackedIdx)
- call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_realKIND, &
+ call MPI_Isend(sendListPtr % rbuffer, nBuffer, MPI_realKIND, &
sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
end if
sendListPtr => sendListPtr % next
@@ -1410,8 +1428,10 @@
do while (associated(recvListPtr))
call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+ nBuffer = recvListPtr % nList * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2)
+
call mpas_unpack_recv_buf3d_real(1, fieldOutPtr % dimSizes(1), 1, fieldOutPtr % dimSizes(2), fieldOutPtr % dimSizes(3), &
- fieldOutPtr % array, recvListPtr, 1, recvListPtr % nlist, &
+ fieldOutPtr % array, recvListPtr, 1, nBuffer, &
recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
deallocate(recvListPtr % rbuffer)
recvListPtr => recvListPtr % next
@@ -1461,7 +1481,7 @@
#endif
end subroutine mpas_dmpar_alltoall_field3d_real!}}}
-
+
subroutine mpas_pack_send_buf1d_integer(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)!{{{
implicit none
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-04-30 17:32:38 UTC (rev 1841)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-04-30 18:44:34 UTC (rev 1842)
@@ -82,11 +82,17 @@
type (field1DChar) :: xtime
type (field1DInteger), pointer :: int1d_ptr
+ type (field1DInteger), pointer :: int1d_ptr2
+ type (field1DInteger), pointer :: int1d_ptr3
type (field2DInteger), pointer :: int2d_ptr
type (field1DInteger), pointer :: indexToCellID_0Halo
type (field1DInteger), pointer :: nEdgesOnCell_0Halo
- type (field2DInteger), pointer :: cellsOnCEll_0Halo
+ type (field2DInteger), pointer :: cellsOnCell_0Halo
+
+ type (field1DInteger), pointer :: indexToCellID_1Halo
+ type (field1DInteger), pointer :: nEdgesOnCell_1Halo
+ type (field2DInteger), pointer :: cellsOnCell_1Halo
! integer, dimension(:), pointer :: indexToCellID_0Halo
! integer, dimension(:), pointer :: nEdgesOnCell_0Halo
@@ -106,9 +112,9 @@
#ifdef HAVE_ZOLTAN
#ifdef _MPI
- real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell
- real (kind=RKIND), dimension(:), pointer :: xEdge, yEdge, zEdge
- real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
+ type (field1DReal), pointer :: xCell, yCell, zCell
+ type (field1DReal), pointer :: xEdge, yEdge, zEdge
+ type (field1DReal), pointer :: xVertex, yVertex, zVertex
#endif
#endif
@@ -122,7 +128,7 @@
type (graph) :: block_graph_0Halo, block_graph_1Halo, block_graph_2Halo
integer :: ghostEdgeStart, ghostVertexStart
- integer :: nBlocksLocal, nBlocksMax, iBlock, nCellsInBlock
+ integer :: nBlocksLocal, nBlocksMax, iBlock, nCellsInBlock, nCellsInHalo
type (MPAS_Time_type) :: startTime
type (MPAS_Time_type) :: sliceTime
@@ -557,20 +563,18 @@
write(6,*) 'Getting decomp'
call mpas_block_decomp_cells_for_proc(domain % dminfo, partial_global_graph_info, local_cell_list, block_id, block_start, block_count)
- write(6,*) 'block_start'
- write(6,*) block_start
-
deallocate(partial_global_graph_info % vertexID)
deallocate(partial_global_graph_info % nAdjacent)
deallocate(partial_global_graph_info % adjacencyList)
- write(6,*) 'Setting up blocks'
nBlocksLocal = size(block_id)
call mpas_dmpar_max_int(domain % dminfo, nBlocksLocal, nBlocksMax)
allocate(indexToCellID_0Halo)
allocate(domain % blocklist)
+ write(6,*) 'setting up 0 halo fields'
+
block_ptr => domain % blocklist
int1d_ptr => indexToCellID_0Halo
do iBlock = 1, nBlocksLocal
@@ -581,11 +585,9 @@
int1d_ptr % block => block_ptr
int1d_ptr % dimSizes(1) = nCellsInBlock
- write(6,*) 'indexToCellID_0Halo dimSizes(1) = ', int1d_ptr % dimSizes(1)
allocate(int1d_ptr % array(nCellsInBlock))
do i = 1, nCellsInBlock
int1d_ptr % array(i) = local_cell_list(block_start(iBlock) + i)
- write(6,*) 'lcl = ',local_cell_list(block_start(iBlock) + i)
end do
if(iBlock < nBlocksLocal) then
@@ -600,8 +602,6 @@
end if
end do
- write(6,*) 'Setting up other arrays'
-
allocate(nEdgesOnCell_0Halo)
allocate(cellsOnCell_0Halo)
@@ -633,201 +633,164 @@
end if
end do
- write(6,*) 'Getting exchange lists'
+ !
+ ! Now that each process has a list of cells that it owns, exchange cell connectivity
+ ! information between the processes that read info for a cell and those that own that cell
+ !
+
+ write(6,*) 'setup 0 halo exchange lists'
call mpas_get_exchange_lists(domain % dminfo, indexToCellIDField, .false., indexToCellID_0Halo, .true.)
- write(6,*) 'Linking exchange lists 1'
+
+ write(6,*) 'link 0 halo exchange lists 1'
call mpas_link_exchange_list_field(indexToCellIDField, indexToCellID_0Halo, nEdgesOnCellField, nEdgesOnCell_0Halo)
- write(6,*) 'Linking exchange lists 2'
+ write(6,*) 'link 0 halo exchange lists 2'
call mpas_link_exchange_list_field(indexToCellIDField, indexToCellID_0Halo, cellsOnCellField, cellsOnCell_0Halo)
- write(6,*) 'send'
- int1d_ptr => indexToCellIDField
- do while(associated(int1d_ptr))
- write(6,*) 'On block ',int1d_ptr % block % blockID
- sendListPtr => int1d_ptr % sendList(1) % next
- do while(associated(sendListPtr))
- write(6,*) 'h', sendListPtr % procID, sendListPtr % blockID, sendListPtr % nList
- write(6,*) sendListPtr % list
- sendListPtr => sendListPtr % next
- end do
- int1d_ptr => int1d_ptr % next
- end do
+ write(6,*) '0 halo all to all 1'
+ call mpas_dmpar_alltoall_field(domain % dminfo, indexToCellIDField, indexToCellID_0Halo)
+ write(6,*) '0 halo all to all 2'
+ call mpas_dmpar_alltoall_field(domain % dminfo, nEdgesOnCellField, nEdgesOnCell_0Halo)
+ write(6,*) '0 halo all to all 3'
+ call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnCellField, cellsOnCell_0Halo)
- write(6,*) 'recv'
+ write(6,*) 'Done with 0 halo'
+
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI
+! allocate(xCell(size(local_cell_list)))
+! allocate(yCell(size(local_cell_list)))
+! allocate(zCell(size(local_cell_list)))
+! call mpas_dmpar_alltoall_field(domain % dminfo, xCellField % array, xCell, &
+! size(xCellField % array), size(local_cell_list), &
+! sendCellList, recvCellList)
+!
+! call mpas_dmpar_alltoall_field(domain % dminfo, yCellField % array, yCell, &
+! size(yCellField % array), size(local_cell_list), &
+! sendCellList, recvCellList)
+!
+! call mpas_dmpar_alltoall_field(domain % dminfo, zCellField % array, zCell, &
+! size(zCellField % array), size(local_cell_list), &
+! sendCellList, recvCellList)
+#endif
+#endif
+
+
+! deallocate(sendCellList % list)
+! deallocate(sendCellList)
+! deallocate(recvCellList % list)
+! deallocate(recvCellList)
+
+ write(6,*) 'Determining 1 halo cells'
+
+ allocate(indexToCellID_1Halo)
+
int1d_ptr => indexToCellID_0Halo
+ int1d_ptr2 => nEdgesOnCell_0Halo
+ int2d_ptr => cellsOnCell_0Halo
+
+ int1d_ptr3 => indexToCellID_1Halo
+
do while(associated(int1d_ptr))
- write(6,*) 'On block ',int1d_ptr % block % blockID
- recvListPtr => int1d_ptr % recvList(1) % next
- do while(associated(recvListPtr))
- write(6,*) 'h', recvListPtr % procID, recvListPtr % blockID, recvListPtr % nList
- recvListPtr => recvListPtr % next
- end do
+ ! Build 0 halo graph. Describing all owned cells.
+ block_graph_0halo % nVerticesTotal = int1d_ptr % dimSizes(1)
+ block_graph_0halo % nVertices = int1d_ptr % dimSizes(1)
+ block_graph_0halo % maxDegree = maxEdges
+ block_graph_0halo % ghostStart = int1d_ptr % dimSizes(1)
+ allocate(block_graph_0Halo % vertexID(int1d_ptr % dimSizes(1)))
+ allocate(block_graph_0Halo % nAdjacent(int1d_ptr % dimSizes(1)))
+ allocate(block_graph_0Halo % adjacencyList(maxEdges, int1d_ptr % dimSizes(1)))
+
+ block_graph_0Halo % vertexID(:) = int1d_ptr % array(:)
+ block_graph_0Halo % nAdjacent(:) = int1d_ptr2 % array(:)
+ block_graph_0Halo % adjacencyList(:,:) = int2d_ptr % array(:,:)
+
+ ! Build 1 halo graph. Containing all owned cells and all cells in the 1 halo.
+ call mpas_block_decomp_add_halo(domain % dminfo, block_graph_0Halo, block_graph_1Halo)
+
+ ! Copy cells in the 1 halo to indexToCellID_1Halo field pointer.
+ nCellsInHalo = block_graph_1Halo % nVerticesTotal - block_graph_1Halo % nVertices
+
+ int1d_ptr3 % block => int1d_ptr % block
+ int1d_ptr3 % dimSizes(1) = nCellsInHalo
+ allocate(int1d_ptr3 % array(nCellsInHalo))
+ int1d_ptr3 % array(:) = block_graph_1halo % vertexID(block_graph_1Halo % ghostStart:block_graph_1Halo % nVerticesTotal)
+
int1d_ptr => int1d_ptr % next
+ int1d_ptr2 => int1d_ptr2 % next
+ int2d_ptr => int2d_ptr % next
+
+ if(associated(int1d_ptr)) then
+ deallocate(block_graph_0Halo % vertexID)
+ deallocate(block_graph_0Halo % nAdjacent)
+ deallocate(block_graph_0Halo % adjacencyList)
+
+ deallocate(block_graph_1Halo % vertexID)
+ deallocate(block_graph_1Halo % nAdjacent)
+ deallocate(block_graph_1Halo % adjacencyList)
+
+ allocate(int1d_ptr3 % next)
+ int1d_ptr3 => int1d_ptr3 % next
+ nullify(int1d_ptr3 % next)
+ end if
end do
- write(6,*) 'copy'
- int1d_ptr => indexToCellID_0Halo
+ write(6,*) 'Setting up the 1halo exchange lists'
+
+ !Build exchange lists for 0 halo to 1 halo, for allToAll communications
+ call mpas_get_exchange_lists(domain % dminfo, indexToCellID_0Halo, .true., indexToCellID_1Halo, .true.)
+
+ write(6,*) 'Setting up 1 halo fields'
+ ! setup 1 halo fields for allToAll communications
+ allocate(nEdgesOnCell_1Halo)
+ allocate(cellsOnCell_1Halo)
+
+ int1d_ptr => indexToCellID_1Halo
+ int1d_ptr2 => nEdgesOnCell_1Halo
+ int2d_ptr => cellsOnCell_1Halo
+
do while(associated(int1d_ptr))
- write(6,*) 'On block ',int1d_ptr % block % blockID
- copyListPtr => int1d_ptr % copyList(1) % next
- do while(associated(copyListPtr))
- write(6,*) 'h', copyListPtr % procID, copyListPtr % blockID, copyListPtr % nList
- write(6,*) copyListPtr % list
- copyListPtr => copyListPtr % next
- end do
+ int1d_ptr2 % block => int1d_ptr % block
+ int2d_ptr % block => int1d_ptr % block
+
+ int1d_ptr2 % dimSizes(1) = int1d_ptr % dimSizes(1)
+ int2d_ptr % dimSizes(1) = maxEdges
+ int2d_ptr % dimSizes(2) = int1d_ptr % dimSizes(1)
+
+ allocate(int1d_ptr2 % array(int1d_ptr2 % dimSizes(1)))
+ allocate(int2d_ptr % array(int2d_ptr % dimSizes(1), int2d_ptr % dimSizes(2)))
+
int1d_ptr => int1d_ptr % next
+ if(associated(int1d_ptr)) then
+ allocate(int1d_ptr2 % next)
+ allocate(int2d_ptr % next)
+ int1d_ptr2 => int1d_ptr2 % next
+ int2d_ptr => int2d_ptr % next
+ nullify(int1d_ptr2 % next)
+ nullify(int2d_ptr % next)
+ end if
end do
+
write(6,*) 'All to all 1'
- call mpas_dmpar_alltoall_field(domain % dminfo, indexToCellIDField, indexToCellID_0Halo)
- write(6,*) 'All to all 2'
- call mpas_dmpar_alltoall_field(domain % dminfo, nEdgesOnCellField, nEdgesOnCell_0Halo)
- write(6,*) 'All to all 3'
- call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnCellField, cellsOnCell_0Halo)
+ call mpas_dmpar_alltoall_field(domain % dminfo, indexToCellID_0Halo, indexToCellID_1Halo)
-! write(6,*) 'idxToCell field'
-! int1d_ptr => indexToCellIDField
-! do while(associated(int1d_ptr))
-! write(6,*) 'block ', int1d_ptr % block % blockID
-! do i = 1, int1d_ptr % dimSizes(1)
-! write(6,*) int1d_ptr % array(i)
-! end do
-! int1d_ptr => int1d_ptr % next
-! end do
+ write(6,*) 'Linking 1 halo exchange lists 1'
+ call mpas_link_exchange_list_field(indexToCellID_0Halo, indexToCellID_1Halo, nEdgesOnCell_0Halo, nEdgesOnCell_1Halo)
-! write(6,*) 'idxToCell 0halo'
-! int1d_ptr => indexToCellID_0Halo
-! do while(associated(int1d_ptr))
-! write(6,*) 'block ', int1d_ptr % block % blockID
-! do i = 1, int1d_ptr % dimSizes(1)
-! write(6,*) int1d_ptr % array(i)
-! end do
-! int1d_ptr => int1d_ptr % next
-! end do
+ write(6,*) 'All to all 2'
+ call mpas_dmpar_alltoall_field(domain % dminfo, nEdgesOnCell_0Halo, nEdgesOnCell_1Halo)
-! write(6,*) 'coc field'
-! int2d_ptr => cellsOnCellField
-! do while(associated(int2d_ptr))
-! write(6,*) 'block ', int2d_ptr % block % blockID
-! do i = 1, int2d_ptr % dimSizes(2)
-! write(6,*) int2d_ptr % array(:,i)
-! end do
-! int2d_ptr => int2d_ptr % next
-! end do
+ write(6,*) 'Linking 1 halo exchange lists 2'
+ call mpas_link_exchange_list_field(indexToCellID_0Halo, indexToCellID_1Halo, cellsOnCell_0Halo, cellsOnCell_1Halo)
-! write(6,*) 'coc 0halo'
-! int2d_ptr => cellsOnCell_0Halo
-! do while(associated(int2d_ptr))
-! write(6,*) 'block ', int2d_ptr % block % blockID
-! do i = 1, int2d_ptr % dimSizes(2)
-! write(6,*) int2d_ptr % array(:,i)
-! end do
-! int2d_ptr => int2d_ptr % next
-! end do
+ write(6,*) 'All to all 3'
+ call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnCell_0Halo, cellsOnCell_1Halo)
write(6,*) 'Stopping'
-
stop
-
-! allocate(indexToCellID_0Halo(size(local_cell_list)))
-! allocate(nEdgesOnCell_0Halo(size(local_cell_list)))
-! allocate(cellsOnCell_0Halo(maxEdges, size(local_cell_list)))
-
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
- allocate(xCell(size(local_cell_list)))
- allocate(yCell(size(local_cell_list)))
- allocate(zCell(size(local_cell_list)))
-#endif
-#endif
-
- !
-! ! Now that each process has a list of cells that it owns, exchange cell connectivity
-! ! information between the processes that read info for a cell and those that own that cell
+
! !
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToCellIDField % array), size(local_cell_list), &
-! indexToCellIDField % array, local_cell_list, &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, indexToCellIDField % array, indexToCellID_0Halo, &
-! size(indexToCellIDField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, nEdgesOnCellField % array, nEdgesOnCell_0Halo, &
-! size(indexToCellIDField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnCellField % array, cellsOnCell_0Halo, &
-! size(cellsOnCellField % array, 1), size(indexToCellIDField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
-! call mpas_dmpar_alltoall_field(domain % dminfo, xCellField % array, xCell, &
-! size(xCellField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, yCellField % array, yCell, &
-! size(yCellField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, zCellField % array, zCell, &
-! size(zCellField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!#endif
-!#endif
-!
-!
-! deallocate(sendCellList % list)
-! deallocate(sendCellList)
-! deallocate(recvCellList % list)
-! deallocate(recvCellList)
-!
-!
-!
-! !
-! ! Build a graph of cell connectivity based on cells owned by this process
-! !
-! block_graph_0Halo % nVerticesTotal = size(local_cell_list)
-! block_graph_0Halo % nVertices = size(local_cell_list)
-! block_graph_0Halo % maxDegree = maxEdges
-! block_graph_0Halo % ghostStart = size(local_cell_list) + 1
-! allocate(block_graph_0Halo % vertexID(size(local_cell_list)))
-! allocate(block_graph_0Halo % nAdjacent(size(local_cell_list)))
-! allocate(block_graph_0Halo % adjacencyList(maxEdges, size(local_cell_list)))
-!
-! block_graph_0Halo % vertexID(:) = indexToCellID_0Halo(:)
-! block_graph_0Halo % nAdjacent(:) = nEdgesOnCell_0Halo(:)
-! block_graph_0Halo % adjacencyList(:,:) = cellsOnCell_0Halo(:,:)
-!
-! ! Get back a graph describing the owned cells plus the cells in the 1-halo
-! call mpas_block_decomp_add_halo(domain % dminfo, block_graph_0Halo, block_graph_1Halo)
-!
-!
-! !
-! ! Work out exchange lists for 1-halo and exchange cell information for 1-halo
-! !
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &
-! block_graph_0Halo % vertexID, block_graph_1Halo % vertexID, &
-! send1Halo, recv1Halo)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % vertexID, block_graph_1Halo % vertexID, &
-! block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &
-! send1Halo, recv1Halo)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % nAdjacent, block_graph_1Halo % nAdjacent, &
-! block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &
-! send1Halo, recv1Halo)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % adjacencyList, block_graph_1Halo % adjacencyList, &
-! block_graph_0Halo % maxDegree, block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &
-! send1Halo, recv1Halo)
-!
-!
-! !
! ! Work out exchange lists for 2-halo and exchange cell information for 2-halo
! !
! block_graph_1Halo % nVertices = block_graph_1Halo % nVerticesTotal
</font>
</pre>