<p><b>duda</b> 2010-09-17 10:37:11 -0600 (Fri, 17 Sep 2010)</p><p>BRANCH COMMIT<br>
<br>
Update ocean core to use new field data types.<br>
<br>
Testing with a quad mesh from Todd, the code produces<br>
bit-identical fields to the repository trunk, except for<br>
maxLevelsEdge, which appears to never be set, and fields such as<br>
CFLNumberGlobal and volumeEdgeGlobal, which are not set at the<br>
initial output time.<br>
<br>
<br>
M module_global_diagnostics.F<br>
M mpas_interface.F<br>
M module_test_cases.F<br>
M Registry<br>
M module_time_integration.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/registry_reorg/src/core_ocean/Registry
===================================================================
--- branches/registry_reorg/src/core_ocean/Registry 2010-09-16 21:24:38 UTC (rev 503)
+++ branches/registry_reorg/src/core_ocean/Registry 2010-09-17 16:37:11 UTC (rev 504)
@@ -47,123 +47,131 @@
dim nVertLevelsP1 nVertLevels+1
#
-# 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 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 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 - -
# Arrays for z-level version of mpas-ocean
-var integer maxLevelsCell ( nCells ) iro kmaxCell - -
-var integer maxLevelsEdge ( nEdges ) iro kmaxEdge - -
-var real hZLevel ( nVertLevels ) iro hZLevel - -
-var real zMidZLevel ( nVertLevels ) iro zMidZLevel - -
-var real zTopZLevel ( nVertLevelsP1 ) iro zTopZLevel - -
+var persistent integer maxLevelsCell ( nCells ) 0 iro kmaxCell mesh - -
+var persistent integer maxLevelsEdge ( nEdges ) 0 iro kmaxEdge mesh - -
+var persistent real hZLevel ( nVertLevels ) 0 iro hZLevel mesh - -
+var persistent real zMidZLevel ( nVertLevels ) 0 iro zMidZLevel mesh - -
+var persistent real zTopZLevel ( nVertLevelsP1 ) 0 iro zTopZLevel 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 real u_src ( nVertLevels nEdges ) iro u_src - -
+var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
+var persistent integer boundaryVertex ( nVertLevels nVertices ) 0 iro boundaryVertex mesh - -
+var persistent real u_src ( nVertLevels nEdges ) 0 iro u_src 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 rho ( nVertLevels nCells Time ) iro rho - -
-var real temperature ( nVertLevels nCells Time ) iro temperature tracers dynamics
-var real salinity ( nVertLevels nCells Time ) iro salinity tracers dynamics
-var real tracer1 ( nVertLevels nCells Time ) iro tracer1 tracers testing
-var real tracer2 ( nVertLevels nCells Time ) iro tracer2 tracers testing
+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 rho ( nVertLevels nCells Time ) 2 iro rho state - -
+var persistent real temperature ( nVertLevels nCells Time ) 2 iro temperature state tracers dynamics
+var persistent real salinity ( nVertLevels nCells Time ) 2 iro salinity state tracers dynamics
+var persistent real tracer1 ( nVertLevels nCells Time ) 2 iro tracer1 state tracers testing
+var persistent real tracer2 ( nVertLevels nCells Time ) 2 iro tracer2 state tracers testing
+# Tendency variables: neither read nor written to any files
+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_temperature ( nVertLevels nCells Time ) 1 - temperature tend tracers dynamics
+var persistent real tend_salinity ( nVertLevels nCells Time ) 1 - salinity tend tracers dynamics
+var persistent real tend_tracer1 ( nVertLevels nCells Time ) 1 - tracer1 tend tracers testing
+var persistent real tend_tracer2 ( nVertLevels nCells Time ) 1 - tracer2 tend tracers testing
+
# 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 pv_edge ( nVertLevels nEdges Time ) o pv_edge - -
-var real h_edge ( nVertLevels nEdges Time ) o h_edge - -
-var real h_vertex ( nVertLevels nVertices Time ) o h_vertex - -
-var real ke ( nVertLevels nCells Time ) o ke - -
-var real ke_edge ( nVertLevels nEdges Time ) o ke_edge - -
-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 real zMid ( nVertLevels nCells Time ) o zMid - -
-var real zTop ( nVertLevelsP1 nCells Time ) o zTop - -
-var real zMidEdge ( nVertLevels nEdges Time ) o zMidEdge - -
-var real zTopEdge ( nVertLevelsP1 nEdges Time ) o zTopEdge - -
-var real p ( nVertLevels nCells Time ) o p - -
-var real pTop ( nVertLevelsP1 nCells Time ) o pTop - -
-var real pZLevel ( nVertLevels nCells Time ) o pZLevel - -
-var real MontPot ( nVertLevels nCells Time ) o MontPot - -
-var real wTop ( nVertLevelsP1 nCells Time ) o wTop - -
-var real ssh ( nCells Time ) o ssh - -
+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 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 h_vertex ( nVertLevels nVertices Time ) 2 o h_vertex state - -
+var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
+var persistent real ke_edge ( nVertLevels nEdges Time ) 2 o ke_edge 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 - -
+var persistent real zMid ( nVertLevels nCells Time ) 2 o zMid state - -
+var persistent real zTop ( nVertLevelsP1 nCells Time ) 2 o zTop state - -
+var persistent real zMidEdge ( nVertLevels nEdges Time ) 2 o zMidEdge state - -
+var persistent real zTopEdge ( nVertLevelsP1 nEdges Time ) 2 o zTopEdge state - -
+var persistent real p ( nVertLevels nCells Time ) 2 o p state - -
+var persistent real pTop ( nVertLevelsP1 nCells Time ) 2 o pTop state - -
+var persistent real pZLevel ( nVertLevels nCells Time ) 2 o pZLevel state - -
+var persistent real MontPot ( nVertLevels nCells Time ) 2 o MontPot state - -
+var persistent real wTop ( nVertLevelsP1 nCells Time ) 2 o wTop state - -
+var persistent real ssh ( nCells Time ) 2 o ssh 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 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 - -
# xsad 10-02-05:
# Globally reduced diagnostic variables: only written to output
-var real areaCellGlobal ( Time ) o areaCellGlobal - -
-var real areaEdgeGlobal ( Time ) o areaEdgeGlobal - -
-var real areaTriangleGlobal ( Time ) o areaTriangleGlobal - -
+var persistent real areaCellGlobal ( Time ) 2 o areaCellGlobal state - -
+var persistent real areaEdgeGlobal ( Time ) 2 o areaEdgeGlobal state - -
+var persistent real areaTriangleGlobal ( Time ) 2 o areaTriangleGlobal state - -
-var real volumeCellGlobal ( Time ) o volumeCellGlobal - -
-var real volumeEdgeGlobal ( Time ) o volumeEdgeGlobal - -
-var real CFLNumberGlobal ( Time ) o CFLNumberGlobal - -
+var persistent real volumeCellGlobal ( Time ) 2 o volumeCellGlobal state - -
+var persistent real volumeEdgeGlobal ( Time ) 2 o volumeEdgeGlobal state - -
+var persistent real CFLNumberGlobal ( Time ) 2 o CFLNumberGlobal state - -
# xsad 10-02-05 end
Modified: branches/registry_reorg/src/core_ocean/module_global_diagnostics.F
===================================================================
--- branches/registry_reorg/src/core_ocean/module_global_diagnostics.F 2010-09-16 21:24:38 UTC (rev 503)
+++ branches/registry_reorg/src/core_ocean/module_global_diagnostics.F 2010-09-17 16:37:11 UTC (rev 504)
@@ -27,8 +27,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
@@ -43,7 +43,7 @@
real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
real (kind=RKIND) :: localCFL, localSum
integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
- integer :: timeLevel,k,i
+ integer :: timeLevel,k,i, num_tracers
integer, parameter :: kMaxVariables = 1024 ! this must be a little more than double the number of variables to be reduced
@@ -51,6 +51,8 @@
integer :: fileID
+ num_tracers = state % num_tracers
+
nVertLevels = grid % nVertLevels
nCellsSolve = grid % nCellsSolve
nEdgesSolve = grid % nEdgesSolve
Modified: branches/registry_reorg/src/core_ocean/module_test_cases.F
===================================================================
--- branches/registry_reorg/src/core_ocean/module_test_cases.F 2010-09-16 21:24:38 UTC (rev 503)
+++ branches/registry_reorg/src/core_ocean/module_test_cases.F 2010-09-17 16:37:11 UTC (rev 504)
@@ -44,7 +44,7 @@
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)
block_ptr => block_ptr % next
end do
@@ -54,7 +54,7 @@
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)
block_ptr => block_ptr % next
end do
@@ -64,7 +64,7 @@
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)
block_ptr => block_ptr % next
end do
@@ -74,7 +74,7 @@
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)
block_ptr => block_ptr % next
end do
@@ -89,8 +89,8 @@
do while (associated(block_ptr))
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
@@ -99,10 +99,10 @@
! Initialize z-level grid variables from h, read in from input file.
block_ptr => domain % blocklist
do while (associated(block_ptr))
- h => block_ptr % time_levs(1) % state % h % array
- u => block_ptr % time_levs(1) % state % u % array
- rho => block_ptr % time_levs(1) % state % rho % array
- tracers => block_ptr % time_levs(1) % state % tracers % array
+ h => block_ptr % state % time_levs(1) % state % h % array
+ u => block_ptr % state % time_levs(1) % state % u % array
+ rho => block_ptr % state % time_levs(1) % state % rho % array
+ tracers => block_ptr % state % time_levs(1) % state % tracers % array
u_src => block_ptr % mesh % u_src % array
xCell => block_ptr % mesh % xCell % array
yCell => block_ptr % mesh % yCell % array
@@ -150,27 +150,27 @@
dist = sqrt( (latCell(iCell)-latCenter)**2 + (lonCell(iCell)-lonCenter)**2)
do iLevel = 1,nVertLevels
! for 20 layer test
- ! tracers(index_temperature,iLevel,iCell) = 5.0 ! temperature
- ! tracers(index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
+ ! tracers(block_ptr % state % time_levs(1) % state % index_temperature,iLevel,iCell) = 5.0 ! temperature
+ ! tracers(block_ptr % state % time_levs(1) % state % index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
! for x3, 25 layer test
- !tracers(index_temperature,iLevel,iCell) = 10.0 ! temperature
- !tracers(index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
+ !tracers(block_ptr % state % time_levs(1) % state % index_temperature,iLevel,iCell) = 10.0 ! temperature
+ !tracers(block_ptr % state % time_levs(1) % state % index_salinity,iLevel,iCell) = 1.4 + iLevel*0.6 ! salinity
- ! tracers(index_tracer1,iLevel,iCell) = 1.0
- ! tracers(index_tracer2,iLevel,iCell) = &
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer1,iLevel,iCell) = 1.0
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer2,iLevel,iCell) = &
! (yCell(iCell)/4000.e3 + xCell(iCell)/2500.e3 )/2.0
! Tracer blob
!if (dist.lt.pi/16) then
- ! tracers(index_tracer1,iLevel,iCell) = 1.0
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer1,iLevel,iCell) = 1.0
!!else
- ! tracers(index_tracer1,iLevel,iCell) = 0.0
+ ! tracers(block_ptr % state % time_levs(1) % state % index_tracer1,iLevel,iCell) = 0.0
!endif
rho(iLevel,iCell) = 1000.0*( 1.0 &
- - 2.5e-4*tracers(index_temperature,iLevel,iCell) &
- + 7.6e-4*tracers(index_salinity,iLevel,iCell))
+ - 2.5e-4*tracers(block_ptr % state % time_levs(1) % state % index_temperature,iLevel,iCell) &
+ + 7.6e-4*tracers(block_ptr % state % time_levs(1) % state % index_salinity,iLevel,iCell))
enddo
enddo
@@ -194,7 +194,7 @@
enddo
print '(10a)', 'itracer ilevel min tracer max tracer'
- do iTracer=1,num_tracers
+ do iTracer=1,block_ptr % state % time_levs(1) % state % num_tracers
do iLevel = 1,nVertLevels
print '(2i5,20es12.4)', iTracer,ilevel, &
minval(tracers(itracer,iLevel,1:nCells)), maxval(tracers(itracer,iLevel,1:nCells))
@@ -219,8 +219,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
@@ -295,8 +295,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
@@ -386,8 +386,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
@@ -508,8 +508,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_ocean/module_time_integration.F
===================================================================
--- branches/registry_reorg/src/core_ocean/module_time_integration.F 2010-09-16 21:24:38 UTC (rev 503)
+++ branches/registry_reorg/src/core_ocean/module_time_integration.F 2010-09-17 16:37:11 UTC (rev 504)
@@ -37,13 +37,13 @@
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
- if (isNaN(sum(block % time_levs(2) % state % u % array))) then
- write(0,*) 'Abort: NaN detected'
- call dmpar_abort(dminfo)
- endif
+! if (isNaN(sum(block % state % time_levs(2) % state % u % array))) then
+! write(0,*) 'Abort: NaN detected'
+! call dmpar_abort(dminfo)
+! endif
block => block % next
end do
@@ -69,13 +69,16 @@
integer :: iCell, k, i
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 )
!
! Initialize time_levs(2) with state at current time
@@ -86,16 +89,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
@@ -119,15 +122,15 @@
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)
if (config_h_mom_eddy_visc4 > 0.0) then
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % divergence % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % vorticity % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
block % mesh % nVertLevels, block % mesh % nVertices, &
block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
end if
@@ -139,9 +142,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
@@ -149,14 +152,14 @@
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(:,:,:), &
- num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
+ block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -167,24 +170,24 @@
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
@@ -195,16 +198,16 @@
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
@@ -223,23 +226,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
@@ -255,9 +260,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
@@ -670,9 +675,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, upwindCell,&
nEdges, nCells, nVertLevels
@@ -733,7 +738,7 @@
cell2 = cellsOnEdge(2,iEdge)
if (cell1 <= nCells .and. cell2 <= nCells) then
do k=1,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracer_edge = 0.5 * ( tracers(iTracer,k,cell1) &
+ tracers(iTracer,k,cell2))
flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) &
@@ -757,7 +762,7 @@
else
upwindCell = cell2
endif
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) &
* tracers(iTracer,k,upwindCell)
tend_tr(iTracer,k,cell1) = tend_tr(iTracer,k,cell1) - flux
@@ -770,7 +775,7 @@
endif
do iCell=1,grid % nCellsSolve
do k=1,grid % nVertLevelsSolve
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) / areaCell(iCell)
end do
end do
@@ -779,14 +784,14 @@
!
! tracer tendency: vertical advection term -d/dz( h \phi w)
!
- allocate(tracerTop(num_tracers,nVertLevels+1))
+ allocate(tracerTop(s % num_tracers,nVertLevels+1))
tracerTop(:,1)=0.0
tracerTop(:,nVertLevels+1)=0.0
do iCell=1,grid % nCellsSolve
if (config_vert_tracer_adv.eq.'centered') then
do k=2,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracerTop(iTracer,k) = ( tracers(iTracer,k-1,iCell) &
+tracers(iTracer,k ,iCell))/2.0
end do
@@ -799,7 +804,7 @@
else
upwindCell = k-1
endif
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracerTop(iTracer,k) = tracers(iTracer,upwindCell,iCell)
end do
end do
@@ -807,7 +812,7 @@
endif
do k=1,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) &
- ( wTop(k ,iCell)*tracerTop(iTracer,k ) &
- wTop(k+1,iCell)*tracerTop(iTracer,k+1))
@@ -836,7 +841,7 @@
invAreaCell2 = 1.0/areaCell(cell2)
do k=1,grid % nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
! \kappa_2 </font>
<font color="gray">abla \phi on edge
tracer_turb_flux = h_tracer_eddy_diff2 &
*( tracers(iTracer,k,cell2) &
@@ -869,7 +874,7 @@
boundaryMask = 1.0
where(boundaryEdge.eq.1) boundaryMask=0.0
- allocate(delsq_tracer(num_tracers,nVertLevels, nCells+1))
+ allocate(delsq_tracer(s % num_tracers,nVertLevels, nCells+1))
delsq_tracer(:,:,:) = 0.
@@ -879,7 +884,7 @@
cell2 = grid % cellsOnEdge % array(2,iEdge)
do k=1,grid % nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
delsq_tracer(iTracer,k,cell1) = delsq_tracer(iTracer,k,cell1) &
+ dvEdge(iEdge)*h_edge(k,iEdge) &
*(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &
@@ -896,7 +901,7 @@
do iCell = 1, nCells
r = 1.0 / areaCell(iCell)
do k=1,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
delsq_tracer(iTracer,k,iCell) = delsq_tracer(iTracer,k,iCell) * r
end do
end do
@@ -910,7 +915,7 @@
invAreaCell2 = 1.0 / areaCell(cell2)
do k=1,grid % nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tracer_turb_flux = h_tracer_eddy_diff4 &
*( delsq_tracer(iTracer,k,cell2) &
- delsq_tracer(iTracer,k,cell1))/dcEdge(iEdge)
@@ -954,12 +959,12 @@
call dmpar_abort(dminfo)
endif
- allocate(fluxVertTop(num_tracers,nVertLevels+1))
+ allocate(fluxVertTop(s % num_tracers,nVertLevels+1))
fluxVertTop(:,1) = 0.0
fluxVertTop(:,nVertLevels+1) = 0.0
do iCell=1,grid % nCellsSolve
do k=2,nVertLevels
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
! compute \kappa_v d\phi/dz
fluxVertTop(iTracer,k) = vertDiffTop(k) &
* (tracers(iTracer,k-1,iCell) - tracers(iTracer,k,iCell) )&
@@ -969,7 +974,7 @@
do k=1,nVertLevels
dist = zTop(k,iCell) - zTop(k+1,iCell)
- do iTracer=1,num_tracers
+ do iTracer=1,s % num_tracers
tend_tr(iTracer,k,iCell) = tend_tr(iTracer,k,iCell) &
+ h(k,iCell)*(fluxVertTop(iTracer,k) - fluxVertTop(iTracer,k+1))/dist
enddo
@@ -982,7 +987,7 @@
! print some diagnostics - for debugging
! print *, 'after vertical mixing',&
! 'iTracer,k, minval(tend_tr(itracer,k,:)), maxval(tend_tr(itracer,k,:))'
-! do iTracer=1,num_tracers
+! do iTracer=1,s % num_tracers
! do k = 1,nVertLevels
! print '(2i5,20es12.4)', iTracer,k, &
! minval(tend_tr(itracer,k,:)), maxval(tend_tr(itracer,k,:))
@@ -1005,8 +1010,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
@@ -1322,8 +1327,8 @@
do k=1,nVertLevels
! Linear equation of state, for the time being
rho(k,iCell) = 1000.0*( 1.0 &
- - 2.5e-4*tracers(index_temperature,k,iCell) &
- + 7.6e-4*tracers(index_salinity,k,iCell))
+ - 2.5e-4*tracers(s % index_temperature,k,iCell) &
+ + 7.6e-4*tracers(s % index_salinity,k,iCell))
end do
end do
endif
@@ -1458,8 +1463,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_ocean/mpas_interface.F
===================================================================
--- branches/registry_reorg/src/core_ocean/mpas_interface.F 2010-09-16 21:24:38 UTC (rev 503)
+++ branches/registry_reorg/src/core_ocean/mpas_interface.F 2010-09-17 16:37:11 UTC (rev 504)
@@ -22,21 +22,21 @@
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)
! mrp 100316 In order for this to work, we need to pass domain % dminfo as an
! input arguement into mpas_init. Ask about that later. For now, there will be
! no initial statistics write.
! call timer_start("global diagnostics")
-! call computeGlobalDiagnostics(domain % dminfo, block % time_levs(1) % state, mesh, 0, dt)
+! call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
! call timer_stop("global diagnostics")
! call output_state_init(output_obj, domain, "OUTPUT")
! call write_output_frame(output_obj, domain)
@@ -83,7 +83,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
</font>
</pre>