<p><b>dwj07@fsu.edu</b> 2012-06-13 11:27:37 -0600 (Wed, 13 Jun 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Fixing an issue where send/recv buffer sizes are mismatched between processors. This only occured in allToAll communications.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-12 19:31:37 UTC (rev 1979)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-13 17:27:37 UTC (rev 1980)
@@ -1151,7 +1151,7 @@
nullify(sendList)
nullify(recvList)
- ! Setup recieve lists, and determine the size of their buffers.
+ ! Setup recieve lists.
do iHalo = 1, nHaloLayers
fieldOutPtr => fieldOut
do while(associated(fieldOutPtr))
@@ -1163,7 +1163,6 @@
commListPtr => recvList
do while(associated(commListPtr))
if(commListPtr % procID == exchListPtr % endPointID) then
- commListPtr % nList = commListPtr % nList + exchListPtr % nList
comm_list_found = .true.
exit
end if
@@ -1191,7 +1190,7 @@
end if
commListPtr % procID = exchListPtr % endPointID
- commListPtr % nList = exchListPtr % nList
+ commListPtr % nList = 0
end if
exchListPtr => exchListPtr % next
@@ -1201,6 +1200,31 @@
end do
end do
+ ! Determine size of receive list buffers.
+ commListPtr => recvList
+ do while(associated(commListPtr))
+ bufferOffset = 0
+ do iHalo = 1, nHaloLayers
+ nAdded = 0
+ fieldOutPtr => fieldOut
+ do while(associated(fieldOutPtr))
+ exchListPtr => fieldOutPtr % recvList % halos(haloLayers(iHalo)) % exchList
+ do while(associated(exchListPtr))
+ if(exchListPtr % endPointID == commListPtr % procID) then
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
+ end if
+ exchListPtr => exchListPtr % next
+ end do
+
+ fieldOutPtr => fieldOutPtr % next
+ end do
+ bufferOffset = bufferOffset + nAdded
+ end do
+ commListPtr % nList = nAdded
+
+ commListPtr => commListPtr % next
+ end do
+
! Allocate buffers for recieves, and initiate mpi_irecv calls.
commListPtr => recvList
do while(associated(commListPtr))
@@ -1407,7 +1431,7 @@
nullify(sendList)
nullify(recvList)
- ! Setup recieve lists, and determine the size of their buffers.
+ ! Setup recieve lists
do iHalo = 1, nHaloLayers
fieldOutPtr => fieldOut
do while(associated(fieldOutPtr))
@@ -1419,7 +1443,6 @@
commListPtr => recvList
do while(associated(commListPtr))
if(commListPtr % procID == exchListPtr % endPointID) then
- commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldOutPtr % dimSizes(1)
comm_list_found = .true.
exit
end if
@@ -1437,7 +1460,6 @@
commListPtr => recvList
commListPtr2 => commListPtr % next
do while(associated(commListPtr2))
- write(6,*) 'create loop'
commListPtr => commListPtr % next
commListPtr2 => commListPtr % next
end do
@@ -1448,7 +1470,6 @@
end if
commListPtr % procID = exchListPtr % endPointID
- commListPtr % nList = exchListPtr % nList * fieldOutPtr % dimSizes(1)
end if
exchListPtr => exchListPtr % next
@@ -1458,6 +1479,31 @@
end do
end do
+ ! Determine size of receive list buffers.
+ commListPtr => recvList
+ do while(associated(commListPtr))
+ bufferOffset = 0
+ do iHalo = 1, nHaloLayers
+ nAdded = 0
+ fieldOutPtr => fieldOut
+ do while(associated(fieldOutPtr))
+ exchListPtr => fieldOutPtr % recvList % halos(haloLayers(iHalo)) % exchList
+ do while(associated(exchListPtr))
+ if(exchListPtr % endPointID == commListPtr % procID) then
+ nAdded = max(nAdded, maxval(exchListPtr % srcList) * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2))
+ end if
+ exchListPtr => exchListPtr % next
+ end do
+
+ fieldOutPtr => fieldOutPtr % next
+ end do
+ bufferOffset = bufferOffset + nAdded
+ end do
+ commListPtr % nList = nAdded
+
+ commListPtr => commListPtr % next
+ end do
+
! Allocate buffers for recieves, and initiate mpi_irecv calls.
commListPtr => recvList
do while(associated(commListPtr))
@@ -1666,7 +1712,7 @@
nullify(sendList)
nullify(recvList)
- ! Setup recieve lists, and determine the size of their buffers.
+ ! Setup recieve lists.
do iHalo = 1, nHaloLayers
fieldOutPtr => fieldOut
do while(associated(fieldOutPtr))
@@ -1716,6 +1762,31 @@
end do
end do
+ ! Determine size of receive list buffers
+ commListPtr => recvList
+ do while(associated(commListPtr))
+ bufferOffset = 0
+ do iHalo = 1, nHaloLayers
+ nAdded = 0
+ fieldOutPtr => fieldOut
+ do while(associated(fieldOutPtr))
+ exchListPtr => fieldOutPtr % recvList % halos(haloLayers(iHalo)) % exchList
+ do while(associated(exchListPtr))
+ if(exchListPtr % endPointID == commListPtr % procID) then
+ nAdded = max(nAdded, maxval(exchListPtr % srcList) * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2))
+ end if
+ exchListPtr => exchListPtr % next
+ end do
+
+ fieldOutPtr => fieldOutPtr % next
+ end do
+ bufferOffset = bufferOffset + nAdded
+ end do
+ commListPtr % nList = nAdded
+
+ commListPtr => commListPtr % next
+ end do
+
! Allocate buffers for recieves, and initiate mpi_irecv calls.
commListPtr => recvList
do while(associated(commListPtr))
@@ -1929,7 +2000,7 @@
nullify(sendList)
nullify(recvList)
- ! Setup recieve lists, and determine the size of their buffers.
+ ! Setup recieve lists.
do iHalo = 1, nHaloLayers
fieldOutPtr => fieldOut
do while(associated(fieldOutPtr))
@@ -1941,7 +2012,6 @@
commListPtr => recvList
do while(associated(commListPtr))
if(commListPtr % procID == exchListPtr % endPointID) then
- commListPtr % nList = commListPtr % nList + exchListPtr % nList
comm_list_found = .true.
exit
end if
@@ -1969,7 +2039,6 @@
end if
commListPtr % procID = exchListPtr % endPointID
- commListPtr % nList = exchListPtr % nList
end if
exchListPtr => exchListPtr % next
@@ -1979,6 +2048,31 @@
end do
end do
+ ! Determine size of receive list buffers
+ commListPtr => recvList
+ do while(associated(commListPtr))
+ bufferOffset = 0
+ do iHalo = 1, nHaloLayers
+ nAdded = 0
+ fieldOutPtr => fieldOut
+ do while(associated(fieldOutPtr))
+ exchListPtr => fieldOutPtr % recvList % halos(haloLayers(iHalo)) % exchList
+ do while(associated(exchListPtr))
+ if(exchListPtr % endPointID == commListPtr % procID) then
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
+ end if
+ exchListPtr => exchListPtr % next
+ end do
+
+ fieldOutPtr => fieldOutPtr % next
+ end do
+ bufferOffset = bufferOffset + nAdded
+ end do
+ commListPtr % nList = nAdded
+
+ commListPtr => commListPtr % next
+ end do
+
! Allocate buffers for recieves, and initiate mpi_irecv calls.
commListPtr => recvList
do while(associated(commListPtr))
@@ -2196,7 +2290,6 @@
commListPtr => recvList
do while(associated(commListPtr))
if(commListPtr % procID == exchListPtr % endPointID) then
- commListPtr % nList = commListPtr % nList + exchListPtr % nList * fieldOutPtr % dimSizes(1)
comm_list_found = .true.
exit
end if
@@ -2224,7 +2317,6 @@
end if
commListPtr % procID = exchListPtr % endPointID
- commListPtr % nList = exchListPtr % nList * fieldOutPtr % dimSizes(1)
end if
exchListPtr => exchListPtr % next
@@ -2234,6 +2326,32 @@
end do
end do
+ ! Determine size of receive list buffers.
+ commListPtr => recvList
+ do while(associated(commListPtr))
+ bufferOffset = 0
+ do iHalo = 1, nHaloLayers
+ nAdded = 0
+ fieldOutPtr => fieldOut
+ do while(associated(fieldOutPtr))
+ exchListPtr => fieldOutPtr % recvList % halos(haloLayers(iHalo)) % exchList
+ do while(associated(exchListPtr))
+ if(exchListPtr % endPointID == commListPtr % procID) then
+ nAdded = max(nAdded, maxval(exchListPtr % srcList) * fieldOutPtr % dimSizes(1))
+ end if
+ exchListPtr => exchListPtr % next
+ end do
+
+ fieldOutPtr => fieldOutPtr % next
+ end do
+ bufferOffset = bufferOffset + nAdded
+ end do
+ commListPtr % nList = nAdded
+
+ commListPtr => commListPtr % next
+ end do
+
+
! Allocate buffers for recieves, and initiate mpi_irecv calls.
commListPtr => recvList
do while(associated(commListPtr))
@@ -2443,7 +2561,7 @@
nullify(sendList)
nullify(recvList)
- ! Setup recieve lists, and determine the size of their buffers.
+ ! Setup recieve lists.
do iHalo = 1, nHaloLayers
fieldOutPtr => fieldOut
do while(associated(fieldOutPtr))
@@ -2493,6 +2611,33 @@
end do
end do
+ ! Determine size of receive list buffers.
+ commListPtr => recvList
+ do while(associated(commListPtr))
+ call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+
+ bufferOffset = 0
+ do iHalo = 1, nHaloLayers
+ nAdded = 0
+ fieldOutPtr => fieldOut
+ do while(associated(fieldOutPtr))
+ exchListPtr => fieldOutPtr % recvList % halos(haloLayers(iHalo)) % exchList
+ do while(associated(exchListPtr))
+ if(exchListPtr % endPointID == commListPtr % procID) then
+ nAdded = max(nAdded, maxval(exchListPtr % srcList) * fieldOutPtr % dimSizes(1) * fieldOutPtr % dimSizes(2))
+ end if
+ exchListPtr => exchListPtr % next
+ end do
+
+ fieldOutPtr => fieldOutPtr % next
+ end do
+ bufferOffset = bufferOffset + nAdded
+ end do
+ commListPtr % nList = nAdded
+
+ commListPtr => commListPtr % next
+ end do
+
! Allocate buffers for recieves, and initiate mpi_irecv calls.
commListPtr => recvList
do while(associated(commListPtr))
</font>
</pre>