<p><b>duda</b> 2011-11-23 15:34:46 -0700 (Wed, 23 Nov 2011)</p><p>BRANCH COMMIT<br>
<br>
Handle super-arrays in PIO output (e.g., scalars -> qv,qc,qr,qi,... on output).<br>
<br>
<br>
M src/registry/gen_inc.c<br>
</p><hr noshade><pre><font color="gray">Modified: branches/pio/src/registry/gen_inc.c
===================================================================
--- branches/pio/src/registry/gen_inc.c 2011-11-23 21:31:16 UTC (rev 1211)
+++ branches/pio/src/registry/gen_inc.c 2011-11-23 22:34:46 UTC (rev 1212)
@@ -2287,8 +2287,8 @@
while (var_list_ptr) {
var_ptr = var_list_ptr->var;
-/* MGD FOR NOW, NO SCALAR FIELDS OR SUPER-ARRAYS */
-if (var_ptr->ndims > 0 && strncmp(var_ptr->super_array, "-", 1024) == 0) {
+/* MGD FOR NOW, NO SCALAR FIELDS */
+if (var_ptr->ndims > 0) {
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
@@ -2301,7 +2301,6 @@
else if (var_ptr->vtype == CHARACTER) sprintf(vtype, "char");
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
-/* MGD SUPER-ARRAYS FOR NOW? */
fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="black">", struct_deref, var_ptr->super_array);
fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &</font>
<font color="black">", struct_deref, var_ptr->super_array);
fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="gray">", struct_deref, var_ptr->super_array);
@@ -2312,7 +2311,63 @@
fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
}
- /******/
+ if (var_ptr->vtype == INTEGER) sprintf(vtype, "int");
+ else if (var_ptr->vtype == REAL) sprintf(vtype, "real");
+ else if (var_ptr->vtype == CHARACTER) sprintf(vtype, "char");
+
+ 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="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)
+ 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="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, " 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="gray">");
+ i++;
+ }
+ }
+
sprintf(temp, "");
dimlist_ptr = var_ptr->dimlist;
@@ -2325,13 +2380,18 @@
}
if (var_ptr->timedim) fortprintf(fd, " call PIO_setframe(output_obj %% pioVarID%s, pio_time)</font>
<font color="gray">", var_ptr->name_in_file);
fortprintf(fd, " call PIO_write_darray(output_obj %% pio_file, output_obj %% pioVarID%s, ", var_ptr->name_in_file);
-/* Handle scalars */
if (var_ptr->ndims != 0) {
/* MGD NEED TO USE CORRECT IODESC FOR THE TYPE OF THIS VARIABLE */
if (var_ptr->vtype == REAL)
- fortprintf(fd, "output_obj %% iodesc%s_Dbl, %s %% %s %% array(", temp, struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, "output_obj %% iodesc%s_Dbl, ", temp);
else
- fortprintf(fd, "output_obj %% iodesc%s_Int, %s %% %s %% array(", temp, struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, "output_obj %% iodesc%s_Int, ", temp);
+
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0)
+ fortprintf(fd, "super_%s%id(", vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, "%s %% %s %% array(", struct_deref, var_ptr->name_in_code);
+
dimlist_ptr = var_ptr->dimlist;
i = 1;
while(dimlist_ptr) {
@@ -2349,7 +2409,9 @@
}
fortprintf(fd, "), i1)</font>
<font color="red">");
}
- /******/
+
+ 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">");
}
@@ -2534,10 +2596,11 @@
fortprintf(fd, "</font>
<font color="red">");
var_ptr = vars;
+
while (var_ptr) {
-/* MGD FOR NOW, NO SCALAR FIELDS OR SUPER-ARRAYS */
-if (var_ptr->ndims > 0 && strncmp(var_ptr->super_array, "-", 1024) == 0 && (var_ptr->vtype == INTEGER || var_ptr->vtype == REAL)) {
+/* MGD FOR NOW, NO SCALAR OR CHARACTER FIELDS */
+if (var_ptr->ndims > 0 && (var_ptr->vtype == INTEGER || var_ptr->vtype == REAL)) {
fortprintf(fd, " if (.false. &</font>
<font color="black">");
if (var_ptr->iostreams & RESTART0) fortprintf(fd, " .or. output_obj %% stream == RESTART &</font>
<font color="black">");
</font>
</pre>