<p><b>dwj07@fsu.edu</b> 2012-06-01 12:14:49 -0600 (Fri, 01 Jun 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Fixing an issue with exchange lists.<br>
Now runs on multiple processors (>2) with one block per processor, without issues.<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-31 19:28:35 UTC (rev 1951)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F 2012-06-01 18:14:49 UTC (rev 1952)
@@ -149,6 +149,8 @@
integer, dimension(:), pointer :: sendingHaloLayers
+ type (mpas_exchange_list), pointer :: exchListPtr
+
integer :: nCellsInBlock, maxEdges, nHalos
integer :: i, iHalo
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-05-31 19:28:35 UTC (rev 1951)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-01 18:14:49 UTC (rev 1952)
@@ -564,6 +564,7 @@
integer, allocatable, dimension(:) :: offsetList, ownedLimitList
integer, allocatable, dimension(:,:) :: ownedListSorted, ownedBlockSorted, recipientList
integer, allocatable, dimension(:) :: ownerListIn, ownerListOut
+ integer, allocatable, dimension(:) :: packingOrder
type (mpas_exchange_list), pointer :: exchListPtr, exchListPtr2
type (field1dInteger), pointer :: fieldCursor, fieldCursor2
type (field0dInteger), pointer :: offsetCursor, ownedLimitCursor
@@ -634,7 +635,6 @@
!
! Determine unique list of needed elements.
!
- !! NEW
nUniqueNeededList = 0
call mpas_hash_init(neededHash)
fieldCursor => neededListField
@@ -652,6 +652,7 @@
nUniqueNeededList = mpas_hash_size(neededHash)
allocate(uniqueSortedNeededList(2,nUniqueNeededList))
+ allocate(packingOrder(nUniqueNeededList))
call mpas_hash_destroy(neededHash)
call mpas_hash_init(neededHash)
@@ -670,12 +671,9 @@
end do
kk = mpas_hash_size(neededHash)
-! write(6,*) 'UNIQUE SIZE 2 ', j, kk
-! WRITE(6,*) 'NON UNIQUE SIZE',nNeededList
call mpas_hash_destroy(neededHash)
call quicksort(nUniqueNeededList, uniqueSortedNeededList)
- !! END NEW
!
! Get list of index offsets for all blocks
@@ -794,19 +792,11 @@
!
! Set totalSize to the maximum number of items in any task's needed list
!
- !! OLD
-! call MPI_Allreduce(nNeededList, totalSize, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
- !! NEW
call MPI_Allreduce(nUniqueNeededList, totalSize, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
allocate(ownerListIn(totalSize))
allocate(ownerListOut(totalSize))
- !! OLD
-! nMesgSend = nNeededList
-! nMesgRecv = nNeededList
-! ownerListOut(1:nNeededList) = neededList(1:nNeededList)
- !! NEW
nMesgSend = nUniqueNeededList
nMesgRecv = nUniqueNeededList
ownerListOut(1:nUniqueNeededList) = uniqueSortedNeededList(1,1:nUniqueNeededList)
@@ -856,7 +846,6 @@
! recipientList(2,:) represnets the index in the buffer to place this data
recipientList(2,ownedListSorted(2,k)) = totalSent
-! write(6,*) 'FOUND', ownerListIn(j), k, ownedListSorted(2,k), iBlock-1, numToSend(iBlock), totalSent
else
ownerListOut(j) = ownerListIn(j)
end if
@@ -865,13 +854,6 @@
end if
end do
-! write(6,*) 'nOwnedList', nOwnedList
-! write(6,*) 'RecipientList'
-! do j = 1,nOwnedList
-! write(6,*) recipientList(:,j)
-! end do
-! write(6,*) 'numToSend', numToSend
-
fieldCursor => ownedListField
do while (associated(fieldCursor))
iBlock = fieldCursor % block % localBlockID + 1
@@ -906,14 +888,12 @@
do j=1,nOwnedList
if (recipientList(1,j) /= -1) then
if(ownedBlock(j) == fieldCursor % block % localBlockID) then
-! write(6,*) 'SENDING', ownedListIndex(j), 'to', recipientList(2,j)
exchListPtr % srcList(recipientList(1,j)) = ownedListIndex(j)
exchListPtr % destList(recipientList(1,j)) = recipientList(2,j)
kk = kk + 1
end if
end if
end do
-! write(6,*) 'NLIST CHECK', exchListPtr % nList, kk
end if
fieldCursor => fieldCursor % next
@@ -930,17 +910,6 @@
call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
end do
-! write(6,*) 'OWNERLISTIN'
-! do i = 1, nMesgRecv
-! write(6,*) ownerListIn(i)
-! end do
-
-! write(6,*) 'uniqueSortedNeededList'
-! do i = 1, nMesgRecv
-! write(6,*) uniqueSortedNeededList(:,i)
-! end do
-
-
!
! With our needed list returned to us, build receive lists based on which indices were
! marked by other tasks
@@ -949,18 +918,32 @@
if(i == dminfo % my_proc_id) cycle
numToRecv(:) = 0
- !! OLD
-! do j=1,nNeededList
-! iBlock = neededBlock(j) + 1
- !! NEW
+ packingOrder = 0
+
+ k = 0
do j=1,nUniqueNeededList
- iBlock = uniqueSortedNeededList(2,j) + 1
- if (ownerListIn(j) == -i) numToRecv(iBlock) = numToRecv(iBlock) + 1
+ if (ownerListIn(j) == -i) then
+ k = k + 1
+ packingOrder(j) = k
+ end if
end do
- totalRecv = 0
fieldCursor => neededListField
do while (associated(fieldCursor))
+ do j = 1, fieldCursor % dimSizes(1)
+ k = mpas_binary_search(uniqueSortedNeededList, 2, 1, nUniqueNeededList, fieldCursor % array(j))
+ if(k <= nUniqueNeededList) then
+ if(ownerListIn(k) == -i) then
+ iBlock = fieldCursor % block % localBlockID + 1
+ numToRecv(iBlock) = numToRecv(iBlock) + 1
+ end if
+ end if
+ end do
+ fieldCursor => fieldCursor % next
+ end do
+
+ fieldCursor => neededListField
+ do while (associated(fieldCursor))
iBlock = fieldCursor % block % localBlockID + 1
if (numToRecv(iBlock) > 0) then
@@ -989,39 +972,19 @@
exchListPtr % srcList = -1
exchListPtr % destList = -1
- !! OLD
-! kk = 1
-! do j=1,nNeededList
-! if (ownerListIn(j) == -i) then
-! k = mpas_binary_search(uniqueSortedNeededList, 2, 1, nOwnedList, ownerListIn(j))
-! if (neededBlock(j) == fieldCursor % block % localBlockID) then
-! totalRecv = totalRecv + 1
-! exchListPtr % srcList(kk) = totalRecv
-! exchListPtr % destList(kk) = neededListIndex(j) + offsetList(iBlock)
-! kk = kk + 1
-! end if
-! end if
-! end do
-
- !! NEW
kk = 1
do j=1,fieldCursor % dimSizes(1)
k = mpas_binary_search(uniqueSortedNeededList, 2, 1, nUniqueNeededList, fieldCursor % array(j))
if(k <= nUniqueNeededList) then
-! write(6,*) 'Recv List FOUND',k, fieldCursor % array(j)
if (ownerListIn(k) == -i) then
-! write(6,*) 'OWNED BY PROC', i
- exchListPtr % srcList(kk) = kk
+ exchListPtr % srcList(kk) = packingOrder(k)
exchListPtr % destList(kk) = j + offsetList(iBlock)
+
kk = kk + 1
-! else
-! write(6,*) 'NOT OWNED BY PROC', i, ownerListIn(k)
end if
end if
end do
-! write(6,*) 'RECV LIST nList =', numToRecv(iBlock), 'kk = ' ,kk
-
end if
fieldCursor => fieldCursor % next
@@ -1044,6 +1007,8 @@
deallocate(recipientList)
deallocate(ownerListIn)
deallocate(ownerListOut)
+ deallocate(uniqueSortedNeededList)
+ deallocate(packingOrder)
#endif
! Build Copy Lists
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-31 19:28:35 UTC (rev 1951)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-06-01 18:14:49 UTC (rev 1952)
@@ -33,6 +33,8 @@
type (mpas_exchange_list), pointer :: sendEdgeList, recvEdgeList
type (mpas_exchange_list), pointer :: sendVertexList, recvVertexList
type (mpas_exchange_list), pointer :: sendVertLevelList, recvVertLevelList
+
+ type (mpas_exchange_list), pointer :: exchListPtr
integer :: readCellStart, readCellEnd, nReadCells
integer :: readEdgeStart, readEdgeEnd, nReadEdges
@@ -291,47 +293,16 @@
write(6,*) 'Building vertex halos', nHalos
call mpas_block_creator_build_vertex_halos(indexToCellID_0Halo, nEdgesOnCell_0Halo, nCellsSolveField, edgesOnCell_0Halo, indexToEdgeID_0Halo, cellsOnEdge_0Halo, nEdgesSolveField)
- ! DWJ DEBUGGING
-! int1d_ptr => nCellsSolveField
-! do while(associated(int1d_ptr))
-! write(6,*) 'nCellsSolve on block', int1d_ptr % block % localBlockID
-! do i = 1, int1d_ptr % dimSizes(1)
-! write(6,*) 'halo', i-1, int1d_ptr % array(i)
-! end do
-
-! int1d_ptr => int1d_ptr % next
-! end do
-
-! int1d_ptr => nVerticesSolveField
-! do while(associated(int1d_ptr))
-! write(6,*) 'nVerticesSolve on block', int1d_ptr % block % localBlockID
-! do i = 1, int1d_ptr % dimSizes(1)
-! write(6,*) 'halo', i-1, int1d_ptr % array(i)
-! end do
-
-! int1d_ptr => int1d_ptr % next
-! end do
-
-! int1d_ptr => nEdgesSolveField
-! do while(associated(int1d_ptr))
-! write(6,*) 'nEdgesSolve on block', int1d_ptr % block % localBlockID
-! do i = 1, int1d_ptr % dimSizes(1)
-! write(6,*) 'halo', i-1, int1d_ptr % array(i)
-! end do
-
-! int1d_ptr => int1d_ptr % next
-! end do
-
! Allocate blocks, and copy indexTo arrays into blocks
write(6,*) 'Allocate blocks, and copy indexTo arrays into blocks'
call mpas_block_creator_finalize_block_init(domain % blocklist, maxEdges, maxEdges2, vertexDegree, nVertLevels, nCellsSolveField, nEdgesSolveField, nVerticesSolveField, indexToCellID_0Halo, indexToEdgeID_0Halo, indexToVertexID_0Halo)
- write(6,*) 'initializing input object'
+! write(6,*) 'initializing input object'
block_ptr => domain % blocklist
- do while(associated(block_ptr))
+! do while(associated(block_ptr))
call mpas_io_input_init(input_obj, block_ptr, domain % dminfo)
- block_ptr => block_ptr % next
- end do
+! block_ptr => block_ptr % next
+! end do
write(6,*) 'getting file attributes'
call MPAS_readStreamAtt(input_obj % io_stream, 'sphere_radius', r_sphere_radius, ierr)
@@ -388,22 +359,121 @@
end if
!DWJ DEBUGGING
- write(6,*) 'BLOCK LOOP 1'
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- write(6,*) 'nEdges', block_ptr % mesh % nEdges
- write(6,*) 'nEdgesSolve', block_ptr % mesh % nEdgesSolve
- write(6,*) 'indexToCellID on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
- end do
- write(6,*) 'edgesOnCell on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
- end do
- block_ptr => block_ptr % next
- end do
+! write(6,*) 'BLOCK LOOP 1'
+! block_ptr => domain % blocklist
+! do while(associated(block_ptr))
+! write(6,*) 'nEdges', block_ptr % mesh % nEdges
+! write(6,*) 'nEdgesSolve', block_ptr % mesh % nEdgesSolve
+! write(6,*) 'indexToCellID on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
+! end do
+! write(6,*) 'edgesOnCell on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
+! end do
+! write(6,*) 'nVertices', block_ptr % mesh % nVertices
+! write(6,*) 'nVerticesSolve', block_ptr % mesh % nVerticesSolve
+! write(6,*) 'indexToVertexID on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nVertices
+! write(6,*) i, block_ptr % mesh % indexToVertexID % array(i)
+! end do
+! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nEdges
+! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
+! end do
+
+! do i = 1, nHalos+1
+! write(6,*) 'ON HALO', i
+! if(i <= nHalos) then
+! exchListPtr => block_ptr % parinfo % cellsToSend % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'cell sendList from block', block_ptr % blockID, ' to proc', exchListPtr % endPointID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+! exchListPtr => block_ptr % parinfo % cellsToRecv % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'cell recvList from proc', exchListPtr % endPointID, ' to block', block_ptr % blockID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+! exchListPtr => block_ptr % parinfo % cellsToCopy % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'cell copyList from block', block_ptr % blockID, ' to block', exchListPtr % endPointID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! end if
+
+! exchListPtr => block_ptr % parinfo % edgesToSend % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'edge sendList from block', block_ptr % blockID, ' to proc', exchListPtr % endPointID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+! exchListPtr => block_ptr % parinfo % edgesToRecv % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'edge recvList from proc', exchListPtr % endPointID, ' to block', block_ptr % blockID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+! exchListPtr => block_ptr % parinfo % edgesToCopy % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'edge copyList from block', block_ptr % blockID, ' to block', exchListPtr % endPointID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+
+! exchListPtr => block_ptr % parinfo % verticesToSend % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'vertex sendList from block', block_ptr % blockID, ' to proc', exchListPtr % endPointID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+! exchListPtr => block_ptr % parinfo % verticesToRecv % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'vertex recvList from proc', exchListPtr % endPointID, ' to block', block_ptr % blockID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+
+! exchListPtr => block_ptr % parinfo % verticesToCopy % halos(i) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'vertex copyList from block', block_ptr % blockID, ' to block', exchListPtr % endPointID
+! do j = 1, exchListPtr % nList
+! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! end do
+
+! block_ptr => block_ptr % next
+! end do
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Do the actual work of reading all fields in from the input or restart file
! For each field:
@@ -422,20 +492,30 @@
call MPAS_io_close(inputHandle, ierr)
!DWJ DEBUGGING
- write(6,*) 'BLOCK LOOP 2'
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- write(6,*) 'indexToCellID on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
- end do
- write(6,*) 'edgesOnCell on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
- end do
- block_ptr => block_ptr % next
- end do
+! write(6,*) 'BLOCK LOOP 2'
+! block_ptr => domain % blocklist
+! do while(associated(block_ptr))
+! write(6,*) 'indexToCellID on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
+! end do
+! write(6,*) 'edgesOnCell on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
+! end do
+! write(6,*) 'indexToVertexID on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nVertices
+! write(6,*) i, block_ptr % mesh % indexToVertexID % array(i)
+! end do
+! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nEdges
+! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
+! end do
+
+! block_ptr => block_ptr % next
+! end do
+
!
! Exchange halos for all of the fields that were read from the input file
!
@@ -443,33 +523,57 @@
call mpas_exch_input_field_halos(domain, input_obj)
!DWJ DEBUGGING
- write(6,*) 'BLOCK LOOP 3'
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- write(6,*) 'indexToCellID on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
- end do
- write(6,*) 'edgesOnCell on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
- end do
- block_ptr => block_ptr % next
- end do
+! write(6,*) 'BLOCK LOOP 3'
+! block_ptr => domain % blocklist
+! do while(associated(block_ptr))
+! write(6,*) 'indexToCellID on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
+! end do
+! write(6,*) 'edgesOnCell on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
+! end do
+! write(6,*) 'indexToVertexID on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nVertices
+! write(6,*) i, block_ptr % mesh % indexToVertexID % array(i)
+! end do
+! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nEdges
+! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
+! end do
+
+! block_ptr => block_ptr % next
+! end do
+
call mpas_block_creator_reindex_block_fields(domain % blocklist)
!DWJ DEBUGGING
- write(6,*) 'BLOCK LOOP 4'
- block_ptr => domain % blocklist
- do while(associated(block_ptr))
- write(6,*) 'edgesOnCell on block', block_ptr % blockID
- do i = 1, block_ptr % mesh % nCells
- write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
- end do
- block_ptr => block_ptr % next
- end do
+! write(6,*) 'BLOCK LOOP 4'
+! block_ptr => domain % blocklist
+! do while(associated(block_ptr))
+! write(6,*) 'edgesOnCell on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
+! end do
+! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nEdges
+! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
+! end do
+! block_ptr => block_ptr % next
+! end do
+
+! write(6,*) 'EXPECTED VERTICES'
+! int1d_ptr => indexToVertexID_0Halo
+! do while(associated(int1d_ptr))
+! do i = 1, int1d_ptr % dimSizes(1)
+! write(6,*) i, int1d_ptr % array(i)
+! end do
+! int1d_ptr => int1d_ptr % next
+! end do
+
call mpas_dmpar_destroy_mulithalo_exchange_list(indexToCellIDField % sendList)
call mpas_dmpar_destroy_mulithalo_exchange_list(indexToCellIDField % recvList)
call mpas_dmpar_destroy_mulithalo_exchange_list(indexToCellIDField % copyList)
</font>
</pre>