<p><b>duda</b> 2009-12-18 11:22:32 -0700 (Fri, 18 Dec 2009)</p><p>BRANCH COMMIT: branches/hyd_model<br>
<br>
Add mechanism to manage tracer arrays as part of larger<br>
'super-arrays'. <br>
<br>
Two additional columns must now be specified for all variables in the<br>
Registry file. The first new column specifies the name of the<br>
'super-array' that a field belongs to in the code (or "-" if the field<br>
is to be kept as a separate array); the second new column specifies<br>
the class within the super-array that the field is associated with.<br>
For example:<br>
<br>
var real qi ( nVertLevels nCells Time ) iro qi scalars moist<br>
var real qc ( nVertLevels nCells Time ) iro qc scalars moist<br>
var real qr ( nVertLevels nCells Time ) iro qr scalars moist<br>
var real o3 ( nVertLevels nCells Time ) iro o3 scalars chem<br>
var real no2 ( nVertLevels nCells Time ) iro no2 scalars chem<br>
<br>
For each field belonging to a super-array, an index into the<br>
inner-most dimension of the super-array is automatically defined and<br>
made available through the grid_types module. This index is named<br>
xyz_INDEX, where xyz is the name-in-code name specified in the third<br>
from the last column in the Registry file; this index may then be<br>
used to access a particular field in its super-array; for example:<br>
<br>
scalars(qi_INDEX, k, iCell) = temp_qi<br>
<br>
Also, for each class, all fields belonging to that class will be<br>
located contiguously in the super-array, regardless of their order in<br>
the Registry file, and they can be accessed collectively through<br>
automatically-generated indices ccc_start and ccc_end, where ccc is<br>
the name of the class; for example:<br>
<br>
sum_species = sum(scalars(moist_start:moist_end, k, iCell))<br>
<br>
Finally, the total number of members of a super-array is defined by an<br>
automatically-generated variable num_sss, where sss is the name of the<br>
super-array; for example:<br>
<br>
do i=1,num_scalars<br>
tracer_edge(i) = 0.5*(scalars(i,k,cell1) + scalars(i,k,cell2))<br>
end do<br>
<br>
<br>
M src/module_io_input.F<br>
M src/module_io_output.F<br>
M src/module_grid_types.F<br>
M Registry/registry_types.h<br>
M Registry/gen_inc.c<br>
M Registry/Registry<br>
M Registry/parse.c<br>
</p><hr noshade><pre><font color="gray">Modified: branches/hyd_model/Registry/Registry
===================================================================
--- branches/hyd_model/Registry/Registry 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/Registry/Registry 2009-12-18 18:22:32 UTC (rev 88)
@@ -34,108 +34,108 @@
dim nVertLevelsP1 nVertLevels+1
#
-# var type name_in_file ( dims ) iro- name_in_code
+# var type name_in_file ( dims ) iro- name_in_code super-array array_class
#
-var real xtime ( Time ) ro xtime
+var real xtime ( Time ) ro xtime - -
-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 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 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 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 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 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 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 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 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 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 integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell
-var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell
-var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge
-var integer edgesOnVertex ( THREE nVertices ) iro edgesOnVertex
-var integer cellsOnVertex ( THREE nVertices ) iro cellsOnVertex
-var real kiteAreasOnVertex ( THREE nVertices ) iro kiteAreasOnVertex
-var real fEdge ( nEdges ) iro fEdge
-var real fVertex ( nVertices ) iro fVertex
-var real h_s ( nCells ) iro h_s
+var integer cellsOnCell ( maxEdges nCells ) iro cellsOnCell - -
+var integer verticesOnCell ( maxEdges nCells ) iro verticesOnCell - -
+var integer verticesOnEdge ( TWO nEdges ) iro verticesOnEdge - -
+var integer edgesOnVertex ( THREE nVertices ) iro edgesOnVertex - -
+var integer cellsOnVertex ( THREE nVertices ) iro cellsOnVertex - -
+var real kiteAreasOnVertex ( THREE nVertices ) iro kiteAreasOnVertex - -
+var real fEdge ( nEdges ) iro fEdge - -
+var real fVertex ( nVertices ) iro fVertex - -
+var real h_s ( nCells ) iro h_s - -
# 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 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 - -
# 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 tracers ( nTracers nVertLevels nCells Time ) iro tracers
+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 tracers ( nTracers nVertLevels nCells Time ) iro 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 pressure ( nVertLevelsP1 nCells Time ) ro pressure
-var real geopotential ( nVertLevelsP1 nCells Time ) ro geopotential
-var real alpha ( nVertLevels nCells Time ) iro alpha
+var real h ( nVertLevels nCells Time ) ro h - -
+var real ww ( nVertLevelsP1 nCells Time ) ro ww - -
+var real pressure ( nVertLevelsP1 nCells Time ) ro pressure - -
+var real geopotential ( nVertLevelsP1 nCells Time ) ro geopotential - -
+var real alpha ( nVertLevels nCells Time ) iro alpha - -
# 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 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 - -
# 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 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 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 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 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 tracers_old ( nTracers nVertLevels nCells ) - tracers_old
+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 tracers_old ( nTracers nVertLevels nCells ) - tracers_old - -
# Space needed for advection
-var real deriv_two ( FIFTEEN TWO nEdges ) o deriv_two
-var integer advCells ( TWENTYONE nCells ) - advCells
+var real deriv_two ( FIFTEEN TWO nEdges ) o deriv_two - -
+var integer advCells ( TWENTYONE nCells ) - advCells - -
Modified: branches/hyd_model/Registry/gen_inc.c
===================================================================
--- branches/hyd_model/Registry/gen_inc.c 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/Registry/gen_inc.c 2009-12-18 18:22:32 UTC (rev 88)
@@ -153,11 +153,69 @@
void gen_field_defs(struct variable * vars, struct dimension * dims)
{
struct variable * var_ptr;
+ struct variable * var_ptr2;
struct dimension * dim_ptr;
struct dimension_list * dimlist_ptr;
FILE * fd;
+ char super_array[1024];
+ char array_class[1024];
+ int i;
+ 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="blue">", 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="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_ptr->super_array, 1024);
+ memcpy(array_class, var_ptr->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", array_class, class_start);
+ }
+ else if (strncmp(array_class, var_ptr->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_ptr->array_class, 1024);
+ fortprintf(fd, " integer :: %s_start = %i</font>
<font color="blue">", 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="blue">", 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
*/
@@ -245,10 +303,25 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 0) {
- 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="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ 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;
+ }
+ if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", (var_ptr2->ndims)+1, var_ptr2->name_in_code);
+ if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", (var_ptr2->ndims)+1, var_ptr2->name_in_code);
+ }
+ else {
+ 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="gray">", var_ptr->ndims, var_ptr->name_in_code);
+ var_ptr = var_ptr->next;
+ }
}
- var_ptr = var_ptr->next;
+ else
+ var_ptr = var_ptr->next;
}
fclose(fd);
@@ -261,13 +334,30 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 1) {
- 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="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ 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;
+ }
+ if (vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ if (vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", (var_ptr2->ndims)+1, var_ptr2->super_array);
+ }
+ else {
+ 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="gray">", var_ptr->ndims, var_ptr->name_in_code);
+ var_ptr = var_ptr->next;
+ }
}
- var_ptr = var_ptr->next;
+ else
+ var_ptr = var_ptr->next;
}
+ fclose(fd);
+
/*
* Generate grid metadata allocations
*/
@@ -283,35 +373,76 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 0) {
- fortprintf(fd, " allocate(g %% %s)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, " allocate(g %% %s %% array(", var_ptr->name_in_code);
- dimlist_ptr = var_ptr->dimlist;
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ 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;
+ }
+ fortprintf(fd, " allocate(g %% %s)</font>
<font color="blue">", var_ptr2->name_in_code);
+ fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr2->name_in_code);
+ fortprintf(fd, " allocate(g %% %s %% array(", var_ptr2->name_in_code);
+ dimlist_ptr = var_ptr2->dimlist;
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
+ while (dimlist_ptr) {
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ fortprintf(fd, "))</font>
<font color="blue">");
+
+ if (var_ptr2->iostreams & INPUT0)
+ fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr2->name_in_code);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr2->name_in_code);
+
+ if (var_ptr2->iostreams & RESTART0)
+ fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr2->name_in_code);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr2->name_in_code);
+
+ if (var_ptr2->iostreams & OUTPUT0)
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr2->name_in_code);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr2->name_in_code);
+ fortprintf(fd, "</font>
<font color="red">");
}
- fortprintf(fd, "))</font>
<font color="blue">");
+ else {
+ fortprintf(fd, " allocate(g %% %s)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(g %% %s %% array(", var_ptr->name_in_code);
+ dimlist_ptr = var_ptr->dimlist;
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ while (dimlist_ptr) {
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ fortprintf(fd, "))</font>
<font color="red">");
- if (var_ptr->iostreams & INPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ if (var_ptr->iostreams & INPUT0)
+ fortprintf(fd, " g %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% input = .false.</font>
<font color="red">", var_ptr->name_in_code);
- if (var_ptr->iostreams & RESTART0)
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", 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);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% restart = .false.</font>
<font color="red">", var_ptr->name_in_code);
- if (var_ptr->iostreams & OUTPUT0)
- fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="red">", var_ptr->name_in_code);
- else
- fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="red">", var_ptr->name_in_code);
- fortprintf(fd, "</font>
<font color="blue">");
+ if (var_ptr->iostreams & OUTPUT0)
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, "</font>
<font color="gray">");
+
+ var_ptr = var_ptr->next;
+ }
}
- var_ptr = var_ptr->next;
+ else
+ var_ptr = var_ptr->next;
}
fclose(fd);
@@ -325,11 +456,29 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 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);
+ 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, " deallocate(g %% %s %% array)</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr2->super_array);
+ }
+ else {
+ fortprintf(fd, " deallocate(g %% %s %% array)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(g %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="gray">", var_ptr->name_in_code);
+ var_ptr = var_ptr->next;
+ }
}
- var_ptr = var_ptr->next;
+ else
+ var_ptr = var_ptr->next;
}
fclose(fd);
@@ -343,57 +492,134 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 1 && var_ptr->ndims > 0) {
- 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;
- fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
- dimlist_ptr = dimlist_ptr->next;
- while (dimlist_ptr) {
- fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ 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="blue">", var_ptr2->super_array);
+ fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " allocate(s %% %s %% array(%i, ", var_ptr2->super_array, i);
+ dimlist_ptr = var_ptr2->dimlist;
+ fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
+ while (dimlist_ptr) {
+ fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ fortprintf(fd, "))</font>
<font color="blue">");
+ fortprintf(fd, " s %% %s %% block => b</font>
<font color="blue">", var_ptr2->super_array);
+
+ if (var_ptr2->iostreams & INPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr2->super_array);
+
+ if (var_ptr2->iostreams & RESTART0)
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr2->super_array);
+
+ if (var_ptr2->iostreams & OUTPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, "</font>
<font color="red">");
}
- 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="blue">");
+ else {
+ fortprintf(fd, " allocate(s %% %s)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(s %% %s %% array(", var_ptr->name_in_code);
+ dimlist_ptr = var_ptr->dimlist;
+ fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ while (dimlist_ptr) {
+ fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ fortprintf(fd, "))</font>
<font color="blue">");
+ fortprintf(fd, " s %% %s %% block => b</font>
<font color="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & INPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & RESTART0)
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & OUTPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, "</font>
<font color="red">");
+ var_ptr = var_ptr->next;
+ }
}
else if (var_ptr->timedim == 1) {
- 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;
+ 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="blue">", var_ptr2->super_array);
+ fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="blue">", 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="blue">", var_ptr2->super_array);
+
+ if (var_ptr2->iostreams & INPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr2->super_array);
+
+ if (var_ptr2->iostreams & RESTART0)
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr2->super_array);
+
+ if (var_ptr2->iostreams & OUTPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr2->super_array);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " allocate(s %% %s)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " s %% %s %% block => b</font>
<font color="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & INPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & RESTART0)
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & OUTPUT0)
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " s %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, "</font>
<font color="gray">");
+ var_ptr = var_ptr->next;
+ }
+ }
+ else
+ var_ptr = var_ptr->next;
}
fclose(fd);
@@ -407,11 +633,29 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 1) {
- 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="blue">", var_ptr->name_in_code);
+ 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, " deallocate(s %% %s %% array)</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="blue">", var_ptr2->super_array);
+ fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="blue">", var_ptr2->super_array);
+ }
+ else {
+ if (var_ptr->ndims > 0) fortprintf(fd, " deallocate(s %% %s %% array)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(s %% %s %% ioinfo)</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " deallocate(s %% %s)</font>
<font color="black"></font>
<font color="gray">", var_ptr->name_in_code);
+ var_ptr = var_ptr->next;
+ }
}
- var_ptr = var_ptr->next;
+ else
+ var_ptr = var_ptr->next;
}
fclose(fd);
@@ -425,12 +669,31 @@
var_ptr = vars;
while (var_ptr) {
if (var_ptr->timedim == 1) {
- if (var_ptr->ndims > 0)
- fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="red">", var_ptr->name_in_code, var_ptr->name_in_code);
- else
- fortprintf(fd, " dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="blue">", var_ptr->name_in_code, var_ptr->name_in_code);
+ 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;
+ }
+ if (var_ptr2->ndims > 0)
+ fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="blue">", var_ptr2->super_array, var_ptr2->super_array);
+ else
+ fortprintf(fd, " dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="blue">", var_ptr2->super_array, var_ptr2->super_array);
+ }
+ else {
+ if (var_ptr->ndims > 0)
+ fortprintf(fd, " dest %% %s %% array = src %% %s %% array</font>
<font color="blue">", var_ptr->name_in_code, var_ptr->name_in_code);
+ else
+ fortprintf(fd, " dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="gray">", var_ptr->name_in_code, var_ptr->name_in_code);
+ var_ptr = var_ptr->next;
+ }
}
- var_ptr = var_ptr->next;
+ else
+ var_ptr = var_ptr->next;
}
fclose(fd);
@@ -494,13 +757,25 @@
if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- 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="blue">", var_ptr->name_in_code);
+ 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="blue">", var_ptr->super_array);
+ fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="blue">", var_ptr->super_array);
+ }
+ else {
+ fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", 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 {
- 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="blue">", var_ptr->name_in_code);
+ if (var_ptr->timedim) {
+ fortprintf(fd, " if ((block %% time_levs(1) %% state %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " (block %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="blue">", var_ptr->name_in_code);
+ }
+ else {
+ fortprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="gray">", var_ptr->name_in_code);
+ }
}
vert_dim = 0;
while (dimlist_ptr) {
@@ -587,7 +862,32 @@
i++;
}
fortprintf(fd, "))</font>
<font color="black"></font>
<font color="blue">");
+
+ 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)
+ fortprintf(fd, "block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ 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)
+ fortprintf(fd, ", block %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ 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="blue">");
+ }
}
+
fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="black">", 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="gray">", vtype, var_ptr->ndims);
@@ -616,10 +916,18 @@
if (var_ptr->ndims > 0) {
fortprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="red">");
- 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="blue">", vtype, var_ptr->ndims, var_ptr->name_in_code);
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ if (var_ptr->timedim)
+ 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, block %% mesh %% %s %% array, &</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_code);
+ }
+ else {
+ if (var_ptr->timedim)
+ fortprintf(fd, " %s%id %% array, block %% time_levs(1) %% state %% %s %% array, &</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_code);
+ else
+ fortprintf(fd, " %s%id %% array, block %% mesh %% %s %% array, &</font>
<font color="gray">", vtype, var_ptr->ndims, var_ptr->name_in_code);
+ }
i = 1;
dimlist_ptr = var_ptr->dimlist;
@@ -673,7 +981,47 @@
}
else
fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", 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)
+ 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,%s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+
+ 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, ") = 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="black">", vtype, var_ptr->ndims);
}
else {
fortprintf(fd, " block %% time_levs(1) %% state %% %s %% scalar = %s%id %% scalar</font>
<font color="gray">", var_ptr->name_in_code, vtype, var_ptr->ndims);
@@ -935,13 +1283,25 @@
if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
- 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="blue">", var_ptr->name_in_code);
+ 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="blue">", var_ptr->super_array);
+ fortprintf(fd, " (domain %% blocklist %% time_levs(1) %% state %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="blue">", var_ptr->super_array);
+ }
+ else {
+ fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", 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 {
- 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="blue">", var_ptr->name_in_code);
+ 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="blue">", 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="blue">", var_ptr->name_in_code);
+ }
+ else {
+ fortprintf(fd, " if ((domain %% blocklist %% mesh %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, " (domain %% blocklist %% mesh %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="gray">", var_ptr->name_in_code);
+ }
}
if (var_ptr->ndims > 0) {
@@ -1011,12 +1371,71 @@
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)
+ fortprintf(fd, "domain %% blocklist %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ 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="blue">");
+ }
+
+ /* Copy from field to super_ array */
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while (i <= var_ptr->ndims) {
+ if (dimlist_ptr->dim->constant_value < 0)
+ 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,%s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+
+ 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, ",");
+ }
+ 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="blue">");
+
+ i = 1;
+ while (i <= var_ptr->ndims) {
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ i++;
+ }
+ }
+
fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="black">", vtype, var_ptr->ndims, var_ptr->name_in_file);
fortprintf(fd, " call dmpar_alltoall_field(domain %% dminfo, &</font>
<font color="red">");
- 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);
+ 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 {
+ if (var_ptr->timedim)
+ fortprintf(fd, " domain %% blocklist %% time_levs(1) %% state %% %s %% array, %s%id %% array, &</font>
<font color="blue">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " domain %% blocklist %% mesh %% %s %% array, %s%id %% array, &</font>
<font color="gray">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ }
i = 1;
dimlist_ptr = var_ptr->dimlist;
@@ -1061,6 +1480,8 @@
fortprintf(fd, " if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="black">", 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="black">", vtype, var_ptr->ndims);
}
fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
Modified: branches/hyd_model/Registry/parse.c
===================================================================
--- branches/hyd_model/Registry/parse.c 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/Registry/parse.c 2009-12-18 18:22:32 UTC (rev 88)
@@ -7,6 +7,7 @@
int parse_reg(FILE *, struct namelist **, struct dimension **, struct variable **);
int getword(FILE *, char *);
int is_integer_constant(char *);
+void sort_vars(struct variable *);
int main(int argc, char ** argv)
{
@@ -33,6 +34,8 @@
return 1;
}
+ sort_vars(vars);
+
gen_namelists(nls);
gen_field_defs(vars, dims);
gen_reads(vars, dims);
@@ -149,6 +152,10 @@
if (strchr(word, (int)'o')) var_ptr->iostreams |= OUTPUT0;
getword(regfile, var_ptr->name_in_code);
+
+ getword(regfile, var_ptr->super_array);
+ getword(regfile, var_ptr->array_class);
+
dimlist_ptr = var_ptr->dimlist;
if (var_ptr->dimlist) var_ptr->dimlist = var_ptr->dimlist->next;
if (dimlist_ptr) free(dimlist_ptr);
@@ -211,3 +218,83 @@
return atoi(c);
}
+
+void sort_vars(struct variable * vars)
+{
+ struct variable * var_ptr;
+ struct variable * var_ptr2;
+ struct variable * var_ptr2_prev;
+ char super_array[1024];
+ char array_class[1024];
+
+ var_ptr = vars;
+
+/*
+ while (var_ptr) {
+ memcpy(super_array, var_ptr->super_array, 1024);
+ memcpy(array_class, var_ptr->array_class, 1024);
+ var_ptr2_prev = var_ptr;
+ var_ptr2 = var_ptr->next;
+ if (var_ptr2 &&
+ (strncmp(super_array, var_ptr2->super_array, 1024) != 0 || strncmp(array_class, var_ptr2->array_class, 1024) != 0)) {
+ while (var_ptr2) {
+ if (strncmp(super_array, var_ptr2->super_array, 1024) == 0 && strncmp(array_class, var_ptr2->array_class, 1024) == 0) {
+ var_ptr2_prev->next = var_ptr2->next;
+ var_ptr2->next = var_ptr->next;
+ var_ptr->next = var_ptr2;
+ var_ptr2 = var_ptr2_prev->next;
+ }
+ else {
+ var_ptr2_prev = var_ptr2_prev->next;
+ var_ptr2 = var_ptr2->next;
+ }
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+*/
+
+ while (var_ptr) {
+ memcpy(super_array, var_ptr->super_array, 1024);
+ var_ptr2_prev = var_ptr;
+ var_ptr2 = var_ptr->next;
+ if (var_ptr2 && strncmp(super_array, var_ptr2->super_array, 1024) != 0) {
+ while (var_ptr2) {
+ if (strncmp(super_array, var_ptr2->super_array, 1024) == 0) {
+ var_ptr2_prev->next = var_ptr2->next;
+ var_ptr2->next = var_ptr->next;
+ var_ptr->next = var_ptr2;
+ var_ptr2 = var_ptr2_prev->next;
+ }
+ else {
+ var_ptr2_prev = var_ptr2_prev->next;
+ var_ptr2 = var_ptr2->next;
+ }
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+
+ var_ptr = vars;
+
+ while (var_ptr) {
+ memcpy(array_class, var_ptr->array_class, 1024);
+ var_ptr2_prev = var_ptr;
+ var_ptr2 = var_ptr->next;
+ if (var_ptr2 && strncmp(array_class, var_ptr2->array_class, 1024) != 0) {
+ while (var_ptr2) {
+ if (strncmp(array_class, var_ptr2->array_class, 1024) == 0) {
+ var_ptr2_prev->next = var_ptr2->next;
+ var_ptr2->next = var_ptr->next;
+ var_ptr->next = var_ptr2;
+ var_ptr2 = var_ptr2_prev->next;
+ }
+ else {
+ var_ptr2_prev = var_ptr2_prev->next;
+ var_ptr2 = var_ptr2->next;
+ }
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+}
Modified: branches/hyd_model/Registry/registry_types.h
===================================================================
--- branches/hyd_model/Registry/registry_types.h 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/Registry/registry_types.h 2009-12-18 18:22:32 UTC (rev 88)
@@ -43,6 +43,8 @@
struct variable {
char name_in_file[1024];
char name_in_code[1024];
+ char super_array[1024];
+ char array_class[1024];
int vtype;
int ndims;
int timedim;
Modified: branches/hyd_model/src/module_grid_types.F
===================================================================
--- branches/hyd_model/src/module_grid_types.F 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/src/module_grid_types.F 2009-12-18 18:22:32 UTC (rev 88)
@@ -5,6 +5,7 @@
integer, parameter :: nTimeLevs = 2
integer, parameter :: storageFactor = 1 ! Additional storage used by time integration scheme
+#include "super_array_indices.inc"
! Derived type describing info for doing I/O specific to a field
type io_info
Modified: branches/hyd_model/src/module_io_input.F
===================================================================
--- branches/hyd_model/src/module_io_input.F 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/src/module_io_input.F 2009-12-18 18:22:32 UTC (rev 88)
@@ -761,6 +761,15 @@
type (field2dReal) :: real2d
type (field3dReal) :: real3d
+ integer :: i1, i2, i3, i4
+
+ integer, dimension(:), pointer :: super_int1d
+ integer, dimension(:,:), pointer :: super_int2d
+ real :: super_real0d
+ real, dimension(:), pointer :: super_real1d
+ real, dimension(:,:), pointer :: super_real2d
+ real, dimension(:,:,:), pointer :: super_real3d
+
integer :: k
allocate(int1d % ioinfo)
Modified: branches/hyd_model/src/module_io_output.F
===================================================================
--- branches/hyd_model/src/module_io_output.F 2009-12-18 01:03:12 UTC (rev 87)
+++ branches/hyd_model/src/module_io_output.F 2009-12-18 18:22:32 UTC (rev 88)
@@ -120,6 +120,15 @@
type (field2dReal) :: real2d
type (field3dReal) :: real3d
+ integer :: i1, i2, i3, i4
+
+ integer, dimension(:), pointer :: super_int1d
+ integer, dimension(:,:), pointer :: super_int2d
+ real :: super_real0d
+ real, dimension(:), pointer :: super_real1d
+ real, dimension(:,:), pointer :: super_real2d
+ real, dimension(:,:,:), pointer :: super_real3d
+
output_obj % time = itime
allocate(int1d % ioinfo)
</font>
</pre>