<p><b>duda</b> 2010-09-23 22:02:02 -0600 (Thu, 23 Sep 2010)</p><p>Merge registry reorganization changes from branches/registry_reorg r500:505<br>
into trunk.<br>
<br>
With these changes, the new form of registry entries for variables is<br>
#<br>
# var persistence type name_in_file ( dims ) time_levs iro- name_in_code struct super-array array_class<br>
#<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>
M src/core_sw/module_global_diagnostics.F<br>
M src/core_sw/mpas_interface.F<br>
M src/core_sw/module_test_cases.F<br>
M src/core_sw/Registry<br>
M src/core_sw/module_time_integration.F<br>
M src/registry/registry_types.h<br>
M src/registry/gen_inc.c<br>
M src/registry/gen_inc.h<br>
M src/registry/parse.c<br>
M src/driver/module_subdriver.F<br>
M src/core_ocean/module_global_diagnostics.F<br>
M src/core_ocean/mpas_interface.F<br>
M src/core_ocean/module_test_cases.F<br>
M src/core_ocean/Registry<br>
M src/core_ocean/module_time_integration.F<br>
M src/framework/module_io_output.F<br>
M src/framework/module_grid_types.F<br>
M src/operators/module_RBF_interpolation.F<br>
M src/operators/module_vector_reconstruction.F<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/mpas/src/core_hyd_atmos/Registry
===================================================================
--- trunk/mpas/src/core_hyd_atmos/Registry 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_hyd_atmos/Registry 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_hyd_atmos/module_advection.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_advection.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_hyd_atmos/module_advection.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_hyd_atmos/module_test_cases.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_test_cases.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_hyd_atmos/module_test_cases.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_hyd_atmos/module_time_integration.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_time_integration.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_hyd_atmos/module_time_integration.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_hyd_atmos/mpas_interface.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/mpas_interface.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_hyd_atmos/mpas_interface.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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
Modified: trunk/mpas/src/core_ocean/Registry
===================================================================
--- trunk/mpas/src/core_ocean/Registry 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_ocean/Registry 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_ocean/module_global_diagnostics.F
===================================================================
--- trunk/mpas/src/core_ocean/module_global_diagnostics.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_ocean/module_global_diagnostics.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_ocean/module_test_cases.F
===================================================================
--- trunk/mpas/src/core_ocean/module_test_cases.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_ocean/module_test_cases.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_ocean/module_time_integration.F
===================================================================
--- trunk/mpas/src/core_ocean/module_time_integration.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_ocean/module_time_integration.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -37,10 +37,10 @@
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
+ if (isNaN(sum(block % state % time_levs(2) % state % u % array))) then
write(0,*) 'Abort: NaN detected'
call dmpar_abort(dminfo)
endif
@@ -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: trunk/mpas/src/core_ocean/mpas_interface.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_interface.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_ocean/mpas_interface.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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
Modified: trunk/mpas/src/core_sw/Registry
===================================================================
--- trunk/mpas/src/core_sw/Registry 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_sw/Registry 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_sw/module_global_diagnostics.F
===================================================================
--- trunk/mpas/src/core_sw/module_global_diagnostics.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_sw/module_global_diagnostics.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_sw/module_test_cases.F
===================================================================
--- trunk/mpas/src/core_sw/module_test_cases.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_sw/module_test_cases.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_sw/module_time_integration.F
===================================================================
--- trunk/mpas/src/core_sw/module_time_integration.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_sw/module_time_integration.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/core_sw/mpas_interface.F
===================================================================
--- trunk/mpas/src/core_sw/mpas_interface.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/core_sw/mpas_interface.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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: trunk/mpas/src/driver/module_subdriver.F
===================================================================
--- trunk/mpas/src/driver/module_subdriver.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/driver/module_subdriver.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -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
Modified: trunk/mpas/src/framework/module_grid_types.F
===================================================================
--- trunk/mpas/src/framework/module_grid_types.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/framework/module_grid_types.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -4,8 +4,7 @@
integer, parameter :: nTimeLevs = 2
-#include "super_array_indices.inc"
-
+
! Derived type describing info for doing I/O specific to a field
type io_info
character (len=1024) :: fieldName
@@ -66,7 +65,7 @@
! Derived type for storing grid meta-data
- type grid_meta
+ type mesh_type
#include "field_dimensions.inc"
@@ -75,21 +74,12 @@
#include "time_invariant_fields.inc"
- end type grid_meta
+ end type mesh_type
- ! Derived type for storing model state
- type grid_state
+#include "variable_groups.inc"
-#include "time_varying_fields.inc"
- end type grid_state
-
- type grid_state_ptr
- type (grid_state), pointer :: state
- end type grid_state_ptr
-
-
! Type for storing (possibly architecture specific) information concerning to parallelism
type parallel_info
type (exchange_list), pointer :: cellsToSend ! List of types describing which cells to send to other blocks
@@ -105,11 +95,8 @@
type block_type
integer :: storageFactor ! Additional storage used by time integration scheme
- type (grid_meta), pointer :: mesh
- type (grid_state_ptr), pointer, dimension(:) :: time_levs
+#include "block_group_members.inc"
- type (grid_state), allocatable, dimension(:) :: intermediate_step
-
type (domain_type), pointer :: domain
type (parallel_info), pointer :: parinfo
@@ -170,60 +157,21 @@
nullify(b % prev)
nullify(b % next)
- allocate(b % time_levs(nTimeLevs))
-
- allocate(b % mesh)
- call allocate_grid_meta(b % mesh, &
-#include "dim_dummy_args.inc"
- )
-
- do i=1,nTimeLevs
- allocate(b % time_levs(i) % state)
- call allocate_grid_state(b % time_levs(i) % state, b)
- end do
-
key = 'STORAGE_FACTOR'
call mpas_query(key, b % storageFactor)
- ! Allocate storage for intermediate steps used by time integration scheme
- allocate(b % intermediate_step(b % storageFactor))
- do i=1,b % storageFactor
- call allocate_grid_state(b % intermediate_step(i), b)
- end do
-
allocate(b % parinfo)
b % domain => dom
+#include "block_allocs.inc"
+
end subroutine allocate_block
- subroutine allocate_grid_meta(g, &
-#include "dim_dummy_args.inc"
- )
+#include "group_alloc_routines.inc"
- implicit none
- type (grid_meta), intent(inout) :: g
-#include "dim_dummy_decls.inc"
-
-#include "grid_meta_allocs.inc"
-
- end subroutine allocate_grid_meta
-
-
- subroutine allocate_grid_state(s, b)
-
- implicit none
-
- type (grid_state), intent(inout) :: s
- type (block_type), pointer :: b
-
-#include "grid_state_allocs.inc"
-
- end subroutine allocate_grid_state
-
-
subroutine deallocate_domain(dom)
implicit none
@@ -251,78 +199,19 @@
integer :: i
- call deallocate_grid_meta(b % mesh)
- deallocate(b % mesh)
- do i=1,nTimeLevs
- call deallocate_grid_state(b % time_levs(i) % state)
- deallocate(b % time_levs(i) % state)
- end do
- deallocate(b % time_levs)
- do i=1,b % storageFactor
- call deallocate_grid_state(b % intermediate_step(i))
- end do
- deallocate(b % intermediate_step)
deallocate(b % parinfo)
+#include "block_deallocs.inc"
+
end subroutine deallocate_block
- subroutine deallocate_grid_meta(g)
+#include "group_dealloc_routines.inc"
- implicit none
- type (grid_meta), intent(inout) :: g
+#include "group_copy_routines.inc"
-#include "grid_meta_deallocs.inc"
- end subroutine deallocate_grid_meta
+#include "group_shift_level_routines.inc"
-
- subroutine deallocate_grid_state(s)
-
- implicit none
-
- type (grid_state), intent(inout) :: s
-
-#include "grid_state_deallocs.inc"
-
- end subroutine deallocate_grid_state
-
-
- subroutine copy_state(src, dest)
-
- implicit none
-
- type (grid_state), intent(in) :: src
- type (grid_state), intent(inout) :: dest
-
-#include "copy_state.inc"
-
- end subroutine copy_state
-
-
- subroutine shift_time_levels(domain)
-
- implicit none
-
- type (domain_type), intent(inout) :: domain
-
- integer :: i
- type (block_type), pointer :: block_ptr
- type (grid_state), pointer :: sptr
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
-
- sptr => block_ptr % time_levs(1) % state
- do i=1,nTimeLevs-1
- block_ptr % time_levs(i) % state => block_ptr % time_levs(i+1) % state
- end do
- block_ptr % time_levs(nTimeLevs) % state => sptr
-
- block_ptr => block_ptr % next
- end do
-
- end subroutine shift_time_levels
-
end module grid_types
Modified: trunk/mpas/src/framework/module_io_output.F
===================================================================
--- trunk/mpas/src/framework/module_io_output.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/framework/module_io_output.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -337,7 +337,7 @@
type (io_output_object), intent(inout) :: output_obj
type (dm_info), intent(in) :: dminfo
- type (grid_meta), intent(in) :: mesh
+ type (mesh_type), intent(in) :: mesh
#include "dim_dummy_decls.inc"
integer :: nferr
Modified: trunk/mpas/src/operators/module_RBF_interpolation.F
===================================================================
--- trunk/mpas/src/operators/module_RBF_interpolation.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/operators/module_RBF_interpolation.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -112,7 +112,7 @@
implicit none
- type (grid_meta), intent(inout) :: grid
+ type (mesh_type), intent(inout) :: grid
integer :: nCells, nEdges
integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
Modified: trunk/mpas/src/operators/module_vector_reconstruction.F
===================================================================
--- trunk/mpas/src/operators/module_vector_reconstruction.F 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/operators/module_vector_reconstruction.F 2010-09-24 04:02:02 UTC (rev 509)
@@ -23,7 +23,7 @@
implicit none
- type (grid_meta), intent(inout) :: grid
+ type (mesh_type), intent(inout) :: grid
! temporary arrays needed in the (to be constructed) init procedure
integer :: nCellsSolve
@@ -123,8 +123,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
! temporary arrays needed in the compute procedure
integer :: nCellsSolve
Modified: trunk/mpas/src/registry/gen_inc.c
===================================================================
--- trunk/mpas/src/registry/gen_inc.c 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/registry/gen_inc.c 2010-09-24 04:02:02 UTC (rev 509)
@@ -150,12 +150,15 @@
}
-void gen_field_defs(struct variable * vars, struct dimension * dims)
+void gen_field_defs(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
struct variable * var_ptr2;
+ struct variable_list * var_list_ptr;
+ struct variable_list * var_list_ptr2;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr;
+ struct group_list * group_ptr;
FILE * fd;
char super_array[1024];
char array_class[1024];
@@ -163,59 +166,7 @@
int class_start, class_end;
int vtype;
- /*
- * Generate indices for super arrays
- */
- fd = fopen("super_array_indices.inc", "w");
- var_ptr = vars;
- memcpy(super_array, var_ptr->super_array, 1024);
- i = 1;
- while (var_ptr) {
- if (strncmp(super_array, var_ptr->super_array, 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- i = 1;
- }
- if (strncmp(var_ptr->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="red">", var_ptr->name_in_code, i++);
- var_ptr = var_ptr->next;
- }
- var_ptr = vars;
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- class_start = 1;
- class_end = 1;
- i = 1;
- while (var_ptr) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (strncmp(super_array, var_ptr->super_array, 1024) != 0) {
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="red">", super_array, i);
- class_start = 1;
- class_end = 1;
- i = 1;
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
- }
- else if (strncmp(array_class, var_ptr->array_class, 1024) != 0) {
- fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- class_start = class_end+1;
- class_end = class_start;
- memcpy(array_class, var_ptr->array_class, 1024);
- fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
- i++;
- }
- else {
- class_end++;
- i++;
- }
- }
- var_ptr = var_ptr->next;
- }
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="red">", array_class, class_end);
- if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="gray">", super_array, i);
- fclose(fd);
-
/*
* Generate declarations of dimensions
*/
@@ -311,96 +262,278 @@
/*
- * Generate declarations of time-invariant fields
+ * Generate declarations of mesh group
*/
fd = fopen("time_invariant_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ group_ptr = groups;
+ while (group_ptr) {
+
+ if (!strncmp(group_ptr->name, "mesh", 1024)) {
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ }
+ if (strncmp(var_list_ptr->var->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="blue">", var_list_ptr->var->name_in_code, i++);
+ var_list_ptr = var_list_ptr->next;
+ }
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(var_list_ptr->var->super_array, "-", 1024) != 0) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ else if (strncmp(array_class, var_list_ptr->var->array_class, 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ class_start = class_end+1;
+ class_end = class_start;
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
+ i++;
+ }
+ else {
+ class_end++;
+ i++;
+ }
}
- if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
- if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+ if (!strncmp(var_ptr->super_array, "-", 1024)) {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims+1, var_ptr->super_array);
+ while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
+ }
+ var_list_ptr = var_list_ptr->next;
}
+ break;
}
- else
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
/*
- * Generate declarations of time-invariant fields
+ * Generate declarations of non-mesh groups
*/
- fd = fopen("time_varying_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ fd = fopen("variable_groups.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ if (strncmp(group_ptr->name, "mesh", 1024)) {
+ fortprintf(fd, " type %s_type</font>
<font color="blue">", group_ptr->name);
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ i = 1;
+ }
+ if (strncmp(var_list_ptr->var->array_class, "-", 1024) != 0) fortprintf(fd, " integer :: index_%s = %i</font>
<font color="blue">", var_list_ptr->var->name_in_code, i++);
+ var_list_ptr = var_list_ptr->next;
+ }
+
+ var_list_ptr = group_ptr->vlist;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ while (var_list_ptr) {
+ if (strncmp(var_list_ptr->var->super_array, "-", 1024) != 0) {
+ if (strncmp(super_array, var_list_ptr->var->super_array, 1024) != 0) {
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+ class_start = 1;
+ class_end = 1;
+ i = 1;
+ memcpy(super_array, var_list_ptr->var->super_array, 1024);
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ else if (strncmp(array_class, var_list_ptr->var->array_class, 1024) != 0) {
+ fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ class_start = class_end+1;
+ class_end = class_start;
+ memcpy(array_class, var_list_ptr->var->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="red">", array_class, class_start);
+ i++;
+ }
+ else {
+ class_end++;
+ i++;
+ }
}
- if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
- if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: %s_end = %i</font>
<font color="blue">", array_class, class_end);
+ if (strncmp(super_array, "-", 1024) != 0) fortprintf(fd, " integer :: num_%s = %i</font>
<font color="blue">", super_array, i);
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+ if (!strncmp(var_ptr->super_array, "-", 1024)) {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
+ }
+ var_list_ptr = var_list_ptr->next;
}
+
+ fortprintf(fd, " end type %s_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " type %s_pointer_type</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (%s_type), pointer :: %s </font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end type %s_pointer_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+
+ fortprintf(fd, " type %s_multilevel_type</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " integer :: nTimeLevels</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_pointer_type), dimension(:), pointer :: time_levs</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " end type %s_multilevel_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">", group_ptr->name);
+ }
+
}
- else
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
-
/*
- * Generate grid metadata allocations
+ * Generate instantiations of variable groups in block_type
*/
- fd = fopen("grid_meta_allocs.inc", "w");
+ fd = fopen("block_group_members.inc", "w");
- dim_ptr = dims;
- while (dim_ptr) {
- if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="red">", dim_ptr->name_in_code, dim_ptr->name_in_code);
- if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="red">", dim_ptr->name_in_file, dim_ptr->name_in_file);
- dim_ptr = dim_ptr->next;
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ fortprintf(fd, " type (%s_multilevel_type), pointer :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ else
+ fortprintf(fd, " type (%s_type), pointer :: %s</font>
<font color="red">", group_ptr->name, group_ptr->name);
+ group_ptr = group_ptr->next;
}
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
+ fclose(fd);
+
+
+ /* To be included in allocate_block */
+ fd = fopen("block_allocs.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " allocate(b %% %s)</font>
<font color="blue">", group_ptr->name);
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " b %% %s %% nTimeLevels = %i</font>
<font color="blue">", group_ptr->name, group_ptr->vlist->var->ntime_levs);
+ fortprintf(fd, " allocate(b %% %s %% time_levs(%i))</font>
<font color="blue">", group_ptr->name, group_ptr->vlist->var->ntime_levs);
+ fortprintf(fd, " do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " allocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " call allocate_%s(b %% %s %% time_levs(i) %% %s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="black"></font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " call allocate_%s(b %% %s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="black"></font>
<font color="blue">");
+ }
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+
+ /* To be included in deallocate_block */
+ fd = fopen("block_deallocs.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " call deallocate_%s(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, " deallocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(b %% %s %% time_levs)</font>
<font color="blue">", group_ptr->name);
+ }
+ else {
+ fortprintf(fd, " call deallocate_%s(b %% %s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ }
+ fortprintf(fd, " deallocate(b %% %s)</font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
+ }
+ fclose(fd);
+
+ /* Definitions of allocate subroutines */
+ fd = fopen("group_alloc_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine allocate_%s(%s, &</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_args.inc\"</font>
<font color="blue">");
+ fortprintf(fd, " )</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "#include \"dim_dummy_decls.inc\"</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ if (!strncmp(group_ptr->name, "mesh", 1024)) {
+ dim_ptr = dims;
+ while (dim_ptr) {
+ if (dim_ptr->constant_value < 0 && !dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s %% %s = %s</font>
<font color="blue">", group_ptr->name, dim_ptr->name_in_code, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && dim_ptr->namelist_defined && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %s %% %s = %s</font>
<font color="blue">", group_ptr->name, dim_ptr->name_in_file, dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="red">");
+ }
+
+
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(g %% %s %% array(%i, ", var_ptr2->super_array, i);
+ var_ptr2 = var_list_ptr2->var;
+ fortprintf(fd, " allocate(%s %% %s)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " allocate(%s %% %s %% array(%i, ", group_ptr->name, var_ptr2->super_array, i);
dimlist_ptr = var_ptr2->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
@@ -421,29 +554,29 @@
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " g %% %s %% array = 0</font>
<font color="blue">", var_ptr2->super_array ); /* initialize field to zero */
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="red">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .false.</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, "</font>
<font color="red">");
}
else {
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(g %% %s %% array(", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(%s %% %s %% array(", group_ptr->name, var_ptr->name_in_code);
dimlist_ptr = var_ptr->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
@@ -464,306 +597,104 @@
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " g %% %s %% array = 0</font>
<font color="blue">", var_ptr->name_in_code ); /* initialize field to zero */
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
}
if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% ioinfo %% output = .false.</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
- }
+ fortprintf(fd, " end subroutine allocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
+ }
fclose(fd);
+
+ /* Definitions of deallocate subroutines */
+ fd = fopen("group_dealloc_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine deallocate_%s(%s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="red">");
-
- /*
- * Generate grid metadata deallocations
- */
- fd = fopen("grid_meta_deallocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 0) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_list_ptr2->var->super_array);
}
else {
if (var_ptr->ndims > 0) {
- fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
}
else {
- fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
}
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
- }
- fclose(fd);
-
-
- /*
- * Generate grid state allocations
- */
- fd = fopen("grid_state_allocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1 && var_ptr->ndims > 0) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% array(%i, ", var_ptr2->super_array, i);
- dimlist_ptr = var_ptr2->dimlist;
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- }
- fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, "</font>
<font color="red">");
- }
- else {
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% array(", var_ptr->name_in_code);
- dimlist_ptr = var_ptr->dimlist;
- if (dimlist_ptr->dim->constant_value < 0) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, "%i", dimlist_ptr->dim->constant_value);
- }
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0) {
- if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
- !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
- else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, ", %i", dimlist_ptr->dim->constant_value);
- }
- dimlist_ptr = dimlist_ptr->next;
- }
- fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
- }
- }
- else if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " allocate(s %% %s %% array(%i)", var_ptr->name_in_code, i);
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr2->super_array);
-
- if (var_ptr2->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr2->super_array);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, "</font>
<font color="red">");
- }
- else {
- fortprintf(fd, " allocate(s %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " s %% %s %% block => b</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
-
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="red">");
- var_ptr = var_ptr->next;
- }
- }
- else
- var_ptr = var_ptr->next;
+ fortprintf(fd, " end subroutine deallocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">", group_ptr->name);
+ group_ptr = group_ptr->next;
}
-
fclose(fd);
-
- /*
- * Generate grid state deallocations
- */
- fd = fopen("grid_state_deallocs.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
+ /* Definitions of copy subroutines */
+ fd = fopen("group_copy_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ fortprintf(fd, " subroutine copy_%s(dest, src)</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), intent(in) :: src</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " type (%s_type), intent(inout) :: dest</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="red">");
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
memcpy(super_array, var_ptr->super_array, 1024);
memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
+ var_list_ptr2 = var_list_ptr;
+ var_list_ptr = var_list_ptr->next;
}
- fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
- fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr2->super_array);
- }
- else {
- if (var_ptr->ndims > 0) fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr->name_in_code);
- var_ptr = var_ptr->next;
- }
- }
- else
- var_ptr = var_ptr->next;
- }
-
- fclose(fd);
-
-
- /*
- * Generate copies of state arrays
- */
- fd = fopen("copy_state.inc", "w");
-
- var_ptr = vars;
- while (var_ptr) {
- if (var_ptr->timedim == 1) {
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- memcpy(super_array, var_ptr->super_array, 1024);
- memcpy(array_class, var_ptr->array_class, 1024);
- vtype = var_ptr->vtype;
- i = 0;
- while (var_ptr && strncmp(super_array, var_ptr->super_array, 1024) == 0) {
- i++;
- var_ptr2 = var_ptr;
- var_ptr = var_ptr->next;
- }
+ var_ptr2 = var_list_ptr2->var;
if (var_ptr2->ndims > 0)
fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="gray">", var_ptr2->super_array, var_ptr2->super_array);
else
@@ -774,26 +705,56 @@
fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="black">", var_ptr->name_in_code, var_ptr->name_in_code);
else
fortprintf(fd, " dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="red">", var_ptr->name_in_code, var_ptr->name_in_code);
- var_ptr = var_ptr->next;
+ var_list_ptr = var_list_ptr->next;
}
}
- else
- var_ptr = var_ptr->next;
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine copy_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">", group_ptr->name);
+ group_ptr = group_ptr->next;
}
+ fclose(fd);
+ /* Definitions of shift_time_level subroutines */
+ fd = fopen("group_shift_level_routines.inc", "w");
+ group_ptr = groups;
+ while (group_ptr) {
+ if (group_ptr->vlist->var->ntime_levs > 1) {
+ fortprintf(fd, " subroutine shift_time_levels_%s(%s)</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " implicit none</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_multilevel_type), intent(inout) :: %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " integer :: i</font>
<font color="blue">");
+ fortprintf(fd, " type (%s_type), pointer :: sptr</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " sptr => %s %% time_levs(1) %% %s</font>
<font color="blue">", group_ptr->name, group_ptr->name);
+ fortprintf(fd, " do i=1,%s %% nTimeLevels-1</font>
<font color="blue">", group_ptr->name);
+ fortprintf(fd, " %s %% time_levs(i) %% %s => %s %% time_levs(i+1) %% %s</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " %s %% time_levs(%s %% nTimeLevels) %% %s => sptr</font>
<font color="blue">", group_ptr->name, group_ptr->name, group_ptr->name);
+ fortprintf(fd, "</font>
<font color="blue">");
+ fortprintf(fd, " end subroutine shift_time_levels_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="gray">", group_ptr->name);
+ }
+ group_ptr = group_ptr->next;
+ }
fclose(fd);
+
}
-void gen_reads(struct variable * vars, struct dimension * dims)
+void gen_reads(struct group_list * groups, struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
+ struct variable_list * var_list_ptr;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
+ struct group_list * group_ptr;
struct dtable * dictionary;
FILE * fd;
char vtype[5];
char fname[32];
+ char struct_deref[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
@@ -835,124 +796,73 @@
*/
fd = fopen("io_input_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
- else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->super_array);
- }
- else {
- fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->super_array);
- }
- }
- else {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- else {
- fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- }
- vert_dim = 0;
- while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- has_vert_dim = !strcmp( "nVertLevels", dimlist_ptr->dim->name_in_code);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (has_vert_dim) {
- vert_dim = i;
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="red">");
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- fortprintf(fd, " else</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- if (has_vert_dim) {
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " end if</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
- }
- else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
- }
- }
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "block %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "block %% %s", group_ptr->name);
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
i = 1;
dimlist_ptr = var_ptr->dimlist;
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- if (i < var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
}
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
+ vert_dim = 0;
while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
- }
- else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ if (i < var_ptr->ndims) {
+ has_vert_dim = !strcmp( "nVertLevels", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (has_vert_dim) {
+ vert_dim = i;
+ fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="blue">");
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, "#endif</font>
<font color="blue">");
+ }
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ if (has_vert_dim) {
+ fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "#endif</font>
<font color="red">");
+ }
}
- else
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
- }
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ }
+ }
dimlist_ptr = dimlist_ptr->next;
i++;
}
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="gray">");
-
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
i = 1;
dimlist_ptr = var_ptr->dimlist;
@@ -963,166 +873,203 @@
else
fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
}
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, "read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
+
dimlist_ptr = dimlist_ptr->next;
i++;
while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ if (i < var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ }
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
dimlist_ptr = dimlist_ptr->next;
i++;
}
fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
- }
- }
-
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- if (var_ptr->timedim)
- fortprintf(fd, " call io_input_field_time(input_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- else
- fortprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
-
- if (vert_dim > 0) {
- fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="red">");
- fortprintf(fd, " do k=2,EXPAND_LEVELS</font>
<font color="red">");
- fortprintf(fd, " %s%id %% array(", vtype, var_ptr->ndims);
- for (i=1; i<=var_ptr->ndims; i++) {
- if (i > 1) fortprintf(fd, ",");
- fortprintf(fd, "%s", i == vert_dim ? "k" : ":");
- }
- fortprintf(fd, ") = %s%id %% array(", vtype, var_ptr->ndims);
- for (i=1; i<=var_ptr->ndims; i++) {
- if (i > 1) fortprintf(fd, ",");
- fortprintf(fd, "%s", i == vert_dim ? "1" : ":");
- }
- fortprintf(fd, ")</font>
<font color="red">");
- fortprintf(fd, " end do</font>
<font color="red">");
- fortprintf(fd, " end if</font>
<font color="red">");
- fortprintf(fd, "#endif</font>
<font color="red">");
- }
-
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="red">");
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
- }
- else {
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% array, block %% time_levs(1) %% state %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- else
- fortprintf(fd, " %s%id %% array, block %% mesh %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- }
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
- if (i < var_ptr->ndims)
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
- else {
- lastdim = dimlist_ptr;
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ if (i < var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ while (dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
}
- else
- fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
}
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
+
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ if (var_ptr->timedim)
+ fortprintf(fd, " call io_input_field_time(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+
+ if (vert_dim > 0) {
+ fortprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " if (.not. config_do_restart) then</font>
<font color="blue">");
+ fortprintf(fd, " do k=2,EXPAND_LEVELS</font>
<font color="blue">");
+ fortprintf(fd, " %s%id %% array(", vtype, var_ptr->ndims);
+ for (i=1; i<=var_ptr->ndims; i++) {
+ if (i > 1) fortprintf(fd, ",");
+ fortprintf(fd, "%s", i == vert_dim ? "k" : ":");
+ }
+ fortprintf(fd, ") = %s%id %% array(", vtype, var_ptr->ndims);
+ for (i=1; i<=var_ptr->ndims; i++) {
+ if (i > 1) fortprintf(fd, ",");
+ fortprintf(fd, "%s", i == vert_dim ? "1" : ":");
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "#endif</font>
<font color="blue">");
+ }
+
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="blue">");
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " %s%id %% array, super_%s%id, &</font>
<font color="blue">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " %s%id %% array, %s %% %s %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, struct_deref, var_ptr->name_in_code);
+
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+
if (i < var_ptr->ndims)
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
else {
lastdim = dimlist_ptr;
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ fortprintf(fd, " read%sCount%s", cp1, cp2);
free(cp1);
free(cp2);
}
else
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
}
+
dimlist_ptr = dimlist_ptr->next;
i++;
- }
- fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="red">", lastdim->dim->name_in_code);
-
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- }
- else
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
-
-
- /* Copy from super_ array to field */
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- while (i <= var_ptr->ndims) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
-
- i++;
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims)
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else {
+ lastdim = dimlist_ptr;
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", read%sCount%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ }
dimlist_ptr = dimlist_ptr->next;
+ i++;
}
-
- if (var_ptr->timedim)
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% array(index_%s,", var_ptr->super_array, var_ptr->name_in_code);
- else
- fortprintf(fd, " block %% mesh %% %s %% array(index_%s,", var_ptr->super_array, var_ptr->name_in_code);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
+ fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
}
- fortprintf(fd, ") = super_%s%id(", vtype, var_ptr->ndims);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- fortprintf(fd, ")</font>
<font color="blue">");
+ else
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
- i = 1;
- while (i <= var_ptr->ndims) {
- fortprintf(fd, " end do</font>
<font color="red">");
- i++;
+
+ /* Copy from super_ array to field */
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (i <= var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " do i%i=1,block %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " do i%i=1,%s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " %s %% %s %% array(%s %% index_%s,", struct_deref, var_ptr->super_array, struct_deref, var_ptr->name_in_code);
+
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ") = super_%s%id(", vtype, var_ptr->ndims);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ i++;
+ }
}
+
+ fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
-
- fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ else {
+ fortprintf(fd, " %s %% %s %% scalar = %s%id %% scalar</font>
<font color="blue">", struct_deref, var_ptr->name_in_code, vtype, var_ptr->ndims);
+ }
+
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
+
+ var_list_ptr = var_list_ptr->next;
}
- else {
- if (var_ptr->timedim)
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% scalar = %s%id %% scalar</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " block %% mesh %% %s %% scalar = %s%id %% scalar</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- }
-
- fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
-
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
@@ -1253,16 +1200,19 @@
}
-void gen_writes(struct variable * vars, struct dimension * dims, struct namelist * namelists)
+void gen_writes(struct group_list * groups, struct variable * vars, struct dimension * dims, struct namelist * namelists)
{
struct variable * var_ptr;
+ struct variable_list * var_list_ptr;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr, * lastdim;
+ struct group_list * group_ptr;
struct dtable * dictionary;
struct namelist * nl;
FILE * fd;
char vtype[5];
char fname[32];
+ char struct_deref[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
@@ -1409,226 +1359,215 @@
*/
fd = fopen("io_output_fields.inc", "w");
- var_ptr = vars;
- while (var_ptr) {
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
- if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
- else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->super_array);
- }
- else {
- fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->super_array);
- fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->super_array);
- }
- }
- else {
- if (var_ptr->timedim) {
- fortprintf(fd, " if ((domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- else {
- fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", var_ptr->name_in_code);
- }
- }
-
- if (var_ptr->ndims > 0) {
- while (dimlist_ptr) {
- if (i < var_ptr->ndims) {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- }
- else {
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
- }
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
-
- fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s", group_ptr->name);
+
i = 1;
dimlist_ptr = var_ptr->dimlist;
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- if (i < var_ptr->ndims)
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
+ }
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "n%sGlobal%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
- else
- fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
- lastdim = dimlist_ptr;
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
+
+ if (var_ptr->ndims > 0) {
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims) {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ }
+ else {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="blue">", vtype, var_ptr->ndims, i, cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+
+ fortprintf(fd, " allocate(%s%id %% array(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+
if (i < var_ptr->ndims)
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
else {
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s", cp1, cp2);
+ fortprintf(fd, "n%sGlobal%s", cp1, cp2);
free(cp1);
free(cp2);
}
else
- fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
lastdim = dimlist_ptr;
}
dimlist_ptr = dimlist_ptr->next;
i++;
- }
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
-
- if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ while (dimlist_ptr) {
+ if (i < var_ptr->ndims)
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ else {
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
+ split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s", cp1, cp2);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ lastdim = dimlist_ptr;
+ }
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="blue">");
+
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " allocate(super_%s%id(", vtype, var_ptr->ndims);
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+
+ if (i < var_ptr->ndims) fortprintf(fd, ", ");
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ }
+ fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
+ }
+
+ /* Copy from field to super_ array */
i = 1;
dimlist_ptr = var_ptr->dimlist;
- while (dimlist_ptr) {
+ while (i <= var_ptr->ndims) {
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- if (i < var_ptr->ndims) fortprintf(fd, ", ");
-
+ i++;
dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " super_%s%id(", vtype, var_ptr->ndims);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, "i%i",i);
+ if (i < var_ptr->ndims) fortprintf(fd, ",");
+ }
+ fortprintf(fd, ") = %s %% %s %% array(", struct_deref, var_ptr->super_array);
+ fortprintf(fd, "%s %% index_%s", struct_deref, var_ptr->name_in_code);
+ for(i=1; i<=var_ptr->ndims; i++) {
+ fortprintf(fd, ",i%i",i);
+ }
+ fortprintf(fd, ")</font>
<font color="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="red">");
i++;
}
- fortprintf(fd, "))</font>
<font color="black"></font>
<font color="red">");
}
-
- /* Copy from field to super_ array */
+
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="blue">");
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " super_%s%id, %s%id %% array, &</font>
<font color="blue">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " %s %% %s %% array, %s%id %% array, &</font>
<font color="red">", struct_deref, var_ptr->name_in_code, vtype, var_ptr->ndims);
+
i = 1;
dimlist_ptr = var_ptr->dimlist;
- while (i <= var_ptr->ndims) {
+
+ if (dimlist_ptr->dim->constant_value < 0)
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
+
+ dimlist_ptr = dimlist_ptr->next;
+ i++;
+ while (dimlist_ptr) {
if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
else
- fortprintf(fd, " do i%i=1,%s</font>
<font color="red">", i, dimlist_ptr->dim->name_in_code);
-
- i++;
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+
dimlist_ptr = dimlist_ptr->next;
- }
-
- fortprintf(fd, " super_%s%id(", vtype, var_ptr->ndims);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, "i%i",i);
- if (i < var_ptr->ndims) fortprintf(fd, ",");
- }
- if (var_ptr->timedim)
- fortprintf(fd, ") = domain %% blocklist %% time_levs(1) %% state %% %s %% array(", var_ptr->super_array);
- else
- fortprintf(fd, ") = domain %% blocklist %% mesh %% %s %% array(", var_ptr->super_array);
- fortprintf(fd, "index_%s", var_ptr->name_in_code);
- for(i=1; i<=var_ptr->ndims; i++) {
- fortprintf(fd, ",i%i",i);
- }
- fortprintf(fd, ")</font>
<font color="red">");
-
- i = 1;
- while (i <= var_ptr->ndims) {
- fortprintf(fd, " end do</font>
<font color="blue">");
i++;
+ }
+
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="blue">", cp1, cp2);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ free(cp1);
+ free(cp2);
}
+ else {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ }
}
-
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="red">");
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " super_%s%id, %s%id %% array, &</font>
<font color="red">", vtype, var_ptr->ndims, vtype, var_ptr->ndims);
else {
- if (var_ptr->timedim)
- fortprintf(fd, " domain %% blocklist %% time_levs(1) %% state %% %s %% array, %s%id %% array, &</font>
<font color="red">", var_ptr->name_in_code, vtype, var_ptr->ndims);
- else
- fortprintf(fd, " domain %% blocklist %% mesh %% %s %% array, %s%id %% array, &</font>
<font color="blue">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_file);
+ fortprintf(fd, " %s%id %% scalar = %s %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, struct_deref, var_ptr->name_in_code);
}
- i = 1;
- dimlist_ptr = var_ptr->dimlist;
-
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
+ if (var_ptr->timedim)
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
else
- fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- while (dimlist_ptr) {
- if (dimlist_ptr->dim->constant_value < 0)
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, ", domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_file);
- else
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
-
- dimlist_ptr = dimlist_ptr->next;
- i++;
- }
-
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="red">", cp1, cp2);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- free(cp1);
- free(cp2);
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (var_ptr->ndims > 0) {
+ fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
- else {
- fortprintf(fd, ", %sGlobal, &</font>
<font color="red">", lastdim->dim->name_in_code);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
- }
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="red">");
+
+ var_list_ptr = var_list_ptr->next;
}
- else {
- fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- if (var_ptr->timedim)
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% time_levs(1) %% state %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- else
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% mesh %% %s %% scalar</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_code);
- }
-
- if (var_ptr->timedim)
- fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- else
- fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (var_ptr->ndims > 0) {
- fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="red">", vtype, var_ptr->ndims);
- if (strncmp(var_ptr->super_array, "-", 1024) != 0)
- fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
- }
- fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
-
- var_ptr = var_ptr->next;
+ group_ptr = group_ptr->next;
}
fclose(fd);
Modified: trunk/mpas/src/registry/gen_inc.h
===================================================================
--- trunk/mpas/src/registry/gen_inc.h 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/registry/gen_inc.h 2010-09-24 04:02:02 UTC (rev 509)
@@ -1,4 +1,4 @@
void gen_namelists(struct namelist *);
-void gen_field_defs(struct variable *, struct dimension *);
-void gen_reads(struct variable *, struct dimension *);
-void gen_writes(struct variable *, struct dimension *, struct namelist *);
+void gen_field_defs(struct group_list * groups, struct variable *, struct dimension *);
+void gen_reads(struct group_list * groups, struct variable *, struct dimension *);
+void gen_writes(struct group_list * groups, struct variable *, struct dimension *, struct namelist *);
Modified: trunk/mpas/src/registry/parse.c
===================================================================
--- trunk/mpas/src/registry/parse.c 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/registry/parse.c 2010-09-24 04:02:02 UTC (rev 509)
@@ -4,7 +4,7 @@
#include "registry_types.h"
#include "gen_inc.h"
-int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **);
+int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **, struct group_list **);
int getword(FILE *, char *);
int is_integer_constant(char *);
void sort_vars(struct variable *);
@@ -15,6 +15,7 @@
struct namelist * nls;
struct dimension * dims;
struct variable * vars;
+ struct group_list * groups;
if (argc != 2) {
fprintf(stderr,"</font>
<font color="black">Usage: %s filename</font>
<font color="black"></font>
<font color="gray">", argv[0]);
@@ -25,7 +26,7 @@
nls = NULL;
dims = NULL;
vars = NULL;
- if (parse_reg(regfile, &nls, &dims, &vars)) {
+ if (parse_reg(regfile, &nls, &dims, &vars, &groups)) {
return 1;
}
}
@@ -37,15 +38,15 @@
sort_vars(vars);
gen_namelists(nls);
- gen_field_defs(vars, dims);
- gen_reads(vars, dims);
- gen_writes(vars, dims, nls);
+ gen_field_defs(groups, vars, dims);
+ gen_reads(groups, vars, dims);
+ gen_writes(groups, vars, dims, nls);
return 0;
}
-int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars)
+int parse_reg(FILE * regfile, struct namelist ** nls, struct dimension ** dims, struct variable ** vars, struct group_list ** groups)
{
char word[1024];
struct namelist * nls_ptr;
@@ -54,13 +55,17 @@
struct variable * var_ptr;
struct dimension_list * dimlist_ptr;
struct dimension * dimlist_cursor;
+ struct group_list * grouplist_ptr;
+ struct variable_list * vlist_cursor;
NEW_NAMELIST(nls_ptr)
NEW_DIMENSION(dim_ptr)
NEW_VARIABLE(var_ptr)
+ NEW_GROUP_LIST(grouplist_ptr);
*nls = nls_ptr;
*dims = dim_ptr;
*vars = var_ptr;
+ *groups = grouplist_ptr;
while(getword(regfile, word) != EOF) {
if (strncmp(word, "namelist", 1024) == 0) {
@@ -130,7 +135,16 @@
var_ptr->timedim = 0;
var_ptr->iostreams = 0;
+ /*
+ * persistence
+ */
getword(regfile, word);
+ if (strncmp(word, "persistent", 1024) == 0)
+ var_ptr->persistence = PERSISTENT;
+ else if (strncmp(word, "scratch", 1024) == 0)
+ var_ptr->persistence = SCRATCH;
+
+ getword(regfile, word);
if (strncmp(word, "real", 1024) == 0)
var_ptr->vtype = REAL;
else if (strncmp(word, "integer", 1024) == 0)
@@ -168,14 +182,50 @@
getword(regfile, word);
}
- /* Read I/O info */
+ /*
+ * time_dim
+ */
getword(regfile, word);
+ var_ptr->ntime_levs = atoi(word);
+
+ /*
+ * I/O info
+ */
+ getword(regfile, word);
if (strchr(word, (int)'i')) var_ptr->iostreams |= INPUT0;
if (strchr(word, (int)'r')) var_ptr->iostreams |= RESTART0;
if (strchr(word, (int)'o')) var_ptr->iostreams |= OUTPUT0;
getword(regfile, var_ptr->name_in_code);
+ /*
+ * struct
+ */
+ getword(regfile, var_ptr->struct_group);
+ grouplist_ptr = *groups;
+ grouplist_ptr = grouplist_ptr->next;
+ while (grouplist_ptr && strncmp(var_ptr->struct_group, grouplist_ptr->name, 1024)) {
+ grouplist_ptr = grouplist_ptr->next;
+ }
+ if (!grouplist_ptr) {
+ grouplist_ptr = *groups;
+ while(grouplist_ptr->next) grouplist_ptr = grouplist_ptr->next;
+ NEW_GROUP_LIST(grouplist_ptr->next);
+ grouplist_ptr = grouplist_ptr->next;
+ memcpy(grouplist_ptr->name, var_ptr->struct_group, (size_t)1024);
+ NEW_VARIABLE_LIST(grouplist_ptr->vlist);
+ grouplist_ptr->vlist->var = var_ptr;
+ }
+ else {
+ vlist_cursor = grouplist_ptr->vlist;
+ while (vlist_cursor->next) vlist_cursor = vlist_cursor->next;
+ NEW_VARIABLE_LIST(vlist_cursor->next);
+ vlist_cursor->next->prev = vlist_cursor;
+ vlist_cursor = vlist_cursor->next;
+ vlist_cursor->var = var_ptr;
+ }
+
+
getword(regfile, var_ptr->super_array);
getword(regfile, var_ptr->array_class);
@@ -203,6 +253,10 @@
if ((*vars)->next) *vars = (*vars)->next;
if (var_ptr) free(var_ptr);
+ grouplist_ptr = *groups;
+ if ((*groups)->next) *groups = (*groups)->next;
+ if (grouplist_ptr) free(grouplist_ptr);
+
return 0;
}
Modified: trunk/mpas/src/registry/registry_types.h
===================================================================
--- trunk/mpas/src/registry/registry_types.h 2010-09-22 01:07:51 UTC (rev 508)
+++ trunk/mpas/src/registry/registry_types.h 2010-09-24 04:02:02 UTC (rev 509)
@@ -3,6 +3,9 @@
#define LOGICAL 2
#define CHARACTER 3
+#define PERSISTENT 0
+#define SCRATCH 1
+
#define INPUT0 0x00000001
#define RESTART0 0x00000002
#define OUTPUT0 0x00000004
@@ -11,6 +14,8 @@
#define NEW_DIMENSION(X) X = (struct dimension *)malloc(sizeof(struct dimension)); X->next = NULL;
#define NEW_DIMENSION_LIST(X) X = (struct dimension_list *)malloc(sizeof(struct dimension_list)); X->dim = NULL; X->prev = NULL; X->next = NULL;
#define NEW_VARIABLE(X) X = (struct variable *)malloc(sizeof(struct variable)); X->dimlist = NULL; X->next = NULL;
+#define NEW_VARIABLE_LIST(X) X = (struct variable_list *)malloc(sizeof(struct variable_list)); X->var = NULL; X->prev = NULL; X->next = NULL;
+#define NEW_GROUP_LIST(X) X = (struct group_list *)malloc(sizeof(struct group_list)); X->vlist = NULL; X->next = NULL;
union default_val {
int ival;
@@ -41,14 +46,29 @@
struct dimension_list * next;
};
+struct variable_list {
+ struct variable * var;
+ struct variable_list * prev;
+ struct variable_list * next;
+};
+
+struct group_list {
+ char name[1024];
+ struct variable_list * vlist;
+ struct group_list * next;
+};
+
struct variable {
char name_in_file[1024];
char name_in_code[1024];
+ char struct_group[1024];
char super_array[1024];
char array_class[1024];
+ int persistence;
int vtype;
int ndims;
int timedim;
+ int ntime_levs;
int iostreams;
struct dimension_list * dimlist;
struct variable * next;
</font>
</pre>