<p><b>duda</b> 2011-08-12 17:27:01 -0600 (Fri, 12 Aug 2011)</p><p>BRANCH COMMIT<br>
<br>
Add the capability to read and write character strings (currently with hard-wired length of 64)<br>
to input and output files. Character string variables should be declared in the registry file<br>
as having type "text" (rather than "integer" or "real").<br>
<br>
This new code is currently only working for scalar string variables, either with or without<br>
a time dimension. However, this is all that is required for the primary application, namely,<br>
the replacement of the xtime real variable with an xtime date-time string, e.g., "2011-08-12_00:00:00"<br>
for use with the new time manager.<br>
<br>
Also, fix declaration of a variable in module_io_output.F from "real" to "real (kind=RKIND)".<br>
<br>
<br>
M src/registry/gen_inc.c<br>
M src/registry/parse.c<br>
M src/framework/module_io_input.F<br>
M src/framework/module_io_output.F<br>
M src/framework/module_grid_types.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/time_manager/src/framework/module_grid_types.F
===================================================================
--- branches/time_manager/src/framework/module_grid_types.F 2011-08-12 19:42:44 UTC (rev 938)
+++ branches/time_manager/src/framework/module_grid_types.F 2011-08-12 23:27:01 UTC (rev 939)
@@ -64,6 +64,22 @@
end type field1DInteger
+ ! Derived type for storing fields
+ type field1DChar
+ type (block_type), pointer :: block
+ character (len=64), dimension(:), pointer :: array
+ type (io_info), pointer :: ioinfo
+ end type field1DChar
+
+
+ ! Derived type for storing fields
+ type field0DChar
+ type (block_type), pointer :: block
+ character (len=64) :: scalar
+ type (io_info), pointer :: ioinfo
+ end type field0DChar
+
+
! Derived type for storing grid meta-data
type mesh_type
Modified: branches/time_manager/src/framework/module_io_input.F
===================================================================
--- branches/time_manager/src/framework/module_io_input.F 2011-08-12 19:42:44 UTC (rev 938)
+++ branches/time_manager/src/framework/module_io_input.F 2011-08-12 23:27:01 UTC (rev 939)
@@ -27,6 +27,8 @@
module procedure io_input_field3dReal
module procedure io_input_field1dInteger
module procedure io_input_field2dInteger
+ module procedure io_input_field0dChar
+ module procedure io_input_field1dChar
end interface io_input_field
interface io_input_field_time
@@ -34,6 +36,8 @@
module procedure io_input_field1dReal_time
module procedure io_input_field2dReal_time
module procedure io_input_field3dReal_time
+ module procedure io_input_field0dChar_time
+ module procedure io_input_field1dChar_time
end interface io_input_field_time
@@ -1036,6 +1040,8 @@
type (field1dReal) :: real1d
type (field2dReal) :: real2d
type (field3dReal) :: real3d
+ type (field0dChar) :: char0d
+ type (field1dChar) :: char1d
integer :: i1, i2, i3, i4
@@ -1045,6 +1051,8 @@
real (kind=RKIND), dimension(:), pointer :: super_real1d
real (kind=RKIND), dimension(:,:), pointer :: super_real2d
real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
+ character (len=64) :: super_char0d
+ character (len=64), dimension(:), pointer :: super_char1d
integer :: k
@@ -1054,6 +1062,8 @@
allocate(real1d % ioinfo)
allocate(real2d % ioinfo)
allocate(real3d % ioinfo)
+ allocate(char0d % ioinfo)
+ allocate(char1d % ioinfo)
#include "io_input_fields.inc"
@@ -1453,6 +1463,116 @@
end subroutine io_input_field2dInteger
+ subroutine io_input_field0dChar_time(input_obj, field)
+
+ implicit none
+
+ type (io_input_object), intent(in) :: input_obj
+ type (field0dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 64
+ start1(2) = input_obj % time
+ count1(2) = 1
+
+#include "input_field0dchar_time.inc"
+
+ nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+
+ end subroutine io_input_field0dChar_time
+
+
+ subroutine io_input_field1dChar_time(input_obj, field)
+
+ implicit none
+
+ type (io_input_object), intent(in) :: input_obj
+ type (field1dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(3) :: start2, count2
+
+ start2(1) = 1
+ start2(2) = field % ioinfo % start(1)
+ start2(3) = input_obj % time
+ count2(1) = 64
+ count2(2) = field % ioinfo % count(1)
+ count2(3) = 1
+
+#include "input_field1dchar_time.inc"
+
+ nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start2, count2, field % array)
+
+ end subroutine io_input_field1dChar_time
+
+
+ subroutine io_input_field0dChar(input_obj, field)
+
+ implicit none
+
+ type (io_input_object), intent(in) :: input_obj
+ type (field0dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 64
+ start1(2) = 1
+ count1(2) = 1
+
+#include "input_field0dchar.inc"
+
+ nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+
+ end subroutine io_input_field0dChar
+
+
+ subroutine io_input_field1dChar(input_obj, field)
+
+ implicit none
+
+ type (io_input_object), intent(in) :: input_obj
+ type (field1dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 64
+ start1(2) = field % ioinfo % start(1)
+ count1(2) = field % ioinfo % count(1)
+
+ !
+ ! Special case: we may want to read the xtime variable across the
+ ! time dimension as a 1d array.
+ !
+ if (trim(field % ioinfo % fieldName) == 'xtime') then
+ varID = input_obj % rdVarIDxtime
+ end if
+
+#include "input_field1dchar.inc"
+
+ nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % array)
+
+ end subroutine io_input_field1dChar
+
+
subroutine io_input_finalize(input_obj, dminfo)
implicit none
Modified: branches/time_manager/src/framework/module_io_output.F
===================================================================
--- branches/time_manager/src/framework/module_io_output.F 2011-08-12 19:42:44 UTC (rev 938)
+++ branches/time_manager/src/framework/module_io_output.F 2011-08-12 23:27:01 UTC (rev 939)
@@ -16,6 +16,7 @@
integer :: stream
+ integer :: wrDimIDStrLen
#include "io_output_obj_decls.inc"
logical :: validExchangeLists
@@ -34,6 +35,8 @@
module procedure io_output_field3dReal
module procedure io_output_field1dInteger
module procedure io_output_field2dInteger
+ module procedure io_output_field0dChar
+ module procedure io_output_field1dChar
end interface io_output_field
interface io_output_field_time
@@ -41,6 +44,8 @@
module procedure io_output_field1dReal_time
module procedure io_output_field2dReal_time
module procedure io_output_field3dReal_time
+ module procedure io_output_field0dChar_time
+ module procedure io_output_field1dChar_time
end interface io_output_field_time
@@ -126,15 +131,19 @@
type (field1dReal) :: real1d
type (field2dReal) :: real2d
type (field3dReal) :: real3d
+ type (field0dChar) :: char0d
+ type (field1dChar) :: char1d
integer :: i1, i2, i3, i4
integer, dimension(:), pointer :: super_int1d
integer, dimension(:,:), pointer :: super_int2d
- real :: super_real0d
+ real (kind=RKIND) :: super_real0d
real (kind=RKIND), dimension(:), pointer :: super_real1d
real (kind=RKIND), dimension(:,:), pointer :: super_real2d
real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
+ character (len=64) :: super_char0d
+ character (len=64), dimension(:), pointer :: super_char1d
output_obj % time = itime
@@ -144,6 +153,8 @@
allocate(real1d % ioinfo)
allocate(real2d % ioinfo)
allocate(real3d % ioinfo)
+ allocate(char0d % ioinfo)
+ allocate(char1d % ioinfo)
call dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nCellsSolve, nCellsGlobal)
call dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nEdgesSolve, nEdgesGlobal)
@@ -350,6 +361,7 @@
nferr = nf_create(trim(output_obj % filename), NF_CLOBBER, output_obj % wr_ncid)
#endif
+ nferr = nf_def_dim(output_obj % wr_ncid, 'StrLen', 64, output_obj % wrDimIDStrLen)
#include "netcdf_def_dims_vars.inc"
if (mesh % on_a_sphere) then
@@ -671,6 +683,116 @@
end subroutine io_output_field2dInteger
+ subroutine io_output_field0dChar_time(output_obj, field)
+
+ implicit none
+
+ type (io_output_object), intent(in) :: output_obj
+ type (field0dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 64
+ start1(2) = output_obj % time
+ count1(2) = 1
+
+#include "output_field0dchar_time.inc"
+
+ nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+
+ nferr = nf_sync(output_obj % wr_ncid)
+
+ end subroutine io_output_field0dChar_time
+
+
+ subroutine io_output_field1dChar_time(output_obj, field)
+
+ implicit none
+
+ type (io_output_object), intent(in) :: output_obj
+ type (field1dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(3) :: start2, count2
+
+ start2(1) = 1
+ start2(2) = field % ioinfo % start(1)
+ start2(3) = output_obj % time
+ count2(1) = 64
+ count2(2) = field % ioinfo % count(1)
+ count2(3) = 1
+
+#include "output_field1dchar_time.inc"
+
+ nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start2, count2, field % array)
+
+ nferr = nf_sync(output_obj % wr_ncid)
+
+ end subroutine io_output_field1dChar_time
+
+
+ subroutine io_output_field0dChar(output_obj, field)
+
+ implicit none
+
+ type (io_output_object), intent(in) :: output_obj
+ type (field0dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 64
+ start1(2) = 1
+ count1(2) = 1
+
+#include "output_field0dchar.inc"
+
+ nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+
+ nferr = nf_sync(output_obj % wr_ncid)
+
+ end subroutine io_output_field0dChar
+
+
+ subroutine io_output_field1dChar(output_obj, field)
+
+ implicit none
+
+ type (io_output_object), intent(in) :: output_obj
+ type (field1dChar), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start1, count1
+
+ start1(1) = 1
+ count1(1) = 64
+ start1(2) = field % ioinfo % start(1)
+ count1(2) = field % ioinfo % count(1)
+
+#include "output_field1dchar.inc"
+
+ nferr = nf_put_vara_text(output_obj % wr_ncid, VarID, start1, count1, field % array)
+
+ nferr = nf_sync(output_obj % wr_ncid)
+
+ end subroutine io_output_field1dChar
+
+
subroutine io_output_finalize(output_obj, dminfo)
implicit none
Modified: branches/time_manager/src/registry/gen_inc.c
===================================================================
--- branches/time_manager/src/registry/gen_inc.c 2011-08-12 19:42:44 UTC (rev 938)
+++ branches/time_manager/src/registry/gen_inc.c 2011-08-12 23:27:01 UTC (rev 939)
@@ -322,12 +322,14 @@
while (var_list_ptr) {
var_ptr = var_list_ptr->var;
if (!strncmp(var_ptr->super_array, "-", 1024)) {
- 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 (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="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == CHARACTER) fortprintf(fd, " type (field%idChar), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
}
else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims+1, var_ptr->super_array);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == CHARACTER) fortprintf(fd, " type (field%idChar), pointer :: %s</font>
<font color="gray">", var_ptr->ndims+1, var_ptr->super_array);
while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
}
var_list_ptr = var_list_ptr->next;
@@ -413,12 +415,14 @@
while (var_list_ptr) {
var_ptr = var_list_ptr->var;
if (!strncmp(var_ptr->super_array, "-", 1024)) {
- 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 (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="blue">", var_ptr->ndims, var_ptr->name_in_code);
+ if (var_ptr->vtype == CHARACTER) fortprintf(fd, " type (field%idChar), pointer :: %s</font>
<font color="red">", var_ptr->ndims, var_ptr->name_in_code);
}
else {
- if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="red">", var_ptr->ndims+1, var_ptr->super_array);
- if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == INTEGER) fortprintf(fd, " type (field%idInteger), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == REAL) fortprintf(fd, " type (field%idReal), pointer :: %s</font>
<font color="blue">", var_ptr->ndims+1, var_ptr->super_array);
+ if (var_ptr->vtype == CHARACTER) fortprintf(fd, " type (field%idChar), pointer :: %s</font>
<font color="gray">", var_ptr->ndims+1, var_ptr->super_array);
while (var_list_ptr->next && !strncmp(var_list_ptr->next->var->super_array, var_list_ptr->var->super_array, 1024)) var_list_ptr = var_list_ptr->next;
}
var_list_ptr = var_list_ptr->next;
@@ -567,7 +571,12 @@
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
+ if (var_ptr->vtype == INTEGER)
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
+ else if (var_ptr->vtype == REAL)
+ fortprintf(fd, " %s %% %s %% array = 0.0</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
+ else if (var_ptr->vtype == CHARACTER)
+ fortprintf(fd, " %s %% %s %% array = \'\'</font>
<font color="black">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
if (var_ptr2->iostreams & INPUT0)
fortprintf(fd, " %s %% %s %% ioinfo %% input = .true.</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array);
@@ -612,7 +621,12 @@
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="red">");
- fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
+ if (var_ptr->vtype == INTEGER)
+ fortprintf(fd, " %s %% %s %% array = 0</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
+ else if (var_ptr->vtype == REAL)
+ fortprintf(fd, " %s %% %s %% array = 0.0</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
+ else if (var_ptr->vtype == CHARACTER)
+ fortprintf(fd, " %s %% %s %% array = \'\'</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code ); /* initialize field to zero */
}
if (var_ptr->iostreams & INPUT0)
@@ -825,6 +839,7 @@
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) {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="gray">", struct_deref, var_ptr->super_array);
@@ -1133,16 +1148,20 @@
/*
* Generate code to read 0d, 1d, 2d, 3d time-invariant fields
*/
- for(j=0; j<2; j++) {
+ for(j=0; j<3; j++) {
for(i=0; i<=3; i++) {
if (j == 0) {
sprintf(fname, "input_field%idinteger.inc", i);
ivtype = INTEGER;
}
- else {
+ else if (j == 1) {
sprintf(fname, "input_field%idreal.inc", i);
ivtype = REAL;
}
+ else if (j == 2) {
+ sprintf(fname, "input_field%idchar.inc", i);
+ ivtype = CHARACTER;
+ }
fd = fopen(fname, "w");
var_ptr = vars;
@@ -1192,6 +1211,33 @@
fclose(fd);
}
+
+ /*
+ * Generate code to read 0d and 1d time-varying character fields
+ */
+ for(i=0; i<=1; i++) {
+ sprintf(fname, "input_field%idchar_time.inc", i);
+ fd = fopen(fname, "w");
+
+ var_ptr = vars;
+ while (var_ptr && (var_ptr->ndims != i || var_ptr->vtype != CHARACTER || !var_ptr->timedim)) var_ptr = var_ptr->next;
+ if (var_ptr) {
+ fortprintf(fd, " if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = input_obj %% rdVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ var_ptr = var_ptr->next;
+ while (var_ptr) {
+ if (var_ptr->ndims == i && var_ptr->vtype == CHARACTER && var_ptr->timedim) {
+ fortprintf(fd, " else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = input_obj %% rdVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ }
+ var_ptr = var_ptr->next;
+ }
+ fortprintf(fd, " end if</font>
<font color="gray">");
+ }
+
+ fclose(fd);
+ }
+
}
@@ -1308,6 +1354,8 @@
fortprintf(fd, " ) then</font>
<font color="blue">");
dimlist_ptr = var_ptr->dimlist;
i = 1;
+ if (var_ptr->vtype == CHARACTER)
+ fortprintf(fd, " dimlist(%i) = output_obj %% wrDimIDStrLen</font>
<font color="black">", i++);
while(dimlist_ptr) {
fortprintf(fd, " dimlist(%i) = output_obj %% wrDimID%s</font>
<font color="gray">", i++, dimlist_ptr->dim->name_in_file);
dimlist_ptr = dimlist_ptr->next;
@@ -1317,6 +1365,8 @@
fortprintf(fd, " nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_INT, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="black">", 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 = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_DOUBLE, %i, dimlist, output_obj %% wrVarID%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 = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_CHAR, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="black">", 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="gray">");
@@ -1369,6 +1419,7 @@
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) {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="gray">", struct_deref, var_ptr->super_array);
@@ -1580,16 +1631,20 @@
/*
* Generate code to write 0d, 1d, 2d, 3d time-invariant fields
*/
- for(j=0; j<2; j++) {
+ for(j=0; j<3; j++) {
for(i=0; i<=3; i++) {
if (j == 0) {
sprintf(fname, "output_field%idinteger.inc", i);
ivtype = INTEGER;
}
- else {
+ else if (j == 1) {
sprintf(fname, "output_field%idreal.inc", i);
ivtype = REAL;
}
+ else if (j == 2) {
+ sprintf(fname, "output_field%idchar.inc", i);
+ ivtype = CHARACTER;
+ }
fd = fopen(fname, "w");
var_ptr = vars;
@@ -1638,5 +1693,32 @@
fclose(fd);
}
+
+ /*
+ * Generate code to write 0d and 1d character time-varying fields
+ */
+ for(i=0; i<=1; i++) {
+ sprintf(fname, "output_field%idchar_time.inc", i);
+ fd = fopen(fname, "w");
+
+ var_ptr = vars;
+ while (var_ptr && (var_ptr->ndims != i || var_ptr->vtype != CHARACTER || !var_ptr->timedim)) var_ptr = var_ptr->next;
+ if (var_ptr) {
+ fortprintf(fd, " if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = output_obj %% wrVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ var_ptr = var_ptr->next;
+ while (var_ptr) {
+ if (var_ptr->ndims == i && var_ptr->vtype == CHARACTER && var_ptr->timedim) {
+ fortprintf(fd, " else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = output_obj %% wrVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ }
+ var_ptr = var_ptr->next;
+ }
+ fortprintf(fd, " end if</font>
<font color="gray">");
+ }
+
+ fclose(fd);
+ }
+
}
Modified: branches/time_manager/src/registry/parse.c
===================================================================
--- branches/time_manager/src/registry/parse.c 2011-08-12 19:42:44 UTC (rev 938)
+++ branches/time_manager/src/registry/parse.c 2011-08-12 23:27:01 UTC (rev 939)
@@ -153,6 +153,8 @@
var_ptr->vtype = INTEGER;
else if (strncmp(word, "logical", 1024) == 0)
var_ptr->vtype = LOGICAL;
+ else if (strncmp(word, "text", 1024) == 0)
+ var_ptr->vtype = CHARACTER;
getword(regfile, var_ptr->name_in_file);
</font>
</pre>