<p><b>duda</b> 2011-11-23 13:15:33 -0700 (Wed, 23 Nov 2011)</p><p>BRANCH COMMIT<br>
<br>
Commit initial code to auto-generate PIO calls for output through the registry.<br>
<br>
Still to be done:<br>
- support for scalar fields with or without a Time dimension; e.g., xtime, cf1<br>
- support for super-arrays<br>
- support for fields of type logical and character (currently only integer and<br>
real are handled)<br>
<br>
<br>
M src/registry/gen_inc.c<br>
M src/framework/mpas_io_output.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/pio/src/framework/mpas_io_output.F
===================================================================
--- branches/pio/src/framework/mpas_io_output.F 2011-11-22 17:50:14 UTC (rev 1209)
+++ branches/pio/src/framework/mpas_io_output.F 2011-11-23 20:15:33 UTC (rev 1210)
@@ -17,8 +17,7 @@
! For PIO
type (iosystem_desc_t) :: pio_iosystem
type (file_desc_t) :: pio_file
-!MGD-REGISTRY will need to generate an io_desc_t for each combination of dimensions
- type (io_desc_t) :: iodesc_nVertLevels_nCells
+#include "pio_output_io_desc.inc"
integer :: wr_ncid
character (len=1024) :: filename
@@ -30,17 +29,9 @@
integer :: wrDimIDStrLen
#include "io_output_obj_decls.inc"
-!MGD-REGISTRY will need to generate dimensions
- ! MGD currently hard-wired for testing
integer :: pioDimIDTime
- integer :: pioDimIDnCells
- integer :: pioDimIDnVertLevels
+#include "pio_output_io_dims_vars.inc"
-!MGD-REGISTRY will need to generate variables
- ! MGD currently hard-wired for testing
- type (var_desc_t) :: pioVarIDtheta
- type (var_desc_t) :: pioVarIDrho
-
logical :: validExchangeLists
type (exchange_list), pointer :: sendCellsList, recvCellsList
type (exchange_list), pointer :: sendEdgesList, recvEdgesList
@@ -95,7 +86,7 @@
domain % dminfo % comm, & ! comp_comm
4, & ! num_iotasks
0, & ! num_aggregator
- 32, & ! stride
+ 16, & ! stride
PIO_rearr_box, & ! rearr
output_obj % pio_iosystem) ! iosystem
! domain % dminfo % nprocs, & ! num_iotasks
@@ -186,12 +177,10 @@
integer :: nVerticesGlobal
integer :: nVertLevelsGlobal
-!MGD-REGISTRY will need to generate compdof info for each combination of dimensions
-!MGD hard-wired for initial PIO testing
integer(kind=PIO_Offset) :: pio_time
integer, dimension(:), pointer :: compdof
- integer, dimension(2) :: dimids2
- integer, dimension(3) :: dimids3
+ integer, dimension(7) :: dimids
+ integer :: indx
integer, dimension(:), pointer :: neededCellList
integer, dimension(:), pointer :: neededEdgeList
@@ -328,26 +317,9 @@
if (.not. output_obj % validExchangeLists) then
-!MGD-REGISTRY will need to generate compdof info for each combination of dimensions
write(0,*) 'MGD PIO_initdecomp'
-
- allocate(compdof(domain % blocklist % mesh % nVertLevelsSolve * domain % blocklist % mesh % nCellsSolve))
- do i=1,domain % blocklist % mesh % nCellsSolve
- do j=1,domain % blocklist % mesh % nVertLevelsSolve
- compdof((i-1)*domain % blocklist % mesh % nVertLevels + j) = &
- (domain % blocklist % mesh % indexToCellID % array(i)-1) * &
- domain % blocklist % mesh % nVertLevels + j
- end do
- end do
+#include "pio_init_decomp.inc"
- dimids2(1) = nVertLevelsGlobal
- dimids2(2) = nCellsGlobal
-
- call PIO_initdecomp(output_obj % pio_iosystem, PIO_DOUBLE, &
- dimids2, compdof, output_obj % iodesc_nVertLevels_nCells)
- deallocate(compdof)
-!MGD end PIO_initdecomp call
-
call mpas_dmpar_get_owner_list(domain % dminfo, &
domain % blocklist % mesh % nCellsSolve, size(neededCellList), &
domain % blocklist % mesh % indexToCellID % array, neededCellList, &
@@ -396,20 +368,12 @@
!include "io_output_fields.inc"
pio_time = output_obj % time
-write(0,*) 'MGD PIO_setframe ', pio_time
- call PIO_setframe(output_obj % pioVarIDtheta, pio_time)
- call PIO_setframe(output_obj % pioVarIDrho, pio_time)
-!MGD-REGISTRY will need to generate write calls for each field
+write(0,*) 'MGD PIO_setframe ', pio_time
write(0,*) 'MGD PIO_write_darray'
-call mpas_timer_start("pio theta")
- call PIO_write_darray(output_obj % pio_file, output_obj % pioVarIDtheta, output_obj % iodesc_nVertLevels_nCells, &
- domain % blocklist % diag % theta % array(:,1:domain%blocklist%mesh%nCellsSolve), i1)
-call mpas_timer_stop("pio theta")
-call mpas_timer_start("pio rho")
- call PIO_write_darray(output_obj % pio_file, output_obj % pioVarIDrho, output_obj % iodesc_nVertLevels_nCells, &
- domain % blocklist % diag % rho % array(:,1:domain%blocklist%mesh%nCellsSolve), i1)
-call mpas_timer_stop("pio rho")
+call mpas_timer_start("pio write")
+#include "pio_output_fields.inc"
+call mpas_timer_stop("pio write")
domain % blocklist % mesh % cellsOnCell % array => cellsOnCell_save
@@ -498,17 +462,18 @@
!MGD-REGISTRY will need to generate definitions for each dimension
write(0,*) 'MGD PIO_def_dim'
- nferr = PIO_def_dim(output_obj % pio_file, 'Time', PIO_UNLIMITED, output_obj % pioDimIDTime)
- nferr = PIO_def_dim(output_obj % pio_file, 'nCells', nCells, output_obj % pioDimIDnCells)
- nferr = PIO_def_dim(output_obj % pio_file, 'nVertLevels', nVertLevels, output_obj % pioDimIDnVertLevels)
+! nferr = PIO_def_dim(output_obj % pio_file, 'Time', PIO_UNLIMITED, output_obj % pioDimIDTime)
+! nferr = PIO_def_dim(output_obj % pio_file, 'nCells', nCells, output_obj % pioDimIDnCells)
+! nferr = PIO_def_dim(output_obj % pio_file, 'nVertLevels', nVertLevels, output_obj % pioDimIDnVertLevels)
!MGD-REGISTRY will need to generate definitions for each field
write(0,*) 'MGD PIO_def_var'
- dimlist(1) = output_obj % pioDimIDnVertLevels
- dimlist(2) = output_obj % pioDimIDnCells
- dimlist(3) = output_obj % pioDimIDTime
- nferr = PIO_def_var(output_obj % pio_file, 'theta', PIO_DOUBLE, dimlist(1:3), output_obj % pioVarIDtheta)
- nferr = PIO_def_var(output_obj % pio_file, 'rho', PIO_DOUBLE, dimlist(1:3), output_obj % pioVarIDrho)
+! dimlist(1) = output_obj % pioDimIDnVertLevels
+! dimlist(2) = output_obj % pioDimIDnCells
+! dimlist(3) = output_obj % pioDimIDTime
+! nferr = PIO_def_var(output_obj % pio_file, 'theta', PIO_DOUBLE, dimlist(1:3), output_obj % pioVarIDtheta)
+! nferr = PIO_def_var(output_obj % pio_file, 'rho', PIO_DOUBLE, dimlist(1:3), output_obj % pioVarIDrho)
+#include "pio_def_dims_vars.inc"
write(0,*) 'MGD PIO_enddef'
@@ -972,9 +937,8 @@
write(0,*) 'MGD PIO_closefile'
call PIO_closefile(output_obj % pio_file)
-!MGD-REGISTRY will need to generate calls to free up each io_desc_t
write(0,*) 'MGD PIO_freedecomp'
- call PIO_freedecomp(output_obj % pio_iosystem, output_obj % iodesc_nVertLevels_nCells)
+#include "pio_output_free_decomp.inc"
write(0,*) 'MGD PIO_finalize'
call PIO_finalize(output_obj % pio_iosystem, nferr)
Modified: branches/pio/src/registry/gen_inc.c
===================================================================
--- branches/pio/src/registry/gen_inc.c 2011-11-22 17:50:14 UTC (rev 1209)
+++ branches/pio/src/registry/gen_inc.c 2011-11-23 20:15:33 UTC (rev 1210)
@@ -1662,9 +1662,10 @@
struct group_list * group_ptr;
struct dtable * dictionary;
struct namelist * nl;
- FILE * fd;
+ FILE * fd, * fd2;
char vtype[5];
char fname[32];
+ char temp[128];
char struct_deref[1024];
char * cp1, * cp2;
int i, j;
@@ -2186,5 +2187,412 @@
fclose(fd);
}
+
+
+/*
+!MGD-REGISTRY will need to generate an io_desc_t for each combination of dimensions
+ type (io_desc_t) :: iodesc_nVertLevels_nCells
+*/
+/*
+!MGD-REGISTRY will need to generate calls to free up each io_desc_t
+write(0,*) 'MGD PIO_freedecomp'
+ call PIO_freedecomp(output_obj % pio_iosystem, output_obj % iodesc_nVertLevels_nCells)
+*/
+ /*
+ * PIO code:
+ * Generate definitions of io_desc_t for each combination of dimensions
+ */
+ fd = fopen("pio_output_io_desc.inc", "w");
+ fd2 = fopen("pio_output_free_decomp.inc", "w");
+ dict_alloc(&dictionary);
+
+ var_ptr = vars;
+ while (var_ptr) {
+ sprintf(temp, "");
+ dimlist_ptr = var_ptr->dimlist;
+
+ /* Avoid the case where we only have a time dimension */
+ if (var_ptr->ndims != 0) {
+ while(dimlist_ptr) {
+ sprintf(temp, "%s_%s", temp, dimlist_ptr->dim->name_in_file);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ if (!dict_search(dictionary, temp)) {
+/* MGD NEED TO ADD IODESC TYPES FOR EACH FIELD TYPE */
+ fortprintf(fd, " type (io_desc_t) :: iodesc%s_Dbl</font>
<font color="blue">", temp);
+ fortprintf(fd, " type (io_desc_t) :: iodesc%s_Int</font>
<font color="blue">", temp);
+ fortprintf(fd2, " call PIO_freedecomp(output_obj %% pio_iosystem, output_obj %% iodesc%s_Dbl)</font>
<font color="blue">", temp);
+ fortprintf(fd2, " call PIO_freedecomp(output_obj %% pio_iosystem, output_obj %% iodesc%s_Int)</font>
<font color="blue">", temp);
+ dict_insert(dictionary, temp);
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+
+ dict_free(&dictionary);
+ fclose(fd);
+ fclose(fd2);
+
+
+/*
+!MGD-REGISTRY will need to generate dimensions
+ ! MGD currently hard-wired for testing
+ integer :: pioDimIDTime
+ integer :: pioDimIDnCells
+ integer :: pioDimIDnVertLevels
+
+!MGD-REGISTRY will need to generate variables
+ ! MGD currently hard-wired for testing
+ type (var_desc_t) :: pioVarIDtheta
+ type (var_desc_t) :: pioVarIDrho
+*/
+ /*
+ * PIO code:
+ * Generate dimension IDs and var_desc_t for each dimension and variable
+ */
+ fd = fopen("pio_output_io_dims_vars.inc", "w");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+ fortprintf(fd, " integer :: pioDimID%s</font>
<font color="blue">", dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+
+ var_ptr = vars;
+ while (var_ptr) {
+ fortprintf(fd, " type (var_desc_t) :: pioVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ var_ptr = var_ptr->next;
+ }
+
+ fclose(fd);
+
+
+/*
+ call PIO_setframe(output_obj % pioVarIDtheta, pio_time)
+ call PIO_write_darray(output_obj % pio_file, output_obj % pioVarIDtheta, output_obj % iodesc_nVertLevels_nCells, &
+ domain % blocklist % diag % theta % array(:,1:domain%blocklist%mesh%nCellsSolve), i1)
+ call PIO_setframe(output_obj % pioVarIDrho, pio_time)
+ call PIO_write_darray(output_obj % pio_file, output_obj % pioVarIDrho, output_obj % iodesc_nVertLevels_nCells, &
+ domain % blocklist % diag % rho % array(:,1:domain%blocklist%mesh%nCellsSolve), i1)
+*/
+ /*
+ * PIO code:
+ * Generate calls to write fields using PIO
+ */
+ fd = fopen("pio_output_fields.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ 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) {
+ 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");
+ 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="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ }
+ else {
+ 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) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ }
+
+ /******/
+ sprintf(temp, "");
+ dimlist_ptr = var_ptr->dimlist;
+
+ /* Avoid the case where we only have a time dimension */
+ if (var_ptr->ndims != 0) {
+ while(dimlist_ptr) {
+ sprintf(temp, "%s_%s", temp, dimlist_ptr->dim->name_in_file);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ }
+ if (var_ptr->timedim) fortprintf(fd, " call PIO_setframe(output_obj %% pioVarID%s, pio_time)</font>
<font color="blue">", 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);
+ else
+ fortprintf(fd, "output_obj %% iodesc%s_Int, %s %% %s %% array(", temp, struct_deref, var_ptr->name_in_code);
+ dimlist_ptr = var_ptr->dimlist;
+ i = 1;
+ while(dimlist_ptr) {
+ if (i == var_ptr->ndims)
+ 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, "1:domain%%blocklist%%mesh%%%sSolve", dimlist_ptr->dim->name_in_file);
+ else
+ fortprintf(fd, ":");
+ else
+ fortprintf(fd, ":,");
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ fortprintf(fd, "), i1)</font>
<font color="blue">");
+ }
+ /******/
+
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="blue">");
}
+
+ var_list_ptr = var_list_ptr->next;
+ }
+ group_ptr = group_ptr->next;
+ }
+
+ fclose(fd);
+
+
+/*
+ allocate(compdof(domain % blocklist % mesh % nVertLevelsSolve * domain % blocklist % mesh % nCellsSolve))
+ do i=1,domain % blocklist % mesh % nCellsSolve
+ do j=1,domain % blocklist % mesh % nVertLevelsSolve
+ compdof((i-1)*domain % blocklist % mesh % nVertLevels + j) = &
+ (domain % blocklist % mesh % indexToCellID % array(i)-1) * &
+ domain % blocklist % mesh % nVertLevels + j
+ end do
+ end do
+
+ dimids2(1) = nVertLevelsGlobal
+ dimids2(2) = nCellsGlobal
+
+ call PIO_initdecomp(output_obj % pio_iosystem, PIO_DOUBLE, &
+ dimids2, compdof, output_obj % iodesc_nVertLevels_nCells)
+ deallocate(compdof)
+*/
+ /*
+ * PIO code:
+ * Create io decompositions for each combination of dimensions
+ */
+ fd = fopen("pio_init_decomp.inc", "w");
+ dict_alloc(&dictionary);
+
+ var_ptr = vars;
+ while (var_ptr) {
+
+ /* Avoid the case where we only have a time dimension */
+ if (var_ptr->ndims != 0) {
+ sprintf(temp, "");
+ dimlist_ptr = var_ptr->dimlist;
+
+ i = 1;
+ j = 1; /* Flag telling whether this is a decomposed field or not */
+ while(dimlist_ptr) {
+ sprintf(temp, "%s_%s", temp, dimlist_ptr->dim->name_in_file);
+
+ /* If this is not a decomposed dimension, we want to only write it from one task */
+ if (i == var_ptr->ndims) {
+ 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))
+ j = 0; /* Not a decomposed field */
+ }
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ if (!dict_search(dictionary, temp)) {
+ fortprintf(fd, "!!!!! %s</font>
<font color="blue">", temp);
+ dimlist_ptr = var_ptr->dimlist;
+ i = 1;
+ while(dimlist_ptr) {
+ if (j == 0) /* If this is not a decomposed field */
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+
+ if (dimlist_ptr->dim->constant_value > 0)
+ fortprintf(fd, " dimids(%i) = %i</font>
<font color="blue">", i, dimlist_ptr->dim->constant_value);
+ else if (dimlist_ptr->dim->namelist_defined > 0)
+ fortprintf(fd, " dimids(%i) = %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else 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, " dimids(%i) = domain %% blocklist %% mesh %% %sSolve</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, " dimids(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+
+ if (j == 0) { /* not a decomposed field */
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " dimids(%i) = 0</font>
<font color="blue">", i);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+
+ fortprintf(fd, " allocate(compdof(");
+ for(i=1; i<var_ptr->ndims; i++)
+ fortprintf(fd, "dimids(%i)*", i);
+ fortprintf(fd, "dimids(%i)", i);
+ fortprintf(fd, "))</font>
<font color="blue">");
+
+ fortprintf(fd, " indx = 1</font>
<font color="blue">");
+ for(i=var_ptr->ndims; i>0; i--)
+ fortprintf(fd, " do i%i=1,dimids(%i)</font>
<font color="blue">", i, i);
+
+ fortprintf(fd, " compdof(indx) = ");
+ dimlist_ptr = var_ptr->dimlist;
+ i = 1;
+ while(dimlist_ptr) {
+ if (i > 1) fortprintf(fd, "(");
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024))
+ fortprintf(fd, "domain %% blocklist %% mesh %% indexToCellID %% array(i%i)", i);
+ else if (!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024))
+ fortprintf(fd, "domain %% blocklist %% mesh %% indexToEdgeID %% array(i%i)", i);
+ else if (!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, "domain %% blocklist %% mesh %% indexToVertexID %% array(i%i)", i);
+ else
+ fortprintf(fd, "i%i", i);
+ for(j=i-1; j>0; j--)
+ if (j == i-1)
+ fortprintf(fd, "-1)*dimids(%i)", j);
+ else
+ fortprintf(fd, "*dimids(%i)", j);
+ if (dimlist_ptr->next) fortprintf(fd, " + ");
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ fortprintf(fd, " indx = indx + 1</font>
<font color="blue">");
+ for(i=1; i<=var_ptr->ndims; i++)
+ fortprintf(fd, " end do</font>
<font color="blue">");
+
+ i = 1;
+ dimlist_ptr = var_ptr->dimlist;
+ while(dimlist_ptr) {
+ if (dimlist_ptr->dim->constant_value > 0)
+ fortprintf(fd, " dimids(%i) = %i</font>
<font color="blue">", i, dimlist_ptr->dim->constant_value);
+ else if (dimlist_ptr->dim->namelist_defined > 0)
+ fortprintf(fd, " dimids(%i) = %s</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, " dimids(%i) = %sGlobal</font>
<font color="blue">", i, dimlist_ptr->dim->name_in_file);
+ i++;
+ dimlist_ptr = dimlist_ptr->next;
+ }
+
+/* MGD NEED TO ADD MORE CODE HERE TO CREATE DECOMPS FOR EACH TYPE */
+ fortprintf(fd, " call PIO_initdecomp(output_obj %% pio_iosystem, PIO_DOUBLE, dimids(1:%i), compdof, output_obj %% iodesc%s_Dbl)</font>
<font color="blue">", var_ptr->ndims, temp);
+ fortprintf(fd, " call PIO_initdecomp(output_obj %% pio_iosystem, PIO_INT, dimids(1:%i), compdof, output_obj %% iodesc%s_Int)</font>
<font color="blue">", var_ptr->ndims, temp);
+
+ fortprintf(fd, " deallocate(compdof)</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ dict_insert(dictionary, temp);
+ }
+ }
+ var_ptr = var_ptr->next;
+ }
+
+ dict_free(&dictionary);
+ fclose(fd);
+
+
+/*
+!MGD-REGISTRY will need to generate definitions for each dimension
+write(0,*) 'MGD PIO_def_dim'
+ nferr = PIO_def_dim(output_obj % pio_file, 'Time', PIO_UNLIMITED, output_obj % pioDimIDTime)
+ nferr = PIO_def_dim(output_obj % pio_file, 'nCells', nCells, output_obj % pioDimIDnCells)
+ nferr = PIO_def_dim(output_obj % pio_file, 'nVertLevels', nVertLevels, output_obj % pioDimIDnVertLevels)
+
+!MGD-REGISTRY will need to generate definitions for each field
+write(0,*) 'MGD PIO_def_var'
+ dimlist(1) = output_obj % pioDimIDnVertLevels
+ dimlist(2) = output_obj % pioDimIDnCells
+ dimlist(3) = output_obj % pioDimIDTime
+ nferr = PIO_def_var(output_obj % pio_file, 'theta', PIO_DOUBLE, dimlist(1:3), output_obj % pioVarIDtheta)
+ nferr = PIO_def_var(output_obj % pio_file, 'rho', PIO_DOUBLE, dimlist(1:3), output_obj % rioVarIDrho)
+*/
+ /*
+ * Generate PIO calls to define dimensions, variables, and global attributes
+ */
+ fd = fopen("pio_def_dims_vars.inc", "w");
+
+ fortprintf(fd, " nferr = PIO_def_dim(output_obj %% pio_file, \'Time\', PIO_UNLIMITED, output_obj %% pioDimIDTime)</font>
<font color="blue">");
+ dim_ptr = dims;
+ while (dim_ptr) {
+ fortprintf(fd, " nferr = PIO_def_dim(output_obj %% pio_file, \'%s\', %s, output_obj %% pioDimID%s)</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code, dim_ptr->name_in_file);
+ dim_ptr = dim_ptr->next;
+ }
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ 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)) {
+
+ fortprintf(fd, " if (.false. &</font>
<font color="blue">");
+ if (var_ptr->iostreams & RESTART0) fortprintf(fd, " .or. output_obj %% stream == RESTART &</font>
<font color="blue">");
+ if (var_ptr->iostreams & OUTPUT0) fortprintf(fd, " .or. output_obj %% stream == OUTPUT &</font>
<font color="blue">");
+ if (var_ptr->iostreams & SFC0) fortprintf(fd, " .or. output_obj %% stream == SFC &</font>
<font color="blue">");
+ fortprintf(fd, " ) then</font>
<font color="blue">");
+ dimlist_ptr = var_ptr->dimlist;
+ fortprintf(fd, "write(0,*) \'MGD defining %s\'</font>
<font color="blue">", var_ptr->name_in_file);
+ i = 1;
+ if (var_ptr->vtype == CHARACTER)
+ fortprintf(fd, " dimlist(%i) = output_obj %% pioDimIDStrLen</font>
<font color="blue">", i++);
+ while(dimlist_ptr) {
+ fortprintf(fd, " dimlist(%i) = output_obj %% pioDimID%s</font>
<font color="blue">", i++, dimlist_ptr->dim->name_in_file);
+ dimlist_ptr = dimlist_ptr->next;
+ }
+ if (var_ptr->timedim) fortprintf(fd, " dimlist(%i) = output_obj %% pioDimIDTime</font>
<font color="blue">", i++);
+ if (var_ptr->vtype == INTEGER)
+ fortprintf(fd, " nferr = PIO_def_var(output_obj %% pio_file, \'%s\', PIO_INT, dimlist(1:%i), output_obj %% pioVarID%s)</font>
<font color="blue">", var_ptr->name_in_file, var_ptr->ndims + var_ptr->timedim, var_ptr->name_in_file);
+ else if (var_ptr->vtype == REAL)
+ fortprintf(fd, " nferr = PIO_def_var(output_obj %% pio_file, \'%s\', PIO_DOUBLE, dimlist(1:%i), output_obj %% pioVarID%s)</font>
<font color="blue">", var_ptr->name_in_file, var_ptr->ndims + var_ptr->timedim, var_ptr->name_in_file);
+ else if (var_ptr->vtype == CHARACTER)
+ fortprintf(fd, " nferr = PIO_def_var(output_obj %% pio_file, \'%s\', PIO_CHAR, dimlist(1:%i), output_obj %% pioVarID%s)</font>
<font color="blue">", var_ptr->name_in_file, var_ptr->ndims + var_ptr->timedim + 1, var_ptr->name_in_file);
+
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="blue">");
+}
+
+ var_ptr = var_ptr->next;
+ }
+
+/* STILL TO DO
+ nl = namelists;
+ while (nl) {
+ if (nl->vtype == INTEGER)
+ fortprintf(fd, " nferr = nf_put_att_int(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_INT, 1, %s)</font>
<font color="blue">", nl->name, nl->name);
+ else if (nl->vtype == REAL) {
+ fortprintf(fd, " if (RKIND == 8) then</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " nferr = nf_put_att_double(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_DOUBLE, 1, %s)</font>
<font color="blue">", nl->name, nl->name);
+ fortprintf(fd, " else if (RKIND == 4) then</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " nferr = nf_put_att_real(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_FLOAT, 1, %s)</font>
<font color="blue">", nl->name, nl->name);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ else if (nl->vtype == CHARACTER)
+ fortprintf(fd, " nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', len_trim(%s), trim(%s))</font>
<font color="blue">", nl->name, nl->name, nl->name);
+ else if (nl->vtype == LOGICAL) {
+ fortprintf(fd, " if (%s) then</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', 1, \'T\')</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', 1, \'F\')</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ nl = nl->next;
+ }
+*/
+
+ fclose(fd);
+
+
+}
</font>
</pre>