<p><b>dwj07@fsu.edu</b> 2012-05-24 13:05:33 -0600 (Thu, 24 May 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Checkpointing work so far.<br>
<br>
Work has only been performed on cells so far.<br>
Arbitrary halo creation works.<br>
Exchange list creation works.<br>
Shared memory copies work.<br>
All to all communications using the new exchange lists work.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F 2012-05-24 17:10:51 UTC (rev 1935)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F 2012-05-24 19:05:33 UTC (rev 1936)
@@ -91,16 +91,14 @@
maxEdges = cellsOnCellBlock % dimSizes(1)
- write(6,*) 'building exch list'
call mpas_dmpar_get_exch_list(1, indexToCellIDBlock, indexToCellID_0Halo)
allocate(nEdgesOnCell_0Halo)
-! nullify(nEdgesOncell_0Halo % next)
+ nullify(nEdgesOncell_0Halo % next)
allocate(cellsOnCell_0Halo)
-! nullify(cellsOnCell_0Halo % next)
+ nullify(cellsOnCell_0Halo % next)
- write(6,*) 'Setup fields'
indexCursor => indexToCellID_0Halo
nEdgesCursor => nEdgesOnCell_0Halo
cellsOnCellCursor => cellsOnCell_0Halo
@@ -138,13 +136,271 @@
nullify(cellsOnCellCursor % next)
end do
- write(6,*) 'communicate 1d field'
call mpas_dmpar_alltoall_field(nEdgesOnCellBlock, nEdgesOnCell_0Halo, sendingHaloLayers)
- write(6,*) 'communicate 2d field'
call mpas_dmpar_alltoall_field(cellsOnCellBlock, cellsOnCell_0Halo, sendingHaloLayers)
-
end subroutine mpas_block_creator_build_0halo_cell_fields!}}}
+ subroutine mpas_block_creator_build_cell_halos(indexToCellID, nEdgesOnCell, cellsOnCell, nCellsSolve)!{{{
+ type (field1dInteger), pointer :: indexToCellID !< Input/Output: indexToCellID field for all halos
+ type (field1dInteger), pointer :: nEdgesOnCell !< Input/Output: nEdgesOnCell field for all halos
+ type (field2dInteger), pointer :: cellsOnCell !< Input/Output: cellsOnCell field for all halos
+ type (field1dInteger), pointer :: nCellsSolve !< Output: Field with indices to end of each halo
+
+ type (dm_info), pointer :: dminfo
+
+ type (field1dInteger), pointer :: haloIndices
+
+ type (field0dInteger), pointer :: offSetCursor, cellLimitCursor
+ type (field1dInteger), pointer :: indexCursor, nEdgesCursor, haloCursor, nCellsSolveCursor
+ type (field2dInteger), pointer :: cellsOnCellCursor
+
+ type (field0dInteger), pointer :: offSetField
+ type (field0dInteger), pointer :: cellLimitField
+
+ integer, dimension(:), pointer :: sendingHaloLayers
+ integer, dimension(:), pointer :: field1dArrayHolder
+ integer, dimension(:,:), pointer :: field2dArrayHolder
+
+ type (graph), pointer :: blockGraph, blockGraphWithHalo
+
+ type (mpas_exchange_list), pointer :: exchListPtr
+
+ integer :: nHalos, nCellsInBlock, nCellsInHalo, maxEdges
+ integer :: iHalo, iBlock, i
+
+ nHalos = config_num_halos
+ dminfo => indexToCellID % block % domain % dminfo
+ allocate(sendingHaloLayers(1))
+ allocate(nCellsSolve)
+
+ allocate(cellLimitField)
+ allocate(offSetField)
+ offSetCursor => offsetField
+ cellLimitCursor => cellLimitField
+ indexCursor => indexToCellID
+ nCellsSolveCursor => nCellsSolve
+ do while (associated(indexCursor))
+ offSetCursor % scalar = indexCursor % dimSizes(1)
+ offSetCursor % block => indexCursor % block
+
+ nCellsSolveCursor % dimSizes(1) = nHalos+1
+ allocate(nCellsSolveCursor % array(nCellsSolveCursor % dimSizes(1)))
+ nCellsSolve % array(1) = indexCursor % dimSizes(1)
+ nCellsSolve % block => indexCursor % block
+
+ cellLimitCursor % scalar = indexCursor % dimSizes(1)
+ cellLimitCursor % block => indexCursor % block
+
+ indexCursor => indexCursor % next
+ if(associated(indexCursor)) then
+ allocate(offSetCursor % next)
+ offSetCursor => offSetCursor % next
+
+ allocate(nCellsSolveCursor % next)
+ nCellsSolveCursor => nCellsSolveCursor % next
+
+ allocate(cellLimitCursor % next)
+ cellLimitCursor => cellLimitCursor % next
+ end if
+ nullify(offSetCursor % next)
+ nullify(nCellssolveCursor % next)
+ nullify(cellLimitCursor % next)
+ end do
+
+ do iHalo = 1, nHalos
+ sendingHaloLayers(1) = iHalo
+
+ allocate(haloIndices)
+
+ indexCursor => indexToCellID
+ nEdgesCursor => nEdgesOnCell
+ cellsOnCellCursor => cellsOnCell
+ haloCursor => haloIndices
+ offSetCursor => offSetField
+ do while(associated(indexCursor))
+ nCellsInBlock = indexCursor % dimSizes(1)
+ maxEdges = cellsOnCellCursor % dimSizes(1)
+
+ offSetCursor % scalar = nCellsInBlock
+
+ allocate(blockGraphWithHalo)
+ allocate(blockGraph)
+ allocate(blockGraph % vertexID(nCellsInBlock))
+ allocate(blockGraph % nAdjacent(nCellsInBlock))
+ allocate(blockGraph % adjacencyList(maxEdges, nCellsInBlock))
+
+ blockGraph % nVertices = nCellsInBlock
+ blockGraph % nVerticesTotal = nCellsInBlock
+ blockGraph % maxDegree = maxEdges
+ blockGraph % ghostStart = nCellsInBlock + 1
+
+!write(6,*) 'max nedges on block', indexCursor % block % blockid, maxval(nEdgescursor % array)
+
+ blockGraph % vertexID(:) = indexCursor % array(:)
+ blockGraph % nAdjacent(:) = nEdgesCursor % array(:)
+ blockGraph % adjacencyList(:,:) = cellsOnCellCursor % array(:,:)
+
+ call mpas_block_decomp_add_halo(dminfo, blockGraph, blockGraphWithHalo)
+
+ haloCursor % dimSizes(1) = blockGraphWithHalo % nVerticesTotal - blockGraphWithHalo % nVertices
+ allocate(haloCursor % array(haloCursor % dimSizes(1)))
+ haloCursor % array(:) = -1
+ haloCursor % array(:) = blockGraphWithHalo % vertexID(blockGraphWithHalo % nVertices+1:blockGraphWithHalo % nVerticesTotal)
+ haloCursor % sendList => indexCursor % sendList
+ haloCursor % recvList => indexCursor % recvList
+ haloCursor % copyList => indexCursor % copyList
+ haloCursor % block => indexCursor % block
+
+ deallocate(blockGraphWithHalo % vertexID)
+ deallocate(blockGraphWithHalo % nAdjacent)
+ deallocate(blockGraphWithHalo % adjacencyList)
+ deallocate(blockGraphWithHalo)
+
+ deallocate(blockGraph % vertexID)
+ deallocate(blockGraph % nAdjacent)
+ deallocate(blockGraph % adjacencyList)
+ deallocate(blockGraph)
+
+ indexCursor => indexCursor % next
+ nEdgesCursor => nEdgesCursor % next
+ cellsOnCellCursor => cellsOnCellCursor % next
+ offSetCursor => offSetCursor % next
+ if(associated(indexCursor)) then
+ allocate(haloCursor % next)
+ haloCursor => haloCursor % next
+ end if
+ nullify(haloCursor % next)
+ end do ! indexCursor loop over blocks
+
+ call mpas_dmpar_get_exch_list(iHalo, indexToCellID, haloIndices, offSetField, cellLimitField)
+
+ ! dwj: 05/24/12 debugging
+! write(6,*) 'new send lists'
+! indexCursor => indexToCellID
+! do while(associated(indexCursor))
+! exchListPtr => indexCursor % sendList % halos(iHalo) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'send list from block ', indexCursor % block % localBlockID, ' to proc ', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) exchListPtr % srcList(i), exchListPtr % destList(i)!, indexCursor % array(exchListPtr % srcList(i))
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! indexCursor => indexCursor % next
+! end do
+
+! write(6,*) 'new recv lists'
+! indexCursor => indexToCellID
+! do while(associated(indexCursor))
+! exchListPtr => indexCursor % recvList % halos(iHalo) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'recv list to block ', indexCursor % block % localBlockID, ' from proc ', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) exchListPtr % srcList(i), exchListPtr % destList(i), indexCursor % array(exchListPtr % srcList(i))
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! indexCursor => indexCursor % next
+! end do
+
+
+! write(6,*) 'new copy lists'
+! indexCursor => indexToCellID
+! do while(associated(indexCursor))
+! exchListPtr => indexCursor % copyList % halos(iHalo) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'copy list from block ', indexCursor % block % localBlockID, ' to ', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) exchListPtr % srcList(i), exchListPtr % destList(i), indexCursor % array(exchListPtr % srcList(i))
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! indexCursor => indexCursor % next
+! end do
+
+ indexCursor => indexToCellID
+ nEdgesCursor => nEdgesOnCell
+ cellsOnCellCursor => cellsOnCell
+ haloCursor => haloIndices
+ nCellsSolveCursor => nCellsSolve
+ do while(associated(indexCursor))
+ nCellsInBlock = indexCursor % dimSizes(1)
+ nCellsInHalo = haloCursor % dimSizes(1)
+
+ nCellsSolveCursor % array(iHalo+1) = nCellsInBlock + nCellsInHalo
+
+ field1dArrayHolder => indexCursor % array
+ indexCursor % dimSizes(1) = nCellsSolveCursor % array(iHalo+1)
+ allocate(indexCursor % array(indexCursor % dimSizes(1)))
+ indexCursor % array = -1
+ indexCursor % array(1:nCellsInBlock) = field1dArrayHolder(:)
+ indexCursor % array(nCellsInBlock+1:nCellsSolveCursor % array(iHalo+1)) = haloCursor % array(1:nCellsInHalo)
+ deallocate(field1dArrayHolder)
+
+ field1dArrayHolder => nEdgesCursor % array
+ nEdgesCursor % dimSizes(1) = nCellsSolveCursor % array(iHalo+1)
+ allocate(nEdgesCursor % array(nEdgesCursor % dimSizes(1)))
+ nEdgesCursor % array = -1
+ nEdgesCursor % array(1:nCellsInBlock) = field1dArrayHolder(:)
+ deallocate(field1dArrayHolder)
+
+ field2dArrayHolder => cellsOnCellCursor % array
+ cellsOnCellCursor % dimSizes(2) = nCellsSolveCursor % array(iHalo+1)
+ allocate(cellsOnCellCursor % array(cellsOnCellCursor % dimSizes(1), cellsOnCellCursor % dimSizes(2)))
+ cellsOnCellCursor % array = -1
+ cellsOnCellCursor % array(:,1:nCellsInBlock) = field2dArrayHolder(:,:)
+ deallocate(field2dArrayHolder)
+
+ indexCursor => indexCursor % next
+ nEdgesCursor => nEdgesCursor % next
+ cellsOnCellCursor => cellsOnCellCursor % next
+ haloCursor => haloCursor % next
+ nCellsSolveCursor => nCellsSolveCursor % next
+ end do
+
+ call mpas_dmpar_alltoall_field(indexToCellID, indexToCellID, sendingHaloLayers)
+ call mpas_dmpar_alltoall_field(nEdgesOnCell, nEdgesOncell, sendingHaloLayers)
+ call mpas_dmpar_alltoall_field(cellsOnCell, cellsOnCell, sendingHaloLayers)
+
+ ! dwj: 05/24/12 debugging
+! indexCursor => indexToCellID
+! do while(associated(indexCursor))
+!write(6,*) 'indexToCellID with HALO', iHalo,' on block ', indexCursor % block % blockID
+! do i = 1, indexcursor % dimSizes(1)
+! write(6,*) i, indexCursor % array(i)
+! end do
+! indexCursor => indexCursor % next
+! end do
+!
+! nEdgesCursor => nEdgesOnCell
+! do while(associated(nEdgesCursor))
+!write(6,*) 'nEdgesOnCell with HALO', iHalo, ' on block', nEdgescursor % block % blockID
+! do i = 1, nEdgesCursor % dimSizes(1)
+! write(6,*) i, nEdgesCursor % array(i)
+! end do
+! nEdgesCursor => nEdgesCursor % next
+! end do
+!
+! cellsOnCellCursor => cellsOnCell
+! do while(associated(cellsOnCellCursor))
+!write(6,*) 'cellsOnCell with HALO', iHalo,' on block ', cellsOnCellCursor % block % blockID
+! do i = 1, cellsOnCellCursor % dimSizes(2)
+! write(6,*) i, cellsOnCellCursor % array(:,i)
+! end do
+! cellsOnCellCursor => cellsOnCellCursor % next
+! end do
+
+
+ call mpas_deallocate_field(haloIndices)
+ end do ! iHalo loop over nHalos
+
+ deallocate(sendingHaloLayers)
+ call mpas_deallocate_field(offSetField)
+
+ end subroutine mpas_block_creator_build_cell_halos!}}}
+
+
+
!***********************************************************************
!
! routine mpas_get_halo_cells_and_exchange_lists
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-05-24 17:10:51 UTC (rev 1935)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-05-24 19:05:33 UTC (rev 1936)
@@ -544,13 +544,14 @@
! ----- NEW ROUTINES BELOW ----- !
-subroutine mpas_dmpar_get_exch_list(haloLayer, ownedListField, neededListField, offsetListField)!{{{
+subroutine mpas_dmpar_get_exch_list(haloLayer, ownedListField, neededListField, offsetListField, ownedLimitField)!{{{
implicit none
integer, intent(in) :: haloLayer
type (field1dInteger), pointer :: ownedListField, neededListField
type (field0dInteger), pointer, optional :: offsetListField
+ type (field0dInteger), pointer, optional :: ownedLimitField
type (dm_info), pointer :: dminfo
@@ -559,12 +560,12 @@
integer :: totalSent, totalRecv
integer, allocatable, dimension(:) :: numToSend, numToRecv
integer, allocatable, dimension(:) :: ownedList, ownedListIndex, ownedBlock, neededList, neededListIndex, neededBlock
- integer, allocatable, dimension(:) :: offsetList
+ integer, allocatable, dimension(:) :: offsetList, ownedLimitList
integer, allocatable, dimension(:,:) :: ownedListSorted, ownedBlockSorted, recipientList
integer, allocatable, dimension(:) :: ownerListIn, ownerListOut
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
type (field1dInteger), pointer :: fieldCursor, fieldCursor2
- type (field0dInteger), pointer :: offsetCursor
+ type (field0dInteger), pointer :: offsetCursor, ownedLimitCursor
integer :: nOwnedBlocks, nNeededBlocks
integer :: nOwnedList, nNeededList
integer :: mpi_ierr, mpi_rreq, mpi_sreq
@@ -590,23 +591,25 @@
! For the neededListField:
! similar to the owneListField...
+ dminfo => ownedListField % block % domain % dminfo
!
- ! Determine total number of owned indices on this task, and
- ! initialize output send and recv lists for ownedListField
+ ! Determine total number of owned blocks on this task
!
- dminfo => ownedListField % block % domain % dminfo
-
- nOwnedList = 0
nOwnedBlocks = 0
fieldCursor => ownedListField
do while (associated(fieldCursor))
nOwnedBlocks = nOwnedBlocks + 1
- nOwnedList = nOwnedList + fieldCursor % dimSizes(1)
+ if(associated(fieldCursor % sendList % halos(haloLayer) % exchList)) then
+ call mpas_dmpar_destroy_exchange_list(fieldCursor % sendList % halos(haloLayer) % exchList)
+ end if
+
+ if(associated(fieldCursor % copyList % halos(haloLayer) % exchList)) then
+ call mpas_dmpar_destroy_exchange_list(fieldCursor % copyList % halos(haloLayer) % exchList)
+ end if
fieldCursor => fieldCursor % next
end do
-
!
! Determine total number of needed indices on this task
!
@@ -616,21 +619,72 @@
do while (associated(fieldCursor))
nNeededBlocks = nNeededBlocks + 1
nNeededList = nNeededList + fieldCursor % dimSizes(1)
+ if(associated(fieldCursor % recvList % halos(haloLayer) % exchList)) then
+ call mpas_dmpar_destroy_exchange_list(fieldCursor % recvList % halos(haloLayer) % exchList)
+ end if
+
fieldCursor => fieldCursor % next
end do
+ !
+ ! Get list of index offsets for all blocks
+ !
+ allocate(offsetList(nNeededBlocks))
+ if (present(offsetListField)) then
+ offsetCursor => offsetListField
+ do while (associated(offsetCursor))
+ offsetList(offsetCursor % block % localBlockID+1) = offsetCursor % scalar
+ offsetCursor => offsetCursor % next
+ end do
+ else
+ offsetList(:) = 0
+ end if
+
+ !
+ ! Get list of bounds limit for owned elements
+ !
+ allocate(ownedLimitList(nOwnedBlocks))
+ if(present(ownedLimitField)) then
+ ownedLimitCursor => ownedLimitField
+ do while(associated(ownedLimitCursor))
+ ownedLimitList(ownedLimitCursor % block % localBlockID+1) = ownedLimitCursor % scalar
+ ownedLimitCursor => ownedLimitCursor % next
+ end do
+ else
+ fieldCursor => ownedListField
+ do while(associated(fieldCursor))
+ ownedLimitList(fieldCursor % block % localBlockID+1) = fieldCursor % dimSizes(1)
+ fieldCursor => fieldCursor % next
+ end do
+ end if
+
+ !
+ ! Determine total number of owned indices on this task, and
+ ! initialize output send and recv lists for ownedListField
+ !
+ nOwnedList = 0
+ fieldCursor => ownedListField
+ do while (associated(fieldCursor))
+ iBlock = fieldcursor % block % localBlockID + 1
+ nOwnedList = nOwnedList + ownedLimitList(iBlock)
+ fieldCursor => fieldCursor % next
+ end do
+
#ifdef _MPI
!
! Gather list of all owned indices and their associated blocks on this task
!
allocate(ownedList(nOwnedList))
allocate(ownedBlock(nOwnedList))
+ ownedBlock = -1
+ ownedList = -1
fieldCursor => ownedListField
i = 1
do while (associated(fieldCursor))
- ownedList(i:i+fieldCursor % dimSizes(1)-1) = fieldCursor % array(:)
- ownedBlock(i:i+fieldCursor % dimSizes(1)-1) = fieldCursor % block % localBlockID
- i = i + fieldCursor % dimSizes(1)
+ iBlock = fieldCursor % block % localBlockID + 1
+ ownedList(i:i+ownedLimitList(iBlock)-1) = fieldCursor % array(1:ownedLimitList(iBlock))
+ ownedBlock(i:i+ownedLimitList(iBlock)-1) = fieldCursor % block % localBlockID
+ i = i + ownedLimitList(iBlock)
fieldCursor => fieldCursor % next
end do
@@ -648,39 +702,23 @@
fieldCursor => fieldCursor % next
end do
-
!
- ! Get list of index offsets for all blocks
- !
- allocate(offsetList(nNeededBlocks))
- if (present(offsetListField)) then
- offsetCursor => offsetListField
- i = 0
- do while (associated(offsetCursor))
- i = i + 1
- offsetList(i) = offsetCursor % scalar
- offsetCursor => offsetCursor % next
- end do
- else
- offsetList(:) = 0
- end if
-
-
- !
! Obtain sorted list of global indices owned by this task and the associated local indices and block IDs
!
allocate(ownedListIndex(nOwnedList))
allocate(ownedListSorted(2,nOwnedList))
allocate(recipientList(2,nOwnedList))
j = 1
+ k = 1
do i=1,nOwnedList
ownedListSorted(1,i) = ownedList(i)
if (i > 1) then
- if(ownedBlock(i) /= ownedBlock(i-1)) j = 1
+ if(ownedBlock(i) /= ownedBlock(i-1)) k = 1
end if
- ownedListIndex(i) = j
+ ownedListIndex(i) = k
ownedListSorted(2,i) = j
j = j + 1
+ k = k + 1
end do
call quicksort(nOwnedList, ownedListSorted)
@@ -702,7 +740,6 @@
j = j + 1
end do
-
!
! Set totalSize to the maximum number of items in any task's needed list
!
@@ -712,7 +749,6 @@
allocate(ownerListOut(totalSize))
nMesgSend = nNeededList
-! ownerListOut(1:nNeededList) = neededList(1:nNeededList)
nMesgRecv = nNeededList
ownerListOut(1:nNeededList) = neededList(1:nNeededList)
@@ -723,17 +759,21 @@
allocate(numToRecv(nNeededBlocks))
! Initial send of data to neighbors.
- call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
- call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
- call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
- call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
- call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
- call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
- call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
- call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+ if(dminfo % nProcs == 1) then
+ ownerListIn = ownerListOut
+ else
+ call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, recvNeighbor, dminfo % comm, mpi_rreq, mpi_ierr)
+ call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, dminfo % my_proc_id, dminfo % comm, mpi_sreq, mpi_ierr)
+ call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+ call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+ call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, recvNeighbor, dminfo % comm, mpi_rreq, mpi_ierr)
+ call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, dminfo % my_proc_id, dminfo % comm, mpi_sreq, mpi_ierr)
+ call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+ call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+ end if
!
- ! For each processor (including ourself), mark the indices that we will provide to
+ ! For each processor (not including ourself), mark the indices that we will provide to
! that processor in ownerListOut, and build a send list for that processor if we
! do need to send any indices
!
@@ -747,7 +787,7 @@
if (ownerListIn(j) > 0) then
k = mpas_binary_search(ownedListSorted, 2, 1, nOwnedList, ownerListIn(j))
if (k <= nOwnedList) then
- iBlock = ownedBlockSorted(2,k) + 1
+ iBlock = ownedBlock(ownedListSorted(2,k)) + 1
ownerListOut(j) = -1 * dminfo % my_proc_id
numToSend(iBlock) = numToSend(iBlock) + 1
totalSent = totalSent + 1
@@ -807,12 +847,12 @@
end do
nMesgSend = nMesgRecv
- call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
- call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+ call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, recvNeighbor, dminfo % comm, mpi_rreq, mpi_ierr)
+ call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, dminfo % my_proc_id, dminfo % comm, mpi_sreq, mpi_ierr)
call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
- call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
- call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+ call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, recvNeighbor, dminfo % comm, mpi_rreq, mpi_ierr)
+ call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, dminfo % my_proc_id, dminfo % comm, mpi_sreq, mpi_ierr)
call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
end do
@@ -892,31 +932,32 @@
deallocate(recipientList)
deallocate(ownerListIn)
deallocate(ownerListOut)
- deallocate(offsetList)
#endif
! Build Copy Lists
allocate(numToSend(1))
fieldCursor => ownedListField
do while (associated(fieldCursor))
- allocate(ownedListSorted(2, fieldCursor % dimSizes(1)))
- allocate(recipientList(2, fieldcursor % dimSizes(1)))
+ iBlock = fieldCursor % block % localBlockID + 1
+ nOwnedList = ownedLimitList(iBlock)
+ allocate(ownedListSorted(2, nOwnedList))
+ allocate(recipientList(2, nOwnedList))
- numToSend = 0
- recipientList = -1
-
- do i = 1, fieldCursor % dimSizes(1)
+ do i = 1, nOwnedList
ownedListSorted(1, i) = fieldCursor % array(i)
ownedListSorted(2, i) = i
end do
- call quicksort(fieldCursor % dimSizes(1), ownedListSorted)
+ call quicksort(nOwnedList, ownedListSorted)
fieldCursor2 => neededListField
do while(associated(fieldCursor2))
+ numToSend = 0
+ recipientList = -1
+
do i = 1, fieldCursor2 % dimSizes(1)
- k = mpas_binary_search(ownedListSorted, 2, 1, fieldCursor % dimSizes(1), fieldCursor2 % array(i))
- if (k <= fieldCursor % dimSizes(1)) then
+ k = mpas_binary_search(ownedListSorted, 2, 1, nOwnedList, fieldCursor2 % array(i))
+ if (k <= nOwnedList) then
numToSend(1) = numToSend(1) + 1
! recipientList(1,:) represents the needed block id
recipientList(1,ownedListSorted(2,k)) = fieldCursor2 % block % localBlockID
@@ -924,7 +965,7 @@
recipientList(2,ownedListSorted(2,k)) = i
end if
end do
-
+
if(numToSend(1) > 0) then
if(.not.associated(fieldCursor % copyList % halos(haloLayer) % exchList)) then
allocate(fieldCursor % copyList % halos(haloLayer) % exchList)
@@ -949,15 +990,15 @@
allocate(exchListPtr % srcList(numToSend(1)))
allocate(exchListPtr % destList(numToSend(1)))
kk = 1
- do j=1,fieldCursor % dimSizes(1)
+ do j=1,nOwnedList
if(recipientList(1,j) == fieldCursor2 % block % localBlockID) then
exchListPtr % srcList(kk) = j
- exchListPtr % destList(kk) = recipientList(2,j)
+ exchListPtr % destList(kk) = recipientList(2,j) + offSetList(fieldCursor2 % block % localBlockID+1)
kk = kk + 1
end if
end do
end if
- fieldCursor2 => fieldCursor % next
+ fieldCursor2 => fieldCursor2 % next
end do
deallocate(recipientList)
@@ -965,9 +1006,11 @@
fieldCursor => fieldCursor % next
end do
deallocate(numToSend)
+ deallocate(offSetList)
end subroutine mpas_dmpar_get_exch_list!}}}
+
subroutine mpas_dmpar_alltoall_field1d_integer(fieldIn, fieldout, haloLayersIn)!{{{
implicit none
@@ -1064,6 +1107,8 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
+ commListPtr % ibuffer = 0
call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
end do
@@ -1121,6 +1166,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -1318,6 +1364,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
end do
@@ -1375,6 +1422,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -1574,6 +1622,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
end do
@@ -1631,6 +1680,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -1835,6 +1885,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_realKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
end do
@@ -1892,6 +1943,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -2088,6 +2140,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_realKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
end do
@@ -2145,6 +2198,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -2345,6 +2399,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_realKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
end do
@@ -2402,6 +2457,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -2651,6 +2707,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
@@ -2660,6 +2717,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -2897,6 +2955,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
@@ -2906,6 +2965,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -3147,6 +3207,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
call MPI_Irecv(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
@@ -3156,6 +3217,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % ibuffer(commListPtr % nList))
+ nullify(commListPtr % rbuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -3403,6 +3465,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
@@ -3412,6 +3475,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -3649,6 +3713,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
@@ -3658,6 +3723,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -3899,6 +3965,7 @@
commListPtr => recvList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr)
commListPtr => commListPtr % next
@@ -3908,6 +3975,7 @@
commListPtr => sendList
do while(associated(commListPtr))
allocate(commListPtr % rbuffer(commListPtr % nList))
+ nullify(commListPtr % ibuffer)
bufferOffset = 0
do iHalo = 1, nHaloLayers
nAdded = 0
@@ -4048,8 +4116,8 @@
type (mpas_communication_list), pointer :: commListPtr
commListPtr => commList
- do while(associated(commList))
- if(associated(commList)) then
+ do while(associated(commListPtr))
+ if(associated(commList % next)) then
commList => commList % next
else
nullify(commList)
@@ -4062,6 +4130,7 @@
if(associated(commListPtr % rbuffer)) then
deallocate(commListPtr % rbuffer)
end if
+
deallocate(commListPtr)
commListPtr => commList
end do
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-05-24 17:10:51 UTC (rev 1935)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-05-24 19:05:33 UTC (rev 1936)
@@ -115,8 +115,6 @@
type (field1DInteger), pointer :: indexToEdgeID_tList
- type (field0dInteger), pointer :: offSetField
-
#ifdef HAVE_ZOLTAN
#ifdef _MPI
type (field1DReal), pointer :: xCell, yCell, zCell
@@ -667,9 +665,52 @@
call mpas_block_creator_build_0halo_cell_fields(indexToCellIDField, nEdgesOnCellField, cellsOnCellField, indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo)
write(6,*) 'Done with 0 halo cells'
+! !! TEST FOR ALL TO ALL FUNCTIONALITY
+! int1d_ptr => indexToCellID_0Halo
+! do while(associated(int1d_ptr))
+! write(6,*) 'Cells on 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
+
+! int1d_ptr => nEdgesOnCell_0Halo
+! do while(associated(int1d_ptr))
+! write(6,*) 'Max edges on 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
+
+! int2d_ptr => cellsOnCell_0Halo
+! do while(associated(int2d_ptr))
+! write(6,*) 'CellsOnCell on 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,*) 'Building cell halos', nHalos
+ call mpas_block_creator_build_cell_halos(indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, nCellsSolveField)
+
write(6,*) 'Stopping'
stop
+ int1d_ptr => nCellsSolveField
+ do while(associated(int1d_ptr))
+ write(6,*) 'nCellsSolve for block', int1d_ptr % block % blockID
+ do i = 1, nHalos+1
+ write(6,*) ' CELLS IN', i-1,' halo ',int1d_ptr % array(i)
+ end do
+ int1d_ptr => int1d_ptr % next
+ end do
+
! write(6,*) 'Building temporary indexToVertexID list. Containing 0 and 1 halo vertices'
! allocate(indexToVertexID_tList)
! int1d_ptr => nEdgesOnCell_0Halo
</font>
</pre>