<p><b>duda</b> 2009-10-20 15:44:00 -0600 (Tue, 20 Oct 2009)</p><p>First attempt at registry changes to allow fields to<br>
have a dimension that is derived from another dimension<br>
defined in the input (grid.nc) file. For example:<br>
<br>
dim nVertLevels nVertLevels<br>
dim nVertLevelsP1 nVertLevels+1<br>
<br>
var real foo ( nVertLevelsP1 nCells ) iro foo<br>
<br>
would define a field 'foo' whose inner-most<br>
dimension is one greater than nVertLevels.<br>
<br>
Right now, creating derived dimensions that vary<br>
by something other than +/- a constant value will<br>
likely not work.<br>
<br>
<br>
M swmodel/Registry/gen_inc.c<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/swmodel/Registry/gen_inc.c
===================================================================
--- trunk/swmodel/Registry/gen_inc.c 2009-10-20 17:55:44 UTC (rev 59)
+++ trunk/swmodel/Registry/gen_inc.c 2009-10-20 21:44:00 UTC (rev 60)
@@ -6,6 +6,38 @@
#include "gen_inc.h"
#include "fortprintf.h"
+int is_derived_dim(char * d)
+{
+ if (strchr(d, (int)'+')) return 1;
+ if (strchr(d, (int)'-')) return 1;
+
+ return 0;
+}
+
+void split_derived_dim_string(char * dim, char ** p1, char ** p2)
+{
+ char * cp, * cm, * c;
+ int n;
+
+ cp = strchr(dim, (int)'+');
+ cm = strchr(dim, (int)'-');
+ if (!cp)
+ c = cm;
+ else if (!cm)
+ c = cp;
+ else if (cm < cp)
+ c = cm;
+ else
+ c = cp;
+
+ n = c - dim;
+ *p1 = (char *)malloc(n*sizeof(char));
+ snprintf(*p1, n, "%s", dim+1);
+
+ *p2 = (char *)malloc((strlen(dim)-n+1)*sizeof(char));
+ sprintf(*p2, "%s", dim+n);
+}
+
void gen_namelists(struct namelist * nls)
{
struct namelist * nls_ptr;
@@ -132,12 +164,12 @@
fd = fopen("field_dimensions.inc", "w");
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " integer :: %s</font>
<font color="blue">", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " integer :: %s</font>
<font color="red">", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " integer :: %sSolve</font>
<font color="blue">", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " integer :: %sSolve</font>
<font color="gray">", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
@@ -149,12 +181,12 @@
*/
fd = fopen("dim_dummy_args.inc", "w");
dim_ptr = dims;
- if (dim_ptr && dim_ptr->constant_value < 0) {
+ if (dim_ptr && dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) {
fortprintf(fd, " %s", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, ", %s", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %s", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, " &</font>
<font color="gray">");
@@ -167,12 +199,12 @@
*/
fd = fopen("dim_dummy_decls.inc", "w");
dim_ptr = dims;
- if (dim_ptr && dim_ptr->constant_value < 0) {
+ if (dim_ptr && dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) {
fortprintf(fd, " integer, intent(in) :: %s", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, ", %s", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %s", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, "</font>
<font color="gray">");
@@ -186,7 +218,7 @@
fd = fopen("dim_decls.inc", "w");
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " integer :: %s</font>
<font color="blue">", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " integer :: %s</font>
<font color="gray">", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
@@ -199,7 +231,7 @@
fd = fopen("read_dims.inc", "w");
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " call io_input_get_dimension(input_obj, \'%s\', %s)</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " call io_input_get_dimension(input_obj, \'%s\', %s)</font>
<font color="gray">", dim_ptr->name_in_file, dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
@@ -243,7 +275,7 @@
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " g %% %s = %s</font>
<font color="blue">", dim_ptr->name_in_code, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " g %% %s = %s</font>
<font color="black">", dim_ptr->name_in_code, dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, "</font>
<font color="gray">");
@@ -414,6 +446,7 @@
FILE * fd;
char vtype[5];
char fname[32];
+ char * cp1, * cp2;
int i, j;
int ivtype;
int has_vert_dim, vert_dim;
@@ -427,7 +460,7 @@
fortprintf(fd, " integer :: rdDimIDTime</font>
<font color="red">");
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " integer :: rdDimID%s</font>
<font color="blue">", dim_ptr->name_in_file);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " integer :: rdDimID%s</font>
<font color="black">", dim_ptr->name_in_file);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, "</font>
<font color="gray">");
@@ -435,7 +468,7 @@
fortprintf(fd, " integer :: rdLocalTime</font>
<font color="red">");
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " integer :: rdLocal%s</font>
<font color="blue">", dim_ptr->name_in_file);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " integer :: rdLocal%s</font>
<font color="black">", dim_ptr->name_in_file);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, "</font>
<font color="gray">");
@@ -493,8 +526,17 @@
}
}
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="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ 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="gray">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
+ }
}
dimlist_ptr = dimlist_ptr->next;
i++;
@@ -505,24 +547,42 @@
i = 1;
dimlist_ptr = var_ptr->dimlist;
- if (i < var_ptr->ndims)
+ 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);
- 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, "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 (i < var_ptr->ndims)
+ 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);
- 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, ", 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++;
}
@@ -571,7 +631,14 @@
fortprintf(fd, " %s", dimlist_ptr->dim->name_in_code);
else {
lastdim = dimlist_ptr;
- fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
+ 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;
@@ -584,14 +651,28 @@
fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
else {
lastdim = dimlist_ptr;
- fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
+ 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, ", block %% mesh %% %s, &</font>
<font color="red">", lastdim->dim->name_in_code);
- fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", cp1, cp1);
+ free(cp1);
+ free(cp2);
+ }
+ else
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="black">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
fortprintf(fd, " deallocate(%s%id %% array)</font>
<font color="gray">", vtype, var_ptr->ndims);
}
else {
@@ -615,7 +696,7 @@
fortprintf(fd, " nferr = nf_inq_dimlen(input_obj %% rd_ncid, input_obj %% rdDimIDTime, input_obj %% rdLocalTime)</font>
<font color="red">");
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) {
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) {
fortprintf(fd, " nferr = nf_inq_dimid(input_obj %% rd_ncid, \'%s\', input_obj %% rdDimID%s)</font>
<font color="black">", dim_ptr->name_in_file, dim_ptr->name_in_file);
fortprintf(fd, " nferr = nf_inq_dimlen(input_obj %% rd_ncid, input_obj %% rdDimID%s, input_obj %% rdLocal%s)</font>
<font color="gray">", dim_ptr->name_in_file, dim_ptr->name_in_file);
}
@@ -638,12 +719,12 @@
fd = fopen("get_dimension_by_name.inc", "w");
dim_ptr = dims;
- while (dim_ptr->constant_value >= 0) dim_ptr = dim_ptr->next;
+ while (dim_ptr->constant_value >= 0 || is_derived_dim(dim_ptr->name_in_code)) dim_ptr = dim_ptr->next;
fortprintf(fd, " if (trim(dimname) == \'%s\') then</font>
<font color="black">", dim_ptr->name_in_code);
fortprintf(fd, " dimsize = input_obj %% rdLocal%s</font>
<font color="red">", dim_ptr->name_in_file);
dim_ptr = dim_ptr->next;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) {
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) {
fortprintf(fd, " else if (trim(dimname) == \'%s\') then</font>
<font color="black">", dim_ptr->name_in_code);
fortprintf(fd, " dimsize = input_obj %% rdLocal%s</font>
<font color="gray">", dim_ptr->name_in_file);
}
@@ -728,6 +809,7 @@
FILE * fd;
char vtype[5];
char fname[32];
+ char * cp1, * cp2;
int i, j;
int ivtype;
@@ -761,7 +843,7 @@
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " integer :: %sGlobal</font>
<font color="blue">", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " integer :: %sGlobal</font>
<font color="black">", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, "</font>
<font color="gray">");
@@ -776,7 +858,7 @@
dim_ptr = dims;
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, " %sGlobal = block_ptr %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_code, dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, " %sGlobal = block_ptr %% mesh %% %s</font>
<font color="black">", dim_ptr->name_in_code, dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, "</font>
<font color="gray">");
@@ -789,12 +871,12 @@
*/
fd = fopen("output_dim_actual_args.inc", "w");
dim_ptr = dims;
- if (dim_ptr && dim_ptr->constant_value < 0) {
+ if (dim_ptr && dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) {
fortprintf(fd, " %sGlobal", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
while (dim_ptr) {
- if (dim_ptr->constant_value < 0) fortprintf(fd, ", %sGlobal", dim_ptr->name_in_code);
+ if (dim_ptr->constant_value < 0 && !is_derived_dim(dim_ptr->name_in_code)) fortprintf(fd, ", %sGlobal", dim_ptr->name_in_code);
dim_ptr = dim_ptr->next;
}
fortprintf(fd, " &</font>
<font color="gray">");
@@ -873,7 +955,14 @@
}
else {
fortprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">", vtype, var_ptr->ndims, i);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ 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="gray">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
}
dimlist_ptr = dimlist_ptr->next;
i++;
@@ -889,7 +978,14 @@
else
fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
else {
- fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
+ 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;
@@ -901,7 +997,14 @@
else
fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
else {
- fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
+ 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;
@@ -934,9 +1037,18 @@
dimlist_ptr = dimlist_ptr->next;
i++;
}
- 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="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ 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">", cp1, cp1);
+ 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="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ }
}
else {
fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="black">", vtype, var_ptr->ndims, var_ptr->name_in_file);
</font>
</pre>