[table of contents] [master index] [comments] [modules] [programs] [variables] [types] [procedures]
MODULE
io_mod - generic subroutine interfaces for file io
PURPOSE
The generic subroutine interfaces 'input' and 'output' provide
a standard interface for reading parameters from and writing
to file. Similar interfaces are used for integer, real, logical,
and character(*) data, for 1D arrays of integers, real, or
character(*) data, and 2D arrays of integers or real data.
Input and output styles can be chosen from several that allow
each data item to be accompanied by a comment string, namely:
comment on line above data, comment before or after data on the
same line, or no comment. Subroutines with names beginning with
set_... allow the user to set values of private module variables
that determine default input and output formats. These default
values may also be overridden by the use of optional arguments
to input and output routines
PUBLIC PROCEDURES
input - generic interface for input subroutines
output - generic interface for output subroutine
set_io_units - set input and output file unit numbers
set_com_style - set comment style (same for input and output)
set_output_fmt - set output format (field widths, float format)
set_echo - choose whether to echo input
set_com_use - choose whether to echo input comments
SUBROUTINE
input - generic interface for reading data from file
output - generic interface for writing data to file
SYNOPSIS
Scalar integer, real(long), character(*) data
call input(data,[c,i,o,e,f,u])
call output(data,[c,o,e,f]) ! integer, real, and logical
call output(data,[c,o,e,f,l]) ! character(*)
data = variable to be read and/or written to file
integer, real(long)
Vectors (1D arrays) integer, real, or character data:
input(data,n,[c,s,i,o,e,f,u])
output(data,n,[c,s,o,e,f]) ! integer or real
output(data,n,[c,o,e,f,l]) ! character(*)
data(:) = 1D array to be to be read from file
integer or real(long)
n = logical dimension of data(1:n)
integer
Matrices (2D arrays) of integer or real data (input & output)
input(data,m,n,[c,s,i,o,e,f,u])
output(data,m,n,[c,s,o,e,f])
data(:,:) = 2D array to be to be read from file
integer or real(long)
m, n = logical dimensions of data(1:m,1:n)
integers
ARGUMENTS
data = scalar, vector, or matrix data, as discussed above
c = comment string for output (or echoed input)
character(*) (optional)
i, o = input and output file unit numbers
integer (optional)
e = echo flag: e=1 echo input, e=0 no echo
integer (optional)
f = comment style flag (see discussion)
character(1) (optional)
u = comment usage flag (see discussion)
character(1) (optional) - only for input
l = field width for character string output
integer(optional) - only for character output
s = vector or matrix io format flag - see discussion below
character(1) (optional) - only for vector or matrix data
SUBROUTINE
output - generic interface for writing data to file
SYNOPSIS
Scalar integer, real(long), character(*) data
call output(data,[c,o,e,f]) ! integer, real, and logical
call output(data,[c,o,e,f,l]) ! character(*)
Vectors (1D arrays) integer, real, or character data:
output(data,n,[c,s,o,e,f]) ! integer or real
output(data,n,[c,o,e,f,l]) ! character(*)
Matrices (2D arrays) of integer or real data (input & output)
output(data,m,n,[c,s,o,e,f])
ARGUMENTS
See arguments of subroutine input
COMMENT
Comment styles:
The module defines four styles in which comments strings
can be associated with inputs and output data. These
styles are associated with four possible values of a
character(1) variable:
'N' -> None - no comment
'A' -> Above - comment on separate line above data
'L' -> Left - comment to the left of data on the same line
'R' -> Right - comment to the right of data on the same line
The 'N' and 'A' style are defined for any type of data,
while only 'N' and 'A' are defined for matrix data.
A default comment style is given by the value of one the
three global character(1) variables, which must have one of
above values:
scalar_com_style for scalar (int, real, or char)
vector_com_style for vectors (int or real)
matrix_com_style for matrices (int or real)
These default comment style variables may modified by
a subroutine call:
call set_com_style([s],[v],[m])
in which optional character(1) variables s, v, and m hold
the desired values of the scalar, vector, and matrix
comment styles, respectively.
The default comment style may be overridden by passing
input or output the optional character(1) argument f with
one of the above values.
-----------------------------------------------------------------
Input format:
All input routines use the default format read(iunit,*) for
both comments and data. As a result of this:
1) The spacing of data and comments within an input record
is irrelevant.
2) Input comment strings must consist of single character(*)
tokens, i.e., they must either be strings with no spaces or
other delimiters, or surrounded by quotation marks.
Rule (2) must be obeyed in the 'L' comment style in order to
to allow the comment to be distinguished from the input data.
In the 'A' and 'R' styles, if a comment string contains spaces,
the data is read corectly, but only the first word of comment
is actually read.
-----------------------------------------------------------------
Output formats:
The output format is controlled by the following global
variables, whose values may be modified by calling
set_output_format:
com_width = width of comment output field (integer)
data_width = width of data output field (integer)
frac_width = # digits after decimal for reals #s (integer)
fmt_ef = format for reals = 'E','F', or 'ES' (character*2)
The field width data_width is used for scalar integer,
real, and character data. Initial values are given in
the declarations of these variables.
Row vectors are output on a single record by repeating the
format string for the corresponding scalar, preceded by a
comment line in the 'A' comment style.
Matrices are output as a sequence of row vectors,
preceded by a comment line in the 'A' comment style.
If the symmetry flag s='A' or s='L', then only the
lower diagonal or below diagonal sector that is read
on input is output (see below)
-----------------------------------------------------------------
Vector io format flag:
s = 'R' Row vector - all data in one record
(default if argument s is absent)
Format (for comment style 'N' or 'A')
data(1) data(2) data(3) ... data(N)
s = 'C' Column vector -each element on a separate line
Format (for comment style 'N' or 'A')
data(1)
data(2)
...
data(N)
-----------------------------------------------------------------
Matrix io format flag:
s = 'N' Normal or No symmetry
(default if argument s is absent)
Format for 3 x 3 matrix
data(1,1) data(1,2) data(1,3)
data(2,1) data(2,2) data(2,3)
data(3,1) data(3,2) data(3,3)
s = 'S' Symmetric matrix
data(i,j) = data(j,i)
read only data(i,j) for j <= i, i=1,..,m
Format for 3 x 3 matrix:
data(1,1)
data(2,1) data(2,2)
data(3,1) data(3,2) data(3,3)
s = 'L' Symmetric matrix with zero diagonal elements
data(i,j) = data(j,i)
data(i,i) = 0
read only data(i,j) for j < i, i=2,..,m
Format for 3 x 3 matrix:
data(2,1)
data(3,1) data(3,2)
-----------------------------------------------------------------
Echoing:
Input data and a comment are printed to an output file if:
1) The global variable default_echo has the value
default_echo = 1, and the optional argument e is absent
2) the optional argument e is present, and e=1.
Echoed output is output using the same comment style as that
used for input.
The default_echo variable may be reset by the subroutine call
call set_echo(e)
where e is the desired integer default value (e=1 for echoing,
e=0 for no echoing)
-----------------------------------------------------------------
Comment Usage:
The module defines three possible treatments of the
comments that are read from the input file with data,
which are associated with four possible values of a
character(1) com_use variable:
'K' -> Keep - Return the input comment as argument c
on output, if c is present, and use it
in any echoed output.
'R' -> Replace - Replace the input comment by the input
value of argument c in any echoed output.
'C' -> Check - Check that the input comment matches the
input value of argument c, write error
message if they do not match (not yet
implemented)
The choice of one of these actions is determined either by
by the value of a global argument*1 variable default_com_use,
or the value of the character(1) argument 'u', if present,
both of which must take on one of the above values.
SUBROUTINE
set_io_units - set input and output file unit numbers
SOURCE
subroutine set_io_units(i,o) integer, intent(IN), optional :: i ! default input unit # integer, intent(IN), optional :: o ! default output unit #
SUBROUTINE
set_echo(e) - choose whether to echo input
SOURCE
subroutine set_echo(e) integer, intent(IN) :: e
SUBROUTINE
set_com_style(s,v,m) - set comment style for input and output
PURPOSE
Allows new values to be set for the default comment
styles for scalars, vectors, and matrices. All
arguments are optional character(1) variables which
must (if present) must have a valid value 'N', 'A',
'L' or 'R for a comment
SOURCE
subroutine set_com_style(s,v,m) character(1), intent(IN), optional :: s ! scalar_com_style character(1), intent(IN), optional :: v ! vector_com_style character(1), intent(IN), optional :: m ! matrix_com_style
SUBROUTINE
set_com_use(u) - choose whether to echo input comments
PURPOSE
Reset default comment usage variable default_com_use
to input value of argument u
-------------------------------------------------------------------
subroutine set_com_use(u)
character(1), intent(IN) :: u ! new value of default_com_use
SUBROUTINE
set_output_fmt - set output format (field widths, float format)
PURPOSE
Routine allows new values to be set for the integer variables com_width , data_width, and/or frac_width, which determine field widths for comment and data fields, and for the character(2) fmt_ef, which is the format specifier 'E' or 'F' used to output real numbers. Also resets the format strings fmt_c, fmt_i, and/or fmt_r, as needed, so as to agree with the new values of the field widths and fmt_ef. Subroutine arguments (all are optional arguments): c = com_width = width of comment field d = data_width = width of scalar data field f = frac_width = # of digits after decimal in floats e = fmt_ef = 'E', 'F', or 'ES' format style for floats
SOURCE
subroutine set_output_fmt(c,d,f,e) integer, intent(IN), optional :: c ! com_width integer, intent(IN), optional :: d ! data_width integer, intent(IN), optional :: f ! frac_width character(2), intent(IN), optional :: e ! fmt_ef