<p><b>duda</b> 2010-09-16 15:24:38 -0600 (Thu, 16 Sep 2010)</p><p>BRANCH COMMIT<br>
<br>
Update hydrostatic core to use new data structures.<br>
<br>
Testing with the baroclinic wave case gives bit-identical results <br>
to the trunk.<br>
<br>
<br>
M src/core_hyd_atmos/mpas_interface.F<br>
M src/core_hyd_atmos/module_advection.F<br>
M src/core_hyd_atmos/module_test_cases.F<br>
M src/core_hyd_atmos/Registry<br>
M src/core_hyd_atmos/module_time_integration.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/registry_reorg/src/core_hyd_atmos/Registry
===================================================================
--- branches/registry_reorg/src/core_hyd_atmos/Registry 2010-09-16 20:49:08 UTC (rev 502)
+++ branches/registry_reorg/src/core_hyd_atmos/Registry 2010-09-16 21:24:38 UTC (rev 503)
@@ -43,127 +43,136 @@
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 - -
# description of the vertical grid structure
-var real rdnu ( nVertLevels ) iro rdnu - -
-var real rdnw ( nVertLevels ) iro rdnw - -
-var real fnm ( nVertLevels ) iro fnm - -
-var real fnp ( nVertLevels ) iro fnp - -
-var real dbn ( nVertLevels ) iro dbn - -
-var real dnu ( nVertLevels ) iro dnu - -
-var real dnw ( nVertLevels ) iro dnw - -
+var persistent real rdnu ( nVertLevels ) 0 iro rdnu mesh - -
+var persistent real rdnw ( nVertLevels ) 0 iro rdnw mesh - -
+var persistent real fnm ( nVertLevels ) 0 iro fnm mesh - -
+var persistent real fnp ( nVertLevels ) 0 iro fnp mesh - -
+var persistent real dbn ( nVertLevels ) 0 iro dbn mesh - -
+var persistent real dnu ( nVertLevels ) 0 iro dnu mesh - -
+var persistent real dnw ( nVertLevels ) 0 iro dnw mesh - -
# Prognostic variables: read from input, saved in restart, and written to output
-var real u ( nVertLevels nEdges Time ) iro u - -
-var real theta ( nVertLevels nCells Time ) iro theta - -
-var real surface_pressure ( nCells Time ) iro surface_pressure - -
-var real qv ( nVertLevels nCells Time ) iro qv scalars moist
-var real qc ( nVertLevels nCells Time ) iro qc scalars moist
-var real qr ( nVertLevels nCells Time ) iro qr scalars moist
-#var real tracers ( nTracers nVertLevels nCells Time ) iro tracers - -
+var persistent real u ( nVertLevels nEdges Time ) 2 iro u state - -
+var persistent real theta ( nVertLevels nCells Time ) 2 iro theta state - -
+var persistent real surface_pressure ( nCells Time ) 2 iro surface_pressure state - -
+var persistent real qv ( nVertLevels nCells Time ) 2 iro qv state scalars moist
+var persistent real qc ( nVertLevels nCells Time ) 2 iro qc state scalars moist
+var persistent real qr ( nVertLevels nCells Time ) 2 iro qr state scalars moist
+#var persistent real tracers ( nTracers nVertLevels nCells Time ) 2 iro state tracers - -
# state variables diagnosed from prognostic state
-var real h ( nVertLevels nCells Time ) ro h - -
-var real ww ( nVertLevelsP1 nCells Time ) ro ww - -
-var real w ( nVertLevelsP1 nCells Time ) ro w - -
-var real pressure ( nVertLevelsP1 nCells Time ) ro pressure - -
-var real geopotential ( nVertLevelsP1 nCells Time ) ro geopotential - -
-var real alpha ( nVertLevels nCells Time ) iro alpha - -
+var persistent real h ( nVertLevels nCells Time ) 2 ro h state - -
+var persistent real ww ( nVertLevelsP1 nCells Time ) 2 ro ww state - -
+var persistent real w ( nVertLevelsP1 nCells Time ) 2 ro w state - -
+var persistent real pressure ( nVertLevelsP1 nCells Time ) 2 ro pressure state - -
+var persistent real geopotential ( nVertLevelsP1 nCells Time ) 2 ro geopotential state - -
+var persistent real alpha ( nVertLevels nCells Time ) 2 iro alpha state - -
# 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 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 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 - -
+# Tendency variables
+var persistent real tend_h ( nVertLevels nCells Time ) 1 - h tend - -
+var persistent real tend_u ( nVertLevels nEdges Time ) 1 - u tend - -
+var persistent real tend_vh ( nVertLevels nEdges Time ) 1 - vh tend - -
+var persistent real tend_theta ( nVertLevels nCells Time ) 1 - theta tend - -
+var persistent real tend_qv ( nVertLevels nCells Time ) 1 - qv tend scalars moist
+var persistent real tend_qc ( nVertLevels nCells Time ) 1 - qc tend scalars moist
+var persistent real tend_qr ( nVertLevels nCells Time ) 1 - qr tend scalars moist
+
# 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 - -
-var real uhAvg ( nVertLevels nEdges ) - uhAvg - -
-var real wwAvg ( nVertLevelsP1 nCells ) - wwAvg - -
-var real qtot ( nVertLevels nCells ) - qtot - -
-var real cqu ( nVertLevels nEdges ) - cqu - -
-var real h_diabatic ( nVertLevels nCells ) - h_diabatic - -
-var real dpsdt ( nCells ) - dpsdt - -
+var persistent real uhAvg ( nVertLevels nEdges ) 0 - uhAvg mesh - -
+var persistent real wwAvg ( nVertLevelsP1 nCells ) 0 - wwAvg mesh - -
+var persistent real qtot ( nVertLevels nCells ) 0 - qtot mesh - -
+var persistent real cqu ( nVertLevels nEdges ) 0 - cqu mesh - -
+var persistent real h_diabatic ( nVertLevels nCells ) 0 - h_diabatic mesh - -
+var persistent real dpsdt ( nCells ) 0 - dpsdt mesh - -
-var real u_old ( nVertLevels nEdges ) - u_old - -
-var real ww_old ( nVertLevelsP1 nCells ) - ww_old - -
-var real theta_old ( nVertLevels nCells ) - theta_old - -
-var real h_edge_old ( nVertLevels nEdges ) - h_edge_old - -
-var real h_old ( nVertLevels nCells ) - h_old - -
-var real pressure_old ( nVertLevelsP1 nCells ) - pressure_old - -
-var real qv_old ( nVertLevels nCells ) - qv_old scalars_old moist_old
-var real qc_old ( nVertLevels nCells ) - qc_old scalars_old moist_old
-var real qr_old ( nVertLevels nCells ) - qr_old scalars_old moist_old
-#var real tracers_old ( nTracers nVertLevels nCells ) - tracers_old - -
+var persistent real u_old ( nVertLevels nEdges ) 0 - u_old mesh - -
+var persistent real ww_old ( nVertLevelsP1 nCells ) 0 - ww_old mesh - -
+var persistent real theta_old ( nVertLevels nCells ) 0 - theta_old mesh - -
+var persistent real h_edge_old ( nVertLevels nEdges ) 0 - h_edge_old mesh - -
+var persistent real h_old ( nVertLevels nCells ) 0 - h_old mesh - -
+var persistent real pressure_old ( nVertLevelsP1 nCells ) 0 - pressure_old mesh - -
+var persistent real qv_old ( nVertLevels nCells ) 0 - qv_old mesh scalars_old moist_old
+var persistent real qc_old ( nVertLevels nCells ) 0 - qc_old mesh scalars_old moist_old
+var persistent real qr_old ( nVertLevels nCells ) 0 - qr_old mesh scalars_old moist_old
+#var persistent real tracers_old ( nTracers nVertLevels nCells ) 0 - tracers_old mesh - -
# Space needed for advection
-var real deriv_two ( FIFTEEN TWO nEdges ) o deriv_two - -
-var integer advCells ( TWENTYONE nCells ) - advCells - -
+var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 o deriv_two mesh - -
+var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells 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 - -
Modified: branches/registry_reorg/src/core_hyd_atmos/module_advection.F
===================================================================
--- branches/registry_reorg/src/core_hyd_atmos/module_advection.F 2010-09-16 20:49:08 UTC (rev 502)
+++ branches/registry_reorg/src/core_hyd_atmos/module_advection.F 2010-09-16 21:24:38 UTC (rev 503)
@@ -17,7 +17,7 @@
!
implicit none
- type (grid_meta), intent(in) :: grid
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
integer, dimension(:,:), pointer :: advCells
Modified: branches/registry_reorg/src/core_hyd_atmos/module_test_cases.F
===================================================================
--- branches/registry_reorg/src/core_hyd_atmos/module_test_cases.F 2010-09-16 20:49:08 UTC (rev 502)
+++ branches/registry_reorg/src/core_hyd_atmos/module_test_cases.F 2010-09-16 21:24:38 UTC (rev 503)
@@ -35,9 +35,9 @@
if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call hyd_test_case_1(block_ptr % mesh, block_ptr % time_levs(1) % state, config_test_case)
+ call hyd_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state, config_test_case)
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
@@ -59,8 +59,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
integer, intent(in) :: test_case
real (kind=RKIND), parameter :: u0 = 35.0
@@ -78,7 +78,7 @@
real (kind=RKIND), dimension(:,:), pointer :: pressure, theta, alpha, geopotential, h
real (kind=RKIND), dimension(:,:,:), pointer :: scalars
- integer :: iCell, iEdge, vtx1, vtx2, ivtx, k, nz, nz1
+ integer :: iCell, iEdge, vtx1, vtx2, ivtx, k, nz, nz1, index_qv
real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
real (kind=RKIND) :: ptop, p0, phi
@@ -129,6 +129,8 @@
grid % areaCell % array = grid % areaCell % array * a**2.0
grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+ index_qv = state % index_qv
nz1 = grid % nVertLevels
nz = nz1 + 1
Modified: branches/registry_reorg/src/core_hyd_atmos/module_time_integration.F
===================================================================
--- branches/registry_reorg/src/core_hyd_atmos/module_time_integration.F 2010-09-16 20:49:08 UTC (rev 502)
+++ branches/registry_reorg/src/core_hyd_atmos/module_time_integration.F 2010-09-16 21:24:38 UTC (rev 503)
@@ -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
@@ -100,7 +100,7 @@
block => domain % blocklist
do while (associated(block))
- call copy_state( block % time_levs(1) % state, block % time_levs(2) % state )
+ call copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
block => block % next
end do
@@ -121,26 +121,26 @@
call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % cqu % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % h % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h % 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 % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % geopotential % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % alpha % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % alpha % 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 % pv_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % 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
@@ -151,7 +151,7 @@
block => domain % blocklist
do while (associated(block))
- call compute_dyn_tend( block % intermediate_step(TEND), block % time_levs(2) % state, block % mesh )
+ call compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % mesh )
block => block % next
end do
@@ -162,10 +162,10 @@
!
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) % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % theta % array(:,:), &
block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
@@ -181,9 +181,9 @@
! from the previous RK step are needed to compute new scalar tendencies in advance_scalars.
! A cleaner way of preserving scalars should be added in future.
!
- block % mesh % scalars_old % array(:,:,:) = block % time_levs(2) % state % scalars % array(:,:,:)
- call copy_state( block % time_levs(1) % state, block % time_levs(2) % state )
- block % time_levs(2) % state % scalars % array(:,:,:) = block % mesh % scalars_old % array(:,:,:)
+ block % mesh % scalars_old % array(:,:,:) = block % state % time_levs(2) % state % scalars % array(:,:,:)
+ call copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
+ block % state % time_levs(2) % state % scalars % array(:,:,:) = block % mesh % scalars_old % array(:,:,:)
block => block % next
end do
@@ -195,8 +195,8 @@
block => domain % blocklist
do while (associated(block))
- call advance_dynamics( block % intermediate_step(TEND), block % time_levs(2) % state, &
- block % mesh, &
+ call advance_dynamics( block % tend, block % state % time_levs(2) % state, &
+ block % mesh, &
small_step, number_sub_steps(rk_step), rk_sub_timestep(rk_step) )
block => block % next
end do
@@ -209,10 +209,10 @@
!
block => domain % blocklist
do while (associated(block))
-!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % u % array(:,:), &
+!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % u % array(:,:), &
!! block % mesh % nVertLevels, block % mesh % nEdges, &
!! block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % h_edge % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % uhAvg % array(:,:), &
@@ -221,34 +221,34 @@
!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % wwAvg % array(:,:), &
!! block % mesh % nVertLevels+1, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % theta % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % theta % 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 % h % array(:,:), &
+!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &
!! block % mesh % nVertLevels, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-!! 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_field1dReal(domain % dminfo, block % mesh % dpsdt % array(:), &
block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field1dReal(domain % dminfo, block % time_levs(2) % state % surface_pressure % array(:), &
+ call dmpar_exch_halo_field1dReal(domain % dminfo, block % state % time_levs(2) % state % surface_pressure % array(:), &
block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % alpha % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % alpha % 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 % ww % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % ww % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % pressure % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
!! call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % pressure_old % array(:,:), &
!! block % mesh % nVertLevels+1, block % mesh % nCells, &
!! block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(2) % state % geopotential % array(:,:), &
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &
block % mesh % nVertLevels+1, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
@@ -269,13 +269,13 @@
! so we keep the advance_scalars routine as well
!
if (rk_step < 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
- call advance_scalars( block % intermediate_step(TEND), &
- block % time_levs(1) % state, block % time_levs(2) % state, &
+ call advance_scalars( block % tend, &
+ block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
block % mesh, rk_timestep(rk_step) )
else
- call advance_scalars_mono( block % intermediate_step(TEND), &
- block % time_levs(1) % state, block % time_levs(2) % state, &
- block % mesh, rk_timestep(rk_step), rk_step, 3, &
+ call advance_scalars_mono( block % tend, &
+ block % state % time_levs(1) % state, block % state % time_levs(2) % state, &
+ block % mesh, rk_timestep(rk_step), rk_step, 3, &
domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
end if
block => block % next
@@ -283,11 +283,11 @@
block => domain % blocklist
do while (associated(block))
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % intermediate_step(TEND) % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % scalars % array(:,:,:), &
+ block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(2) % state % scalars % array(:,:,:), &
- num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &
+ block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do
@@ -299,9 +299,9 @@
block => domain % blocklist
do while (associated(block))
- call compute_solver_constants( block % time_levs(2) % state, block % mesh )
- call compute_state_diagnostics( block % time_levs(2) % state, block % mesh )
- call compute_solve_diagnostics( dt, block % time_levs(2) % state, block % mesh )
+ call compute_solver_constants( block % state % time_levs(2) % state, block % mesh )
+ call compute_state_diagnostics( block % state % time_levs(2) % state, block % mesh )
+ call compute_solve_diagnostics( dt, block % state % time_levs(2) % state, block % mesh )
block => block % next
end do
@@ -320,8 +320,8 @@
!
block => domain % blocklist
do while (associated(block))
- call reconstruct(block % time_levs(2) % state, block % mesh)
- call compute_w(block % time_levs(2) % state, block % time_levs(1) % state, block % mesh, dt)
+ call reconstruct(block % state % time_levs(2) % state, block % mesh)
+ call compute_w(block % state % time_levs(2) % state, block % state % time_levs(1) % state, block % mesh, dt)
block => block % next
end do
@@ -331,21 +331,21 @@
domain_mass = 0.
scalar_mass = 0.
block => domain % blocklist
- scalar_min = block % time_levs(2) % state % scalars % array (2,1,1)
- scalar_max = block % time_levs(2) % state % scalars % array (2,1,1)
+ scalar_min = block % state % time_levs(2) % state % scalars % array (2,1,1)
+ scalar_max = block % state % time_levs(2) % state % scalars % array (2,1,1)
do while(associated(block))
do iCell = 1, block % mesh % nCellsSolve
- domain_mass = domain_mass + block % time_levs(2) % state % surface_pressure % array (iCell) * &
+ domain_mass = domain_mass + block % state % time_levs(2) % state % surface_pressure % array (iCell) * &
block % mesh % areaCell % array (iCell) &
- - block % time_levs(2) % state % pressure % array (block % mesh % nVertLevels + 1, 1) * &
+ - block % state % time_levs(2) % state % pressure % array (block % mesh % nVertLevels + 1, 1) * &
block % mesh % areaCell % array (iCell)
do k=1, block % mesh % nVertLevelsSolve
- scalar_mass = scalar_mass - block % time_levs(2) % state % scalars % array (2,k,iCell) * &
- block % time_levs(2) % state % h % array (k,iCell) * &
+ scalar_mass = scalar_mass - block % state % time_levs(2) % state % scalars % array (2,k,iCell) * &
+ block % state % time_levs(2) % state % h % array (k,iCell) * &
block % mesh % dnw % array (k) * &
block % mesh % areaCell % array (iCell)
- scalar_min = min(scalar_min,block % time_levs(2) % state % scalars % array (2,k,iCell))
- scalar_max = max(scalar_max,block % time_levs(2) % state % scalars % array (2,k,iCell))
+ scalar_min = min(scalar_min,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
+ scalar_max = max(scalar_max,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
end do
end do
block => block % next
@@ -378,8 +378,8 @@
implicit none
- type (grid_state), intent(in) :: s
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(in) :: s
+ type (mesh_type), intent(inout) :: grid
integer :: iEdge, iCell, k, cell1, cell2, iq
@@ -392,11 +392,11 @@
grid % qtot % array = 0.
grid % cqu % array = 1.
- if (num_scalars > 0) then
+ if (s % num_scalars > 0) then
do iCell = 1, nCells
do k = 1, nVertLevels
- do iq = moist_start, moist_end
+ do iq = s % moist_start, s % moist_end
grid % qtot % array(k,iCell) = grid % qtot % array(k,iCell) + s % scalars % array (iq, k, iCell)
end do
end do
@@ -430,8 +430,8 @@
implicit none
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(inout) :: grid
real (kind=RKIND), dimension(:,:,:), pointer :: scalar
real (kind=RKIND), dimension(:,:), pointer :: h, pressure, qtot, alpha, geopotential, theta
@@ -521,9 +521,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, h_vertex, workpv, q, upstream_bias
@@ -1022,9 +1022,9 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(inout) :: s
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(inout) :: s
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND), intent(in) :: dt
integer, intent(in) :: small_step, number_small_steps
@@ -1275,13 +1275,13 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(in) :: s_old
- type (grid_state), intent(out) :: s_new
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(in) :: s_old
+ type (state_type), intent(inout) :: s_new
+ type (mesh_type), intent(in) :: grid
real (kind=RKIND) :: dt
- integer :: i, iCell, iEdge, k, iScalar, cell1, cell2
+ integer :: i, iCell, iEdge, k, iScalar, cell1, cell2, num_scalars
real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
@@ -1290,12 +1290,14 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nVertLevels + 1 ) :: wdtn
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels + 1 ) :: wdtn
integer :: nVertLevels
real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
real (kind=RKIND) :: coef_3rd_order
+ num_scalars = s_old % num_scalars
+
coef_3rd_order = 0.
if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
@@ -1462,16 +1464,16 @@
implicit none
- type (grid_state), intent(in) :: tend
- type (grid_state), intent(in) :: s_old
- type (grid_state), intent(out) :: s_new
- type (grid_meta), intent(in) :: grid
+ type (tend_type), intent(in) :: tend
+ type (state_type), intent(in) :: s_old
+ type (state_type), intent(inout) :: s_new
+ type (mesh_type), intent(in) :: grid
integer, intent(in) :: rk_step, rk_order
real (kind=RKIND), intent(in) :: dt
type (dm_info), intent(in) :: dminfo
type (exchange_list), pointer :: cellsToSend, cellsToRecv
- integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2
+ integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2, num_scalars
real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
real (kind=RKIND) :: fdir, flux_upwind, h_flux_upwind, s_upwind
@@ -1481,10 +1483,10 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nEdges+1) :: h_flux
- real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
- real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
- real (kind=RKIND), dimension( num_scalars ) :: s_max, s_min, s_max_update, s_min_update
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nEdges+1) :: h_flux
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
+ real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
+ real (kind=RKIND), dimension( s_old % num_scalars ) :: s_max, s_min, s_max_update, s_min_update
integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
@@ -1492,6 +1494,8 @@
real (kind=RKIND), parameter :: eps=1.e-20
real (kind=RKIND) :: coef_3rd_order
+ num_scalars = s_old % num_scalars
+
scalar_old => s_old % scalars % array
scalar_new => s_new % scalars % array
deriv_two => grid % deriv_two % array
@@ -1794,8 +1798,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
@@ -2045,9 +2049,9 @@
implicit none
- type (grid_state), intent(inout) :: s_new
- type (grid_state), intent(in) :: s_old
- type (grid_meta), intent(inout) :: grid
+ type (state_type), intent(inout) :: s_new
+ type (state_type), intent(in) :: s_old
+ type (mesh_type), intent(inout) :: grid
real (kind=RKIND), intent(in) :: dt
Modified: branches/registry_reorg/src/core_hyd_atmos/mpas_interface.F
===================================================================
--- branches/registry_reorg/src/core_hyd_atmos/mpas_interface.F 2010-09-16 20:49:08 UTC (rev 502)
+++ branches/registry_reorg/src/core_hyd_atmos/mpas_interface.F 2010-09-16 21:24:38 UTC (rev 503)
@@ -23,16 +23,16 @@
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_solver_constants(block % time_levs(1) % state, mesh)
- call compute_state_diagnostics(block % time_levs(1) % state, mesh)
- call compute_solve_diagnostics(dt, block % time_levs(1) % state, mesh)
+ call compute_solver_constants(block % state % time_levs(1) % state, mesh)
+ call compute_state_diagnostics(block % state % time_levs(1) % state, mesh)
+ call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
call initialize_advection_rk(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
</font>
</pre>