<p><b>duda</b> 2010-05-04 16:02:51 -0600 (Tue, 04 May 2010)</p><p>BRANCH COMMIT<br>
<br>
Changes to support time-invariant, 0d real 'fields' in the registry.<br>
Now, it is possible to declare a registry variable such as<br>
<br>
var real ptop ( ) iro ptop - -<br>
<br>
that will be accessible in the code as <br>
<br>
block % mesh % ptop % scalar<br>
<br>
<br>
M src/registry/gen_inc.c<br>
M src/framework/module_io_input.F<br>
M src/framework/module_io_output.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/mpas_cam_coupling/src/framework/module_io_input.F
===================================================================
--- branches/mpas_cam_coupling/src/framework/module_io_input.F 2010-05-04 20:26:01 UTC (rev 243)
+++ branches/mpas_cam_coupling/src/framework/module_io_input.F 2010-05-04 22:02:51 UTC (rev 244)
@@ -21,6 +21,7 @@
interface io_input_field
+ module procedure io_input_field0dReal
module procedure io_input_field1dReal
module procedure io_input_field2dReal
module procedure io_input_field3dReal
@@ -1057,6 +1058,33 @@
end subroutine io_input_get_dimension
+ subroutine io_input_field0dReal(input_obj, field)
+
+ implicit none
+
+ type (io_input_object), intent(in) :: input_obj
+ type (field0dReal), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(1) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 1
+
+#include "input_field0dreal.inc"
+
+#if (RKIND == 8)
+ nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#else
+ nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#endif
+
+ end subroutine io_input_field0dReal
+
+
subroutine io_input_field1dReal(input_obj, field)
implicit none
Modified: branches/mpas_cam_coupling/src/framework/module_io_output.F
===================================================================
--- branches/mpas_cam_coupling/src/framework/module_io_output.F 2010-05-04 20:26:01 UTC (rev 243)
+++ branches/mpas_cam_coupling/src/framework/module_io_output.F 2010-05-04 22:02:51 UTC (rev 244)
@@ -27,6 +27,7 @@
interface io_output_field
+ module procedure io_output_field0dReal
module procedure io_output_field1dReal
module procedure io_output_field2dReal
module procedure io_output_field3dReal
@@ -336,6 +337,35 @@
end subroutine io_output_init
+ subroutine io_output_field0dReal(output_obj, field)
+
+ implicit none
+
+ type (io_output_object), intent(in) :: output_obj
+ type (field0dReal), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(1) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 1
+
+#include "output_field0dreal_time.inc"
+
+#if (RKIND == 8)
+ nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#else
+ nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#endif
+
+ nferr = nf_sync(output_obj % wr_ncid)
+
+ end subroutine io_output_field0dReal
+
+
subroutine io_output_field1dReal(output_obj, field)
implicit none
Modified: branches/mpas_cam_coupling/src/registry/gen_inc.c
===================================================================
--- branches/mpas_cam_coupling/src/registry/gen_inc.c 2010-05-04 20:26:01 UTC (rev 243)
+++ branches/mpas_cam_coupling/src/registry/gen_inc.c 2010-05-04 22:02:51 UTC (rev 244)
@@ -414,32 +414,50 @@
else {
fortprintf(fd, " allocate(g %% %s)</font>
<font color="black">", 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 (var_ptr->ndims > 0) {
+ 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="blue">");
+
+ 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="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="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & OUTPUT0)
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ else
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .false.</font>
<font color="blue">", var_ptr->name_in_code);
+ fortprintf(fd, "</font>
<font color="red">");
}
- 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="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="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="red">");
-
+ else {
+ 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="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="blue">", var_ptr->name_in_code);
+
+ if (var_ptr->iostreams & OUTPUT0)
+ fortprintf(fd, " g %% %s %% ioinfo %% output = .true.</font>
<font color="blue">", var_ptr->name_in_code);
+ 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;
}
}
@@ -473,9 +491,15 @@
fortprintf(fd, " deallocate(g %% %s)</font>
<font color="black"></font>
<font color="red">", var_ptr2->super_array);
}
else {
- 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 (var_ptr->ndims > 0) {
+ 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="blue">", var_ptr->name_in_code);
+ }
+ else {
+ 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;
}
}
@@ -1026,7 +1050,10 @@
fortprintf(fd, " deallocate(super_%s%id)</font>
<font color="red">", vtype, var_ptr->ndims);
}
else {
- fortprintf(fd, " block %% time_levs(1) %% state %% %s %% scalar = %s%id %% scalar</font>
<font color="blue">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ if (var_ptr->timedim)
+ fortprintf(fd, " block %% time_levs(1) %% state %% %s %% scalar = %s%id %% scalar</font>
<font color="blue">", var_ptr->name_in_code, vtype, var_ptr->ndims);
+ else
+ fortprintf(fd, " block %% mesh %% %s %% scalar = %s%id %% scalar</font>
<font color="black">", var_ptr->name_in_code, vtype, var_ptr->ndims);
}
fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="gray">");
@@ -1086,10 +1113,10 @@
/*
- * Generate code to read 1d, 2d, 3d time-invariant fields
+ * Generate code to read 0d, 1d, 2d, 3d time-invariant fields
*/
for(j=0; j<2; j++) {
- for(i=1; i<=3; i++) {
+ for(i=0; i<=3; i++) {
if (j == 0) {
sprintf(fname, "input_field%idinteger.inc", i);
ivtype = INTEGER;
@@ -1497,7 +1524,10 @@
}
else {
fortprintf(fd, " %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">", vtype, var_ptr->ndims, var_ptr->name_in_file);
- fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% time_levs(1) %% state %% %s %% scalar</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->timedim)
+ fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% time_levs(1) %% state %% %s %% scalar</font>
<font color="blue">", vtype, var_ptr->ndims, var_ptr->name_in_code);
+ else
+ fortprintf(fd, " %s%id %% scalar = domain %% blocklist %% mesh %% %s %% scalar</font>
<font color="gray">", vtype, var_ptr->ndims, var_ptr->name_in_code);
}
if (var_ptr->timedim)
@@ -1521,7 +1551,7 @@
* Generate code to write 1d, 2d, 3d time-invariant fields
*/
for(j=0; j<2; j++) {
- for(i=1; i<=3; i++) {
+ for(i=0; i<=3; i++) {
if (j == 0) {
sprintf(fname, "output_field%idinteger.inc", i);
ivtype = INTEGER;
</font>
</pre>