<p><b>duda</b> 2010-09-16 14:49:08 -0600 (Thu, 16 Sep 2010)</p><p>BRANCH COMMIT<br>
<br>
Update shallow water core and driver to use new data types.<br>
<br>
A 15-day test with SWTC5 gives bit-identical results compared<br>
with the trunk.<br>
<br>
<br>
M driver/module_subdriver.F<br>
M core_sw/module_time_integration.F<br>
M core_sw/Registry<br>
M core_sw/module_test_cases.F<br>
M core_sw/mpas_interface.F<br>
M core_sw/module_global_diagnostics.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/registry_reorg/src/core_sw/Registry
===================================================================
--- branches/registry_reorg/src/core_sw/Registry 2010-09-16 18:52:28 UTC (rev 501)
+++ branches/registry_reorg/src/core_sw/Registry 2010-09-16 20:49:08 UTC (rev 502)
@@ -30,90 +30,95 @@
dim nTracers nTracers
#
-# var type name_in_file ( dims ) iro- name_in_code super-array array_class
+# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class
#
-var real xtime ( Time ) ro xtime - -
+var persistent real xtime ( Time ) 2 ro xtime state - -
-var real latCell ( nCells ) iro latCell - -
-var real lonCell ( nCells ) iro lonCell - -
-var real xCell ( nCells ) iro xCell - -
-var real yCell ( nCells ) iro yCell - -
-var real zCell ( nCells ) iro zCell - -
-var integer indexToCellID ( nCells ) iro indexToCellID - -
+var persistent real latCell ( nCells ) 0 iro latCell mesh - -
+var persistent real lonCell ( nCells ) 0 iro lonCell mesh - -
+var persistent real xCell ( nCells ) 0 iro xCell mesh - -
+var persistent real yCell ( nCells ) 0 iro yCell mesh - -
+var persistent real zCell ( nCells ) 0 iro zCell mesh - -
+var persistent integer indexToCellID ( nCells ) 0 iro indexToCellID mesh - -
-var real latEdge ( nEdges ) iro latEdge - -
-var real lonEdge ( nEdges ) iro lonEdge - -
-var real xEdge ( nEdges ) iro xEdge - -
-var real yEdge ( nEdges ) iro yEdge - -
-var real zEdge ( nEdges ) iro zEdge - -
-var integer indexToEdgeID ( nEdges ) iro indexToEdgeID - -
+var persistent real latEdge ( nEdges ) 0 iro latEdge mesh - -
+var persistent real lonEdge ( nEdges ) 0 iro lonEdge mesh - -
+var persistent real xEdge ( nEdges ) 0 iro xEdge mesh - -
+var persistent real yEdge ( nEdges ) 0 iro yEdge mesh - -
+var persistent real zEdge ( nEdges ) 0 iro zEdge mesh - -
+var persistent integer indexToEdgeID ( nEdges ) 0 iro indexToEdgeID mesh - -
-var real latVertex ( nVertices ) iro latVertex - -
-var real lonVertex ( nVertices ) iro lonVertex - -
-var real xVertex ( nVertices ) iro xVertex - -
-var real yVertex ( nVertices ) iro yVertex - -
-var real zVertex ( nVertices ) iro zVertex - -
-var integer indexToVertexID ( nVertices ) iro indexToVertexID - -
+var persistent real latVertex ( nVertices ) 0 iro latVertex mesh - -
+var persistent real lonVertex ( nVertices ) 0 iro lonVertex mesh - -
+var persistent real xVertex ( nVertices ) 0 iro xVertex mesh - -
+var persistent real yVertex ( nVertices ) 0 iro yVertex mesh - -
+var persistent real zVertex ( nVertices ) 0 iro zVertex mesh - -
+var persistent integer indexToVertexID ( nVertices ) 0 iro indexToVertexID mesh - -
-var integer cellsOnEdge ( TWO nEdges ) iro cellsOnEdge - -
-var integer nEdgesOnCell ( nCells ) iro nEdgesOnCell - -
-var integer nEdgesOnEdge ( nEdges ) iro nEdgesOnEdge - -
-var integer edgesOnCell ( maxEdges nCells ) iro edgesOnCell - -
-var integer edgesOnEdge ( maxEdges2 nEdges ) iro edgesOnEdge - -
+var persistent integer cellsOnEdge ( TWO nEdges ) 0 iro cellsOnEdge mesh - -
+var persistent integer nEdgesOnCell ( nCells ) 0 iro nEdgesOnCell mesh - -
+var persistent integer nEdgesOnEdge ( nEdges ) 0 iro nEdgesOnEdge mesh - -
+var persistent integer edgesOnCell ( maxEdges nCells ) 0 iro edgesOnCell mesh - -
+var persistent integer edgesOnEdge ( maxEdges2 nEdges ) 0 iro edgesOnEdge mesh - -
-var real weightsOnEdge ( maxEdges2 nEdges ) iro weightsOnEdge - -
-var real dvEdge ( nEdges ) iro dvEdge - -
-var real dcEdge ( nEdges ) iro dcEdge - -
-var real angleEdge ( nEdges ) iro angleEdge - -
-var real areaCell ( nCells ) iro areaCell - -
-var real areaTriangle ( nVertices ) iro areaTriangle - -
+var persistent real weightsOnEdge ( maxEdges2 nEdges ) 0 iro weightsOnEdge mesh - -
+var persistent real dvEdge ( nEdges ) 0 iro dvEdge mesh - -
+var persistent real dcEdge ( nEdges ) 0 iro dcEdge mesh - -
+var persistent real angleEdge ( nEdges ) 0 iro angleEdge mesh - -
+var persistent real areaCell ( nCells ) 0 iro areaCell mesh - -
+var persistent real areaTriangle ( nVertices ) 0 iro areaTriangle mesh - -
-var real edgeNormalVectors ( R3 nEdges ) o edgeNormalVectors - -
-var real localVerticalUnitVectors ( R3 nCells ) o localVerticalUnitVectors - -
-var real cellTangentPlane ( R3 TWO nEdges ) o cellTangentPlane - -
+var persistent real edgeNormalVectors ( R3 nEdges ) 0 o edgeNormalVectors mesh - -
+var persistent real localVerticalUnitVectors ( R3 nCells ) 0 o localVerticalUnitVectors mesh - -
+var persistent real cellTangentPlane ( R3 TWO nEdges ) 0 o cellTangentPlane mesh - -
-var integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell - -
-var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell - -
-var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge - -
-var integer edgesOnVertex ( vertexDegree nVertices ) iro edgesOnVertex - -
-var integer cellsOnVertex ( vertexDegree nVertices ) iro cellsOnVertex - -
-var real kiteAreasOnVertex ( vertexDegree nVertices ) iro kiteAreasOnVertex - -
-var real fEdge ( nEdges ) iro fEdge - -
-var real fVertex ( nVertices ) iro fVertex - -
-var real fCell ( nCells ) iro fCell - -
-var real h_s ( nCells ) iro h_s - -
+var persistent integer cellsOnCell ( maxEdges nCells ) 0 iro cellsOnCell mesh - -
+var persistent integer verticesOnCell ( maxEdges nCells ) 0 iro verticesOnCell mesh - -
+var persistent integer verticesOnEdge ( TWO nEdges ) 0 iro verticesOnEdge mesh - -
+var persistent integer edgesOnVertex ( vertexDegree nVertices ) 0 iro edgesOnVertex mesh - -
+var persistent integer cellsOnVertex ( vertexDegree nVertices ) 0 iro cellsOnVertex mesh - -
+var persistent real kiteAreasOnVertex ( vertexDegree nVertices ) 0 iro kiteAreasOnVertex mesh - -
+var persistent real fEdge ( nEdges ) 0 iro fEdge mesh - -
+var persistent real fVertex ( nVertices ) 0 iro fVertex mesh - -
+var persistent real fCell ( nCells ) 0 iro fCell mesh - -
+var persistent real h_s ( nCells ) 0 iro h_s mesh - -
# Arrays required for reconstruction of velocity field
-var real coeffs_reconstruct ( R3 maxEdges nCells ) - coeffs_reconstruct - -
+var persistent real coeffs_reconstruct ( R3 maxEdges nCells ) 0 - coeffs_reconstruct mesh - -
# Boundary conditions: read from input, saved in restart and written to output
-var integer boundaryEdge ( nVertLevels nEdges ) iro boundaryEdge - -
-var integer boundaryVertex ( nVertLevels nVertices ) iro boundaryVertex - -
+var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
+var persistent integer boundaryVertex ( nVertLevels nVertices ) 0 iro boundaryVertex mesh - -
# Prognostic variables: read from input, saved in restart, and written to output
-var real u ( nVertLevels nEdges Time ) iro u - -
-var real h ( nVertLevels nCells Time ) iro h - -
-var real tracers ( nTracers nVertLevels nCells Time ) iro tracers - -
+var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
+var persistent real h ( nVertLevels nCells Time ) 2 iro h state - -
+var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro tracers state - -
+# Tendency variables
+var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
+var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
+var persistent real tend_tracers ( nTracers nVertLevels nCells Time ) 1 - tracers tend - -
+
# Diagnostic fields: only written to output
-var real v ( nVertLevels nEdges Time ) o v - -
-var real divergence ( nVertLevels nCells Time ) o divergence - -
-var real vorticity ( nVertLevels nVertices Time ) o vorticity - -
-var real vorticity_cell ( nVertLevels nCells Time ) o vorticity_cell - -
-var real pv_edge ( nVertLevels nEdges Time ) o pv_edge - -
-var real h_edge ( nVertLevels nEdges Time ) o h_edge - -
-var real ke ( nVertLevels nCells Time ) o ke - -
-var real pv_vertex ( nVertLevels nVertices Time ) o pv_vertex - -
-var real pv_cell ( nVertLevels nCells Time ) o pv_cell - -
-var real uReconstructX ( nVertLevels nCells Time ) o uReconstructX - -
-var real uReconstructY ( nVertLevels nCells Time ) o uReconstructY - -
-var real uReconstructZ ( nVertLevels nCells Time ) o uReconstructZ - -
-var real uReconstructZonal ( nVertLevels nCells Time ) o uReconstructZonal - -
-var real uReconstructMeridional ( nVertLevels nCells Time ) o uReconstructMeridional - -
+var persistent real v ( nVertLevels nEdges Time ) 2 o v state - -
+var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
+var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
+var persistent real vorticity_cell ( nVertLevels nCells Time ) 2 o vorticity_cell state - -
+var persistent real pv_edge ( nVertLevels nEdges Time ) 2 o pv_edge state - -
+var persistent real h_edge ( nVertLevels nEdges Time ) 2 o h_edge state - -
+var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
+var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
+var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
+var persistent real uReconstructX ( nVertLevels nCells Time ) 2 o uReconstructX state - -
+var persistent real uReconstructY ( nVertLevels nCells Time ) 2 o uReconstructY state - -
+var persistent real uReconstructZ ( nVertLevels nCells Time ) 2 o uReconstructZ state - -
+var persistent real uReconstructZonal ( nVertLevels nCells Time ) 2 o uReconstructZonal state - -
+var persistent real uReconstructMeridional ( nVertLevels nCells Time ) 2 o uReconstructMeridional state - -
# Other diagnostic variables: neither read nor written to any files
-var real vh ( nVertLevels nEdges Time ) - vh - -
-var real circulation ( nVertLevels nVertices Time ) - circulation - -
-var real gradPVt ( nVertLevels nEdges Time ) - gradPVt - -
-var real gradPVn ( nVertLevels nEdges Time ) - gradPVn - -
-var real h_vertex ( nVertLevels nVertices Time ) - h_vertex - -
+var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
+var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
+var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
+var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
+var persistent real h_vertex ( nVertLevels nVertices Time ) 2 - h_vertex state - -
Modified: branches/registry_reorg/src/core_sw/module_global_diagnostics.F
===================================================================
--- branches/registry_reorg/src/core_sw/module_global_diagnostics.F 2010-09-16 18:52:28 UTC (rev 501)
+++ branches/registry_reorg/src/core_sw/module_global_diagnostics.F 2010-09-16 20:49:08 UTC (rev 502)
@@ -37,8 +37,8 @@
implicit none
type (dm_info), intent(in) :: dminfo
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
integer, intent(in) :: timeIndex
real (kind=RKIND), intent(in) :: dt
Modified: branches/registry_reorg/src/core_sw/module_test_cases.F
===================================================================
--- branches/registry_reorg/src/core_sw/module_test_cases.F 2010-09-16 18:52:28 UTC (rev 501)
+++ branches/registry_reorg/src/core_sw/module_test_cases.F 2010-09-16 20:49:08 UTC (rev 502)
@@ -33,9 +33,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_1(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -47,9 +47,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_2(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -61,9 +61,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_5(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -75,9 +75,9 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call sw_test_case_6(block_ptr % mesh, block_ptr % time_levs(1) % state)
+ call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
do i=2,nTimeLevs
- call copy_state(block_ptr % time_levs(1) % state, block_ptr % time_levs(i) % state)
+ call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
block_ptr => block_ptr % next
@@ -102,8 +102,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
real (kind=RKIND), parameter :: h0 = 1000.0
@@ -184,8 +184,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
real (kind=RKIND), parameter :: gh0 = 29400.0
@@ -281,8 +281,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: u0 = 20.
real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
@@ -408,8 +408,8 @@
implicit none
- type (grid_meta), intent(inout) :: grid
- type (grid_state), intent(inout) :: state
+ type (mesh_type), intent(inout) :: grid
+ type (state_type), intent(inout) :: state
real (kind=RKIND), parameter :: h0 = 8000.0
real (kind=RKIND), parameter :: w = 7.848e-6
Modified: branches/registry_reorg/src/core_sw/module_time_integration.F
===================================================================
--- branches/registry_reorg/src/core_sw/module_time_integration.F 2010-09-16 18:52:28 UTC (rev 501)
+++ branches/registry_reorg/src/core_sw/module_time_integration.F 2010-09-16 20:49:08 UTC (rev 502)
@@ -37,7 +37,7 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % xtime % scalar = block % time_levs(1) % state % xtime % scalar + dt
+ block % state % time_levs(2) % state % xtime % scalar = block % state % time_levs(1) % state % xtime % scalar + dt
block => block % next
end do
@@ -62,13 +62,17 @@
integer :: iCell, k
type (block_type), pointer :: block
+ type (state_type) :: provis
- integer, parameter :: PROVIS = 1
- integer, parameter :: TEND = 2
integer :: rk_step
real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
+ block => domain % blocklist
+ call allocate_state(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)
!
! Initialize time_levs(2) with state at current time
@@ -79,16 +83,16 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
- block % time_levs(2) % state % h % array(:,:) = block % time_levs(1) % state % h % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
do iCell=1,block % mesh % nCells ! couple tracers to h
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = block % time_levs(1) % state % tracers % array(:,k,iCell) &
- * block % time_levs(1) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell)
end do
end do
- call copy_state(block % time_levs(1) % state, block % intermediate_step(PROVIS))
+ call copy_state(provis, block % state % time_levs(1) % state)
block => block % next
end do
@@ -113,7 +117,7 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(PROVIS) % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
block => block % next
@@ -123,9 +127,9 @@
block => domain % blocklist
do while (associated(block))
- call compute_tend(block % intermediate_step(TEND), block % intermediate_step(PROVIS), block % mesh)
- call compute_scalar_tend(block % intermediate_step(TEND), block % intermediate_step(PROVIS), block % mesh)
- call enforce_boundaryEdge(block % intermediate_step(TEND), block % mesh)
+ call compute_tend(block % tend, provis, block % mesh)
+ call compute_scalar_tend(block % tend, provis, block % mesh)
+ call enforce_boundaryEdge(block % tend, block % mesh)
block => block % next
end do
@@ -133,13 +137,13 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % u % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % intermediate_step(TEND) % h % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % tracers % array(:,:,:), &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
block % mesh % nTracers, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
@@ -150,23 +154,23 @@
if (rk_step < 4) then
block => domain % blocklist
do while (associated(block))
- block % intermediate_step(PROVIS) % u % array(:,:) = block % time_levs(1) % state % u % array(:,:) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % u % array(:,:)
- block % intermediate_step(PROVIS) % h % array(:,:) = block % time_levs(1) % state % h % array(:,:) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % h % array(:,:)
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+ provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % intermediate_step(PROVIS) % tracers % array(:,k,iCell) = ( &
- block % time_levs(1) % state % h % array(k,iCell) * &
- block % time_levs(1) % state % tracers % array(:,k,iCell) &
- + rk_substep_weights(rk_step) * block % intermediate_step(TEND) % tracers % array(:,k,iCell) &
- ) / block % intermediate_step(PROVIS) % h % array(k,iCell)
+ provis % tracers % array(:,k,iCell) = ( &
+ block % state % time_levs(1) % state % h % array(k,iCell) * &
+ block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &
+ ) / provis % h % array(k,iCell)
end do
end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % intermediate_step(PROVIS) % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
- call compute_solve_diagnostics(dt, block % intermediate_step(PROVIS), block % mesh)
+ call compute_solve_diagnostics(dt, provis, block % mesh)
block => block % next
end do
end if
@@ -175,15 +179,15 @@
block => domain % blocklist
do while (associated(block))
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(2) % state % u % array(:,:) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % u % array(:,:)
- block % time_levs(2) % state % h % array(:,:) = block % time_levs(2) % state % h % array(:,:) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % h % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
+ + rk_weights(rk_step) * block % tend % u % array(:,:)
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
+ + rk_weights(rk_step) * block % tend % h % array(:,:)
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = &
- block % time_levs(2) % state % tracers % array(:,k,iCell) &
- + rk_weights(rk_step) * block % intermediate_step(TEND) % tracers % array(:,k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
end do
end do
block => block % next
@@ -202,23 +206,25 @@
do while (associated(block))
do iCell=1,block % mesh % nCells
do k=1,block % mesh % nVertLevels
- block % time_levs(2) % state % tracers % array(:,k,iCell) = &
- block % time_levs(2) % state % tracers % array(:,k,iCell) &
- / block % time_levs(2) % state % h % array(k,iCell)
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ / block % state % time_levs(2) % state % h % array(k,iCell)
end do
end do
if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % time_levs(2) % state % u % array(:,:) = block % time_levs(1) % state % u % array(:,:)
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
- call compute_solve_diagnostics(dt, block % time_levs(2) % state, block % mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(2) % state, block % mesh)
- call reconstruct(block % time_levs(2) % state, block % mesh)
+ call reconstruct(block % state % time_levs(2) % state, block % mesh)
block => block % next
end do
+ call deallocate_state(provis)
+
end subroutine rk4
@@ -234,9 +240,9 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
real (kind=RKIND) :: flux, vorticity_abs, workpv, q, upstream_bias
@@ -394,9 +400,9 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iCell, iEdge, k, iTracer, cell1, cell2
real (kind=RKIND) :: flux, tracer_edge
@@ -440,8 +446,8 @@
implicit none
real (kind=RKIND), intent(in) :: dt
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(in) :: grid
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
@@ -753,8 +759,8 @@
implicit none
- type (grid_state), intent(inout) :: tend
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend
+ type (mesh_type), intent(in) :: grid
integer, dimension(:,:), pointer :: boundaryEdge
real (kind=RKIND), dimension(:,:), pointer :: tend_u
Modified: branches/registry_reorg/src/core_sw/mpas_interface.F
===================================================================
--- branches/registry_reorg/src/core_sw/mpas_interface.F 2010-09-16 18:52:28 UTC (rev 501)
+++ branches/registry_reorg/src/core_sw/mpas_interface.F 2010-09-16 20:49:08 UTC (rev 502)
@@ -22,14 +22,14 @@
implicit none
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
- call compute_solve_diagnostics(dt, block % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
call rbfInterp_initialize(mesh)
call init_reconstruct(mesh)
- call reconstruct(block % time_levs(1) % state, mesh)
+ call reconstruct(block % state % time_levs(1) % state, mesh)
end subroutine mpas_init
@@ -74,7 +74,7 @@
call timer_start("global_diagnostics")
call computeGlobalDiagnostics(domain % dminfo, &
- block_ptr % time_levs(2) % state, block_ptr % mesh, &
+ block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
itimestep, dt)
call timer_stop("global_diagnostics")
end if
Modified: branches/registry_reorg/src/driver/module_subdriver.F
===================================================================
--- branches/registry_reorg/src/driver/module_subdriver.F 2010-09-16 18:52:28 UTC (rev 501)
+++ branches/registry_reorg/src/driver/module_subdriver.F 2010-09-16 20:49:08 UTC (rev 502)
@@ -13,7 +13,7 @@
subroutine mpas_init(block, mesh, dt)
use grid_types
type (block_type), intent(inout) :: block
- type (grid_meta), intent(inout) :: mesh
+ type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
end subroutine mpas_init
@@ -59,7 +59,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
call mpas_init(block_ptr, block_ptr % mesh, dt)
- if (.not. config_do_restart) block_ptr % time_levs(1) % state % xtime % scalar = 0.0
+ if (.not. config_do_restart) block_ptr % state % time_levs(1) % state % xtime % scalar = 0.0
block_ptr => block_ptr % next
end do
@@ -79,7 +79,7 @@
call timer_stop("time integration")
! Move time level 2 fields back into time level 1 for next time step
- call shift_time_levels(domain)
+ call shift_time_levels_state(domain % blocklist % state)
if (mod(itimestep, config_output_interval) == 0) then
call write_output_frame(output_obj, domain)
@@ -116,7 +116,7 @@
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call compute_output_diagnostics(block_ptr % time_levs(1) % state, block_ptr % mesh)
+ call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
block_ptr => block_ptr % next
end do
@@ -138,8 +138,8 @@
implicit none
- type (grid_state), intent(inout) :: state
- type (grid_meta), intent(in) :: grid
+ type (state_type), intent(inout) :: state
+ type (mesh_type), intent(in) :: grid
integer :: i, eoe
integer :: iEdge, k
</font>
</pre>