<p><b>dwj07@fsu.edu</b> 2012-06-04 15:24:01 -0600 (Mon, 04 Jun 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Fixing an issue with the bufferOffset on the receiving end of communications.<br>
Fixed a FPE within the timer module.<br>
Added some more debugging statements to mpas_io_input, but they are commented out.<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-01 22:36:15 UTC (rev 1957)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-04 21:24:01 UTC (rev 1958)
@@ -837,7 +837,6 @@
k = mpas_binary_search(ownedListSorted, 2, 1, nOwnedList, ownerListIn(j))
if (k <= nOwnedList) then
iBlock = ownedBlock(ownedListSorted(2,k)) + 1
- ownerListOut(j) = -1 * dminfo % my_proc_id
numToSend(iBlock) = numToSend(iBlock) + 1
totalSent = totalSent + 1
@@ -846,6 +845,7 @@
! recipientList(2,:) represnets the index in the buffer to place this data
recipientList(2,ownedListSorted(2,k)) = totalSent
+ ownerListOut(j) = -1 * dminfo % my_proc_id
else
ownerListOut(j) = ownerListIn(j)
end if
@@ -967,24 +967,22 @@
exchListPtr % endPointID = i
exchListPtr % nlist = numToRecv(iBlock)
- allocate(exchListPtr % srcList(numToRecv(iBlock)))
- allocate(exchListPtr % destList(numToRecv(iBlock)))
+ allocate(exchListPtr % srcList(exchListPtr % nList))
+ allocate(exchListPtr % destList(exchListPtr % nList))
exchListPtr % srcList = -1
exchListPtr % destList = -1
- kk = 1
+ kk = 0
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
+ kk = kk + 1
exchListPtr % srcList(kk) = packingOrder(k)
exchListPtr % destList(kk) = j + offsetList(iBlock)
-
- kk = kk + 1
end if
end if
end do
-
end if
fieldCursor => fieldCursor % next
@@ -1322,8 +1320,8 @@
do i = 1, exchListPtr % nList
iBuffer = exchListPtr % srcList(i) + bufferOffset
fieldOutPtr % array(exchListPtr % destList(i)) = commListPtr % ibuffer(iBuffer)
- nAdded = nAdded + 1
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -1580,9 +1578,9 @@
do j = 1, fieldOutPtr % dimSizes(1)
iBuffer = (exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(1) + j + bufferOffset
fieldOutPtr % array(j, exchListPtr % destList(i)) = commListPtr % ibuffer(iBuffer)
- nAdded = nAdded + 1
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -1842,10 +1840,10 @@
do k = 1, fieldOutPtr % dimSizes(1)
iBuffer = (exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(2) * fieldOutPtr % dimSizes(1) + (j-1) * fieldOutPtr % dimSizes(1) + k + bufferOffset
fieldOutPtr % array(k, j, exchListPtr % destList(i)) = commListPtr % ibuffer(iBuffer)
- nAdded = nAdded + 1
end do
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -2099,8 +2097,8 @@
do i = 1, exchListPtr % nList
iBuffer = exchListPtr % srcList(i) + bufferOffset
fieldOutPtr % array(exchListPtr % destList(i)) = commListPtr % rbuffer(iBuffer)
- nAdded = nAdded + 1
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -2357,9 +2355,9 @@
do j = 1, fieldOutPtr % dimSizes(1)
iBuffer = (exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(1) + j + bufferOffset
fieldOutPtr % array(j, exchListPtr % destList(i)) = commListPtr % rbuffer(iBuffer)
- nAdded = nAdded + 1
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -2619,10 +2617,10 @@
do k = 1, fieldOutPtr % dimSizes(1)
iBuffer = (exchListPtr % srcList(i)-1) * fieldOutPtr % dimSizes(2) * fieldOutPtr % dimSizes(1) + (j-1) * fieldOutPtr % dimSizes(1) + k + bufferOffset
fieldOutPtr % array(k, j, exchListPtr % destList(i)) = commListPtr % rbuffer(iBuffer)
- nAdded = nAdded + 1
end do
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -2668,7 +2666,7 @@
integer :: bufferOffset, nAdded
integer, dimension(:), pointer :: haloLayers
- logical comm_list_found
+ logical :: comm_list_found
dminfo => field % block % domain % dminfo
@@ -2814,6 +2812,7 @@
do i = 1, exchListPtr % nList
commListPtr % ibuffer(exchListPtr % destList(i) + bufferOffset) = fieldCursor % array(exchListPtr % srcList(i))
nAdded = nAdded + 1
+
end do
end if
@@ -2826,6 +2825,7 @@
end do
call MPI_Isend(commListPtr % ibuffer, commListPtr % nList, MPI_INTEGERKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr)
+
commListPtr => commListPtr % next
end do
#endif
@@ -2871,8 +2871,8 @@
if(exchListPtr % endPointID == commListPtr % procID) then
do i = 1, exchListPtr % nList
fieldCursor % array(exchListPtr % destList(i)) = commListPtr % ibuffer(exchListPtr % srcList(i) + bufferOffset)
- nAdded = nAdded + 1
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -2916,7 +2916,7 @@
integer :: bufferOffset, nAdded
integer, dimension(:), pointer :: haloLayers
- logical comm_list_found
+ logical :: comm_list_found
dminfo => field % block % domain % dminfo
@@ -3122,9 +3122,9 @@
do i = 1, exchListPtr % nList
do j = 1, fieldCursor % dimSizes(1)
fieldCursor % array(j, exchListPtr % destList(i)) = commListPtr % ibuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizeS(1) + j + bufferOffset)
- nAdded = nAdded + 1
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -3168,7 +3168,7 @@
integer :: bufferOffset, nAdded
integer, dimension(:), pointer :: haloLayers
- logical comm_list_found
+ logical :: comm_list_found
dminfo => field % block % domain % dminfo
@@ -3379,10 +3379,10 @@
do k = 1, fieldCursor % dimSizes(1)
fieldCursor % array(k, j, exchListPtr % destList(i)) = commListPtr % ibuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2) &
+ (j-1)*fieldCursor % dimSizes(1) + k + bufferOffset)
- nAdded = nAdded + 1
end do
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -3426,7 +3426,7 @@
integer :: bufferOffset, nAdded
integer, dimension(:), pointer :: haloLayers
- logical comm_list_found
+ logical :: comm_list_found
dminfo => field % block % domain % dminfo
@@ -3629,8 +3629,8 @@
if(exchListPtr % endPointID == commListPtr % procID) then
do i = 1, exchListPtr % nList
fieldCursor % array(exchListPtr % destList(i)) = commListPtr % rbuffer(exchListPtr % srcList(i) + bufferOffset)
- nAdded = nAdded + 1
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -3674,7 +3674,7 @@
integer :: bufferOffset, nAdded
integer, dimension(:), pointer :: haloLayers
- logical comm_list_found
+ logical :: comm_list_found
dminfo => field % block % domain % dminfo
@@ -3880,9 +3880,9 @@
do i = 1, exchListPtr % nList
do j = 1, fieldCursor % dimSizes(1)
fieldCursor % array(j, exchListPtr % destList(i)) = commListPtr % rbuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizeS(1) + j + bufferOffset)
- nAdded = nAdded + 1
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
end do
@@ -3926,7 +3926,7 @@
integer :: bufferOffset, nAdded
integer, dimension(:), pointer :: haloLayers
- logical comm_list_found
+ logical :: comm_list_found
dminfo => field % block % domain % dminfo
@@ -4137,10 +4137,10 @@
do k = 1, fieldCursor % dimSizes(1)
fieldCursor % array(k, j, exchListPtr % destList(i)) = commListPtr % rbuffer((exchListPtr % srcList(i)-1)*fieldCursor % dimSizes(1) * fieldCursor % dimSizes(2) &
+ (j-1)*fieldCursor % dimSizes(1) + k + bufferOffset)
- nAdded = nAdded + 1
end do
end do
end do
+ nAdded = max(nAdded, maxval(exchListPtr % srcList))
end if
exchListPtr => exchListPtr % next
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-06-01 22:36:15 UTC (rev 1957)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-06-04 21:24:01 UTC (rev 1958)
@@ -330,15 +330,12 @@
write(6,*) 'Copy attributes to other blocks.'
block_ptr => domain % blocklist % next
do while (associated(block_ptr))
- write(6,*) 'Setting sphere radius =', domain % blocklist % mesh % sphere_radius
- write(6,*) 'Setting on a sphere = ',domain % blocklist % mesh % on_a_sphere
block_ptr % mesh % sphere_radius = domain % blocklist % mesh % sphere_radius
block_ptr % mesh % on_a_sphere = domain % blocklist % mesh % on_a_sphere
! Link the sendList and recvList pointers in each field type to the appropriate lists
! in parinfo, e.g., cellsToSend and cellsToRecv; in future, it can also be extended to
! link blocks of fields to eachother
- write(6,*) 'creating field links'
call mpas_create_field_links(block_ptr)
block_ptr => block_ptr % next
@@ -370,6 +367,10 @@
! do i = 1, block_ptr % mesh % nCells
! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
! end do
+! write(6,*) 'nEdgesOnCell on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % nEdgesOnCell % 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)
@@ -386,8 +387,14 @@
! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
! end do
-! do i = 1, nHalos+1
-! write(6,*) 'ON HALO', i
+! block_ptr => block_ptr % next
+! end do
+
+! write(6,*) 'EXCHANGE LISTS'
+! do i = 1, nHalos+1
+! write(6,*) 'ON HALO', i
+! block_ptr => domain % blocklist
+! do while(associated(block_ptr))
! if(i <= nHalos) then
! exchListPtr => block_ptr % parinfo % cellsToSend % halos(i) % exchList
! do while(associated(exchListPtr))
@@ -397,7 +404,7 @@
! 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
@@ -406,7 +413,7 @@
! 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
@@ -416,7 +423,7 @@
! 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
@@ -425,7 +432,7 @@
! 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
@@ -434,7 +441,7 @@
! 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
@@ -443,8 +450,8 @@
! 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
@@ -453,7 +460,7 @@
! 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
@@ -462,7 +469,7 @@
! 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
@@ -471,9 +478,8 @@
! end do
! exchListPtr => exchListPtr % next
! end do
+! block_ptr => block_ptr % next
! end do
-
-! block_ptr => block_ptr % next
! end do
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -501,6 +507,10 @@
! do i = 1, block_ptr % mesh % nCells
! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
! end do
+! write(6,*) 'nEdgeSOnCell on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % mesh % nEdgesOnCell % 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)
@@ -532,6 +542,10 @@
! do i = 1, block_ptr % mesh % nCells
! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
! end do
+! write(6,*) 'h on block', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCells
+! write(6,*) i, block_ptr % state % time_levs(1) % state % h % 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)
@@ -549,6 +563,23 @@
! block_ptr => block_ptr % next
! end do
+! write(6,*) 'EXPECTED CELL COMPARISON'
+! int1d_ptr => indexToCellID_0Halo
+! block_ptr => domain % blocklist
+! do while(associated(int1d_ptr))
+! write(6,*) 'ON BLOCK', block_ptr % blockID
+! do i = 1, block_ptr % mesh % nCellsSolve
+! write(6,*) i, int1d_ptr % array(i), block_ptr % mesh % indexToCellID % array(i), int1d_ptr % array(i) - block_ptr % mesh % indexToCellID % array(i)
+! end do
+! write(6,*) '---------------'
+! do i = block_ptr % mesh % nCellsSolve+1, block_ptr % mesh % nCells
+! write(6,*) i, int1d_ptr % array(i), block_ptr % mesh % indexToCellID % array(i), int1d_ptr % array(i) - block_ptr % mesh % indexToCellID % array(i)
+! end do
+! int1d_ptr => int1d_ptr % next
+! block_ptr => block_ptr % next
+! end do
+
+ write(6,*) 'Reindex block fields'
call mpas_block_creator_reindex_block_fields(domain % blocklist)
!DWJ DEBUGGING
@@ -567,15 +598,6 @@
! 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)
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_timer.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_timer.F 2012-06-01 22:36:15 UTC (rev 1957)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_timer.F 2012-06-04 21:24:01 UTC (rev 1958)
@@ -343,7 +343,11 @@
current % efficiency = 1.0
#endif
- current % avg_time = current % total_time / current % calls
+ if(current % calls > 0) then
+ current % avg_time = current % total_time / current % calls
+ else
+ current % avg_time = 0.0
+ end if
call mpas_dmpar_max_real(domain_info, current % max_time, all_max_time)
current % max_time = all_max_time
</font>
</pre>