<p><b>dwj07@fsu.edu</b> 2012-04-27 19:49:14 -0600 (Fri, 27 Apr 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Updating with support for multiple blocks on a single processor.<br>
Need to explore support for multiple blocks on multiple processors.<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-27 22:12:22 UTC (rev 1836)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_block_decomp.F 2012-04-28 01:49:14 UTC (rev 1837)
@@ -564,13 +564,14 @@
integer :: recvNeighbor, sendNeighbor
integer :: current_proc, nMesgRecv, nMesgSend
integer :: localBlockID, globalBlockID, owningProc
+ integer :: currentProc
integer :: mpi_ierr, mpi_rreq, mpi_sreq
integer, dimension(:), pointer :: numToSend, numToRecv, numToCopy
integer, dimension(:), pointer :: ownerListIn, ownerBlockListIn, ownerListOut, ownerBlockListOut
- integer, dimension(:), pointer :: elementRecipients
+ integer, dimension(:,:), pointer :: elementRecipients
! Setup exchange lists on ownedList to be built later.
! Really only sendList will be setup
@@ -638,8 +639,6 @@
sorted_field_ptr % block => field_ptr % block
sorted_field_ptr % dimSizes(1) = 2
sorted_field_ptr % dimSizes(2) = field_ptr % dimSizes(1)
- write(6,*) 'Setting sorted_field_ptr dimensions = ', 2, field_ptr % dimSizes(1)
- write(6,*) 'Set sorted_field_ptr dimensions = ', sorted_field_ptr % dimSizes(1), sorted_field_ptr % dimSizes(2)
sorted_field_ptr % sendList => field_ptr % sendList
sorted_field_ptr % recvList => field_ptr % recvList
sorted_field_ptr % copyList => field_ptr % copyList
@@ -677,7 +676,7 @@
allocate(ownerBlockListIn(nNeededElementsMax))
allocate(ownerListOut(nNeededElementsMax))
allocate(ownerBlockListOut(nNeededElementsMax))
- allocate(elementRecipients(nOwnedElementsMax))
+ allocate(elementRecipients(2,nOwnedElementsMax))
field_ptr => neededListField
iElement = 1
@@ -690,14 +689,10 @@
field_ptr => field_ptr % next
end do
- write(6,*) 'iElement = ', iElement
-
recvNeighbor = mod(dminfo % my_proc_id + dminfo % nprocs - 1, dminfo % nprocs)
sendNeighbor = mod(dminfo % my_proc_id + 1, dminfo % nprocs)
nMesgRecv = nNeededElements
- write(6,*) 'cp 2'
-
! Build send lists, and determine owning block id's for needed elements
do i = 1, dminfo % nProcs
ownerBlockListOut = ownerBlockListIn
@@ -717,7 +712,8 @@
ownerListOut(j) = -1 * sorted_field_ptr % block % blockID
ownerListIn(j) = -1 * sorted_field_ptr % block % blockID
numToSend(ownerBlockListIn(j) + 1) = numToSend(ownerBlockListIn(j) + 1) + 1
- elementRecipients(sorted_field_ptr % array(2,k)) = numToSend(ownerblockListIn(j)+1)
+ elementRecipients(1,sorted_field_ptr % array(2,k)) = ownerBLockListIn(j)
+ elementRecipients(2,sorted_field_ptr % array(2,k)) = numToSend(ownerblockListIn(j)+1)
else
ownerListOut(j) = ownerListIn(j)
end if
@@ -744,11 +740,12 @@
exchListPtr % blockID = j - 1
exchListPtr % nlist = numToSend(j)
- write(6,*) 'New send list with proc and block = ', currentProc, j-1, numToSend(j)
allocate(exchListPtr % list(numToSend(j)))
do iElement = 1, nOwnedElements
- exchListPtr % list(elementRecipients(iElement)) = iElement
+ if(elementRecipients(1,iElement) == j-1) then
+ exchListPtr % list(elementRecipients(2,iElement)) = iElement
+ end if
end do
end if
end do ! j loop over totalBlocksNeeded
@@ -774,27 +771,21 @@
call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
end do ! i loop over nProcs
- write(6,*) 'cp 3'
-
field_ptr => neededListField
- elementShift = 0
do while(associated(field_ptr))
numToRecv = 0
- do i = 1, field_ptr % dimSizes(1)
- if(ownerBlockListIn(elementShift + i) == field_ptr % block % blockID) then
- numToRecv(abs(ownerListIn(elementShift+i))+1) = numToRecv(abs(ownerListIn(elementShift+i))+1) + 1
+ do i = 1, nNeededElements
+ if(ownerBlockListIn(i) == field_ptr % block % blockID) then
+ numToRecv(abs(ownerListIn(i))+1) = numToRecv(abs(ownerListIn(i))+1) + 1
end if
end do
- write(6,*) 'numToRecv'
- write(6,*) numToRecv
-
- do iBlock = 1, totalBlocksNeeded
+ do iBlock = 1, totalBlocksOwned
if(numToRecv(iBlock) > 0) then
if(ownedDecomposed) then
owningProc = iBlock - 1
else
- call mpas_get_owning_proc(dminfo, iBlock -1, owningProc)
+ call mpas_get_owning_proc(dminfo, iBlock - 1, owningProc)
end if
! Determine if copyList or recvList should be used
@@ -821,21 +812,18 @@
allocate(exchListPtr % list(numToRecv(iBlock)))
iElement = 0
- do i = 1, field_ptr % dimSizes(1)
- if(ownerBlockListIn(elementShift + i) == field_ptr % block % blockID) then
+ do i = 1, nNeededElements
+ if(ownerBlockListIn(i) == field_ptr % block % blockID) then
iElement = iElement + 1
- exchListPtr % list(iElement) = i
+ exchListPtr % list(iElement) = iElement
end if
end do
end if
end do
- elementShift = elementShift + field_ptr % dimSizes(1)
field_ptr => field_ptr % next
end do
- write(6,*) 'cp 4'
-
deallocate(ownerListIn)
deallocate(ownerBlockListIn)
deallocate(ownerListOut)
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-27 22:12:22 UTC (rev 1836)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-04-28 01:49:14 UTC (rev 1837)
@@ -557,6 +557,9 @@
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)
@@ -582,6 +585,7 @@
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
@@ -637,7 +641,44 @@
write(6,*) 'Linking 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,*) sendListPtr % procID, sendListPtr % blockID, sendListPtr % nList
+! write(6,*) sendListPtr % list
+! sendListPtr => sendListPtr % next
+! end do
+! int1d_ptr => int1d_ptr % next
+! end do
+!
+! write(6,*) 'recv'
+! int1d_ptr => indexToCellID_0Halo
+! 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,*) recvListPtr % procID, recvListPtr % blockID, recvListPtr % nList
+! recvListPtr => recvListPtr % next
+! end do
+! int1d_ptr => int1d_ptr % next
+! end do
+!
+! write(6,*) 'copy'
+! int1d_ptr => indexToCellID_0Halo
+! 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,*) copyListPtr % procID, copyListPtr % blockID, copyListPtr % nList
+! write(6,*) copyListPtr % list
+! copyListPtr => copyListPtr % next
+! end do
+! int1d_ptr => int1d_ptr % next
+! end do
+
write(6,*) 'All to all 1'
call mpas_dmpar_alltoall_field(domain % dminfo, indexToCellIDField, indexToCellID_0Halo)
write(6,*) 'All to all 2'
@@ -645,24 +686,46 @@
write(6,*) 'All to all 3'
call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnCellField, cellsOnCell_0Halo)
- write(6,*) 'coc field'
- int2d_ptr => cellsOnCellField
- do while(associated(int2d_ptr))
- do i = 1, int2d_ptr % dimSizes(2)
- write(6,*) int2d_ptr % array(:,i)
- end do
- int2d_ptr => int2d_ptr % next
- end do
+! 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,*) 'coc 0halo'
- int2d_ptr => cellsOnCell_0Halo
- do while(associated(int2d_ptr))
- do i = 1, int2d_ptr % dimSizes(2)
- write(6,*) int2d_ptr % array(:,i)
- end do
- int2d_ptr => int2d_ptr % next
- end do
+! 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,*) '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,*) '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,*) 'Stopping'
stop
</font>
</pre>