<p><b>dwj07@fsu.edu</b> 2012-06-07 09:30:13 -0600 (Thu, 07 Jun 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Cleaning up debug write statements.<br>
<br>
Creating routines to initialize and deallocate provisional state within each block.<br>
Cleaning up the way rk4 solvers in ocean and shallow water cores handle provisional states.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/multiple_blocks/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-06-07 15:30:13 UTC (rev 1971)
@@ -93,31 +93,8 @@
real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp
real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
+ call mpas_setup_provis_states(domain % blocklist)
- block => domain % blocklist
- do while(associated(block))
- allocate(block % provis)
- call mpas_allocate_state(block, block % provis, &
- block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &
- block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels )
-
- block => block % next
- end do
-
- block => domain % blocklist
- do while(associated(block))
- if(associated(block % prev) .and. associated(block % next)) then
- call mpas_create_state_links(block % provis, prev = block % prev % provis, next = block % next % provis)
- else if(associated(block % prev)) then
- call mpas_create_state_links(block % provis, prev = block % prev % provis)
- else if(associated(block % next)) then
- call mpas_create_state_links(block % provis, next = block % next % provis)
- else
- call mpas_create_state_links(block % provis)
- end if
- block => block % next
- end do
-
!
! Initialize time_levs(2) with state at current time
! Initialize first RK state
@@ -245,8 +222,6 @@
end if
call mpas_timer_stop("RK4-update diagnostic variables")
-
-
!--- accumulate update (for RK4)
call mpas_timer_start("RK4-RK4 accumulate update")
@@ -361,12 +336,7 @@
end do
call mpas_timer_stop("RK4-cleaup phase")
- block => domain % blocklist
- do while(associated(block))
- call mpas_deallocate_state(block % provis)
- deallocate(block % provis)
- block => block % next
- end do
+ call mpas_deallocate_provis_states(domain % blocklist)
end subroutine ocn_time_integrator_rk4!}}}
Modified: branches/omp_blocks/multiple_blocks/src/core_sw/mpas_sw_time_integration.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/core_sw/mpas_sw_time_integration.F 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/core_sw/mpas_sw_time_integration.F 2012-06-07 15:30:13 UTC (rev 1971)
@@ -70,31 +70,8 @@
real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
- block => domain % blocklist
- do while(associated(block))
- allocate(block % provis)
- call mpas_allocate_state(block, block % provis, &
- block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &
- block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels, &
- block % mesh % nTracers)
-
- block => block % next
- end do
-
- block => domain % blocklist
- do while(associated(block))
- if(associated(block % prev) .and. associated(block % next)) then
- call mpas_create_state_links(block % provis, prev = block % prev % provis, next = block % next % provis)
- else if(associated(block % prev)) then
- call mpas_create_state_links(block % provis, prev = block % prev % provis)
- else if(associated(block % next)) then
- call mpas_create_state_links(block % provis, next = block % next % provis)
- else
- call mpas_create_state_links(block % provis)
- end if
- block => block % next
- end do
-
+ call mpas_setup_provis_states(domain % blocklist)
+
!
! Initialize time_levs(2) with state at current time
! Initialize first RK state
@@ -238,12 +215,7 @@
block => block % next
end do
- block => domain % blocklist
- do while(associated(block))
- call mpas_deallocate_state(block % provis)
- deallocate(block % provis)
- block => block % next
- end do
+ call mpas_deallocate_provis_states(domain % blocklist)
end subroutine sw_rk4
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_block_creator.F 2012-06-07 15:30:13 UTC (rev 1971)
@@ -1013,12 +1013,11 @@
!
!-----------------------------------------------------------------------
- subroutine mpas_block_creator_finalize_block_init(blocklist, maxEdges, maxEdges2, vertexDegree, nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, indexToCellID, indexToEdgeID, indexToVertexID)!{{{
+ subroutine mpas_block_creator_finalize_block_init(blocklist, & !{{{
+#include "dim_dummy_args.inc"
+ , nCellsSolve, nEdgesSolve, nVerticesSolve, indexToCellID, indexToEdgeID, indexToVertexID)
type (block_type), pointer :: blocklist !< Input/Output: Linked List of blocks
- integer :: maxEdges !< Input: maxEdges dimension
- integer :: maxEdges2 !< Input: maxEdges2 dimension
- integer :: vertexDegree !< Input: vertexDegree dimension
- integer :: nVertLevels !< Input: nVertLEvels dimension
+#include "dim_dummy_decls_inout.inc"
type (field1dInteger), pointer :: nCellsSolve !< Input: nCellsSolve field information
type (field1dInteger), pointer :: nEdgesSolve !< Input: nEdgesSolve field information
type (field1dInteger), pointer :: nVerticesSolve !< Input: nVerticesSolve field information
@@ -1032,7 +1031,7 @@
type (field1dInteger), pointer :: nCellsCursor, nEdgesCursor, nVerticesCursor
type (field1dInteger), pointer :: indexToCellCursor, indexToEdgeCursor, indexToVertexCursor
- integer :: nCells, nVertices, nEdges, nHalos
+ integer :: nHalos
integer :: nCellsSolve_0Halo, nVerticesSolve_0Halo, nEdgesSolve_0Halo
integer :: blockID, localBlockID
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_dmpar.F 2012-06-07 15:30:13 UTC (rev 1971)
@@ -3690,7 +3690,7 @@
integer, dimension(:), pointer :: haloLayers
logical :: comm_list_found
-
+
dminfo => field % block % domain % dminfo
if(present(haloLayersIn)) then
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_grid_types.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_grid_types.F 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_grid_types.F 2012-06-07 15:30:13 UTC (rev 1971)
@@ -412,26 +412,8 @@
b % blockID = blockID
-! nullify(b % prev)
-! nullify(b % next)
-
allocate(b % parinfo)
-! write(6,*) 'parinfo cell exch lists'
-! allocate(b % parinfo % cellsToSend % halos(nHaloLayers))
-! allocate(b % parinfo % cellsToRecv % halos(nHaloLayers))
-! allocate(b % parinfo % cellsToCopy % halos(nHaloLayers))
-
-! 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
-
-! 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
#include "block_allocs.inc"
@@ -441,7 +423,9 @@
#include "group_alloc_routines.inc"
+#include "provis_alloc_routines.inc"
+
subroutine mpas_deallocate_domain(dom)!{{{
implicit none
Modified: branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F
===================================================================
--- branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/framework/mpas_io_input.F 2012-06-07 15:30:13 UTC (rev 1971)
@@ -27,20 +27,10 @@
end type io_input_object
-
- type (mpas_exchange_list), pointer :: sendListPtr, recvListPtr, copyListPtr
- type (mpas_exchange_list), pointer :: sendCellList, recvCellList
- type (mpas_exchange_list), pointer :: sendEdgeList, recvEdgeList
- type (mpas_exchange_list), pointer :: sendVertexList, recvVertexList
- type (mpas_exchange_list), pointer :: sendVertLevelList, recvVertLevelList
-
- type (mpas_exchange_list), pointer :: exchListPtr
-
integer :: readCellStart, readCellEnd, nReadCells
integer :: readEdgeStart, readEdgeEnd, nReadEdges
integer :: readVertexStart, readVertexEnd, nReadVertices
integer :: readVertLevelStart, readVertLevelEnd, nReadVertLevels
-
contains
@@ -74,102 +64,42 @@
type (field2dInteger), pointer :: cellsOnEdgeField
type (field2dInteger), pointer :: cellsOnVertexField
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
type (field1dReal), pointer :: xCellField, yCellField, zCellField
type (field1dReal), pointer :: xEdgeField, yEdgeField, zEdgeField
type (field1dReal), pointer :: xVertexField, yVertexField, zVertexField
-!#endif
-!#endif
type (field1DChar) :: xtime
- type (field0DInteger), pointer :: int0d_ptr
- type (field1DInteger), pointer :: int1d_ptr
- type (field1DInteger), pointer :: int1d_ptr2
- type (field1DInteger), pointer :: int1d_ptr3
- type (field1DInteger), pointer :: int1d_ptr4
- type (field1DInteger), pointer :: int1d_ptr5
- type (field2DInteger), pointer :: int2d_ptr
- 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
- type (field2DInteger), dimension(:), pointer :: cellsOnCell_Halos
+ type (field1DInteger), pointer :: indexToCellID_Block
+ type (field1DInteger), pointer :: nEdgesOnCell_Block
+ type (field2DInteger), pointer :: cellsOnCell_Block
+ type (field2DInteger), pointer :: verticesOnCell_Block
+ type (field2DInteger), pointer :: edgesOnCell_Block
- type (field1dInteger), dimension(:), pointer :: indexToVertexID_Halos
- type (field1dInteger), dimension(:), pointer :: indexToEdgesID_Halos
+ type (field1DInteger), pointer :: indexToVertexID_Block
+ type (field2DInteger), pointer :: cellsOnVertex_Block
- type (field1DInteger), pointer :: indexToCellID_0Halo
- type (field1DInteger), pointer :: nEdgesOnCell_0Halo
- type (field2DInteger), pointer :: cellsOnCell_0Halo
- type (field2DInteger), pointer :: verticesOnCell_0Halo
- type (field2DInteger), pointer :: edgesOnCell_0Halo
+ type (field1DInteger), pointer :: indexToEdgeID_Block
+ type (field2DInteger), pointer :: cellsOnEdge_Block
- 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
-
- type (field1DInteger), pointer :: indexToEdgeID_tList
-
-!#ifdef HAVE_ZOLTAN
-!#ifdef _MPI
type (field1DReal), pointer :: xCell, yCell, zCell
type (field1DReal), pointer :: xEdge, yEdge, zEdge
type (field1DReal), pointer :: xVertex, yVertex, zVertex
-!#endif
-!#endif
- integer, dimension(:,:), pointer :: cellIDSorted, vertexIDSorted, edgeIDSorted
- integer, dimension(:), pointer :: local_cell_list, local_edge_list, local_vertex_list
+ integer, dimension(:), pointer :: local_cell_list
integer, dimension(:), pointer :: block_id, block_start, block_count
- integer, dimension(:), pointer :: local_vertlevel_list, needed_vertlevel_list
- integer :: nlocal_edges, nlocal_vertices
- type (mpas_exchange_list), pointer :: send1Halo, recv1Halo
- type (mpas_exchange_list), pointer :: send2Halo, recv2Halo
type (graph) :: partial_global_graph_info
- type (graph) :: block_graph_0Halo, block_graph_1Halo, block_graph_2Halo
- integer :: ghostEdgeStart, ghostVertexStart
- integer :: nBlocksLocal, nBlocksMax, iBlock, haloStart
- integer :: nCellsInBlock, nCellsInHalo
- integer :: nVerticesInBlock
- integer :: nEdgesInBlock
-
type (MPAS_Time_type) :: startTime
- type (MPAS_Time_type) :: sliceTime
- type (MPAS_TimeInterval_type) :: timeDiff
- type (MPAS_TimeInterval_type) :: minTimeDiff
character(len=32) :: timeStamp
character(len=1024) :: filename
integer :: nHalos
- integer, dimension(config_num_halos+1) :: nCellsCumulative ! own cells, halo 1 cells, halo 2 cells
- integer, dimension(config_num_halos+2) :: nEdgesCumulative ! own edges, own cell's edges, halo 1 edges, halo 2 edges
- integer, dimension(config_num_halos+2) :: nVerticesCumulative ! own vertices, own cell's vertices, halo 1 vertices, halo 2 vertices
- integer, dimension(config_num_halos) :: nCellsHalo ! halo 1 cells, halo 2 cells
- integer, dimension(config_num_halos+1) :: nEdgesHalo ! own cell's edges, halo 1 edges, halo 2 edges
- integer, dimension(config_num_halos+1) :: nVerticesHalo ! own cell's vertices, halo 1 vertices, halo 2 vertices
-
- integer, dimension(:), pointer :: tempIDs
- integer :: ntempIDs, offset
-
- integer :: nHalo, nOwnCells, nOwnEdges, nOwnVertices, cellCount, edgeCount, vertexCount, iEdge, iVertex
- type (hashtable) :: edgeHash, vertexHash
-
nHalos = config_num_halos
if (config_do_restart) then
@@ -263,48 +193,32 @@
! Determine which cells are owned by this process
- write(6,*) 'Getting decomp'
call mpas_block_decomp_cells_for_proc(domain % dminfo, partial_global_graph_info, local_cell_list, block_id, block_start, block_count)
deallocate(partial_global_graph_info % vertexID)
deallocate(partial_global_graph_info % nAdjacent)
deallocate(partial_global_graph_info % adjacencyList)
- 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, verticesOnCellField, edgesOnCellField, indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, verticesOnCell_0Halo, edgesOnCell_0Halo)
- write(6,*) 'Done with 0 halo cells'
+ call mpas_block_creator_setup_blocks_and_0halo_cells(domain, indexToCellID_Block, local_cell_list, block_id, block_start, block_count)
+ call mpas_block_creator_build_0halo_cell_fields(indexToCellIDField, nEdgesOnCellField, cellsOnCellField, verticesOnCellField, edgesOnCellField, indexToCellID_Block, nEdgesOnCell_Block, cellsOnCell_Block, verticesOnCell_Block, edgesOnCell_Block)
- 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)
+ call mpas_block_creator_build_0_and_1halo_vertex_fields(indexToVertexIDField, cellsOnVertexField, indexToCellID_Block, nEdgesOnCell_Block, verticesOnCell_Block, indexToVertexID_Block, cellsOnVertex_Block, 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)
+ call mpas_block_creator_build_0_and_1halo_vertex_fields(indexToEdgeIDField, cellsOnEdgeField, indexToCellID_Block, nEdgesOnCell_Block, edgesOnCell_Block, indexToEdgeID_Block, cellsOnEdge_Block, nEdgesSolveField)
- write(6,*) 'Done with 0 and 1 halo edges and vertices'
+ call mpas_block_creator_build_cell_halos(indexToCellID_Block, nEdgesOnCell_Block, cellsOnCell_Block, verticesOnCell_Block, edgesOnCell_Block, nCellsSolveField)
- write(6,*) 'Building cell halos', nHalos
- call mpas_block_creator_build_cell_halos(indexToCellID_0Halo, nEdgesOnCell_0Halo, cellsOnCell_0Halo, verticesOnCell_0Halo, edgesOnCell_0Halo, nCellsSolveField)
+ call mpas_block_creator_build_vertex_halos(indexToCellID_Block, nEdgesOnCell_Block, nCellsSolveField, verticesOnCell_Block, indexToVertexID_Block, cellsOnVertex_Block, nVerticesSolveField)
- 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)
+ call mpas_block_creator_build_vertex_halos(indexToCellID_Block, nEdgesOnCell_Block, nCellsSolveField, edgesOnCell_Block, indexToEdgeID_Block, cellsOnEdge_Block, nEdgesSolveField)
- 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)
-
! Allocate blocks, and copy indexTo arrays into blocks
- write(6,*) 'Allocate blocks, and copy indexTo arrays into blocks'
- call mpas_block_creator_finalize_block_init(domain % blocklist, maxEdges, maxEdges2, vertexDegree, nVertLevels, nCellsSolveField, nEdgesSolveField, nVerticesSolveField, indexToCellID_0Halo, indexToEdgeID_0Halo, indexToVertexID_0Halo)
+ call mpas_block_creator_finalize_block_init(domain % blocklist, &
+#include "dim_dummy_args.inc"
+ , nCellsSolveField, nEdgesSolveField, nVerticesSolveField, indexToCellID_Block, indexToEdgeID_Block, indexToVertexID_Block)
-! write(6,*) 'initializing input object'
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
call mpas_io_input_init(input_obj, domain % blocklist, domain % dminfo)
-! block_ptr => block_ptr % next
-! end do
- write(6,*) 'getting file attributes'
call MPAS_readStreamAtt(input_obj % io_stream, 'sphere_radius', r_sphere_radius, ierr)
if (ierr /= MPAS_STREAM_NOERR) then
write(0,*) 'Warning: Attribute sphere_radius not found in '//trim(input_obj % filename)
@@ -327,7 +241,6 @@
end if
end if
- write(6,*) 'Copy attributes to other blocks.'
block_ptr => domain % blocklist % next
do while (associated(block_ptr))
block_ptr % mesh % sphere_radius = domain % blocklist % mesh % sphere_radius
@@ -357,131 +270,6 @@
write(0,*) 'Restarting model from time ', timeStamp
end if
- !DWJ DEBUGGING
-! write(6,*) 'BLOCK LOOP 1'
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
-! write(6,*) 'nEdges', block_ptr % mesh % nEdges
-! write(6,*) 'nEdgesSolve', block_ptr % mesh % nEdgesSolve
-! write(6,*) 'indexToCellID on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
-! end do
-! write(6,*) 'nEdgesOnCell on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % nEdgesOnCell % array(i)
-! end do
-! write(6,*) 'edgesOnCell on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
-! end do
-
-! write(6,*) 'nVertices', block_ptr % mesh % nVertices
-! write(6,*) 'nVerticesSolve', block_ptr % mesh % nVerticesSolve
-! write(6,*) 'indexToVertexID on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nVertices
-! write(6,*) i, block_ptr % mesh % indexToVertexID % array(i)
-! end do
-! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nEdges
-! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
-! end do
-
-! block_ptr => block_ptr % next
-! end do
-
-! write(6,*) 'EXCHANGE LISTS'
-! do i = 1, nHalos+1
-! write(6,*) 'ON HALO', i
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
-! if(i <= nHalos) then
-! exchListPtr => block_ptr % parinfo % cellsToSend % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'cell sendList from block', block_ptr % blockID, ' to proc', exchListPtr % endPointID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-! exchListPtr => block_ptr % parinfo % cellsToRecv % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'cell recvList from proc', exchListPtr % endPointID, ' to block', block_ptr % blockID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-! exchListPtr => block_ptr % parinfo % cellsToCopy % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'cell copyList from block', block_ptr % blockID, ' to block', exchListPtr % endPointID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-! end if
-!
-! exchListPtr => block_ptr % parinfo % edgesToSend % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'edge sendList from block', block_ptr % blockID, ' to proc', exchListPtr % endPointID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-! exchListPtr => block_ptr % parinfo % edgesToRecv % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'edge recvList from proc', exchListPtr % endPointID, ' to block', block_ptr % blockID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-! exchListPtr => block_ptr % parinfo % edgesToCopy % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'edge copyList from block', block_ptr % blockID, ' to block', exchListPtr % endPointID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-!
-! exchListPtr => block_ptr % parinfo % verticesToSend % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'vertex sendList from block', block_ptr % blockID, ' to proc', exchListPtr % endPointID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-! exchListPtr => block_ptr % parinfo % verticesToRecv % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'vertex recvList from proc', exchListPtr % endPointID, ' to block', block_ptr % blockID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-!
-! exchListPtr => block_ptr % parinfo % verticesToCopy % halos(i) % exchList
-! do while(associated(exchListPtr))
-! write(6,*) 'vertex copyList from block', block_ptr % blockID, ' to block', exchListPtr % endPointID
-! do j = 1, exchListPtr % nList
-! write(6,*) j, exchListPtr % srcList(j), exchListPtr % destList(j)
-! end do
-! exchListPtr => exchListPtr % next
-! end do
-! block_ptr => block_ptr % next
-! end do
-! end do
-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Do the actual work of reading all fields in from the input or restart file
! For each field:
@@ -492,112 +280,19 @@
! 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)
- !DWJ DEBUGGING
-! write(6,*) 'BLOCK LOOP 2'
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
-! write(6,*) 'indexToCellID on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
-! end do
-! write(6,*) 'nEdgeSOnCell on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % nEdgesOnCell % array(i)
-! end do
-! write(6,*) 'edgesOnCell on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
-! end do
-
-! write(6,*) 'indexToVertexID on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nVertices
-! write(6,*) i, block_ptr % mesh % indexToVertexID % array(i)
-! end do
-! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nEdges
-! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
-! end do
-
-! block_ptr => block_ptr % next
-! end do
-
!
! Exchange halos for all of the fields that were read from the input file
!
- write(6,*) 'halo exchanges'
call mpas_exch_input_field_halos(domain, input_obj)
- !DWJ DEBUGGING
-! write(6,*) 'BLOCK LOOP 3'
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
-! write(6,*) 'indexToCellID on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % indexToCellID % array(i)
-! end do
-! write(6,*) 'h on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % state % time_levs(1) % state % h % array(:, i)
-! end do
-! write(6,*) 'edgesOnCell on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
-! end do
-
-! write(6,*) 'indexToVertexID on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nVertices
-! write(6,*) i, block_ptr % mesh % indexToVertexID % array(i)
-! end do
-! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nEdges
-! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
-! end do
-
-! block_ptr => block_ptr % next
-! end do
-
-! write(6,*) 'EXPECTED CELL COMPARISON'
-! int1d_ptr => indexToCellID_0Halo
-! block_ptr => domain % blocklist
-! do while(associated(int1d_ptr))
-! write(6,*) 'ON BLOCK', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCellsSolve
-! write(6,*) i, int1d_ptr % array(i), block_ptr % mesh % indexToCellID % array(i), int1d_ptr % array(i) - block_ptr % mesh % indexToCellID % array(i)
-! end do
-! write(6,*) '---------------'
-! do i = block_ptr % mesh % nCellsSolve+1, block_ptr % mesh % nCells
-! write(6,*) i, int1d_ptr % array(i), block_ptr % mesh % indexToCellID % array(i), int1d_ptr % array(i) - block_ptr % mesh % indexToCellID % array(i)
-! end do
-! int1d_ptr => int1d_ptr % next
-! block_ptr => block_ptr % next
-! end do
-
- write(6,*) 'Reindex block fields'
call mpas_block_creator_reindex_block_fields(domain % blocklist)
- !DWJ DEBUGGING
-! write(6,*) 'BLOCK LOOP 4'
-! block_ptr => domain % blocklist
-! do while(associated(block_ptr))
-! write(6,*) 'edgesOnCell on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nCells
-! write(6,*) i, block_ptr % mesh % edgesOnCell % array(:, i)
-! end do
-
-! write(6,*) 'verticesOnEdge on block', block_ptr % blockID
-! do i = 1, block_ptr % mesh % nEdges
-! write(6,*) i, block_ptr % mesh % verticesOnEdge % array(:, i)
-! end do
-! block_ptr => block_ptr % next
-! end do
-
call mpas_dmpar_destroy_mulithalo_exchange_list(indexToCellIDField % sendList)
call mpas_dmpar_destroy_mulithalo_exchange_list(indexToCellIDField % recvList)
call mpas_dmpar_destroy_mulithalo_exchange_list(indexToCellIDField % copyList)
@@ -620,27 +315,50 @@
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(indexToCellID_Block)
+ call mpas_deallocate_field(nEdgesOnCell_Block)
+ call mpas_deallocate_field(cellsOnCell_Block)
+ call mpas_deallocate_field(verticesOnCell_Block)
+ call mpas_deallocate_field(edgesOnCell_Block)
+ call mpas_deallocate_field(indexToVertexID_Block)
+ call mpas_deallocate_field(cellsOnVertex_Block)
+ call mpas_deallocate_field(indexToEdgeID_Block)
+ call mpas_deallocate_field(cellsOnEdge_Block)
call mpas_deallocate_field(nCellsSolveField)
call mpas_deallocate_field(nVerticesSolveField)
call mpas_deallocate_field(nEdgesSolveField)
+#ifdef HAVE_ZOLTAN
+ call mpas_deallocate_field(xCellField)
+ call mpas_deallocate_field(yCellField)
+ call mpas_deallocate_field(zCellField)
+ call mpas_deallocate_field(xVertexField)
+ call mpas_deallocate_field(yVertexField)
+ call mpas_deallocate_field(zVertexField)
+ call mpas_deallocate_field(xEdgeField)
+ call mpas_deallocate_field(yEdgeField)
+ call mpas_deallocate_field(zEdgeField)
+
+ call mpas_deallocate_field(xCell)
+ call mpas_deallocate_field(yCell)
+ call mpas_deallocate_field(zCell)
+ call mpas_deallocate_field(xVertex)
+ call mpas_deallocate_field(yVertex)
+ call mpas_deallocate_field(zVertex)
+ call mpas_deallocate_field(xEdge)
+ call mpas_deallocate_field(yEdge)
+ call mpas_deallocate_field(zEdge)
+#endif
+
deallocate(local_cell_list)
deallocate(block_id)
deallocate(block_start)
deallocate(block_count)
+ deallocate(readingBlock)
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
+!#ifdef HAVE_ZOLTAN
+!#ifdef _MPI
! allocate(xCell(size(local_cell_list)))
! allocate(yCell(size(local_cell_list)))
! allocate(zCell(size(local_cell_list)))
@@ -655,8 +373,8 @@
! call mpas_dmpar_alltoall_field(domain % dminfo, zCellField % array, zCell, &
! size(zCellField % array), size(local_cell_list), &
! sendCellList, recvCellList)
-#endif
-#endif
+!#endif
+!#endif
!#ifdef HAVE_ZOLTAN
!#ifdef _MPI
Modified: branches/omp_blocks/multiple_blocks/src/registry/gen_inc.c
===================================================================
--- branches/omp_blocks/multiple_blocks/src/registry/gen_inc.c 2012-06-06 17:50:08 UTC (rev 1970)
+++ branches/omp_blocks/multiple_blocks/src/registry/gen_inc.c 2012-06-07 15:30:13 UTC (rev 1971)
@@ -180,7 +180,7 @@
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr;
struct group_list * group_ptr;
- FILE * fd;
+ FILE * fd, *fd2;
char super_array[1024];
char array_class[1024];
char outer_dim[1024];
@@ -213,7 +213,6 @@
fclose(fd);
-
/*
* Generate dummy dimension argument list
*/
@@ -236,7 +235,6 @@
fclose(fd);
-
/*
* Generate dummy dimension argument declaration list
*/
@@ -259,8 +257,76 @@
fclose(fd);
+ /*
+ * Generate dummy dimension argument declaration list
+ */
+ fd = fopen("dim_dummy_decls_inout.inc", "w");
+ dim_ptr = dims;
+ if (dim_ptr && dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " integer, intent(inout) :: %s", dim_ptr->name_in_code);
+ dim_ptr = dim_ptr->next;
+ }
+ else if (dim_ptr && dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " integer, intent(inout) :: %s", dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ while (dim_ptr) {
+ if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %s", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %s", dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="blue">");
+ fclose(fd);
+
/*
+ * Generate non-input dummy dimension argument declaration list
+ */
+ fd = fopen("dim_dummy_decls_noinput.inc", "w");
+ dim_ptr = dims;
+ if (dim_ptr && dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " integer :: %s", dim_ptr->name_in_code);
+ dim_ptr = dim_ptr->next;
+ }
+ else if (dim_ptr && dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " integer :: %s", dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ while (dim_ptr) {
+ if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %s", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %s", dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ fclose(fd);
+
+
+
+ /*
+ * Generate dummy dimension assignment instructions
+ */
+ fd = fopen("dim_dummy_assigns.inc", "w");
+ dim_ptr = dims;
+ if (dim_ptr && dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " %s = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_code, dim_ptr->name_in_code);
+ dim_ptr = dim_ptr->next;
+ }
+ else if (dim_ptr && dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " %s = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ while (dim_ptr) {
+ if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_code, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="gray">");
+
+ fclose(fd);
+
+
+ /*
* Generate declarations of dimensions
*/
fd = fopen("dim_decls.inc", "w");
@@ -495,6 +561,59 @@
fclose(fd);
+ /*
+ * Generate routines for allocating provisional types
+ */
+ fd = fopen("provis_alloc_routines.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " subroutine mpas_setup_provis_%ss(b)!{{{</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (block_type), pointer :: b</font>
<font color="blue">");
+ fortprintf(fd, " type (block_type), pointer :: block</font>
<font color="black"></font>
<font color="blue">");
+ fortprintf(fd, "#include \"dim_dummy_decls_noinput.inc\"</font>
<font color="black"></font>
<font color="blue">");
+ fortprintf(fd, " block => b</font>
<font color="blue">");
+ fortprintf(fd, " do while(associated(block))</font>
<font color="blue">");
+ fortprintf(fd, "#include \"dim_dummy_assigns.inc\"</font>
<font color="black"></font>
<font color="blue">");
+ fortprintf(fd, " allocate(block %% provis)</font>
<font color="blue">");
+ fortprintf(fd, " call mpas_allocate_%s(block, block %% provis, &</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="black"></font>
<font color="blue">");
+ fortprintf(fd, " block => block %% next </font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="black"></font>
<font color="blue">");
+ fortprintf(fd, " block => b</font>
<font color="blue">");
+ fortprintf(fd, " do while(associated(block))</font>
<font color="blue">");
+ fortprintf(fd, " if(associated(block %% prev) .and. associated(block %% next)) then</font>
<font color="blue">");
+ fortprintf(fd, " call mpas_create_%s_links(block %% provis, prev = block %% prev %% provis, next = block %% next %% provis)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " else if(associated(block %% prev)) then</font>
<font color="blue">");
+ fortprintf(fd, " call mpas_create_%s_links(block %% provis, prev = block %% prev %% provis)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " else if(associated(block %% next)) then</font>
<font color="blue">");
+ fortprintf(fd, " call mpas_create_%s_links(block %% provis, next = block %% next %% provis)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " call mpas_create_%s_links(block %% provis)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, " block => block %% next </font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine mpas_setup_provis_%ss!}}}</font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ fortprintf(fd, " subroutine mpas_deallocate_provis_%ss(b)!{{{</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (block_type), pointer :: b</font>
<font color="blue">");
+ fortprintf(fd, " type (block_type), pointer :: block</font>
<font color="black"></font>
<font color="blue">");
+ fortprintf(fd, " block => b</font>
<font color="blue">");
+ fortprintf(fd, " do while(associated(block))</font>
<font color="blue">");
+ fortprintf(fd, " call mpas_deallocate_%s(block %% provis)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " deallocate(block %% provis)</font>
<font color="blue">");
+ fortprintf(fd, " block => block %% next</font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine mpas_deallocate_provis_%ss!}}}</font>
<font color="blue">", group_ptr->name);
+ }
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+
+
/* To be included in allocate_block */
fd = fopen("block_allocs.inc", "w");
group_ptr = groups;
</font>
</pre>