<p><b>dwj07@fsu.edu</b> 2012-05-30 15:23:35 -0600 (Wed, 30 May 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Checkpointing work.<br>
Works apparently fine one 1 processor with 1 block.<br>
Some more work is needed for multiple processors and multiple blocks.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/core_ocean/mpas_ocn_advection.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/core_ocean/mpas_ocn_advection.F 2012-05-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/core_ocean/mpas_ocn_advection.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -274,6 +274,7 @@
if (ip1 > n-1) ip1 = 1
iEdge = grid % EdgesOnCell % array (i,iCell)
+
xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/grid % sphere_radius
yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/grid % sphere_radius
zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/grid % sphere_radius
Modified: branches/omp_blocks/multiple_blocks/src/framework/Makefile
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/Makefile 2012-05-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/Makefile 2012-05-30 21:23:35 UTC (rev 1949)
@@ -42,7 +42,7 @@
mpas_grid_types.o: mpas_kind_types.o mpas_dmpar_types.o mpas_attlist.o
-mpas_dmpar.o: mpas_sort.o streams.o mpas_kind_types.o mpas_grid_types.o
+mpas_dmpar.o: mpas_sort.o streams.o mpas_kind_types.o mpas_grid_types.o mpas_hash.o
mpas_sort.o: mpas_kind_types.o
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-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -32,11 +32,12 @@
allocate(domain % blocklist)
block => domain % blocklist
+ nullify(block % prev)
nullify(block % next)
allocate(indexToCellIDField)
nullify(indexToCellIDField % next)
-
+
blockCursor => block
fieldCursor => indexToCellIDField
do i = 1, nBlocks
@@ -46,6 +47,7 @@
fieldCursor % block => blockCursor
fieldCursor % dimSizes(1) = blockCount(i)
+ nullify(fieldCursor % ioinfo)
call mpas_dmpar_init_mulithalo_exchange_list(fieldCursor % sendList, nHalos)
call mpas_dmpar_init_mulithalo_exchange_list(fieldCursor % recvList, nHalos)
@@ -57,6 +59,8 @@
if(i < nBlocks) then
allocate(blockCursor % next)
allocate(fieldCursor % next)
+
+ blockCursor % next % prev => blockCursor
blockCursor => blockCursor % next
fieldCursor => fieldCursor % next
@@ -67,17 +71,21 @@
end do
end subroutine mpas_block_creator_setup_blocks_and_0halo_cells!}}}
- subroutine mpas_block_creator_build_0halo_cell_fields(indexToCellIDBlock, nEdgesOnCellBlock, cellsOnCellBlock, indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo)!{{{
+ subroutine mpas_block_creator_build_0halo_cell_fields(indexToCellIDBlock, nEdgesOnCellBlock, cellsOnCellBlock, verticesOnCellBlock, edgesOnCellBlock, indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, verticesOnCell_0Halo, edgesOnCell_0Halo)!{{{
type(field1dInteger), pointer :: indexToCellIDBlock !< Input: Block of read in indexToCellID field
type(field1dInteger), pointer :: nEdgesOnCellBlock !< Input: Block of read in nEdgesOnCell field
type(field2dInteger), pointer :: cellsOnCellBlock !< Input: Block of read in cellsOnCell field
+ type(field2dInteger), pointer :: verticesOnCellBlock !< Input: Block of read in verticesOnCell field
+ type(field2dInteger), pointer :: edgesOnCellBlock !< Input: Block of read in edgesOnCellField
type(field1dInteger), pointer :: indexToCellID_0Halo !< Input: 0-Halo indices for indexToCellID field
type(field1dInteger), pointer :: nEdgesOnCell_0Halo !< Output: nEdgesOnCell field for 0-Halo cells
type(field2dInteger), pointer :: cellsOnCell_0Halo !< Output: cellsOnCell field for 0-Halo cells
+ type(field2dInteger), pointer :: verticesOnCell_0Halo !< Output: verticesOnCell field for 0-Halo cells
+ type(field2dInteger), pointer :: edgesOnCell_0Halo !< Output: edgesOnCell field for 0-Halo cells
type(field1dInteger), pointer :: indexCursor, nEdgesCursor
- type(field2dInteger), pointer :: cellsOnCellCursor
+ type(field2dInteger), pointer :: cellsOnCellCursor, verticesOnCellCursor, edgesOnCellCursor
integer, dimension(:), pointer :: sendingHaloLayers
@@ -99,18 +107,37 @@
allocate(cellsOnCell_0Halo)
nullify(cellsOnCell_0Halo % next)
+ allocate(verticesOnCell_0Halo)
+ nullify(verticesOnCell_0Halo % next)
+
+ allocate(edgesOnCell_0Halo)
+ nullify(edgesOnCell_0Halo % next)
+
indexCursor => indexToCellID_0Halo
nEdgesCursor => nEdgesOnCell_0Halo
cellsOnCellCursor => cellsOnCell_0Halo
+ verticesOnCellCursor => verticesOnCell_0Halo
+ edgesOnCellCursor => edgesOnCell_0Halo
do while(associated(indexCursor))
nCellsInBlock = indexCursor % dimSizes(1)
nEdgesCursor % block => indexCursor % block
cellsOnCellCursor % block => indexCursor % block
+ verticesOnCellCursor % block => indexCursor % block
+ edgesOnCellCursor % block => indexCursor % block
+ nullify(nEdgesCursor % ioinfo)
+ nullify(cellsOnCellCursor % ioinfo)
+ nullify(verticesOnCellCursor % ioinfo)
+ nullify(edgesOnCellCursor % ioinfo)
+
nEdgesCursor % dimSizes(1) = nCellsInBlock
cellsOnCellCursor % dimSizes(1) = maxEdges
cellsOnCellCursor % dimSizes(2) = nCellsInBlock
+ verticesOnCellCursor % dimSizes(1) = maxEdges
+ verticesOnCellCursor % dimSizes(2) = nCellsInBlock
+ edgesOnCellCursor % dimSizes(1) = maxEdges
+ edgesOnCellCursor % dimSizes(2) = nCellsInBlock
nEdgesCursor % sendList => indexCursor % sendList
nEdgesCursor % recvList => indexCursor % recvList
@@ -118,32 +145,276 @@
cellsOnCellCursor % sendList => indexCursor % sendList
cellsOnCellCursor % recvList => indexCursor % recvList
cellsOnCellCursor % copyList => indexCursor % copyList
+ verticesOnCellCursor % sendList => indexCursor % sendList
+ verticesOnCellCursor % recvList => indexCursor % recvList
+ verticesOnCellCursor % copyList => indexCursor % copyList
+ edgesOnCellCursor % sendList => indexCursor % sendList
+ edgesOnCellCursor % recvList => indexCursor % recvList
+ edgesOnCellCursor % copyList => indexCursor % copyList
allocate(nEdgesCursor % array(nEdgesCursor % dimSizes(1)))
allocate(cellsOnCellCursor % array(cellsOnCellCursor % dimSizes(1), cellsOnCellCursor % dimSizes(2)))
+ allocate(verticesOnCellCursor % array(verticesOnCellCursor % dimSizes(1), verticesOnCellCursor % dimSizes(2)))
+ allocate(edgesOnCellCursor % array(edgesOnCellCursor % dimSizes(1), edgesOnCellCursor % dimSizes(2)))
indexCursor => indexCursor % next
if(associated(indexCursor)) then
allocate(nEdgesCursor % next)
allocate(cellsOnCellCursor % next)
+ allocate(verticesOnCellCursor % next)
+ allocate(edgesOnCellCursor % next)
nEdgesCursor => nEdgesCursor % next
cellsOnCellCursor => cellsOnCellCursor % next
+ verticesOnCellCursor => verticesOnCellCursor % next
+ edgesOnCellCursor => edgesOnCellCursor % next
end if
nullify(nEdgesCursor % next)
nullify(cellsOnCellCursor % next)
+ nullify(verticesOnCellCursor % next)
+ nullify(edgesOnCellCursor % next)
end do
call mpas_dmpar_alltoall_field(nEdgesOnCellBlock, nEdgesOnCell_0Halo, sendingHaloLayers)
call mpas_dmpar_alltoall_field(cellsOnCellBlock, cellsOnCell_0Halo, sendingHaloLayers)
+ call mpas_dmpar_alltoall_field(verticesOnCellBlock, verticesOnCell_0Halo, sendingHaloLayers)
+ call mpas_dmpar_alltoall_field(edgesOnCellBlock, edgesOnCell_0Halo, sendingHaloLayers)
end subroutine mpas_block_creator_build_0halo_cell_fields!}}}
- subroutine mpas_block_creator_build_cell_halos(indexToCellID, nEdgesOnCell, cellsOnCell, nCellsSolve)!{{{
+ subroutine mpas_block_creator_build_0_and_1halo_vertex_fields(indexToVertexIDBlock, cellsOnVertexBlock, indexToCellID_0Halo, nEdgesOnCell_0Halo, verticesOnCell_0Halo, indexToVertexID_0Halo, cellsOnVertex_0Halo, nVerticesSolve)!{{{
+ type (field1dInteger), pointer :: indexToVertexIDBlock !< Input: indexToVertexID read in field
+ type (field2dInteger), pointer :: cellsOnVertexBlock !< Input: cellsOnVertex read in field
+ type (field1dInteger), pointer :: indexToCellID_0Halo !< Input: indexToCellID field on 0 halo
+ type (field1dInteger), pointer :: nEdgesOnCell_0Halo !< Input: nEdgesOnCell field on 0 halo
+ type (field2dInteger), pointer :: verticesOnCell_0Halo !< Input: verticesOnCell field on 0 and 1 halos
+ type (field1dInteger), pointer :: indexToVertexID_0Halo !< Output: indexToVertexID field on 0 and 1 halos
+ type (field2dInteger), pointer :: cellsOnVertex_0Halo !< Output: CellsOnVertex field on 0 and 1 halos
+ type (field1dInteger), pointer :: nVerticesSolve !< Output: Array with max index to vertices in halos
+
+ type (field0dInteger), pointer :: offSetField, vertexLimitField
+ type (field1dInteger), pointer :: haloIndices
+
+ type (field0dInteger), pointer :: offSetCursor, vertexLimitCursor
+ type (field1dInteger), pointer :: indexToCellCursor, indexToVertexCursor, nEdgesCursor, haloCursor, nVerticesSolveCursor
+ type (field2dInteger), pointer :: verticesOnCellCursor, cellsOnVertexCursor, cellsOnCellCursor
+
+ type (mpas_exchange_list), pointer :: exchListPtr
+
+ integer, dimension(:), pointer :: localVertexList
+ integer, dimension(:), pointer :: sendingHaloLayers
+ integer :: nVerticesLocal, nCellsInBlock, maxEdges, vertexDegree, nHalos
+ integer :: haloStart
+ integer :: iBlock, i, j, k
+
+ allocate(sendingHaloLayers(1))
+ sendingHaloLayers(1) = 1
+
+ maxEdges = verticesOnCell_0Halo % dimSizes(1)
+ vertexDegree = cellsOnVertexBlock % dimSizes(1)
+ nHalos = config_num_halos
+
+ allocate(cellsOnVertex_0Halo)
+ allocate(indexToVertexID_0Halo)
+
+ indexToCellCursor => indexToCellID_0Halo
+ verticesOnCellCursor => verticesOnCell_0Halo
+ nEdgesCursor => nEdgesOnCell_0Halo
+ indexToVertexCursor => indexToVertexID_0Halo
+ cellsOnVertexCursor => cellsOnVertex_0Halo
+ do while(associated(indexToCellCursor))
+ nCellsInBlock = indexToCellCursor % dimSizes(1)
+
+ call mpas_block_decomp_all_edges_in_block(maxEdges, nCellsInBlock, nEdgesCursor % array, verticesOnCellCursor % array, nVerticesLocal, localVertexList)
+
+ indexToVertexCursor % block => indexToCellCursor % block
+ nullify(indexToVertexCursor % ioinfo)
+ indexToVertexCursor % dimSizes(1) = nVerticesLocal
+ allocate(indexToVertexCursor % array(indexToVertexCursor % dimSizes(1)))
+ indexToVertexCursor % array(:) = localVertexList(:)
+
+ cellsOnVertexCursor % block => indexToCellCursor % block
+ nullify(cellsOnVertexCursor % ioinfo)
+ cellsOnVertexCursor % dimSizes(1) = vertexDegree
+ cellsOnVertexCursor % dimSizes(2) = nVerticesLocal
+ allocate(cellsOnVertexCursor % array(cellsOnVertexCursor % dimSizes(1), cellsOnVertexCursor % dimSizes(2)))
+
+ call mpas_dmpar_init_mulithalo_exchange_list(indexToVertexCursor % sendList, nHalos+1)
+ call mpas_dmpar_init_mulithalo_exchange_list(indexToVertexCursor % recvList, nHalos+1)
+ call mpas_dmpar_init_mulithalo_exchange_list(indexToVertexCursor % copyList, nHalos+1)
+
+ cellsOnVertexCursor % sendList => indexToVertexCursor % sendList
+ cellsOnVertexCursor % recvList => indexToVertexCursor % recvList
+ cellsOnVertexCursor % copyList => indexToVertexCursor % copyList
+
+ deallocate(localVertexList)
+ indexToCellCursor => indexToCellCursor % next
+ verticesOnCellCursor => verticesOnCellCursor % next
+ nEdgescursor => nEdgesCursor % next
+
+ if(associated(indexToCellCursor)) then
+ allocate(indexToVertexCursor % next)
+ indexToVertexCursor => indexToVertexCursor % next
+
+ allocate(cellsOnVertexCursor % next)
+ cellsOnVertexCursor => cellsOnVertexCursor % next
+ end if
+ nullify(indexToVertexCursor % next)
+ nullify(cellsOnVertexCursor % next)
+ end do
+
+ call mpas_dmpar_get_exch_list(1, indexToVertexIDBlock, indexToVertexID_0Halo)
+
+! write(6,*) 'CELLSONVERTEXBLOCK'
+! indexToVertexCursor => indexToVertexIDBlock
+! do while(associated(indexToVertexCursor))
+! write(6,*) 'sendLists on block',indexToVertexCursor % block % blockID
+! exchListPtr => indexToVertexCursor % sendList % halos(1) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'to', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) i, exchListPtr % srcList(i), exchListPtr % destList(i)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! write(6,*) 'recvLists on block',indexToVertexCursor % block % blockID
+! exchListPtr => indexToVertexCursor % recvList % halos(1) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'from', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) i, exchListPtr % srcList(i), exchListPtr % destList(i)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! write(6,*) 'copyLists on block',indexToVertexCursor % block % blockID
+! exchListPtr => indexToVertexCursor % copyList % halos(1) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'to', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) i, exchListPtr % srcList(i), exchListPtr % destList(i)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! indexToVertexCursor => indexToVertexCursor % next
+! end do
+
+! write(6,*) 'CELLSONVERTEX_0HALO'
+! cellsOnVertexCursor => cellsOnVertex_0Halo
+! do while(associated(cellsOnVertexCursor))
+! write(6,*) 'sendLists on block',cellsOnVertexCursor % block % blockID
+! exchListPtr => cellsOnVertexCursor % sendList % halos(1) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'to', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) i, exchListPtr % srcList(i), exchListPtr % destList(i)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! write(6,*) 'recvLists on block',cellsOnVertexCursor % block % blockID
+! exchListPtr => cellsOnVertexCursor % recvList % halos(1) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'from', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) i, exchListPtr % srcList(i), exchListPtr % destList(i)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! write(6,*) 'copyLists on block',cellsOnVertexCursor % block % blockID
+! exchListPtr => cellsOnVertexCursor % copyList % halos(1) % exchList
+! do while(associated(exchListPtr))
+! write(6,*) 'to', exchListPtr % endPointID
+! do i = 1, exchListPtr % nList
+! write(6,*) i, exchListPtr % srcList(i), exchListPtr % destList(i)
+! end do
+! exchListPtr => exchListPtr % next
+! end do
+! cellsOnVertexCursor => cellsOnVertexCursor % next
+! end do
+
+ call mpas_dmpar_alltoall_field(cellsOnVertexBlock, cellsOnVertex_0Halo, sendingHaloLayers)
+
+ allocate(haloIndices)
+ allocate(offSetField)
+ allocate(vertexLimitField)
+ allocate(nVerticesSolve)
+
+ indexToVertexCursor => indexToVertexID_0Halo
+ cellsOnVertexCursor => cellsOnVertex_0Halo
+ indexToCellCursor => indexToCellID_0Halo
+ haloCursor => haloIndices
+ offSetCursor => offSetField
+ vertexLimitCursor => vertexLimitField
+ nVerticesSolveCursor => nVerticesSolve
+ do while(associated(indexToVertexCursor))
+ call mpas_block_decomp_partitioned_edge_list(indexToCellCursor % dimSizes(1), indexToCellCursor % array, &
+ vertexDegree, indexToVertexCursor % dimSizes(1), cellsOnVertexCursor % array, &
+ indexToVertexCursor % array, haloStart)
+
+ haloCursor % block => indexToVertexCursor % block
+ offSetCursor % block => indexToVertexCursor % block
+ vertexLimitCursor % block => indexToVertexCursor % block
+ nVerticesSolveCursor % block => indexToVertexCursor % block
+
+ nullify(haloCursor % ioinfo)
+ nullify(offSetCursor % ioinfo)
+ nullify(vertexLimitCursor % ioinfo)
+ nullify(nVerticesSolveCursor % ioinfo)
+
+ haloCursor % dimSizes(1) = indexToVertexCursor % dimSizes(1) - haloStart
+ allocate(haloCursor % array(haloCursor % dimSizes(1)))
+ haloCursor % array(:) = indexToVertexCursor % array(haloStart+1:indexToVertexCursor % dimSizes(1))
+
+ haloCursor % sendList => indexToVertexCursor % sendList
+ haloCursor % recvList => indexToVertexCursor % recvList
+ haloCursor % copyList => indexToVertexCursor % copyList
+
+ offSetCursor % scalar = haloStart - 1
+ vertexLimitCursor % scalar = haloStart - 1
+
+ nVerticesSolveCursor % dimSizes(1) = nHalos+2 ! 1 for 0 halo, 1 for nHalo+1
+ allocate(nVerticesSolveCursor % array(nVerticesSolve % dimSizes(1)))
+ nVerticesSolveCursor % array = -1
+ nVerticesSolveCursor % array(1) = haloStart - 1
+ nVerticesSolveCursor % array(2) = indexToVertexCursor % dimSizes(1)
+
+ indexToVertexCursor => indexToVertexCursor % next
+ cellsOnVertexCursor => cellsOnVertexCursor % next
+ indexToCellCursor => indexToCellCursor % next
+ if(associateD(indexToVertexCursor)) then
+ allocate(haloCursor % next)
+ haloCursor => haloCursor % next
+
+ allocate(offSetcursor % next)
+ offSetCursor => offSetCursor % next
+
+ allocate(vertexLimitCursor % next)
+ vertexLimitCursor => vertexLimitCursor % next
+
+ allocate(nVerticesSolveCursor % next)
+ nVerticesSolveCursor => nVerticesSolveCursor % next
+ end if
+ nullify(haloCursor % next)
+ nullify(offSetCursor % next)
+ nullify(vertexLimitCursor % next)
+ nullify(nVerticesSolveCursor % next)
+ end do
+
+ call mpas_dmpar_get_exch_list(1, indexToVertexID_0Halo, haloIndices, offSetField, vertexLimitField)
+
+ call mpas_deallocate_field(haloIndices)
+ call mpas_deallocate_field(offSetField)
+ call mpas_deallocate_field(vertexLimitCursor)
+ deallocate(sendingHaloLayers)
+
+ end subroutine mpas_block_creator_build_0_and_1halo_vertex_fields!}}}
+
+ subroutine mpas_block_creator_build_cell_halos(indexToCellID, nEdgesOnCell, cellsOnCell, verticesOnCell, edgesOnCell, 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 (field2dInteger), pointer :: verticesOnCell !< Input/Output: verticesOnCell field for all halos
+ type (field2dInteger), pointer :: edgesOnCell !< Input/Output: edgesOnCell field for all halos
type (field1dInteger), pointer :: nCellsSolve !< Output: Field with indices to end of each halo
type (dm_info), pointer :: dminfo
@@ -152,7 +423,7 @@
type (field0dInteger), pointer :: offSetCursor, cellLimitCursor
type (field1dInteger), pointer :: indexCursor, nEdgesCursor, haloCursor, nCellsSolveCursor
- type (field2dInteger), pointer :: cellsOnCellCursor
+ type (field2dInteger), pointer :: cellsOnCellCursor, verticesOnCellCursor, edgesOnCellCursor
type (field0dInteger), pointer :: offSetField
type (field0dInteger), pointer :: cellLimitField
@@ -182,14 +453,17 @@
do while (associated(indexCursor))
offSetCursor % scalar = indexCursor % dimSizes(1)
offSetCursor % block => indexCursor % block
+ nullify(offSetCursor % ioinfo)
nCellsSolveCursor % dimSizes(1) = nHalos+1
allocate(nCellsSolveCursor % array(nCellsSolveCursor % dimSizes(1)))
- nCellsSolve % array(1) = indexCursor % dimSizes(1)
- nCellsSolve % block => indexCursor % block
+ nCellsSolveCursor % array(1) = indexCursor % dimSizes(1)
+ nCellsSolveCursor % block => indexCursor % block
+ nullify(nCellsSolveCursor % ioinfo)
cellLimitCursor % scalar = indexCursor % dimSizes(1)
cellLimitCursor % block => indexCursor % block
+ nullify(cellLimitCursor % ioinfo)
indexCursor => indexCursor % next
if(associated(indexCursor)) then
@@ -215,6 +489,8 @@
indexCursor => indexToCellID
nEdgesCursor => nEdgesOnCell
cellsOnCellCursor => cellsOnCell
+ verticesOnCellCursor => verticesOnCell
+ edgesOnCellCursor => edgesOnCell
haloCursor => haloIndices
offSetCursor => offSetField
do while(associated(indexCursor))
@@ -250,6 +526,7 @@
haloCursor % recvList => indexCursor % recvList
haloCursor % copyList => indexCursor % copyList
haloCursor % block => indexCursor % block
+ nullify(haloCursor % ioinfo)
deallocate(blockGraphWithHalo % vertexID)
deallocate(blockGraphWithHalo % nAdjacent)
@@ -264,6 +541,8 @@
indexCursor => indexCursor % next
nEdgesCursor => nEdgesCursor % next
cellsOnCellCursor => cellsOnCellCursor % next
+ verticesOnCellCursor => verticesOnCellCursor % next
+ edgesOnCellCursor => edgesOnCellCursor % next
offSetCursor => offSetCursor % next
if(associated(indexCursor)) then
allocate(haloCursor % next)
@@ -321,6 +600,8 @@
indexCursor => indexToCellID
nEdgesCursor => nEdgesOnCell
cellsOnCellCursor => cellsOnCell
+ verticesOnCellCursor => verticesOnCell
+ edgesOnCellCursor => edgesOnCell
haloCursor => haloIndices
nCellsSolveCursor => nCellsSolve
do while(associated(indexCursor))
@@ -350,10 +631,26 @@
cellsOnCellCursor % array = -1
cellsOnCellCursor % array(:,1:nCellsInBlock) = field2dArrayHolder(:,:)
deallocate(field2dArrayHolder)
+
+ field2dArrayHolder => verticesOnCellCursor % array
+ verticesOnCellCursor % dimSizes(2) = nCellsSolveCursor % array(iHalo+1)
+ allocate(verticesOnCellCursor % array(verticesOnCellCursor % dimSizes(1), verticesOnCellCursor % dimSizes(2)))
+ verticesOnCellCursor % array = -1
+ verticesOnCellCursor % array(:,1:nCellsInBlock) = field2dArrayHolder(:,:)
+ deallocate(field2dArrayHolder)
+
+ field2dArrayHolder => edgesOnCellCursor % array
+ edgesOnCellCursor % dimSizes(2) = nCellsSolveCursor % array(iHalo+1)
+ allocate(edgesOnCellCursor % array(edgesOnCellCursor % dimSizes(1), edgesOnCellCursor % dimSizes(2)))
+ edgesOnCellCursor % array = -1
+ edgesOnCellCursor % array(:,1:nCellsInBlock) = field2dArrayHolder(:,:)
+ deallocate(field2dArrayHolder)
indexCursor => indexCursor % next
nEdgesCursor => nEdgesCursor % next
cellsOnCellCursor => cellsOnCellCursor % next
+ verticesOnCellCursor => verticesOnCellCursor % next
+ edgesOnCellCursor => edgesOnCellCursor % next
haloCursor => haloCursor % next
nCellsSolveCursor => nCellsSolveCursor % next
end do
@@ -361,6 +658,8 @@
call mpas_dmpar_alltoall_field(indexToCellID, indexToCellID, sendingHaloLayers)
call mpas_dmpar_alltoall_field(nEdgesOnCell, nEdgesOncell, sendingHaloLayers)
call mpas_dmpar_alltoall_field(cellsOnCell, cellsOnCell, sendingHaloLayers)
+ call mpas_dmpar_alltoall_field(verticesOnCell, verticesOnCell, sendingHaloLayers)
+ call mpas_dmpar_alltoall_field(edgesOnCell, edgesOnCell, sendingHaloLayers)
! dwj: 05/24/12 debugging
! indexCursor => indexToCellID
@@ -399,256 +698,214 @@
end subroutine mpas_block_creator_build_cell_halos!}}}
+ subroutine mpas_block_creator_build_vertex_halos(indexToCellID, nEdgesOnCell, nCellsSolve, verticesOnCell, indexToVertexID, cellsOnVertex, nVerticesSolve)!{{{
+ type (field1dInteger), pointer :: indexToCellID !< Input: indexToCellID field for all halos
+ type (field1dInteger), pointer :: nEdgesOnCell !< Input: nEdgesOnCell field for all halos
+ type (field1dInteger), pointer :: nCellsSolve !< Input: nCellsSolve field for all halos
+ type (field2dInteger), pointer :: verticesOnCell !< Input/Output: verticesOnCell field for all halos
+ type (field1dInteger), pointer :: indexToVertexID !< Input/Output: indexToVertexID field for halos 0 and 1, but output for all halos
+ type (field2dInteger), pointer :: cellsOnVertex !< Output: cellsOnVertex field for all halos
+ type (field1dInteger), pointer :: nVerticesSolve !< Input/Output: nVerticesSolve field for halos 0 and 1, but output for all halos
+ type (field0dInteger), pointer :: offSetField, vertexLimitField
+ type (field1dInteger), pointer :: haloIndices
-!***********************************************************************
-!
-! routine mpas_get_halo_cells_and_exchange_lists
-!
-!> \brief Determines cell indices for each halo layer, and builds exchange lists
-!> \author Doug Jacobsen
-!> \date 04/30/12
-!> \version SVN:$Id$
-!> \details
-!> This routine builds the field indexToCellID_nHalos, which is an array of nHalos linked lists.
-!> Each index in indexToCellID_nHalos represnts a linked list of cells in a given halo.
-!> It creates the exchange lists for cells, and places them in the block structure.
-!> In order to call this routine, there are some assumptions made.
-!> The first assumption is that the 1 index of each array is setup correctly,
-!> ie block pointers are valid, dimSizes are valid, next pointers are valid, ets
-!> The second assumption is that the arrays in each field are allocated and full with their appropriate information.
-!> These assumptions lead to the conclusion that the 0 halo has to be properly setup prior to calling this routine.
-!
-!-----------------------------------------------------------------------
+ type (field0dInteger), pointer :: offSetCursor, vertexLimitCursor
+ type (field1dInteger), pointer :: indexToCellCursor, nEdgesCursor, nCellsSolveCursor, indexToVertexCursor, nVerticesSolveCursor, haloCursor
+ type (field2dInteger), pointer :: verticesOnCellCursor, cellsOnVertexCursor
-! subroutine mpas_get_halo_cells_and_exchange_lists(indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, indexToCellID_nHalos, nEdgesOnCell_nHalos, cellsOnCell_nHalos)!{{{
+ integer, dimension(:), pointer :: sendingHaloLayers
+ integer, dimension(:), pointer :: array1dHolder, localVertexList
+ integer, dimension(:,:), pointer :: array2dHolder
-! type (field1dInteger), pointer :: indexToCellID_0Halo
-! type (field1dInteger), pointer :: nEdgesOnCell_0Halo
-! type (field2dInteger), pointer :: cellsOnCell_0Halo
+ integer :: iHalo, iBlock, i, j, k
+ integer :: nHalos, nBlocks, nCellsInBlock, nVerticesLocal, haloStart, haloEnd, haloSize
+ integer :: maxEdges, vertexDegree
-! type (field1dInteger), dimension(:), pointer :: indexToCellID_nHalos
-! type (field1dInteger), dimension(:), pointer :: nEdgesOnCell_nHalos
-! type (field2dInteger), dimension(:), pointer :: cellsOnCell_nHalos
+ type (hashtable), dimension(:), pointer :: vertexList
-! type (field1dInteger), pointer :: indexToCellID_ptr, indexToCellID_Halo_ptr
-! type (field1dInteger), pointer :: nEdgesOnCell_ptr, nEdgesOnCell_Halo_ptr
-! type (field2dInteger), pointer :: cellsOnCell_ptr, cellsOnCell_Halo_ptr
+ ! Determine dimensions
+ nHalos = config_num_halos
+ maxEdges = verticesOnCell % dimSizes(1)
+ vertexDegree = cellsOnVertex % dimSizes(1)
-! type (field0dInteger), pointer :: offSetField
-! type (field0dInteger), pointer :: offSet_ptr
+ ! Allocate some needed arrays and fields
+ allocate(sendingHaloLayers(1))
+ allocate(haloIndices)
+ allocate(offSetField)
+ allocate(vertexLimitField)
-! type (dm_info), pointer :: dminfo
-! type (block_type), pointer :: block_ptr
+ ! Determine number of blocks, and setup field lists
+ nBlocks = 0
+ indexToVertexCursor => indexToVertexID
+ haloCursor => haloIndices
+ offSetCursor => offSetField
+ vertexLimitCursor => vertexLimitField
+ nVerticesSolveCursor => nVerticesSolve
+ do while(associated(indexToVertexCursor))
+ nBlocks = nBlocks + 1
-! type (graph) :: block_graph, block_graph_with_halo
+ vertexLimitCursor % scalar = nVerticesSolveCursor % array(1)
+ offSetCursor % scalar = nVerticesSolveCursor % array(2)
-! type (mpas_exchange_list), pointer :: exchListPtr
+ vertexLimitCursor % block => indexToVertexCursor % block
+ offSetCursor % block => indexToVertexCursor % block
+ haloCursor % block => indexToVertexCursor % block
-! integer :: nHalos
-! integer :: nCellsInBlock, nCellsInHalo, maxEdges
-! integer :: indexShift, exchListOffSet
-! integer :: haloStart, haloEnd
-! integer :: iHalo, i, j, k
+ nullify(vertexLimitCursor % ioinfo)
+ nullify(offSetCursor % ioinfo)
+ nullify(haloCursor % ioinfo)
-! nHalos = config_num_halos
+ haloCursor % sendList => indexToVertexCursor % sendList
+ haloCursor % recvList => indexToVertexCursor % recvList
+ haloCursor % copyList => indexToVertexCursor % copyList
-! dminfo => indexToCellID_0Halo % block % domain % dminfo
+ indexToVertexCursor => indexToVertexCursor % next
+ nVerticesSolveCursor => nVerticesSolveCursor % next
+ if(associated(indexToVertexCursor)) then
+ allocate(haloCursor % next)
+ haloCursor => haloCursor % next
-! maxEdges = cellsOnCell_0Halo % dimSizes(1)
-! allocate(indexToCellID_nHalos(nHalos))
-! allocate(nEdgesOnCell_nHalos(nHalos))
-! allocate(cellsOnCell_nHalos(nHalos))
-! allocate(offSetField)
+ allocate(offSetCursor % next)
+ offSetCursor => offSetCursor % next
-! block_ptr => indexToCellID_0Halo % block
-! offSet_ptr => offSetField
+ allocate(vertexLimitCursor % next)
+ vertexLimitCursor =>vertexLimitCursor % next
+ end if
+ nullify(haloCursor % next)
+ nullify(offSetCursor % next)
+ nullify(vertexLimitCursor % next)
+ end do
-! do while(associated(block_ptr))
-! allocate(block_ptr % parinfo)
-! call mpas_dmpar_init_mulithalo_exchange_list(block_ptr % parinfo % cellsToSend, nHalos)
-! call mpas_dmpar_init_mulithalo_exchange_list(block_ptr % parinfo % cellsToRecv, nHalos)
-! call mpas_dmpar_init_mulithalo_exchange_list(block_ptr % parinfo % cellsToCopy, nHalos)
+ ! Allocate and initialize hashtables
+ allocate(vertexList(nBlocks))
+ do iBlock = 1, nBlocks
+ call mpas_hash_init(vertexList(iBlock))
+ end do
-! offSet_ptr % block => block_ptr
-! block_ptr => block_ptr % next
-! if(associated(block_ptr)) then
-! allocate(offSet_ptr % next)
-! offSet_ptr => offSet_ptr % next
-! end if
-! nullify(offSet_ptr % next)
-! end do
+ ! Build unique 0 and 1 halo list for each block
+ indexToVertexCursor => indexToVertexID
+ do while(associated(indexToVertexCursor))
+ iBlock = indexToVertexCursor % block % localBlockID + 1
-! do iHalo = 1, nHalos
-! ! Setup block pointers for the next halo
-! indexToCellID_ptr => indexToCellID_0Halo
-! nEdgesOnCell_ptr => nEdgesOnCell_0Halo
-! cellsOnCell_ptr => cellsOnCell_0Halo
+ do i = 1, indexToVertexCursor % dimSizes(1)
+ if(.not. mpas_hash_search(vertexList(iBlock), indexToVertexCursor % array(i))) then
+ call mpas_hash_insert(vertexList(iBlock), indexToVertexCursor % array(i))
+ end if
+ end do
-! indexToCellID_Halo_ptr => indexToCellID_nHalos(iHalo)
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_nHalos(iHalo)
-! cellsOnCell_Halo_ptr => cellsOnCell_nHalos(iHalo)
-! do while (associated(indexToCellID_ptr))
+ indexToVertexCursor => indexToVertexCursor % next
+ end do
-! indexToCellID_Halo_ptr % block => indexToCellID_ptr % block
-! nEdgesOnCell_Halo_ptr % block => nEdgesOnCell_ptr % block
-! cellsOnCell_Halo_ptr % block => cellsOnCell_ptr % block
+ ! Append new unique vertex id's to indexToVertexID field.
+ do iHalo = 3, nHalos+2
+ sendingHaloLayers(1) = iHalo-1
+ indexToVertexCursor => indexToVertexID
+ nEdgesCursor => nEdgesOnCell
+ nCellsSolveCursor => nCellsSolve
+ verticesOnCellCursor => verticesOnCell
+ nVerticesSolveCursor => nVerticesSolve
+ haloCursor => haloIndices
+ offSetCursor => offSetField
+ do while(associated(indexToVertexCursor))
+ iBlock = indexToVertexCursor % block % localBlockID+1
+ nCellsInBlock = nCellsSolveCursor % array(iHalo-1)
+ offSetCursor % scalar = nVerticesSolveCursor % array(iHalo-1)
+
+! call mpas_block_decomp_all_edges_in_block(maxEdges, nCellsInBlock, nEdgesCursor % array(1:nCellsInBlock), verticesOnCellCursor % array(:,1:nCellsInBlock), nVerticesLocal, localVertexList)
+ call mpas_block_decomp_all_edges_in_block(maxEdges, nCellsInBlock, nEdgesCursor % array, verticesOnCellCursor % array, nVerticesLocal, localVertexList)
-! indexToCellID_ptr => indexToCellID_ptr % next
-! nEdgesOnCell_ptr => nEdgesOnCell_ptr % next
-! cellsOnCell_ptr => cellsOnCell_ptr % next
-! if(associated(indexToCellID_ptr)) then
-! allocate(indexToCellID_Halo_ptr % next)
-! allocate(nEdgesOnCell_Halo_ptr % next)
-! allocate(cellsOnCell_Halo_ptr % next)
-! indexToCellID_Halo_ptr => indexToCellID_Halo_ptr % next
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_Halo_ptr % next
-! cellsOnCell_Halo_ptr => cellsOnCell_Halo_ptr % next
-! end if
+ nVerticesSolveCursor % array(iHalo) = nVerticesLocal
+ haloSize = nVerticesLocal - nVerticesSolveCursor % array(iHalo-1)
+ haloCursor % dimSizes(1) = haloSize
-! nullify(indexTocellID_Halo_ptr % next)
-! nullify(nEdgesOnCell_Halo_ptr % next)
-! nullify(cellsOnCell_Halo_ptr % next)
-! end do
+ allocate(haloCursor % array(haloCursor % dimSizes(1)))
-! indexToCellID_ptr => indexToCellID_0Halo
-! nEdgesOnCell_ptr => nEdgesOnCell_0Halo
-! cellsOnCell_ptr => cellsOnCell_0Halo
-! offSet_ptr => offSetField
-! do while (associated(indexToCellID_ptr))
-! nCellsInBlock = indexToCellID_ptr % dimSizes(1)
+ j = 1
+ do i = 1, nVerticesLocal
+ if(.not. mpas_hash_search(vertexList(iBlock), localVertexList(i))) then
+ call mpas_hash_insert(vertexList(iBlock), localVertexList(i))
+ haloCursor % array(j) = localVertexList(i)
+ j = j + 1
+ end if
+ end do
-! ! Determine number of total cells in block and halos
-! do k = 1, iHalo-1
-! indexToCellID_Halo_ptr => indexToCellID_nHalos(k)
-! do while(associated(indexToCellID_Halo_ptr))
-! if(indexToCellID_Halo_ptr % block % blockID == indexToCellID_ptr % block % blockID) exit
-! indexToCellID_Halo_ptr => indexToCellID_Halo_ptr % next
-! end do
-! nCellsInBlock = nCellsInBlock + indexToCellID_Halo_ptr % dimSizes(1)
-! end do
+ deallocate(localVertexList)
-! ! Setup block graph, using owned and halo cells
-! offSet_ptr % scalar = nCellsInBlock
-! block_graph % nVertices = nCellsInBlock
-! block_graph % nVerticesTotal = nCellsInBlock
-! block_graph % maxDegree = maxEdges
-! block_graph % ghostStart = nCellsInBlock + 1
+ indexToVertexCursor => indexToVertexCursor % next
+ nEdgesCursor => nEdgesCursor % next
+ nCellsSolveCursor => nCellsSolveCursor % next
+ verticesOnCellCursor => verticesOnCellCursor % next
+ nVerticesSolveCursor => nVerticesSolveCursor % next
+ haloCursor => haloCursor % next
+ offSetCursor => offSetCursor % next
+ end do
-! allocate(block_graph % vertexID(nCellsInBlock))
-! allocate(block_graph % nAdjacent(nCellsInBlock))
-! allocate(block_graph % adjacencyList(maxEdges, nCellsInBlock))
+ call mpas_dmpar_get_exch_list(iHalo-1, indexToVertexID, haloIndices, offSetField, vertexLimitField)
-! ! Add all owned cells to graph
-! indexShift = 0
-! block_graph % vertexID(indexShift+1:indexToCellID_ptr % dimSizes(1)) = indexToCellID_ptr % array(:)
-! block_graph % nAdjacent(indexShift+1:nEdgesOnCell_ptr % dimSizes(1)) = nEdgesOnCell_ptr % array(:)
-! block_graph % adjacencyList(:,indexShift+1:cellsOnCell_ptr % dimSizes(2)) = cellsOnCell_ptr % array(:,:)
+ indexToVertexCursor => indexToVertexID
+ cellsOnVertexCursor => cellsOnVertex
+ nVerticesSolveCursor => nVerticesSolve
+ haloCursor => haloIndices
+ do while(associated(indexToVertexCursor))
+ array1dHolder => indexToVertexCursor % array
+ indexToVertexCursor % dimSizes(1) = nVerticesSolveCursor % array(iHalo)
+ allocate(indexToVertexCursor % array(indexToVertexCursor % dimSizes(1)))
+ indexToVertexCursor % array(1:nVerticesSolveCursor % array(iHalo-1)) = array1dHolder(:)
+ indexToVertexCursor % array(nVerticesSolveCursor % array(iHalo-1)+1:nVerticesSolveCursor % array(iHalo)) = haloCursor % array(:)
+ deallocate(array1dHolder)
-! ! Add all halo cells to graph
-! indexShift = indexShift + indexToCellID_ptr % dimSizes(1)
-! do k = 1, iHalo-1
-! indexToCellID_Halo_ptr => indexToCellID_nHalos(k)
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_nHalos(k)
-! cellsOnCell_Halo_ptr => cellsOnCell_nHalos(k)
-! do while(associated(indexToCellID_Halo_ptr))
-! if(indexToCellID_Halo_ptr % block % blockID == indexToCellID_ptr % block % blockID) exit
-! indexToCellID_Halo_ptr => indexToCellID_Halo_ptr % next
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_Halo_ptr % next
-! cellsOnCell_Halo_ptr => cellsOnCell_Halo_ptr % next
-! end do
+ array2dHolder => cellsOnVertexCursor % array
+ cellsOnVertexCursor % dimSizes(2) = nVerticesSolveCursor % array(iHalo)
+ allocate(cellsOnVertexCursor % array(cellsOnVertexCursor % dimSizes(1), cellsOnVertexCursor % dimSizes(2)))
+ cellsOnVertexCursor % array(:,1:nVerticesSolveCursor % array(iHalo-1)) = array2dHolder(:,:)
+ deallocate(array2dHolder)
-! block_graph % vertexID(indexShift+1:indexShift+indexToCellID_Halo_ptr % dimSizes(1)) = indexToCellID_Halo_ptr % array(:)
-! block_graph % nAdjacent(indexShift+1:indexShift+nEdgesOnCell_Halo_ptr % dimSizes(1)) = nEdgesOnCell_Halo_ptr % array(:)
-! block_graph % adjacencyList(:,indexShift+1:indexShift+cellsOnCell_Halo_ptr % dimSizes(2)) = cellsOnCell_Halo_ptr % array(:,:)
-! indexShift = indexShift + indexToCellID_Halo_ptr % dimSizes(1)
-! end do
+ deallocate(haloCursor % array)
-! ! Get a new block graph with the next halo layer added.
-! call mpas_block_decomp_add_halo(dminfo, block_graph, block_graph_with_halo)
-!
-! indexToCellID_Halo_ptr => indexToCellID_nHalos(iHalo)
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_nHalos(iHalo)
-! cellsOnCell_Halo_ptr => cellsOnCell_nHalos(iHalo)
-!
-! do while(associated(indexToCellID_Halo_ptr))
-!
-! if(indexToCellID_Halo_ptr % block % blockID == indexToCellID_ptr % block % blockID) exit
-!
-! indexToCellID_Halo_ptr => indexToCellID_Halo_ptr % next
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_Halo_ptr % next
-! cellsOnCell_Halo_ptr => cellsOnCell_Halo_ptr % next
-! end do
+ indexToVertexCursor => indexToVertexCursor % next
+ cellsOnVertexCursor => cellsOnVertexCursor % next
+ nVerticesSolveCursor => nVerticesSolveCursor % next
+ haloCursor => haloCursor % next
+ end do
-! haloStart = block_graph_with_halo % nVertices
-! haloEnd = block_graph_with_halo % nVerticesTotal
-! nCellsInHalo = haloEnd - haloStart
+ call mpas_dmpar_alltoall_field(cellsOnVertex, cellsOnVertex, sendingHaloLayers)
+ end do
-! indexToCellID_Halo_ptr % dimSizes(1) = nCellsInHalo
-! nEdgesOnCell_Halo_ptr % dimSizes(1) = nCellsInHalo
-! cellsOnCell_Halo_ptr % dimSizes(1) = maxEdges
-! cellsOnCell_Halo_ptr % dimSizes(2) = nCellsInHalo
+ ! Deallocate fields, hashtables, and arrays
+ call mpas_deallocate_field(haloIndices)
+ call mpas_deallocate_field(vertexLimitField)
+ call mpas_deallocate_field(offSetField)
+ do iBlock=1,nBlocks
+ call mpas_hash_destroy(vertexList(iBlock))
+ end do
+ deallocate(vertexList)
+ deallocate(sendingHaloLayers)
-! allocate(indexToCellID_Halo_ptr % array(nCellsInHalo))
-! allocate(nEdgesOnCell_Halo_ptr % array(nCellsInHalo))
-! allocate(cellsOnCell_Halo_ptr % array(maxEdges, nCellsInHalo))
-! indexToCellID_Halo_ptr % array(:) = block_graph_with_halo % vertexID(haloStart+1:haloEnd)
+ end subroutine mpas_block_creator_build_vertex_halos!}}}
-! deallocate(block_graph % vertexID)
-! deallocate(block_graph % nAdjacent)
-! deallocate(block_graph % adjacencyList)
-! deallocate(block_graph_with_halo % vertexID)
-! deallocate(block_graph_with_halo % nAdjacent)
-! deallocate(block_graph_with_halo % adjacencyList)
-! indexToCellID_ptr => indexToCellID_ptr % next
-! nEdgesOnCell_ptr => nEdgesOnCell_ptr % next
-! cellsOnCell_ptr => cellsOnCell_ptr % next
-! offSet_ptr => offSet_ptr % next
-! end do
-! indexToCellID_Halo_ptr => indexToCellID_nHalos(iHalo)
-! nEdgesOnCell_Halo_ptr => nEdgesOnCell_nHalos(iHalo)
-! cellsOnCell_Halo_ptr => cellsOnCell_nHalos(iHalo)
+!***********************************************************************
+!
+! routine mpas_get_halo_cells_and_exchange_lists
+!
+!> \brief Determines cell indices for each halo layer, and builds exchange lists
+!> \author Doug Jacobsen
+!> \date 04/30/12
+!> \version SVN:$Id$
+!> \details
+!> This routine builds the field indexToCellID_nHalos, which is an array of nHalos linked lists.
+!> Each index in indexToCellID_nHalos represnts a linked list of cells in a given halo.
+!> It creates the exchange lists for cells, and places them in the block structure.
+!> In order to call this routine, there are some assumptions made.
+!> The first assumption is that the 1 index of each array is setup correctly,
+!> ie block pointers are valid, dimSizes are valid, next pointers are valid, ets
+!> The second assumption is that the arrays in each field are allocated and full with their appropriate information.
+!> These assumptions lead to the conclusion that the 0 halo has to be properly setup prior to calling this routine.
+!
+!-----------------------------------------------------------------------
-! call mpas_dmpar_get_exch_list(iHalo, indexToCellID_0Halo, indexToCellID_Halo_ptr)
-
-! call mpas_dmpar_alltoall_field(indexToCellID_0Halo, indexToCellID_Halo_ptr)
-! call mpas_dmpar_alltoall_field(nEdgesOnCell_0Halo, nEdgesOnCell_Halo_ptr)
-! call mpas_dmpar_alltoall_field(cellsOnCell_0Halo, cellsOnCell_Halo_ptr)
-
-! indexToCellID_ptr => indexToCellID_0Halo
-! indexToCellID_Halo_ptr => indextoCellID_nHalos(iHalo)
-! offSet_ptr => offSetField
-! do while(associated(indexToCellID_ptr))
-! ! Offset destination indices for recieves and local copies.
-! exchListPtr => indexToCellID_Halo_ptr % recvList % halos(iHalo) % exchList
-! do i = 1, exchListPtr % nList
-! exchListPtr % destList(i) = exchListPtr % destList(i) + offSet_ptr % scalar
-! end do
-
-! exchListPtr => indexToCellID_Halo_ptr % copyList % halos(iHalo) % exchList
-! do i = 1, exchListPtr % nList
-! exchListPtr % destList(i) = exchListPtr % destList(i) + offSet_ptr % scalar
-! end do
-
-! indexToCellID_ptr % block % parinfo % cellsToSend % halos(iHalo) % exchList => indexToCellID_ptr % sendList % halos(iHalo) % exchList
-! indexToCellID_ptr % block % parinfo % cellsToRecv % halos(iHalo) % exchList => indexToCellID_Halo_ptr % recvList % halos(iHalo) % exchList
-! indexToCellID_ptr % block % parinfo % cellsToCopy % halos(iHalo) % exchList => indexToCellID_Halo_ptr % copyList % halos(iHalo) % exchList
-
-! nullify(indexToCellID_ptr % sendList % halos(iHalo) % exchList)
-! nullify(indexToCellID_ptr % recvList % halos(iHalo) % exchList)
-! nullify(indexToCellID_ptr % copyList % halos(iHalo) % exchList)
-
-! indexToCellID_ptr => indexToCellID_ptr % next
-! indextoCellID_Halo_ptr => indexToCellID_Halo_ptr % next
-! offSet_ptr => offSet_ptr % next
-! end do
-
-! end do ! iHalo loop over nHalos
-
-! end subroutine mpas_get_halo_cells_and_exchange_lists !}}}
-
!***********************************************************************
!
! routine mpas_get_vertex_ids_and_exchange_lists
@@ -671,86 +928,4 @@
!
!-----------------------------------------------------------------------
-! subroutine mpas_get_vertex_ids_and_exchange_lists(dminfo, nHalos, maxEdges, vertexDegree, indexToCellID_0Halo, nEdgesOnCell_0Halo, verticesOnCell_0Halo, cellsOnVertex_0Halo, indexToCellID_nHalos, indexToVertexID_0Halo, indexToVertexID_nHalos)!{{{
-! type (dm_info), intent(in) :: dminfo
-! integer, intent(in) :: nHalos
-! integer, intent(in) :: maxEdges
-! integer, intent(in) :: vertexDegree
-
-! type(field1dInteger), pointer :: indexToCellID_0Halo
-! type(field1dInteger), pointer :: nEdgesOnCell_0Halo
-! type(field1dInteger), pointer :: verticesOnCell_0Halo
-! type(field1dInteger), pointer :: cellsOnVertex_0Halo
-! type(field1dInteger), dimension(:), pointer :: indexToCellID_nHalos
-
-! type(field1dInteger), pointer :: indexToVertexID_0Halo
-! type(field1dInteger), dimension(:), pointer :: indexToVertexID_nHalos
-
-! type(field1dInteger), dimension(:), pointer :: cellsOnVertex_nHalos
-! type(field1dInteger), dimension(:), pointer :: nEdgesOnCell_nHalos
-
-! type(field1dInteger), pointer :: indexToCellID_ptr, nEdgesOnCell_ptr, verticesOnCell_ptr, cellsOnVertex_ptr, indexToVertexID_ptr
-! type(field1dInteger), pointer :: indexToCellID_Halo_ptr, indexToVertexID_Halo_ptr
-
-! integer, dimension(:), pointer :: all_vertices_in_block
-! integer :: nCellsInBlock
-! integer :: nVerticesInBlock
-! integer :: nVerticesInHalo, haloStart, haloEnd
-
-! type (graph) :: block_graph, block_graph_with_halo
-
-! integer :: iCell, iVertex
-! integer :: i, j, k, iHalo
-
-! allocate(indexToVertexID_0Halo)
-! allocate(indexToVertexID_nHalos(nHalos+1)) ! 1 more halo than cells
-! allocate(cellsOnVertex_nHalos(nHalos+1)) ! 1 more halo than cells
-! allocate(nEdgesOnCell_nHalos(nHalos))
-
-! ! Build the 0 and 1 halos
-! indexToCellID_ptr => indexToCellID_0Halo
-! nEdgesOnCell_ptr => nEdgesOnCell_0Halo
-! verticesOnCell_ptr => verticesOnCell_0Halo
-! cellsOnVertex_ptr => cellsOnVertex_0Halo
-! indexToVertexID_ptr => indexToVertexID_0Halo
-! indexToVertexID_Halo_ptr => indexToVertexID_nHalos(1)
-! do while(associated(indexToCellID_ptr))
-! nCellsInBlock = indexToCellID_ptr % dimSizes(1)
-
-! call mpas_block_decomp_all_edges_in_block(maxEdges, nCellsInBlock, nEdgesOnCell_ptr % array, verticesOnCell_ptr % array, nVerticesInBlock, all_vertices_in_block)
-! call mpas_block_decomp_partitioned_edge_list(nCellsInBlock, indexToCellID_ptr % array, vertexDegree, nVerticesInBlock, cellsOnVertex_ptr % array, all_vertices_in_block, haloStart)
-
-! call mpas_block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &
-! verticesOnCell_2Halo, nlocal_vertices, local_vertex_list)
-
-! call mpas_block_decomp_partitioned_edge_list(nOwnCells, &
-! block_graph_2Halo % vertexID(1:nOwnCells), &
-! vertexDegree, nlocal_vertices, cellsOnVertex_2Halo, local_vertex_list, ghostVertexStart)
-
-! indexToVertexID_ptr % block => indexToCellID_ptr % block
-! indexToVertexID_ptr % dimSizes(1) = haloStart
-! allocate(indexToVertexID_ptr % array(indexToVertexID_ptr % dimSizes(1)))
-
-! indexToVertexID_ptr % array(:) = all_vertices_in_block(1:haloStart)
-
-! indexToVertexID_Halo_ptr % block => indexToCellID_Halo_ptr % block
-! indexToVertexID_Halo_ptr % dimSizes(1) = nVerticesInBlock - haloStart
-! allocate(indexToVertexID_Halo_ptr % array(indexToVertexID_Halo_ptr % dimSizes(1)))
-
-! indexToVertexID_Halo_ptr % array(:) = all_vertices_in_block(haloStart+1:nVerticesInBlock)
-
-! indexToCellID_ptr => indexToCellID_ptr % next
-! verticesOnCell_ptr => verticesOnCell_ptr % next
-! cellsOnVertex_ptr => cellsOnVertex_ptr % next
-! if(associated(indexToCellID_ptr)) then
-! allocate(indexToVertexID_ptr % next)
-! indexToVertexID_ptr => indexToVertexID_ptr % next
-! end if
-
-! nullify(indexToVertexID_ptr % next)
-! end do
-
-! end subroutine mpas_get_vertex_ids_and_exchange_lists!}}}
-
-
end module mpas_block_creator
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-05-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -3,6 +3,7 @@
use mpas_dmpar_types
use mpas_grid_types
use mpas_sort
+ use mpas_hash
#ifdef _MPI
include 'mpif.h'
@@ -570,7 +571,11 @@
integer :: nOwnedList, nNeededList
integer :: mpi_ierr, mpi_rreq, mpi_sreq
+ type (hashtable) :: neededHash
+ integer :: nUniqueNeededList
+ integer, dimension(:,:), pointer :: uniqueSortedNeededList
+
!
! *** NB: This code assumes that block % blockID values are local block IDs and are in the range [1, numBlocks]
! where numBlocks is the number of blocks owned by each task
@@ -627,6 +632,52 @@
end do
!
+ ! Determine unique list of needed elements.
+ !
+ !! NEW
+ nUniqueNeededList = 0
+ call mpas_hash_init(neededHash)
+ fieldCursor => neededListField
+ do while (associated(fieldCursor))
+ do i = 1, fieldCursor % dimSizes(1)
+ if(.not. mpas_hash_search(neededHash, fieldCursor % array(i))) then
+ nUniqueNeededList = nUniqueNeededList + 1
+ call mpas_hash_insert(neededHash, fieldCursor % array(i))
+ end if
+ end do
+ fieldCursor => fieldCursor % next
+ end do
+
+ kk = mpas_hash_size(neededHash)
+
+ nUniqueNeededList = mpas_hash_size(neededHash)
+ allocate(uniqueSortedNeededList(2,nUniqueNeededList))
+ call mpas_hash_destroy(neededHash)
+ call mpas_hash_init(neededHash)
+
+ j = 0
+ fieldCursor => neededListField
+ do while (associated(fieldCursor))
+ do i = 1, fieldCursor % dimSizes(1)
+ if(.not. mpas_hash_search(neededHash, fieldCursor % array(i))) then
+ j = j +1
+ uniqueSortedNeededList(1, j) = fieldCursor % array(i)
+ uniqueSortedNeededList(2, j) = fieldCursor % block % localBlockID
+ call mpas_hash_insert(neededHash, fieldCursor % array(i))
+ end if
+ end do
+ fieldCursor => fieldCursor % next
+ 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
!
allocate(offsetList(nNeededBlocks))
@@ -730,7 +781,7 @@
call quicksort(nOwnedList, ownedBlockSorted)
- allocate(neededListIndex(nOwnedList))
+ allocate(neededListIndex(nNeededList))
j = 1
do i=1,nNeededList
if (i > 1) then
@@ -743,14 +794,22 @@
!
! Set totalSize to the maximum number of items in any task's needed list
!
- call MPI_Allreduce(nNeededList, totalSize, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
+ !! 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))
- nMesgSend = nNeededList
- nMesgRecv = nNeededList
- ownerListOut(1:nNeededList) = neededList(1:nNeededList)
+ !! OLD
+! nMesgSend = nNeededList
+! nMesgRecv = nNeededList
+! ownerListOut(1:nNeededList) = neededList(1:nNeededList)
+ !! NEW
+ nMesgSend = nUniqueNeededList
+ nMesgRecv = nUniqueNeededList
+ ownerListOut(1:nUniqueNeededList) = uniqueSortedNeededList(1,1:nUniqueNeededList)
recvNeighbor = mod(dminfo % my_proc_id + dminfo % nprocs - 1, dminfo % nprocs)
sendNeighbor = mod(dminfo % my_proc_id + 1, dminfo % nprocs)
@@ -796,6 +855,8 @@
recipientList(1,ownedListSorted(2,k)) = numToSend(iBlock)
! 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
@@ -804,6 +865,13 @@
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
@@ -831,16 +899,21 @@
exchListPtr % nlist = numToSend(iBlock)
allocate(exchListPtr % srcList(numToSend(iBlock)))
allocate(exchListPtr % destList(numToSend(iBlock)))
+ exchListPtr % srcList = -1
+ exchListPtr % destList = -1
+
kk = 1
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
@@ -857,7 +930,17 @@
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
@@ -866,13 +949,17 @@
if(i == dminfo % my_proc_id) cycle
numToRecv(:) = 0
- do j=1,nNeededList
- iBlock = neededBlock(j) + 1
+ !! OLD
+! do j=1,nNeededList
+! iBlock = neededBlock(j) + 1
+ !! NEW
+ do j=1,nUniqueNeededList
+ iBlock = uniqueSortedNeededList(2,j) + 1
if (ownerListIn(j) == -i) numToRecv(iBlock) = numToRecv(iBlock) + 1
end do
+ totalRecv = 0
fieldCursor => neededListField
- totalRecv = 0
do while (associated(fieldCursor))
iBlock = fieldCursor % block % localBlockID + 1
@@ -899,17 +986,42 @@
exchListPtr % nlist = numToRecv(iBlock)
allocate(exchListPtr % srcList(numToRecv(iBlock)))
allocate(exchListPtr % destList(numToRecv(iBlock)))
+ 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,nNeededList
- if (ownerListIn(j) == -i) then
- if (neededBlock(j) == fieldCursor % block % localBlockID) then
- totalRecv = totalRecv + 1
- exchListPtr % srcList(kk) = totalRecv
- exchListPtr % destList(kk) = neededListIndex(j) + offsetList(iBlock)
+ 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 % 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
@@ -952,6 +1064,11 @@
fieldCursor2 => neededListField
do while(associated(fieldCursor2))
+ if(associated(fieldCursor, fieldCursor2)) then
+ fieldCursor2 => fieldCursor2 % next
+ cycle
+ end if
+
numToSend = 0
recipientList = -1
@@ -989,6 +1106,9 @@
exchListPtr % nlist = numToSend(1)
allocate(exchListPtr % srcList(numToSend(1)))
allocate(exchListPtr % destList(numToSend(1)))
+ exchListPtr % srcList = -1
+ exchListPtr % destList = -1
+
kk = 1
do j=1,nOwnedList
if(recipientList(1,j) == fieldCursor2 % block % localBlockID) then
@@ -2747,7 +2867,7 @@
! Handle local copy. If MPI is off, then only local copies are performed.
fieldCursor => field
- do while(associated(field))
+ do while(associated(fieldCursor))
do iHalo = 1, nHaloLayers
exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList
@@ -2997,7 +3117,7 @@
! Handle local copy. If MPI is off, then only local copies are performed.
fieldCursor => field
- do while(associated(field))
+ do while(associated(fieldCursor))
do iHalo = 1, nHaloLayers
exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList
@@ -3252,7 +3372,7 @@
! Handle local copy. If MPI is off, then only local copies are performed.
fieldCursor => field
- do while(associated(field))
+ do while(associated(fieldCursor))
do iHalo = 1, nHaloLayers
exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList
@@ -3505,7 +3625,7 @@
! Handle local copy. If MPI is off, then only local copies are performed.
fieldCursor => field
- do while(associated(field))
+ do while(associated(fieldCursor))
do iHalo = 1, nHaloLayers
exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList
@@ -3755,7 +3875,7 @@
! Handle local copy. If MPI is off, then only local copies are performed.
fieldCursor => field
- do while(associated(field))
+ do while(associated(fieldCursor))
do iHalo = 1, nHaloLayers
exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList
@@ -4010,7 +4130,7 @@
! Handle local copy. If MPI is off, then only local copies are performed.
fieldCursor => field
- do while(associated(field))
+ do while(associated(fieldCursor))
do iHalo = 1, nHaloLayers
exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_grid_types.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_grid_types.F 2012-05-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_grid_types.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -412,22 +412,25 @@
b % blockID = blockID
- nullify(b % prev)
- nullify(b % next)
+! nullify(b % prev)
+! nullify(b % next)
allocate(b % parinfo)
- allocate(b % parinfo % cellsToSend % halos(nHaloLayers))
- allocate(b % parinfo % cellsToRecv % halos(nHaloLayers))
- allocate(b % parinfo % cellsToCopy % halos(nHaloLayers))
+! write(6,*) 'parinfo cell exch lists'
+! allocate(b % parinfo % cellsToSend % halos(nHaloLayers))
+! allocate(b % parinfo % cellsToRecv % halos(nHaloLayers))
+! allocate(b % parinfo % cellsToCopy % halos(nHaloLayers))
- allocate(b % parinfo % edgesToSend % halos(nHaloLayers + 1)) ! first index is owned-cell edges
- allocate(b % parinfo % edgesToRecv % halos(nHaloLayers + 1)) ! first index is owned-cell edges
- allocate(b % parinfo % edgesToCopy % halos(nHaloLayers + 1)) ! first index is owned-cell edges
+! write(6,*) 'parinfo edges exch lists'
+! allocate(b % parinfo % edgesToSend % halos(nHaloLayers + 1)) ! first index is owned-cell edges
+! allocate(b % parinfo % edgesToRecv % halos(nHaloLayers + 1)) ! first index is owned-cell edges
+! allocate(b % parinfo % edgesToCopy % halos(nHaloLayers + 1)) ! first index is owned-cell edges
- allocate(b % parinfo % verticesToSend % halos(nHaloLayers + 1)) ! first index is owned-cell vertices
- allocate(b % parinfo % verticesToRecv % halos(nHaloLayers + 1)) ! first index is owned-cell vertices
- allocate(b % parinfo % verticesToCopy % halos(nHaloLayers + 1)) ! first index is owned-cell vertices
+! write(6,*) 'parinfo vertices exch lists'
+! allocate(b % parinfo % verticesToSend % halos(nHaloLayers + 1)) ! first index is owned-cell vertices
+! allocate(b % parinfo % verticesToRecv % halos(nHaloLayers + 1)) ! first index is owned-cell vertices
+! allocate(b % parinfo % verticesToCopy % halos(nHaloLayers + 1)) ! first index is owned-cell vertices
b % domain => dom
@@ -439,7 +442,7 @@
#include "group_alloc_routines.inc"
- subroutine mpas_deallocate_domain(dom)
+ subroutine mpas_deallocate_domain(dom)!{{{
implicit none
@@ -455,7 +458,7 @@
deallocate(dom)
- end subroutine mpas_deallocate_domain
+ end subroutine mpas_deallocate_domain!}}}
subroutine mpas_deallocate_field0d_integer(f)!{{{
type (field0dInteger), pointer :: f
@@ -463,13 +466,17 @@
f_cursor => f
- do while(associated(f))
+ do while(associated(f_cursor))
if(associated(f % next)) then
f => f % next
else
nullify(f)
end if
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
deallocate(f_cursor)
f_cursor => f
end do
@@ -488,7 +495,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -508,7 +522,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -528,7 +549,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -542,14 +570,19 @@
f_cursor => f
- do while(associated(f))
+ do while(associated(f_cursor))
if(associated(f % next)) then
f => f % next
else
nullify(f)
end if
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
deallocate(f_cursor)
+
f_cursor => f
end do
@@ -567,7 +600,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -587,7 +627,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -607,7 +654,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -621,13 +675,17 @@
f_cursor => f
- do while(associated(f))
+ do while(associated(f_cursor))
if(associated(f % next)) then
f => f % next
else
nullify(f)
end if
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
deallocate(f_cursor)
f_cursor => f
end do
@@ -646,7 +704,14 @@
nullify(f)
end if
- deallocate(f_cursor % array)
+ if(associated(f_cursor % ioinfo)) then
+ deallocate(f_cursor % ioinfo)
+ end if
+
+ if(associated(f_cursor % array)) then
+ deallocate(f_cursor % array)
+ end if
+
deallocate(f_cursor)
f_cursor => f
@@ -654,7 +719,7 @@
end subroutine mpas_deallocate_field1d_char!}}}
- subroutine mpas_deallocate_block(b)
+ subroutine mpas_deallocate_block(b)!{{{
implicit none
@@ -681,7 +746,7 @@
#include "block_deallocs.inc"
- end subroutine mpas_deallocate_block
+ end subroutine mpas_deallocate_block!}}}
#include "group_dealloc_routines.inc"
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_hash.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_hash.F 2012-05-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_hash.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -106,7 +106,7 @@
mpas_hash_search = .false.
hashval = mod(key, TABLESIZE) + 1
-
+
cursor => h%table(hashval)%p
do while(associated(cursor))
if (cursor%key == key) then
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-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -92,7 +92,11 @@
type (field2DInteger), pointer :: int2d_ptr2
type (field2DInteger), pointer :: int2d_ptr3
+ type (field1dInteger), pointer :: indexToCellCursor, indexToVertexCursor, indexToEdgeCursor
+
type (field1dInteger), pointer :: nCellsSolveField
+ type (field1dInteger), pointer :: nVerticesSolveField
+ type (field1dInteger), pointer :: nEdgesSolveField
type (field1DInteger), dimension(:), pointer :: indexToCellID_Halos
type (field1DInteger), dimension(:), pointer :: nEdgesOnCell_Halos
@@ -110,6 +114,9 @@
type (field1DInteger), pointer :: indexToVertexID_0Halo
type (field2DInteger), pointer :: cellsOnVertex_0Halo
+ type (field1DInteger), pointer :: indexToEdgeID_0Halo
+ type (field2DInteger), pointer :: cellsOnEdge_0Halo
+
type (field1DInteger), pointer :: indexToVertexID_tList
type (field2DInteger), pointer :: cellsOnVertex_tList
@@ -123,6 +130,7 @@
#endif
#endif
+ integer, dimension(:,:), pointer :: cellIDSorted, vertexIDSorted, edgeIDSorted
integer, dimension(:), pointer :: local_cell_list, local_edge_list, local_vertex_list
integer, dimension(:), pointer :: block_id, block_start, block_count
integer, dimension(:), pointer :: local_vertlevel_list, needed_vertlevel_list
@@ -590,7 +598,7 @@
call mpas_io_get_var(inputHandle, 'cellsOnEdge', cellsOnEdgeField % array, ierr)
deallocate(readIndices)
cellsOnEdgeField % dimSizes(1) = 2
- cellsOnEdgeField % dimSizes(1) = nReadEdges
+ cellsOnEdgeField % dimSizes(2) = nReadEdges
cellsOnEdgeField % block => readingBlock
cellsOnEdgeField % sendList => indexToEdgeIDField % sendList
cellsOnEdgeField % recvList => indexToEdgeIDField % recvList
@@ -619,13 +627,12 @@
cellsOnVertexField % dimSizes(1) = vertexDegree
cellsOnVertexField % dimSizes(2) = nReadVertices
cellsOnVertexField % block => readingBlock
- cellsOnVertexField % sendList => indexToEdgeIDField % sendList
- cellsOnVertexField % recvList => indexToEdgeIDField % recvList
- cellsOnVertexField % copyList => indexToEdgeIDField % copyList
+ cellsOnVertexField % sendList => indexToVertexIDField % sendList
+ cellsOnVertexField % recvList => indexToVertexIDField % recvList
+ cellsOnVertexField % copyList => indexToVertexIDField % copyList
nullify(cellsOnVertexField % next)
deallocate(readIndices)
-
-
+
!
! Set up a graph derived data type describing the connectivity for the cells
! that were read by this process
@@ -662,152 +669,371 @@
write(6,*) 'calling setup blocks and 0halo cells'
call mpas_block_creator_setup_blocks_and_0halo_cells(domain, indexToCellID_0Halo, local_cell_list, block_id, block_start, block_count)
write(6,*) 'calling build 0halo cell fields'
- call mpas_block_creator_build_0halo_cell_fields(indexToCellIDField, nEdgesOnCellField, cellsOnCellField, indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo)
+ call mpas_block_creator_build_0halo_cell_fields(indexToCellIDField, nEdgesOnCellField, cellsOnCellField, verticesOnCellField, edgesOnCellField, indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, verticesOnCell_0Halo, edgesOnCell_0Halo)
write(6,*) 'Done with 0 halo cells'
-! !! TEST FOR ALL TO ALL FUNCTIONALITY
-! int1d_ptr => indexToCellID_0Halo
+ write(6,*) 'calling build 0-1 halo vertex fields'
+ call mpas_block_creator_build_0_and_1halo_vertex_fields(indexToVertexIDField, cellsOnVertexField, indexToCellID_0Halo, nEdgesOnCell_0Halo, verticesOnCell_0Halo, indexToVertexID_0Halo, cellsOnVertex_0Halo, nVerticesSolveField)
+
+ write(6,*) 'calling build 0-1 halo edge fields'
+ call mpas_block_creator_build_0_and_1halo_vertex_fields(indexToEdgeIDField, cellsOnEdgeField, indexToCellID_0Halo, nEdgesOnCell_0Halo, edgesOnCell_0Halo, indexToEdgeID_0Halo, cellsOnEdge_0Halo, nEdgesSolveField)
+
+ write(6,*) 'Done with 0 and 1 halo edges and vertices'
+
+ write(6,*) 'Building cell halos', nHalos
+ call mpas_block_creator_build_cell_halos(indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, verticesOnCell_0Halo, edgesOnCell_0Halo, nCellsSolveField)
+
+ write(6,*) 'Building vertex halos', nHalos
+ call mpas_block_creator_build_vertex_halos(indexToCellID_0Halo, nEdgesOnCell_0Halo, nCellsSolveField, verticesOnCell_0Halo, indexToVertexID_0Halo, cellsOnVertex_0Halo, nVerticesSolveField)
+
+ 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)
+
+! int1d_ptr => nCellsSolveField
! 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)
+! 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 => nEdgesOnCell_0Halo
+! int1d_ptr => nVerticesSolveField
! do while(associated(int1d_ptr))
-! write(6,*) 'Max edges on block', int1d_ptr % block % blockid
+! write(6,*) 'nVerticesSolve on block', int1d_ptr % block % localBlockID
! do i = 1, int1d_ptr % dimSizes(1)
-! write(6,*) int1d_ptr % array(i)
+! write(6,*) 'halo', i-1, 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)
+! 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
-! int2d_ptr => int2d_ptr % next
+! int1d_ptr => int1d_ptr % next
! end do
- write(6,*) 'Building cell halos', nHalos
- call mpas_block_creator_build_cell_halos(indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, nCellsSolveField)
+ ! Allocate blocks, and copy indexTo arrays into blocks
+ write(6,*) 'Allocate blocks, and copy indexTo arrays into blocks'
+ block_ptr => domain % blocklist
+ int1d_ptr => nCellsSolveField
+ int1d_ptr2 => nVerticesSolveField
+ int1d_ptr3 => nEdgesSolveField
+ indexToCellCursor => indexToCellID_0Halo
+ indexToVertexCursor => indexToVertexID_0Halo
+ indexToEdgeCursor => indexToEdgeID_0Halo
+ do while(associated(block_ptr))
+ nCells = int1d_ptr % array(nHalos+1)
+ nVertices = int1d_ptr2 % array(nHalos+2)
+ nEdges = int1d_ptr3 % array(nHalos+2)
- write(6,*) 'Stopping'
- stop
+ call mpas_allocate_block(nHalos, block_ptr, domain , block_ptr % blockID, &
+#include "dim_dummy_args.inc"
+ )
- 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
+ block_ptr % mesh % indexToCellID % array(1:int1d_ptr % array(1)) = indexToCellCursor % array(1:int1d_ptr % array(1))
+ block_ptr % mesh % indexToVertexID % array(1:int1d_ptr2 % array(1)) = indexToVertexCursor % array(1:int1d_ptr2 % array(1))
+ block_ptr % mesh % indexToEdgeID % array(1:int1d_ptr3 % array(1)) = indexToEdgeCursor % array(1:int1d_ptr3 % array(1))
+
+ block_ptr % parinfo % cellsToSend => indexToCellCursor % sendList
+ block_ptr % parinfo % cellsToRecv => indexToCellCursor % recvList
+ block_ptr % parinfo % cellsToCopy => indexToCellCursor % copyList
+ nullify(indexToCellCursor % sendList)
+ nullify(indexToCellCursor % recvList)
+ nullify(indexToCellCursor % copyList)
+
+ block_ptr % parinfo % verticesToSend => indexToVertexCursor % sendList
+ block_ptr % parinfo % verticesToRecv => indexToVertexCursor % recvList
+ block_ptr % parinfo % verticesToCopy => indexToVertexCursor % copyList
+ nullify(indexToVertexCursor % sendList)
+ nullify(indexToVertexCursor % recvList)
+ nullify(indexToVertexCursor % copyList)
+
+ block_ptr % parinfo % edgesToSend => indexToEdgeCursor % sendList
+ block_ptr % parinfo % edgesToRecv => indexToEdgeCursor % recvList
+ block_ptr % parinfo % edgesToCopy => indexToEdgeCursor % copyList
+ nullify(indexToEdgeCursor % sendList)
+ nullify(indexToEdgeCursor % recvList)
+ nullify(indexToEdgeCursor % copyList)
+
+ block_ptr % mesh % nCellsSolve = int1d_ptr % array(1)
+ block_ptr % mesh % nVerticesSolve = int1d_ptr2 % array(1)
+ block_ptr % mesh % nEdgesSolve = int1d_ptr3 % array(1)
+
+ block_ptr => block_ptr % next
int1d_ptr => int1d_ptr % next
+ int1d_ptr2 => int1d_ptr2 % next
+ int1d_ptr3 => int1d_ptr3 % next
+ indexToCellCursor => indexToCellCursor % next
+ indexToVertexCursor => indexToVertexCursor % next
+ indexToEdgeCursor => indexToEdgeCursor % next
end do
-! write(6,*) 'Building temporary indexToVertexID list. Containing 0 and 1 halo vertices'
-! allocate(indexToVertexID_tList)
-! int1d_ptr => nEdgesOnCell_0Halo
-! int1d_ptr2 => indexToVertexID_tList
-! int2d_ptr => verticesOnCell_0Halo
-! int2d_ptr2 => cellsOnVertex_tList
-! do while(associated(int1d_ptr))
-! call mpas_block_decomp_all_edges_in_block(maxEdges, int1d_ptr % dimSizes(1), int1d_ptr % array, &
-! int2d_ptr % array, nVerticesInBlock, int1d_ptr2 % array)
-!
-! int1d_ptr2 % block => int1d_ptr % block
-! int2d_ptr2 % block => int1d_ptr % block
-!
-! int1d_ptr2 % dimSizes(1) = nVerticesInBlock
-! int2d_ptr2 % dimSizes(1) = vertexDegree
-! int2d_ptr2 % dimSizes(2) = nVerticesInBlock
-!
-! allocate(int2d_ptr2 % array(vertexDegree, nVerticesInBlock))
-!
-! int1d_ptr => int1d_ptr % next
-! int2d_ptr => int2d_ptr % next
-!
-! if(associated(int1d_ptr)) then
-! allocate(int1d_ptr2 % next)
-! allocate(int2d_ptr2 % next)
-! int1d_ptr2 => int1d_ptr2 % next
-! int2d_ptr2 => int2d_ptr2 % next
-! end if
-! nullify(int1d_ptr2 % next)
-! nullify(int2d_ptr2 % next)
-! end do
-!
-! write(6,*) 'Making vertex exchange lists'
-!
-! call mpas_get_exchange_lists(domain % dminfo, indexToVertexIDField, .false., indexToVertexID_tList, .true.)
-!
-! write(6,*) 'SendLists'
-! sendListPtr => indexToVertexIDField % sendList(1) % next
-! do while(associated(sendListPtr))
-! write(6,*) sendListPtr % procID, sendListPtr % blockID, sendListPtr % nList
-! write(6,*) sendListPtr % list
-! sendListPtr => sendListPtr % next
-! end do
-!
-! write(6,*) 'Linking vertex exchange lists'
-! call mpas_link_exchange_list_field(indexToVertexIDField, indexToVertexID_tList, cellsOnVertexField, cellsOnVertex_tList)
-! write(6,*) 'All to all on cellsOnVertex'
-! call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnVertexField, cellsOnVertex_tList)
-!
-! write(6,*) 'Splitting vertices into 0 and 1 halos'
-! allocate(indexToVertexID_0Halo)
-! allocate(indexToVertexID_Halos(nHalos+1))
-! int1d_ptr => indexToCellID_0Halo
-! int1d_ptr2 => indexToVertexID_tList
-! int1d_ptr3 => indexToVertexID_0Halo
-! int1d_ptr4 => indexToVertexID_Halos(1)
-! int2d_ptr => cellsOnVertex_tList
-! int2d_ptr2 => cellsOnVertex_0Halo
-!
-! do while(associated(int1d_ptr))
-! call mpas_block_decomp_partitioned_edge_list(int1d_ptr % dimSizes(1), int1d_ptr % array, vertexDegree, int1d_ptr2 % dimSizes(1), int2d_ptr % array, int1d_ptr2 % array, haloStart)
-!
-! int1d_ptr3 % block => int1d_ptr % block
-! int1d_ptr3 % dimSizes(1) = haloStart
-! allocate(int1d_ptr3 % array(haloStart))
-! int1d_ptr3 % array(:) = int1d_ptr2 % array(1:haloStart)
-!
-! int1d_ptr4 % block => int1d_ptr % block
-! int1d_ptr4 % dimSizes(1) = int1d_ptr2 % dimSizes(1) - haloStart
-! allocate(int1d_ptr4 % array(int1d_ptr4 % dimSizes(1)))
-! int1d_ptr4 % array(:) = int1d_ptr2 % array(haloStart+1:int1d_ptr2 % dimSizes(1))
-!
-! int2d_ptr2 % block => int2d_ptr2 % block
-! int2d_ptr2 % dimSizes(1) = vertexDegree
-! int2d_ptr2 % dimSizes(2) = haloStart
-! allocate(int2d_ptr2 % array(vertexDegree, haloStart))
-! int2d_ptr2 % array(:,:) = int2d_ptr % array(:, 1:haloStart)
-!
-! int1d_ptr => int1d_ptr % next
-! int1d_ptr2 => int1d_ptr2 % next
-! int2d_ptr => int2d_ptr % next
-! if(associated(int1d_ptr)) then
-! allocate(int1d_ptr3 % next)
-! allocate(int1d_ptr4 % next)
-! allocate(int2d_ptr2 % next)
-! int1d_ptr3 => int1d_ptr3 % next
-! int1d_ptr4 => int1d_ptr4 % next
-! int2d_ptr2 => int2d_ptr2 % next
-! end if
-! nullify(int1d_ptr3 % next)
-! nullify(int1d_ptr4 % next)
-! nullify(int2d_ptr3 % next)
-! end do
+ write(6,*) 'initializing input object'
+ call mpas_io_input_init(input_obj, domain % blocklist, domain % dminfo)
-! call mpas_deallocate_field(indexToVertexID_tList)
-! call mpas_deallocate_field(cellsOnVertex_tList)
-
+ write(6,*) 'getting file attributes'
+ call MPAS_readStreamAtt(input_obj % io_stream, 'sphere_radius', r_sphere_radius, ierr)
+ if (ierr /= MPAS_STREAM_NOERR) then
+ write(0,*) 'Warning: Attribute sphere_radius not found in '//trim(input_obj % filename)
+ write(0,*) ' Setting sphere_radius to 1.0'
+ domain % blocklist % mesh % sphere_radius = 1.0
+ else
+ domain % blocklist % mesh % sphere_radius = r_sphere_radius
+ end if
+
+ call MPAS_readStreamAtt(input_obj % io_stream, 'on_a_sphere', c_on_a_sphere, ierr)
+ if (ierr /= MPAS_STREAM_NOERR) then
+ write(0,*) 'Warning: Attribute on_a_sphere not found in '//trim(input_obj % filename)
+ write(0,*) ' Setting on_a_sphere to ''YES'''
+ domain % blocklist % mesh % on_a_sphere = .true.
+ else
+ if (index(c_on_a_sphere, 'YES') /= 0) then
+ domain % blocklist % mesh % on_a_sphere = .true.
+ else
+ domain % blocklist % mesh % on_a_sphere = .false.
+ end if
+ end if
+
+ write(6,*) 'Copy attributes to other blocks.'
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ 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
+ end do
+
+ if (.not. config_do_restart) then
+ input_obj % time = 1
+ else
+ !
+ ! If doing a restart, we need to decide which time slice to read from the
+ ! restart file
+ !
+ input_obj % time = MPAS_seekStream(input_obj % io_stream, config_start_time, MPAS_STREAM_EXACT_TIME, timeStamp, ierr)
+ if (ierr == MPAS_IO_ERR) then
+ write(0,*) 'Error: restart file '//trim(filename)//' did not contain time '//trim(config_start_time)
+ call mpas_dmpar_abort(domain % dminfo)
+ end if
+!write(0,*) 'MGD DEBUGGING time = ', input_obj % time
+ write(0,*) 'Restarting model from time ', timeStamp
+ end if
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Do the actual work of reading all fields in from the input or restart file
+ ! For each field:
+ ! 1) Each process reads a contiguous range of cell/edge/vertex indices, which
+ ! may not correspond with the cells/edges/vertices that are owned by the
+ ! process
+ ! 2) All processes then send the global indices that were read to the
+ ! processes that own those indices based on
+ ! {send,recv}{Cell,Edge,Vertex,VertLevel}List
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ write(6,*) 'Read and distribute fields'
+ call mpas_read_and_distribute_fields(input_obj)
+
+ call mpas_io_input_finalize(input_obj, domain % dminfo)
+
+ call MPAS_io_close(inputHandle, ierr)
+
+ write(6,*) 'nEdges', domain % blockList % mesh % nEdges
+ write(6,*) 'nEdgesSolve', domain % blockList % mesh % nEdgesSolve
+ write(6,*) 'indexToCellID 1'
+ do i = 1, domain % blockList % mesh % nCells
+ write(6,*) i, domain % blocklist % mesh % indexToCellID % array(i)
+ end do
+ write(6,*) 'edgesOnCell 1'
+ do i = 1, domain % blockList % mesh % nCells
+ write(6,*) i, domain % blocklist % mesh % edgesOnCell % array(:, i)
+ end do
+
+ !
+ ! Exchange halos for all of the fields that were read from the input file
+ !
+ write(6,*) 'halo exchanges'
+ call mpas_exch_input_field_halos(domain, input_obj)
+
+ write(6,*) 'indexToCellID 2'
+ do i = 1, domain % blockList % mesh % nCells
+ write(6,*) i, domain % blocklist % mesh % indexToCellID % array(i)
+ end do
+ write(6,*) 'edgesOnCell 2'
+ do i = 1, domain % blockList % mesh % nCells
+ write(6,*) i, domain % blocklist % mesh % edgesOnCell % array(:, i)
+ end do
+
+ write(6,*) 're-index fields'
+ block_ptr => domain % blocklist
+ do while(associated(block_ptr))
+ !
+ ! Rename vertices in cellsOnCell, edgesOnCell, etc. to local indices
+ !
+ allocate(cellIDSorted(2, block_ptr % mesh % nCells))
+ allocate(edgeIDSorted(2, block_ptr % mesh % nEdges))
+ allocate(vertexIDSorted(2, block_ptr % mesh % nVertices))
+
+ do i=1,block_ptr % mesh % nCells
+ cellIDSorted(1,i) = block_ptr % mesh % indexToCellID % array(i)
+ cellIDSorted(2,i) = i
+ end do
+ call quicksort(block_ptr % mesh % nCells, cellIDSorted)
+
+ do i=1,block_ptr % mesh % nEdges
+ edgeIDSorted(1,i) = block_ptr % mesh % indexToEdgeID % array(i)
+ edgeIDSorted(2,i) = i
+ end do
+ call quicksort(block_ptr % mesh % nEdges, edgeIDSorted)
+
+ do i=1,block_ptr % mesh % nVertices
+ vertexIDSorted(1,i) = block_ptr % mesh % indexToVertexID % array(i)
+ vertexIDSorted(2,i) = i
+ end do
+ call quicksort(block_ptr % mesh % nVertices, vertexIDSorted)
+
+
+ do i=1,block_ptr % mesh % nCells
+ do j=1,block_ptr % mesh % nEdgesOnCell % array(i)
+ k = mpas_binary_search(cellIDSorted, 2, 1, block_ptr % mesh % nCells, &
+ block_ptr % mesh % cellsOnCell % array(j,i))
+ if (k <= block_ptr % mesh % nCells) then
+ block_ptr % mesh % cellsOnCell % array(j,i) = cellIDSorted(2,k)
+ else
+ block_ptr % mesh % cellsOnCell % array(j,i) = block_ptr % mesh % nCells + 1
+ end if
+
+! write(6,*) 'searching for edge', block_ptr % mesh % edgesOnCell % array(j,i)
+ k = mpas_binary_search(edgeIDSorted, 2, 1, block_ptr % mesh % nEdges, &
+ block_ptr % mesh % edgesOnCell % array(j,i))
+ if (k <= block_ptr % mesh % nEdges) then
+ block_ptr % mesh % edgesOnCell % array(j,i) = edgeIDSorted(2,k)
+ else
+! write(6,*) 'Setting',block_ptr % mesh % edgesOnCell % array(j,i),'to',block_ptr % mesh % nEdges + 1
+ block_ptr % mesh % edgesOnCell % array(j,i) = block_ptr % mesh % nEdges + 1
+ end if
+
+ k = mpas_binary_search(vertexIDSorted, 2, 1, block_ptr % mesh % nVertices, &
+ block_ptr % mesh % verticesOnCell % array(j,i))
+ if (k <= block_ptr % mesh % nVertices) then
+ block_ptr % mesh % verticesOnCell % array(j,i) = vertexIDSorted(2,k)
+ else
+ block_ptr % mesh % verticesOnCell % array(j,i) = block_ptr % mesh % nVertices + 1
+ end if
+ end do
+ end do
+
+ do i=1,block_ptr % mesh % nEdges
+ do j=1,2
+
+ k = mpas_binary_search(cellIDSorted, 2, 1, block_ptr % mesh % nCells, &
+ block_ptr % mesh % cellsOnEdge % array(j,i))
+ if (k <= block_ptr % mesh % nCells) then
+ block_ptr % mesh % cellsOnEdge % array(j,i) = cellIDSorted(2,k)
+ else
+ block_ptr % mesh % cellsOnEdge % array(j,i) = block_ptr % mesh % nCells + 1
+ end if
+
+ k = mpas_binary_search(vertexIDSorted, 2, 1, block_ptr % mesh % nVertices, &
+ block_ptr % mesh % verticesOnEdge % array(j,i))
+ if (k <= block_ptr % mesh % nVertices) then
+ block_ptr % mesh % verticesOnEdge % array(j,i) = vertexIDSorted(2,k)
+ else
+ block_ptr % mesh % verticesOnEdge % array(j,i) = block_ptr % mesh % nVertices + 1
+ end if
+
+ end do
+
+ do j=1,block_ptr % mesh % nEdgesOnEdge % array(i)
+
+ k = mpas_binary_search(edgeIDSorted, 2, 1, block_ptr % mesh % nEdges, &
+ block_ptr % mesh % edgesOnEdge % array(j,i))
+ if (k <= block_ptr % mesh % nEdges) then
+ block_ptr % mesh % edgesOnEdge % array(j,i) = edgeIDSorted(2,k)
+ else
+ block_ptr % mesh % edgesOnEdge % array(j,i) = block_ptr % mesh % nEdges + 1
+ end if
+
+ end do
+ end do
+
+ do i=1,block_ptr % mesh % nVertices
+ do j=1,vertexDegree
+
+ k = mpas_binary_search(cellIDSorted, 2, 1, block_ptr % mesh % nCells, &
+ block_ptr % mesh % cellsOnVertex % array(j,i))
+ if (k <= block_ptr % mesh % nCells) then
+ block_ptr % mesh % cellsOnVertex % array(j,i) = cellIDSorted(2,k)
+ else
+ block_ptr % mesh % cellsOnVertex % array(j,i) = block_ptr % mesh % nCells + 1
+ end if
+
+ k = mpas_binary_search(edgeIDSorted, 2, 1, block_ptr % mesh % nEdges, &
+ block_ptr % mesh % edgesOnVertex % array(j,i))
+ if (k <= block_ptr % mesh % nEdges) then
+ block_ptr % mesh % edgesOnVertex % array(j,i) = edgeIDSorted(2,k)
+ else
+ block_ptr % mesh % edgesOnVertex % array(j,i) = block_ptr % mesh % nEdges + 1
+ end if
+
+ end do
+ end do
+
+ deallocate(cellIDSorted)
+ deallocate(edgeIDSorted)
+ deallocate(vertexIDSorted)
+
+ block_ptr => block_ptr % next
+ end do
+
+ write(6,*) 'edgesOnCell 3'
+ do i = 1, domain % blockList % mesh % nCells
+ write(6,*) i, domain % blocklist % mesh % edgesOnCell % array(:, i)
+ end do
+
+ call mpas_deallocate_field(indexToCellIDField)
+ call mpas_deallocate_field(indexToEdgeIDField)
+ call mpas_deallocate_field(indexToVertexIDField)
+ call mpas_deallocate_field(cellsOnCellField)
+
+ call mpas_deallocate_field(edgesOnCellField)
+ call mpas_deallocate_field(verticesOnCellField)
+ call mpas_deallocate_field(cellsOnEdgeField)
+ call mpas_deallocate_field(cellsOnVertexField)
+
+ call mpas_deallocate_field(indexToCellID_0Halo)
+ call mpas_deallocate_field(nEdgesOnCell_0Halo)
+ call mpas_deallocate_field(cellsOnCell_0Halo)
+ call mpas_deallocate_field(verticesOnCell_0Halo)
+ call mpas_deallocate_field(edgesOnCell_0Halo)
+ call mpas_deallocate_field(indexToVertexID_0Halo)
+ call mpas_deallocate_field(cellsOnVertex_0Halo)
+ call mpas_deallocate_field(indexToEdgeID_0Halo)
+ call mpas_deallocate_field(cellsOnEdge_0Halo)
+
+ call mpas_deallocate_field(nCellsSolveField)
+ call mpas_deallocate_field(nVerticesSolveField)
+ call mpas_deallocate_field(nEdgesSolveField)
+
+ deallocate(local_cell_list)
+ deallocate(block_id)
+ deallocate(block_start)
+ deallocate(block_count)
+
+! write(6,*) 'Stopping'
+! stop
+
#ifdef HAVE_ZOLTAN
#ifdef _MPI
! allocate(xCell(size(local_cell_list)))
@@ -827,41 +1053,6 @@
#endif
#endif
-
-! deallocate(sendCellList % list)
-! deallocate(sendCellList)
-! deallocate(recvCellList % list)
-! deallocate(recvCellList)
-
-! call mpas_get_vertex_ids_and_exchange_lists(domain % dminfo, nHalos, maxEdges, vertexDegree, indexToCellID_0Halo, nEdgesOnCell_0Halo
-
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
-! write(6,*) 'block id = ', block_ptr % blockID
-! do i = 1, nHalos
-! write(6,*) 'sendList on halo layer', i
-! sendListPtr => block_ptr % parinfo % cellsToSend(i)
-! do while(associated(sendListPtr))
-! write(6,*) sendListPtr % procID, sendListPtr % blockID, sendListPtr % nList
-! sendListPtr => sendListPtr % next
-! end do
-! write(6,*) 'recvList on halo layer', i
-! recvListPtr => block_ptr % parinfo % cellsToRecv(i)
-! do while(associated(recvListPtr))
-! write(6,*) recvListPtr % procID, recvListPtr % blockID, recvListPtr % nList
-! recvListPtr => recvListPtr % next
-! end do
-! write(6,*) 'copyList on halo layer', i
-! copyListPtr => block_ptr % parinfo % cellsToCopy(i)
-! do while(associated(copyListPtr))
-! write(6,*) copyListPtr % procID, copyListPtr % blockID, copyListPtr % nList
-! copyListPtr => copyListPtr % next
-! end do
-
-! end do
-! block_ptr => block_ptr % next
-! end do
-
!#ifdef HAVE_ZOLTAN
!#ifdef _MPI
! !! For now, only use Zoltan with MPI
@@ -873,171 +1064,7 @@
!#endif
!#endif
!
-! ! Knowing which cells are in block and the 2-halo, we can exchange lists of which edges are
-! ! on each cell and which vertices are on each cell from the processes that read these
-! ! fields for each cell to the processes that own the cells
-! !
-! allocate(nEdgesOnCell_2Halo(block_graph_2Halo % nVerticesTotal))
-! allocate(edgesOnCell_2Halo(maxEdges, block_graph_2Halo % nVerticesTotal))
-! allocate(verticesOnCell_2Halo(maxEdges, block_graph_2Halo % nVerticesTotal))
!
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToCellIDField % array), block_graph_2Halo % nVerticesTotal, &
-! indexToCellIDField % array, block_graph_2Halo % vertexID, &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, nEdgesOnCellField % array, nEdgesOnCell_2Halo, &
-! size(indexToCellIDField % array), size(local_cell_list), &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, edgesOnCellField % array, edgesOnCell_2Halo, &
-! maxEdges, nReadCells, block_graph_2Halo % nVerticesTotal, &
-! sendCellList, recvCellList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, verticesOnCellField % array, verticesOnCell_2Halo, &
-! maxEdges, nReadCells, block_graph_2Halo % nVerticesTotal, &
-! sendCellList, recvCellList)
-!
-!
-! !
-! ! Get a list of which edges and vertices are adjacent to cells (including halo cells) in block
-! !
-! call mpas_block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &
-! edgesOnCell_2Halo, nlocal_edges, local_edge_list)
-! call mpas_block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &
-! verticesOnCell_2Halo, nlocal_vertices, local_vertex_list)
-!
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToEdgeIDField % array), nlocal_edges, &
-! indexToEdgeIDField % array, local_edge_list, &
-! sendEdgeList, recvEdgeList)
-!
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToVertexIDField % array), nlocal_vertices, &
-! indexToVertexIDField % array, local_vertex_list, &
-! sendVertexList, recvVertexList)
-!
-!
-!
-! !
-! ! Work out which edges and vertices are owned by this process, and which are ghost
-! !
-! allocate(cellsOnEdge_2Halo(2,nlocal_edges))
-! allocate(cellsOnVertex_2Halo(vertexDegree,nlocal_vertices))
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnEdgeField % array, cellsOnEdge_2Halo, &
-! 2, size(cellsOnEdgeField % array, 2), nlocal_edges, &
-! sendEdgeList, recvEdgeList)
-!
-! call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnVertexField % array, cellsOnVertex_2Halo, &
-! vertexDegree, size(cellsOnVertexField % array, 2), nlocal_vertices, &
-! sendVertexList, recvVertexList)
-!
-!
-! call mpas_block_decomp_partitioned_edge_list(nOwnCells, &
-! block_graph_2Halo % vertexID(1:nOwnCells), &
-! 2, nlocal_edges, cellsOnEdge_2Halo, local_edge_list, ghostEdgeStart)
-!
-! call mpas_block_decomp_partitioned_edge_list(nOwnCells, &
-! block_graph_2Halo % vertexID(1:nOwnCells), &
-! vertexDegree, nlocal_vertices, cellsOnVertex_2Halo, local_vertex_list, ghostVertexStart)
-!
-! !------- set owned and halo cell indices -------!
-!
-! nCellsCumulative(1) = nOwnCells
-! nCellsCumulative(2) = block_graph_1Halo % nVerticesTotal
-! nCellsCumulative(3) = block_graph_2Halo % nVerticesTotal
-!
-! !------- determin the perimeter and owned edges of own cells and halos -------!
-!
-! nOwnEdges = ghostEdgeStart-1
-! nOwnVertices = ghostVertexStart-1
-!
-! ! skip the own edges found at the beginning of local_edge_list
-! call mpas_hash_init(edgeHash)
-! do i=1,nOwnEdges
-! call mpas_hash_insert(edgeHash, local_edge_list(i))
-! end do
-!
-! ! skip the own vertices found at the beginning of local_vertex_list
-! call mpas_hash_init(vertexHash)
-! do i=1,nOwnVertices
-! call mpas_hash_insert(vertexHash, local_vertex_list(i))
-! end do
-!
-! cellCount = 1 !tracks the index of the local cell array
-! edgeCount = nOwnEdges !tracks where to insert the next local edge
-! vertexCount = nOwnVertices !tracks where to insert the next local vertex
-!
-! nEdgesCumulative(1) = nOwnEdges
-! nVerticesCumulative(1) = nOwnVertices
-!
-! !Order the local_edge_list and local_vertex_list accordingly and set the bounds of each perimeter ----
-! do i = 1, nHalos + 1 ! for the own cells and each halo...
-! do j = cellCount, nCellsCumulative(i)
-!
-! ! the number of edges on a cell is same to the number of vertices, and therefore
-! ! nEdgesOnCell_2Halo(j) will be the correct upper bound for both both edges and vertices on cell
-! do k = 1, nEdgesOnCell_2Halo(j)
-! iEdge = edgesOnCell_2Halo(k,j)
-! if (.not. mpas_hash_search(edgeHash, iEdge)) then
-! edgeCount = edgeCount + 1
-! local_edge_list(edgeCount) = iEdge
-! call mpas_hash_insert(edgeHash, iEdge)
-! end if
-!
-! iVertex = verticesOnCell_2Halo(k,j)
-! if (.not. mpas_hash_search(vertexHash, iVertex)) then
-! vertexCount = vertexCount + 1
-! local_vertex_list(vertexCount) = iVertex
-! call mpas_hash_insert(vertexHash, iVertex)
-! end if
-! end do
-!
-! end do
-!
-! cellCount = nCellsCumulative(i) + 1
-! nEdgesCumulative(i+1) = edgeCount
-! nVerticesCumulative(i+1) = vertexCount
-! end do
-!
-! do i = 1, nHalos
-! nCellsHalo(i) = nCellsCumulative(i+1) - nCellsCumulative(i)
-! end do
-!
-! do i = 1, nHalos + 1
-! nEdgesHalo(i) = nEdgesCumulative(i+1) - nEdgesCumulative(i)
-! end do
-!
-! do i = 1, nHalos + 1
-! nVerticesHalo(i) = nVerticesCumulative(i+1) - nVerticesCumulative(i)
-! end do
-!
-! call mpas_hash_destroy(edgeHash)
-! call mpas_hash_destroy(vertexHash)
-!
-!
-! ! At this point, local_edge_list(1:nOwnEdges) contains all of the owned edges for this block
-! ! and local_edge_list(ghostEdgeStart:nlocal_edges) contains all of the ghost edges
-!
-! ! At this point, local_vertex_list(1;ghostVertexStart-1) contains all of the owned vertices for this block
-! ! and local_vertex_list(ghostVertexStart:nlocal_vertices) contains all of the ghost vertices
-!
-! ! Also, at this point, block_graph_2Halo % vertexID(1:block_graph_2Halo%nVertices) contains all of the owned
-! ! cells for this block, and block_graph_2Halo % vertexID(block_graph_2Halo%nVertices+1:block_graph_2Halo%nVerticesTotal)
-! ! contains all of the ghost cells
-!
-!
-! deallocate(sendEdgeList % list)
-! deallocate(sendEdgeList)
-! deallocate(recvEdgeList % list)
-! deallocate(recvEdgeList)
-!
-! deallocate(sendVertexList % list)
-! deallocate(sendVertexList)
-! deallocate(recvVertexList % list)
-! deallocate(recvVertexList)
-!
!#ifdef HAVE_ZOLTAN
!#ifdef _MPI
! allocate(xEdge(nlocal_edges))
@@ -1049,22 +1076,6 @@
!#endif
!#endif
!
-! !
-! ! Knowing which edges/vertices are owned by this block and which are actually read
-! ! from the input or restart file, we can build exchange lists to perform
-! ! all-to-all field exchanges from process that reads a field to the processes that
-! ! need them
-! !
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToEdgeIDField % array), nlocal_edges, &
-! indexToEdgeIDField % array, local_edge_list, &
-! sendEdgeList, recvEdgeList)
-!
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(indexToVertexIDField % array), nlocal_vertices, &
-! indexToVertexIDField % array, local_vertex_list, &
-! sendVertexList, recvVertexList)
-!
!#ifdef HAVE_ZOLTAN
!#ifdef _MPI
! call mpas_dmpar_alltoall_field(domain % dminfo, xEdgeField % array, xEdge, &
@@ -1127,365 +1138,11 @@
!#endif
!#endif
!
-! !
-! ! Build ownership and exchange lists for vertical levels
-! ! Essentially, process 0 owns all vertical levels when reading and writing,
-! ! and it distributes them or gathers them to/from all other processes
-! !
-! if (domain % dminfo % my_proc_id == 0) then
-! allocate(local_vertlevel_list(nVertLevels))
-! do i=1,nVertLevels
-! local_vertlevel_list(i) = i
-! end do
-! else
-! allocate(local_vertlevel_list(0))
-! end if
-! allocate(needed_vertlevel_list(nVertLevels))
-! do i=1,nVertLevels
-! needed_vertlevel_list(i) = i
-! end do
-!
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! size(local_vertlevel_list), size(needed_vertlevel_list), &
-! local_vertlevel_list, needed_vertlevel_list, &
-! sendVertLevelList, recvVertLevelList)
-!
-! deallocate(local_vertlevel_list)
-! deallocate(needed_vertlevel_list)
-!
-!
-! !
-! ! Read and distribute all fields given ownership lists and exchange lists (maybe already in block?)
-! !
-! allocate(domain % blocklist)
-!
-! nCells = block_graph_2Halo % nVerticesTotal
-! nEdges = nlocal_edges
-! nVertices = nlocal_vertices
-!
-! call mpas_allocate_block(nHalos, domain % blocklist, domain, domain%dminfo%my_proc_id, &
-!#include "dim_dummy_args.inc"
-! )
-!
-!!!!!!!!!!!MGD HERE WE NEED TO READ IN indexTo*ID fields !!!!!!!!!!!!!!!!!
-! call MPAS_io_inq_var(inputHandle, 'indexToCellID', ierr=ierr)
-! call MPAS_io_set_var_indices(inputHandle, 'indexToCellID', local_cell_list(1:nOwnCells), ierr=ierr)
-! call mpas_io_get_var(inputHandle, 'indexToCellID', domain % blocklist % mesh % indexToCellID % array, ierr)
-!
-! call MPAS_io_inq_var(inputHandle, 'indexToEdgeID', ierr=ierr)
-! call MPAS_io_set_var_indices(inputHandle, 'indexToEdgeID', local_edge_list(1:nOwnEdges), ierr=ierr)
-! call mpas_io_get_var(inputHandle, 'indexToEdgeID', domain % blocklist % mesh % indexToEdgeID % array, ierr)
-!
-! call MPAS_io_inq_var(inputHandle, 'indexToVertexID', ierr=ierr)
-! call MPAS_io_set_var_indices(inputHandle, 'indexToVertexID', local_vertex_list(1:nOwnVertices), ierr=ierr)
-! call mpas_io_get_var(inputHandle, 'indexToVertexID', domain % blocklist % mesh % indexToVertexID % array, ierr)
-!
-! domain % blocklist % mesh % nCellsSolve = nOwnCells
-! domain % blocklist % mesh % nEdgesSolve = nOwnEdges
-! domain % blocklist % mesh % nVerticesSolve = nOwnVertices
-! domain % blocklist % mesh % nVertLevelsSolve = domain % blocklist % mesh % nVertLevels ! No vertical decomp yet...
-!
-! call mpas_io_input_init(input_obj, domain % blocklist, domain % dminfo)
-!
-!
-! !
-! ! Read attributes
-! !
-! call MPAS_readStreamAtt(input_obj % io_stream, 'sphere_radius', r_sphere_radius, ierr)
-! if (ierr /= MPAS_STREAM_NOERR) then
-! write(0,*) 'Warning: Attribute sphere_radius not found in '//trim(input_obj % filename)
-! write(0,*) ' Setting sphere_radius to 1.0'
-! domain % blocklist % mesh % sphere_radius = 1.0
-! else
-! domain % blocklist % mesh % sphere_radius = r_sphere_radius
-! end if
-!
-! call MPAS_readStreamAtt(input_obj % io_stream, 'on_a_sphere', c_on_a_sphere, ierr)
-! if (ierr /= MPAS_STREAM_NOERR) then
-! write(0,*) 'Warning: Attribute on_a_sphere not found in '//trim(input_obj % filename)
-! write(0,*) ' Setting on_a_sphere to ''YES'''
-! domain % blocklist % mesh % on_a_sphere = .true.
-! else
-! if (index(c_on_a_sphere, 'YES') /= 0) then
-! domain % blocklist % mesh % on_a_sphere = .true.
-! else
-! domain % blocklist % mesh % on_a_sphere = .false.
-! end if
-! end if
-!
-! if (.not. config_do_restart) then
-! input_obj % time = 1
-! else
-! !
-! ! If doing a restart, we need to decide which time slice to read from the
-! ! restart file
-! !
-! input_obj % time = MPAS_seekStream(input_obj % io_stream, config_start_time, MPAS_STREAM_EXACT_TIME, timeStamp, ierr)
-! if (ierr == MPAS_IO_ERR) then
-! write(0,*) 'Error: restart file '//trim(filename)//' did not contain time '//trim(config_start_time)
-! call mpas_dmpar_abort(domain % dminfo)
-! end if
-!write(0,*) 'MGD DEBUGGING time = ', input_obj % time
-! write(0,*) 'Restarting model from time ', timeStamp
-!
-! end if
-!
-!
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! ! Do the actual work of reading all fields in from the input or restart file
-! ! For each field:
-! ! 1) Each process reads a contiguous range of cell/edge/vertex indices, which
-! ! may not correspond with the cells/edges/vertices that are owned by the
-! ! process
-! ! 2) All processes then send the global indices that were read to the
-! ! processes that own those indices based on
-! ! {send,recv}{Cell,Edge,Vertex,VertLevel}List
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! call mpas_read_and_distribute_fields(input_obj)
-!
-! call mpas_io_input_finalize(input_obj, domain % dminfo)
-!
-! call MPAS_io_close(inputHandle, ierr)
-!
-!
-! !
-! ! Work out halo exchange lists for cells, edges, and vertices
-! ! NB: The next pointer in each element of, e.g., cellsToSend, acts as the head pointer of
-! ! the list, since Fortran does not allow arrays of pointers
-! !
-!
-! !--------- Create Cell Exchange Lists ---------!
-!
-! ! pass in neededList of ownedCells and halo layer 1 cells
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnCells, nCellsCumulative(2), &
-! block_graph_2Halo % vertexID(1:nOwnCells), block_graph_2Halo % vertexID(1 : nCellsCumulative(2)), &
-! domain % blocklist % parinfo % cellsToSend(1) % next, domain % blocklist % parinfo % cellsToRecv(1) % next)
-!
-! ! pass in neededList of ownedCells and halo layer 2 cells; offset of number of halo 1 cells is required
-! offset = nCellsHalo(1)
-! nTempIDs = nOwnCells + nCellsHalo(2)
-! allocate(tempIDs(nTempIDs))
-! tempIDs(1:nOwnCells) = block_graph_2Halo % vertexID(1:nOwnCells)
-! tempIDs(nOwnCells+1:nTempIDs) = block_graph_2Halo % vertexID(nCellsCumulative(2)+1 : nCellsCumulative(3))
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnCells, nTempIDs, &
-! block_graph_2Halo % vertexID(1:nOwnCells), tempIDs, &
-! domain % blocklist % parinfo % cellsToSend(2) % next, domain % blocklist % parinfo % cellsToRecv(2) % next, &
-! offset)
-! deallocate(tempIDs)
-!
-!
-! !--------- Create Edge Exchange Lists ---------!
-!
-! ! pass in neededList of ownedEdges and ownedCell perimeter edges
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnEdges, nEdgesCumulative(2), &
-! local_edge_list(1:nOwnEdges), local_edge_list(1 : nEdgesCumulative(2)), &
-! domain % blocklist % parinfo % edgesToSend(1) % next, domain % blocklist % parinfo % edgesToRecv(1) % next)
-!
-! ! pass in neededList of owned edges and yet-to-be-included edges from halo 1 cells; offset of number of ownedCell perimeter edges is required
-! offset = nEdgesHalo(1)
-! nTempIDs = nOwnEdges + nEdgesHalo(2)
-! allocate(tempIDs(nTempIDs))
-! tempIDs(1:nOwnEdges) = local_edge_list(1:nOwnEdges)
-! tempIDs(nOwnEdges+1:nTempIDs) = local_edge_list(nEdgesCumulative(2)+1 : nEdgesCumulative(3))
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnEdges, nTempIDs, &
-! local_edge_list(1:nOwnEdges), tempIDs, &
-! domain % blocklist % parinfo % edgesToSend(2) % next, domain % blocklist % parinfo % edgesToRecv(2) % next, &
-! offset)
-! deallocate(tempIDs)
-!
-! ! pass in neededList of owned edges and yet-to-be-included edges from halo 2 cells; offset of number of ownedCell perimeter edges and halo 1 edges is required
-! offset = nEdgesHalo(1) + nEdgesHalo(2)
-! nTempIDs = nOwnEdges + nEdgesHalo(3)
-! allocate(tempIDs(nTempIDs))
-! tempIDs(1:nOwnEdges) = local_edge_list(1:nOwnEdges)
-! tempIDs(nOwnEdges+1:nTempIDs) = local_edge_list(nEdgesCumulative(3)+1 : nEdgesCumulative(4))
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnEdges, nTempIDs, &
-! local_edge_list(1:nOwnEdges), tempIDs, &
-! domain % blocklist % parinfo % edgesToSend(3) % next, domain % blocklist % parinfo % edgesToRecv(3) % next, &
-! offset)
-! deallocate(tempIDs)
-!
-!
-! !--------- Create Vertex Exchange Lists ---------!
-!
-!
-! ! pass in neededList of ownedVertices and ownedCell perimeter vertices
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnVertices, nVerticesCumulative(2), &
-! local_vertex_list(1:nOwnVertices), local_vertex_list(1 : nVerticesCumulative(2)), &
-! domain % blocklist % parinfo % verticesToSend(1) % next, domain % blocklist % parinfo % verticesToRecv(1) % next)
-!
-! ! pass in neededList of owned vertices and yet-to-be-included vertices from halo 1 cells; offset of number of ownedCell perimeter vertices is required
-! offset = nVerticesHalo(1)
-! nTempIDs = nOwnVertices + nVerticesHalo(2)
-! allocate(tempIDs(nTempIDs))
-! tempIDs(1:nOwnVertices) = local_vertex_list(1:nOwnVertices)
-! tempIDs(nOwnVertices+1:nTempIDs) = local_vertex_list(nVerticesCumulative(2)+1 : nVerticesCumulative(3))
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnVertices, nTempIDs, &
-! local_vertex_list(1:nOwnVertices), tempIDs, &
-! domain % blocklist % parinfo % verticesToSend(2) % next, domain % blocklist % parinfo % verticesToRecv(2) % next, &
-! offset)
-! deallocate(tempIDs)
-!
-! ! pass in neededList of owned vertices and yet-to-be-included vertices from halo 2 cells; offset of number of ownedCell perimeter vertices and halo 1 vertices is required
-! offset = nVerticesHalo(1) + nVerticesHalo(2)
-! nTempIDs = nOwnVertices + nVerticesHalo(3)
-! allocate(tempIDs(nTempIDs))
-! tempIDs(1:nOwnVertices) = local_vertex_list(1:nOwnVertices)
-! tempIDs(nOwnVertices+1:nTempIDs) = local_vertex_list(nVerticesCumulative(3)+1 : nVerticesCumulative(4))
-! call mpas_dmpar_get_owner_list(domain % dminfo, &
-! nOwnVertices, nTempIDs, &
-! local_vertex_list(1:nOwnVertices), tempIDs, &
-! domain % blocklist % parinfo % verticesToSend(3) % next, domain % blocklist % parinfo % verticesToRecv(3) % next, &
-! offset)
-! deallocate(tempIDs)
-!
-!
-! domain % blocklist % mesh % nCellsSolve = nOwnCells
-! domain % blocklist % mesh % nEdgesSolve = nOwnEdges
-! domain % blocklist % mesh % nVerticesSolve = ghostVertexStart-1
-! domain % blocklist % mesh % nVertLevelsSolve = domain % blocklist % mesh % nVertLevels ! No vertical decomp yet...
-!
-! ! 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
-! call mpas_create_field_links(domain % blocklist)
-!
-!
-! !
-! ! Exchange halos for all of the fields that were read from the input file
-! !
-! call mpas_exch_input_field_halos(domain, input_obj)
-!
-!
-! !
-! ! Rename vertices in cellsOnCell, edgesOnCell, etc. to local indices
-! !
-! allocate(cellIDSorted(2,domain % blocklist % mesh % nCells))
-! allocate(edgeIDSorted(2,domain % blocklist % mesh % nEdges))
-! allocate(vertexIDSorted(2,domain % blocklist % mesh % nVertices))
-!
-! do i=1,domain % blocklist % mesh % nCells
-! cellIDSorted(1,i) = domain % blocklist % mesh % indexToCellID % array(i)
-! cellIDSorted(2,i) = i
-! end do
-! call quicksort(block_graph_2Halo % nVerticesTotal, cellIDSorted)
-!
-! do i=1,domain % blocklist % mesh % nEdges
-! edgeIDSorted(1,i) = domain % blocklist % mesh % indexToEdgeID % array(i)
-! edgeIDSorted(2,i) = i
-! end do
-! call quicksort(nlocal_edges, edgeIDSorted)
-!
-! do i=1,domain % blocklist % mesh % nVertices
-! vertexIDSorted(1,i) = domain % blocklist % mesh % indexToVertexID % array(i)
-! vertexIDSorted(2,i) = i
-! end do
-! call quicksort(nlocal_vertices, vertexIDSorted)
-!
-!
-! do i=1,domain % blocklist % mesh % nCells
-! do j=1,domain % blocklist % mesh % nEdgesOnCell % array(i)
-!
-! k = mpas_binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &
-! domain % blocklist % mesh % cellsOnCell % array(j,i))
-! if (k <= domain % blocklist % mesh % nCells) then
-! domain % blocklist % mesh % cellsOnCell % array(j,i) = cellIDSorted(2,k)
-! else
-! domain % blocklist % mesh % cellsOnCell % array(j,i) = domain % blocklist % mesh % nCells + 1
-! end if
-!
-! k = mpas_binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &
-! domain % blocklist % mesh % edgesOnCell % array(j,i))
-! if (k <= domain % blocklist % mesh % nEdges) then
-! domain % blocklist % mesh % edgesOnCell % array(j,i) = edgeIDSorted(2,k)
-! else
-! domain % blocklist % mesh % edgesOnCell % array(j,i) = domain % blocklist % mesh % nEdges + 1
-! end if
-!
-! k = mpas_binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &
-! domain % blocklist % mesh % verticesOnCell % array(j,i))
-! if (k <= domain % blocklist % mesh % nVertices) then
-! domain % blocklist % mesh % verticesOnCell % array(j,i) = vertexIDSorted(2,k)
-! else
-! domain % blocklist % mesh % verticesOnCell % array(j,i) = domain % blocklist % mesh % nVertices + 1
-! end if
-!
-! end do
-! end do
-!
-! do i=1,domain % blocklist % mesh % nEdges
-! do j=1,2
-!
-! k = mpas_binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &
-! domain % blocklist % mesh % cellsOnEdge % array(j,i))
-! if (k <= domain % blocklist % mesh % nCells) then
-! domain % blocklist % mesh % cellsOnEdge % array(j,i) = cellIDSorted(2,k)
-! else
-! domain % blocklist % mesh % cellsOnEdge % array(j,i) = domain % blocklist % mesh % nCells + 1
-! end if
-!
-! k = mpas_binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &
-! domain % blocklist % mesh % verticesOnEdge % array(j,i))
-! if (k <= domain % blocklist % mesh % nVertices) then
-! domain % blocklist % mesh % verticesOnEdge % array(j,i) = vertexIDSorted(2,k)
-! else
-! domain % blocklist % mesh % verticesOnEdge % array(j,i) = domain % blocklist % mesh % nVertices + 1
-! end if
-!
-! end do
-!
-! do j=1,domain % blocklist % mesh % nEdgesOnEdge % array(i)
-!
-! k = mpas_binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &
-! domain % blocklist % mesh % edgesOnEdge % array(j,i))
-! if (k <= domain % blocklist % mesh % nEdges) then
-! domain % blocklist % mesh % edgesOnEdge % array(j,i) = edgeIDSorted(2,k)
-! else
-! domain % blocklist % mesh % edgesOnEdge % array(j,i) = domain % blocklist % mesh % nEdges + 1
-! end if
-!
-! end do
-! end do
-!
-! do i=1,domain % blocklist % mesh % nVertices
-! do j=1,vertexDegree
-!
-! k = mpas_binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &
-! domain % blocklist % mesh % cellsOnVertex % array(j,i))
-! if (k <= domain % blocklist % mesh % nCells) then
-! domain % blocklist % mesh % cellsOnVertex % array(j,i) = cellIDSorted(2,k)
-! else
-! domain % blocklist % mesh % cellsOnVertex % array(j,i) = domain % blocklist % mesh % nCells + 1
-! end if
-!
-! k = mpas_binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &
-! domain % blocklist % mesh % edgesOnVertex % array(j,i))
-! if (k <= domain % blocklist % mesh % nEdges) then
-! domain % blocklist % mesh % edgesOnVertex % array(j,i) = edgeIDSorted(2,k)
-! else
-! domain % blocklist % mesh % edgesOnVertex % array(j,i) = domain % blocklist % mesh % nEdges + 1
-! end if
-!
-! end do
-! end do
-! deallocate(cellIDSorted)
-! deallocate(edgeIDSorted)
-! deallocate(vertexIDSorted)
-!
-!
+
! !
! ! Deallocate fields, graphs, and other memory
! !
-! deallocate(indexToCellIDField % ioinfo)
-! deallocate(indexToCellIDField % array)
!#ifdef HAVE_ZOLTAN
!#ifdef _MPI
! deallocate(xCellField % ioinfo)
@@ -1496,31 +1153,7 @@
! deallocate(zCellField % array)
!#endif
!#endif
-! deallocate(indexToEdgeIDField % ioinfo)
-! deallocate(indexToEdgeIDField % array)
-! deallocate(indexToVertexIDField % ioinfo)
-! deallocate(indexToVertexIDField % array)
-! deallocate(cellsOnCellField % ioinfo)
-! deallocate(cellsOnCellField % array)
-! deallocate(edgesOnCellField % ioinfo)
-! deallocate(edgesOnCellField % array)
-! deallocate(verticesOnCellField % ioinfo)
-! deallocate(verticesOnCellField % array)
-! deallocate(cellsOnEdgeField % ioinfo)
-! deallocate(cellsOnEdgeField % array)
-! deallocate(cellsOnVertexField % ioinfo)
-! deallocate(cellsOnVertexField % array)
-! deallocate(cellsOnCell_0Halo)
-! deallocate(nEdgesOnCell_0Halo)
-! deallocate(indexToCellID_0Halo)
-! deallocate(cellsOnEdge_2Halo)
-! deallocate(cellsOnVertex_2Halo)
-! deallocate(nEdgesOnCell_2Halo)
-! deallocate(edgesOnCell_2Halo)
-! deallocate(verticesOnCell_2Halo)
-! deallocate(block_graph_0Halo % vertexID)
-! deallocate(block_graph_0Halo % nAdjacent)
-! deallocate(block_graph_0Halo % adjacencyList)
+
!#ifdef HAVE_ZOLTAN
!#ifdef _MPI
! deallocate(xCell)
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_io_output.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_io_output.F 2012-05-30 18:32:23 UTC (rev 1948)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_output.F 2012-05-30 21:23:35 UTC (rev 1949)
@@ -22,8 +22,7 @@
contains
-
- subroutine mpas_output_state_init(output_obj, domain, stream, outputSuffix)
+ subroutine mpas_output_state_init(output_obj, domain, stream, outputSuffix)!{{{
implicit none
@@ -66,11 +65,10 @@
block_ptr % mesh &
)
- end subroutine mpas_output_state_init
+ end subroutine mpas_output_state_init!}}}
+ subroutine mpas_insert_string_suffix(stream, suffix, filename)!{{{
- subroutine mpas_insert_string_suffix(stream, suffix, filename)
-
implicit none
character (len=*), intent(in) :: stream
@@ -92,10 +90,9 @@
if (filename(i:i) == ':') filename(i:i) = '.'
end do
- end subroutine mpas_insert_string_suffix
+ end subroutine mpas_insert_string_suffix!}}}
-
- subroutine mpas_output_state_for_domain(output_obj, domain, itime)
+ subroutine mpas_output_state_for_domain(output_obj, domain, itime)!{{{
implicit none
@@ -205,7 +202,7 @@
block_ptr % mesh % cellsOnVertex % array(j,i) = block_ptr % mesh % indexToCellID % array(block_ptr % mesh % cellsOnVertex % array(j,i))
edgesOnVertex1_ptr % array(j,i) = block_ptr % mesh % edgesOnVertex % array(j,i)
- block_ptr % mesh % edgesOnVertex % array(j,i) = block_ptr % mesh % indexToCellID % array(block_ptr % mesh % edgesOnVertex % array(j,i))
+ block_ptr % mesh % edgesOnVertex % array(j,i) = block_ptr % mesh % indexToEdgeID % array(block_ptr % mesh % edgesOnVertex % array(j,i))
end do
end do
@@ -230,6 +227,15 @@
cellsOnVertex1_ptr => cellsOnVertex1_ptr % next
edgesOnVertex1_ptr => edgesOnVertex1_ptr % next
end if
+ nullify(cellsOnCell1_ptr % next)
+ nullify(edgesonCell1_ptr % next)
+ nullify(verticesOnCell1_ptr % next)
+ nullify(cellsOnEdge1_ptr % next)
+ nullify(verticesOnEdge1_ptr % next)
+ nullify(edgesOnEdge1_ptr % next)
+ nullify(cellsOnVertex1_ptr % next)
+ nullify(edgesOnVertex1_ptr % next)
+
end do
! Write output file
@@ -319,11 +325,10 @@
end if
end do
- end subroutine mpas_output_state_for_domain
+ end subroutine mpas_output_state_for_domain!}}}
+ subroutine mpas_output_state_finalize(output_obj, dminfo)!{{{
- subroutine mpas_output_state_finalize(output_obj, dminfo)
-
implicit none
type (io_output_object), intent(inout) :: output_obj
@@ -331,10 +336,9 @@
call mpas_io_output_finalize(output_obj, dminfo)
- end subroutine mpas_output_state_finalize
+ end subroutine mpas_output_state_finalize!}}}
-
- subroutine mpas_io_output_init( domain, output_obj, &
+ subroutine mpas_io_output_init( domain, output_obj, &!{{{
dminfo, &
mesh &
)
@@ -362,10 +366,9 @@
#include "add_output_atts.inc"
- end subroutine mpas_io_output_init
+ end subroutine mpas_io_output_init!}}}
-
- subroutine mpas_io_output_finalize(output_obj, dminfo)
+ subroutine mpas_io_output_finalize(output_obj, dminfo)!{{{
implicit none
@@ -376,6 +379,6 @@
call MPAS_closeStream(output_obj % io_stream, nferr)
- end subroutine mpas_io_output_finalize
+ end subroutine mpas_io_output_finalize!}}}
end module mpas_io_output
</font>
</pre>