PROGRAM DATAEX
C
C  Fortran 77 program to read and check format of exchange data files.
C  This is mainly a format checking program, but it can also be used to
C  retrieve the contents of an exchange file.  This is a memory-
C  economizer version so for 3-D and 4-D data files (eg. FFI=3010,4010)
C  the contents of the primary variable data records are written to an 
C  unformatted scratch file which is rewound and can be read in this or  
C  a user-supplied routine.
C
C  MS DOS Fortran users will have to break this code into smaller modules
C  for compilation.
C
C  Sections of code preceded by a string of plus signs (+++) and 
C  terminated by a string of minus signs (---) indicate locations where
C  a user of this program must supply the indicated variable definitions.
C  With the possible exception of the OPEN statements, this code is 
C  standard Fortran 77.
C
C  This code is intended to be used with reference to the document 
C  written by S.Gaines and S.Hipskind entitled "Format Specification 
C  for Data Exchange".  Most of the variables used in this code 
C  correspond in name and function to those defined in the referenced 
C  document.
C
C  There are three types of error diagnostics written to unit IOU.
C  The severity of the error is indicated by the number of asterisks
C  preceding the diagnostic.
C
C  One asterisk (*) indicates a suggestion for improving the file 
C  format and the associated "error" will not cause this program to 
C  reject the file format.
C
C  Two asterisks (**) indicate a violation of the format standards but
C  the associated error is not fatal, so this program will continue 
C  after encountering an error of this type.
C
C  Three asterisks (***) indicate a fatal error for this program and
C  a violation of the format standards (subsequent error diagnostics 
C  may be meaningless).  This type of error can indicate that 
C  parameter values defined in the PARAMETER statements must be 
C  redefined.
C
C  NOTE:  There is one aspect of the file format that may not be checked
C         by this routine.  That is a ^Z (control-Z, ASCII decimal value
C         26) as the only character in a line.  Fortran on some operating
C         systems (VMS for example) interprets such an occurence of ^Z as 
C         an EOF (end-of-file mark) so if one is encountered then this 
C         program thinks its at the end of the data file and will not 
C         read beyond it.
C
C         In that case, an external process (DCL command file, etc.) may 
C         have to be used to check the file for occurrences of ^Z and 
C         write the results of the search to a file defined by the
C         character string FCTLZ.  This program reads that file (unit 
C         IZU), if CHCKNP=.TRUE., and notes the line numbers of lines
C         containing one or more ^Zs in the output file (IOU).
C
C         If FCTLZ does not exist, then this program does not try
C         to read unit IZU.
C
C
C  BUGS
C
C    Note added 91-10-22:  These bugs only apply if PARSIT = .FALSE.
C
C    General:
C      This code reads numeric data values with "free format" read
C      statements and assumes that successive numeric values are
C      delimited by one or more spaces.  Most versions of Fortran also
C      permit a comma to be used as a delimiter and some versions may
C      allow other characters as delimiters.  If these delimiter
C      characters (other than spaces) appear in a numeric data record,
C      they will not produce a read error, and may go undetected unless
C      their presence produces a noticable error in the values of the
C      independent variables.
C
C      The "free format" Fortran reads may also allow data record format
C      errors to go undetected if DX for the independent variable mark is
C      zero (nonuniform increment).
C
C    FFI 1001:
C      If DX(1)=0 and one or more primary variable values are omitted
C      from one or more data records, then no format errors will be
C      detected.  This is an unavoidable bug resulting from the fact
C      that the independent and primary variables are read as one
C      logical record with no constraints on the number of lines 
C      occupied by the record.
C
C
C  History:
C    06-07-18  (JDW)
C      Removed checking for improper mission name
C    06-06-28 (JDW)
C      Increased MAXA to 65.
C      Increased MAXCA to 25.
C    06-06-22 (JDW)
C      Increased MAXAC from 10 to 15
C
C    96-02-29  (JDW)
C      Increased MAXA from 30 to 40.
C
C    96-02-29  (JDW)
C      Modified RHEAD to skip over database header if DBHEAD = .TRUE.
C      Modified DATAEX to set DBHEAD
C
C    95-03-06  (SEG)
C      Increased MAXX1 from 1000 to 5000.
C
C    94-08-03  (SEG)
C      Modified TMON3 to test each value of X each call.
C
C    94-01-03  (SEG)
C      Increased MAXV to 70.
C
C    92-11-02  (SEG)
C      Increased MAXX1 from 300 to 1000.
C
C    92-06-09  (SEG)
C      Increased MAXV to 50.
C
C    92-02-11  (SEG)
C      Modified PARFLT to check for blank space separators between
C      numeric values.
C
C    92-01-18  (SEG)
C      Modified CKNPC subroutine to properly check last line of the
C      data file.  The main concern was to flag the last line if it
C      is not properly terminated.
C
C    91-12-17  (SEG)
C      Modified file header reading routines to use PARHD and TIXN to
C      read and test numeric values in place of RHINT, RHMISS, RHSCAL.
C      This change was to ensure that blank lines preceding numeric
C      values are flagged, and that commas used as field delimiters
C      will be flagged.
C
C    91-10-25  (SEG)
C      Added code in PD2160 to check lengths of character strings.
C
C    91-10-23  (SEG)
C      Added PARSIT option to eliminate the bugs outlined above, 
C      and to flag the following conditions:
C        Non-numeric characters in the data records;
C        Excess number of values within a data record;
C        Blank lines within the data records;
C        Excessive padding of data records with spaces.
C      Also added code to terminate file checking/reading if NDIAG > 50.
C      Corrected bugs pointed out by J.Wild in RDATA, PRDATA, RD2310 to
C      omit testing/printing of X1 if NX(1)=AMISS(1) or NX(1)=0.
C
C    91-10-09  (SEG)
C      Modified RHBGIN to ensure that MNAME0 is the first non-blank
C      character string in MNAME.  Included FRSTNB to help with this
C      task.
C
C    91-08-13  (SEG)
C      Modified CKNPC to test last line for nonprintable characters in
C      the event that an end-of-file designator appears before an
C      end-of-line.
C
C    91-08-09  (SEG)
C      Modified test at the end of this main program to only print a
C      warning about nonconstant number of lines per independent 
C      variable mark when the format does not allow for a variable
C      number for NX(1) in the auxiliary variable list.
C
C    91-07-03  (SEG)
C      Modified CKNPC to return NLINES, and added code near the end of 
C      this routine to print the number of lines per independent 
C      variable mark.
C
C    91-06-28  (SEG)
C      Modified RDATA, TRIVM, and TSTDX to be more lenient with the
C      definition of constant data intervals (DX(s) not 0).  TSTDX
C      was also changed to be able to test more than one value of DX
C      per call.
C
C      Modified CH2FLT so that lower case `e' in exponential notation
C      is not flagged as an error.
C
C
C  S.E.Gaines, April 1991.
C=========================
C
C
c      PARAMETER  ( MAXA   =  70 ) -- Changed this to 100 to accomodate larger nauxv
c      PARAMETER  ( MAXCA  =  25 ) -- Changed this to 40 to accomodate larger nauxc
      PARAMETER  ( MAXA   = 100 )
      PARAMETER  ( MAXCA  =  40 )
      PARAMETER  ( MAXCOM = 100 )
      PARAMETER  ( MAXCPL = 132 )
      PARAMETER  ( MAXIV  =   4 )
      PARAMETER  ( MAXV   =  70 )
      PARAMETER  ( MAXX1  =5000 )
      PARAMETER  ( MAXX2  = 200 )
      PARAMETER  ( MAXX3  =  30 )
      PARAMETER  ( MXCFLG =   2 )
C
      LOGICAL   CHCKNP, EXISTS, PARSIT, PRNTIT, RETDAT, DBHEAD
C
      CHARACTER*(MAXCPL)   ANAME( MAXA )
      CHARACTER*(MAXCPL)   CA( MAXCA )
      CHARACTER*(MAXCPL)   CAMISS( MAXCA )
      CHARACTER*255        CDUM
      CHARACTER*1          CFLG( MXCFLG )
      CHARACTER*6          CRFMT
      CHARACTER*6          CWFMT
      CHARACTER*(MAXCPL)   CX2
      CHARACTER*(MAXCPL)   FCTLZ
      CHARACTER*(MAXCPL)   FILSPC
      CHARACTER*(MAXCPL)   MNAME
      CHARACTER*(MAXCPL)   MNAME0
      CHARACTER*(MAXCPL)   NCOM( MAXCOM )
      CHARACTER*(MAXCPL)   ONAME
      CHARACTER*(MAXCPL)   ORG
      CHARACTER*(MAXCPL)   SCOM( MAXCOM )
      CHARACTER*(MAXCPL)   SNAME
      CHARACTER*(MAXCPL)   VNAME( MAXV )
      CHARACTER*(MAXCPL)   XNAME( MAXIV )
C
      DIMENSION   A( MAXA ),       AMISS( MAXA ),   ASCAL( MAXA )
      DIMENSION   DX( MAXIV ),     DUM( MAXX1 )
      DIMENSION   KFLG( MXCFLG )
      DIMENSION   LENA( MAXCA ),   LENX( MAXIV )
      DIMENSION   NX( MAXIV ),     NXDEF( MAXIV ) 
      DIMENSION   V( MAXX1,MAXV ), VMISS( MAXV ),   VSCAL( MAXV )
      DIMENSION   X1( MAXX1 ),     X2( MAXX2 ),     X3( MAXX3 ) 
C
C  Define logical unit numbers.
C  IUN = data file.
C  IIU = input file.
C  IOU = output file containing diagnostics.
C  ISU = scratch file for writing and reading 3-D and 4-D data.
C  IZU = file whose name is defined by FCTLZ and contains the results 
C        of the search for ^Zs.
C
      DATA   IUN  / 21 /
      DATA   IIU  /  5 /
      DATA   IOU  /  6 /
      DATA   ISU  / 77 /
      DATA   IZU  / 88 /
C
C  Define default values for logical variables.
C  CHCKNP = .TRUE. = check data file for non-printable characters 
C           before reading the data values.
C  EXISTS = .TRUE. = file FCTLZ exists and there are ^Zs in the
C           the data file.
C  PARSIT = .TRUE. = numeric data records are `parsed' and checked for 
C           extra numeric values.
C         = .FALSE. = numeric data records are read with `free format'
C           READ statements.
C  PRNTIT = .TRUE. = print contents of data file.
C  RETDAT = .TRUE. = 3-D and 4-D primary variable values are written to
C           the unformatted scratch file in the same order as they were
C           read from the data file.  The scratch file is rewound and
C           properly positioned for reading the values after calling 
C           subroutine RDATA.
C  DBHEAD = .TRUE. = the datafile contains a UARS header that must be skipped
C           over.
C
C
      DATA  CHCKNP  / .TRUE.  /
      DATA  EXISTS  / .FALSE. /
      DATA  PARSIT  / .TRUE.  /
      DATA  PRNTIT  / .FALSE. /
      DATA  RETDAT  / .FALSE. /
      DATA  DBHEAD  / .TRUE.  /
C
C
C  Define format for reading character data.
C
      WRITE( CRFMT,FMT='(2H(A,I3,1H))' )  MAXCPL
C
C  Define ASCII characters to flag and count in routine CKNPC.
C
      NFLG    = 1
      CFLG(1) = CHAR( 9 )
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C  Define/open input, output and scratch files (IIU, IOU, ISU).
C
C+UNIX
C  In this case the input and output files are defined on the
C  command line which executes this program.
C
c     OPEN( IIU, STATUS='OLD' )
c     OPEN( IOU, STATUS='NEW' )
      OPEN( ISU, STATUS='SCRATCH',FORM='UNFORMATTED' )
C-UNIX
C+VMS
C  In this case the input and output files are defined as 
C  DEXDIR:DATAEX.IN and DEXDIR:DATAEX.OUT, where DEXDIR is the logical
C  name for the directory containing the files DATAEX.IN and DATAEX.OUT.
C
C      OPEN( IIU, FILE='DEXDIR:DATAEX.IN', STATUS='OLD' )
C      OPEN( IOU, FILE='DEXDIR:DATAEX.OUT',STATUS='NEW', 
C     *           CARRIAGECONTROL='LIST' )
C      OPEN( ISU, STATUS='SCRATCH',FORM='UNFORMATTED' )
C-VMS
C
C  Re-define the program control variables if necessary.
C  MNAME0 is the standard mission name.
C  FCTLZ  is the name of the file containing the results of the
C         search for ^Zs by some external process.
C
C  In this case they are read from the input file.
C
      READ( IIU,FMT='(L1)' )  CHCKNP
      READ( IIU,FMT='(L1)' )  PARSIT
      READ( IIU,FMT='(L1)' )  RETDAT
      READ( IIU,FMT='(L1)' )  PRNTIT
      READ( IIU,FMT='(L1)' )  DBHEAD
      READ( IIU,FMT=CRFMT  )  MNAME0
      READ( IIU,FMT=CRFMT  )  FCTLZ
      IF( PRNTIT )  RETDAT = .TRUE.
C-----------------------------------------------------------------------
C
C  Print values of the program control variables.
C
      WRITE(IOU,*) 'Program control variables:'
      WRITE(IOU,FMT='(9H  CHCKNP=,L1)')  CHCKNP
      WRITE(IOU,FMT='(9H  PARSIT=,L1)')  PARSIT
      WRITE(IOU,FMT='(9H  PRNTIT=,L1)')  PRNTIT
      WRITE(IOU,FMT='(9H  RETDAT=,L1)')  RETDAT
      WRITE(IOU,FMT='(9H  DBHEAD=,L1)')  DBHEAD
C
      CDUM = '  '//MNAME0
      CALL LASTNB ( CDUM, LEN(CDUM), LNB )
      CALL CHFMT  ( LNB, CWFMT )
      WRITE(IOU,*) ' MNAME0:'
      WRITE(IOU,FMT=CWFMT)  CDUM
C
      CDUM = '  CRFMT='//CRFMT
      CALL LASTNB ( CDUM, LEN(CDUM), LNB )
      CALL CHFMT  ( LNB, CWFMT )
      WRITE(IOU,FMT=CWFMT)  CDUM
C
      WRITE(IOU,*) ' ASCII decimal values of nonprintable characters',
     *             ' to be flagged and counted:'
      WRITE(IOU,FMT='(20I4)')  ( ICHAR(CFLG(I)), I=1,NFLG )
C
C  Open IZU if file FCTLZ exits.
C
      CALL LASTNB ( FCTLZ, LEN(FCTLZ), NCFZ )
      INQUIRE( FILE=FCTLZ(1:NCFZ),EXIST=EXISTS )
      IF( EXISTS ) THEN
         OPEN( IZU,FILE=FCTLZ(1:NCFZ),STATUS='OLD' )
      ENDIF
C
C  Loop on data files.
C
      NFILES = 0
  100 CONTINUE
         NDIAG = 0
C
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C        Define/open the data file (IUN).  FILSPC contains the complete 
C        file specification (path name) of the data file.
C
C        In this case FILSPC is read from the input file.
C
         READ( IIU,FMT=CRFMT,END=300 )  FILSPC
	 PRINT *, FILSPC
         CALL LASTNB ( FILSPC, LEN(FILSPC), NCFS )
         WRITE( IOU,* ) '  '
         WRITE( IOU,* ) 'Reading file '//FILSPC(1:NCFS)
C+UNIX
         OPEN( IUN,FILE=FILSPC(1:NCFS),STATUS='OLD' )
C-UNIX
C+VMS
C         OPEN( IUN,FILE=FILSPC(1:NCFS),STATUS='OLD',READONLY )
C-VMS
C-----------------------------------------------------------------------
         NFILES = NFILES + 1
C
C        Check for non-printable characters.
C
         NLINES = 0
         IF( CHCKNP ) THEN
            IF( EXISTS ) THEN
               CALL FGCTLZ ( FILSPC, NCFS, CRFMT, CDUM, NDIAG, 
     *                       IZU, IOU )
            ENDIF
            IF (DBHEAD) READ (IUN,*)
            CALL CKNPC ( CDUM, CFLG, KFLG, NFLG, MAXCPL, 
     *                   NLINES, NDIAG, IUN, IOU )
            REWIND IUN
         ENDIF
C
C        Read file header.
C        All relevant file header info is returned by subroutine RHEAD.
C
         CALL RHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
     *                NV, NVPM, VSCAL, VMISS, VNAME,
     *                NAUXV, ASCAL, AMISS, ANAME,
     *                NAUXC, LENA, CAMISS, 
     *                NSCOML, SCOM, NNCOML, NCOM, 
     *                MAXX1, MAXX2, MAXX3,
     *                MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM, 
     *                MNAME0, CRFMT, IUN, IOU, ISUBV, NDIAG, IERR,
     *                DBHEAD )
         IF( IERR .NE. 0 )  GO TO 290
         IF( PRNTIT ) THEN
            CALL PRHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
     *                    NV, NVPM, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NAUXC, LENA, CAMISS, 
     *                    NSCOML, SCOM, NNCOML, NCOM, CWFMT, IOU )
         ENDIF
C
C        Loop on reading data records.
C        One independent variable mark and all associated auxiliary,
C        independent, and primary variable values are returned with
C        each call to subroutine RDATA.
C        For 3-D and 4-D primary variables (eg. FFI=3010 and 4010),
C        the primary variable values are written to the unformatted 
C        scratch file in the same order as they were read from the 
C        data file, and can be read from the scratch file after 
C        calling subroutine RDATA.
C
         LINE  = NLHEAD
         NCIDR = 0
         NBIDR = 0
         NIVM  = 0
         NVALS = 0
  230    CONTINUE
            IF( RETDAT .AND. IFFI .GT. 2999 )  REWIND ISU
            CALL RDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
     *                   A, AMISS, CA, CAMISS, LENA, NAUXV, NAUXC, 
     *                   V, VMISS, MAXX1, NV, NVPM, 
     *                   CDUM, DUM, LINE, NBIDR, NCIDR, NVALS,
     *                   CRFMT, RETDAT, PARSIT,
     *                   IUN, IOU, ISU, NIVM, 
     *                   ISUBV, NDIAG, IERR )
            IF( IERR .NE. 0 ) GO TO 288
            IF( RETDAT .AND. IFFI .GT. 2999 )  REWIND ISU
            IF( PRNTIT ) THEN
               CALL PRDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
     *                       A, AMISS, CA, LENA, NAUXV, NAUXC, 
     *                       V, MAXX1, NV, NVPM, CWFMT, IOU, ISU,
     *                       ISUBV )
               IF( IFFI .GT. 2999 )  REWIND ISU
            ENDIF
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C           At this point, all data values associated with the current
C           independent variable mark are available for user-defined 
C           routines.  Values of 3-D and 4-D primary variables must be 
C           read from the scratch file (unit ISU).
C-----------------------------------------------------------------------
C
C           Terminate reading/checking of the file if there are too
C           many error diagnostics.
C
            IF( NDIAG .GT. 50 ) THEN
               WRITE( IOU,* ) ' !!!! TOO MANY ERRORS, I QUIT !!!!'
            ELSE
               GO TO 230
            ENDIF
  288    CONTINUE
         IF( NIVM .LT. 1 ) THEN
            WRITE(IOU,*) '  **No complete data records were found'
            NDIAG = NDIAG + 1
         ENDIF
         IF( NCIDR .GT. 5000 ) THEN
            IPCB = INT( 100.0*FLOAT(NBIDR-NVALS)/FLOAT(NCIDR) )
            IF( IPCB .GT. 25 ) THEN
               WRITE( IOU,FMT='(3X,14H*ADMONITION-- ,I2,
     *          49H% of the data records are extraneous blank spaces)' )
     *          IPCB
            ENDIF
         ENDIF
         WRITE( IOU,* ) ' Number of lines in file header=', NLHEAD
         WRITE( IOU,* ) ' Number of successfully read independent'
         WRITE( IOU,* ) ' variable marks and associated data=', NIVM
  290    CONTINUE
         IF( NDIAG .GT. 0 ) THEN
            WRITE( IOU,* ) ' Number of diagnostics=', NDIAG
            WRITE( IOU,* ) 
     *           '****** File format is not acceptable         ******'
            WRITE( IOU,* ) 
     *           '****** Please make corrections and try again ******'
         ELSE
            IF( NLINES .GT. 0 ) THEN
               NLDATA = NLINES - NLHEAD
               NLPIVM = NLDATA / NIVM
               FLPIVM = FLOAT( NLDATA ) / FLOAT( NIVM )
               IF( NIVM*NLPIVM .NE. NLDATA .AND. IFFI .NE. 2110 .AND.
     *             IFFI .NE. 2160 .AND. IFFI .NE. 2310 ) THEN
                  WRITE( IOU,* ) 
     *         '??????  File format looks ok except that the     ??????'
                  WRITE( IOU,* )
     *         '??????  number of lines of data per independent  ??????'
                  WRITE( IOU,* )
     *         '??????  variable mark is not a constant          ??????'
                  WRITE( IOU,* )
     *         ' Number of lines per independent variable mark=',FLPIVM
               ELSE
                  WRITE( IOU,* )
     *         ' Number of lines per independent variable mark=',FLPIVM
                  WRITE( IOU,* ) 
     *            '$$$$$$ Looks good!  Thanks for the file $$$$$$'
               ENDIF
            ELSE
               WRITE( IOU,* ) 
     *         '$$$$$$ Looks good!  Thanks for the file $$$$$$'
            ENDIF
         ENDIF
         CLOSE( IUN )
         GO TO 100
  300 CONTINUE
      WRITE( IOU,* ) '  '
      WRITE( IOU,* ) ' Number of files read=', NFILES
C
C  Delete IZU if it has been opened.
C
      IF( EXISTS ) THEN
         CLOSE(IZU,STATUS='DELETE')
      ENDIF
      END
      SUBROUTINE CH2FLT ( C, I1, I2, N1, N2, VAL, IFLAG, NDIAG, IOU )
C
C  Given a character string, C, and location limits to search (I1,I2),
C  this routine looks for and extracts the first floating point number
C  (VAL) it can find, including sign and decimal point.
C  VAL starts with a number, + or - or decimal point, and ends with the
C  first non-numeric character (other than +, -, ., or E).
C  N1 and N2 are the location limits within which it found VAL.
C  If IFLAG is returned as zero then no VAL was found.
C
C  Required routines:   CH2INT.
C
C  History:
C  91-06-27 (SEG) Commented out the code to issue an error diagnostic
C           if `e' is used in exponential notation.
C
C
      CHARACTER*(*)  C
      CHARACTER*8    IFMT
C
      IFLAG = 0
      NDEC  = 0
      NEXP  = 0
      NSIGN1= 0
      NSIGN2= 0
C
C  Locate first integer number (NS1, NE1).
C
      CALL CH2INT ( C, I1, I2, NS1, NE1, IVAL1 )
      IF( IVAL1 .LT. 0 )  GO TO 100
      N1 = NS1
      N2 = NE1
C
C  Check for decimal before IVAL1.
C
      IF( NS1 .GT. I1 ) THEN
         IF( C(NS1-1:NS1-1) .EQ. '.' ) THEN
            NDEC = NS1 - 1
            N1   = NS1 - 1
         ENDIF
      ENDIF
C
C  Check for sign before IVAL1.
C
      IF( N1 .GT. I1 ) THEN
         IF( C(N1-1:N1-1) .EQ. '-' .OR. C(N1-1:N1-1) .EQ. '+' ) THEN
            NSIGN1 = N1 - 1
            N1     = N1 - 1
         ENDIF
      ENDIF
C
C  Check for a fractional number after IVAL1.
C
      IF( NDEC .LT. 1 ) THEN
         IF( N2 .LT. I2 ) THEN
            IF( C(N2+1:N2+1) .EQ. '.' ) THEN
               NDEC = N2 + 1
               N2   = N2 + 1
C
C              Check for fraction after the decimal point.
C
               IF( N2 .LT. I2 ) THEN
                  IF( C(N2+1:N2+1) .GE. '0' .AND. 
     *                C(N2+1:N2+1) .LE. '9' ) THEN

                     CALL CH2INT ( C, NDEC+1, I2, NS2, NE2, IVAL2 )
                     IF( IVAL2 .GE. 0 )  N2 = NE2
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
      ENDIF
C
C  Check for exponent.
C
      IF( N2 .LT. I2 ) THEN
         IF( C(N2+1:N2+1) .EQ. 'E' .OR. C(N2+1:N2+1) .EQ. 'e' ) THEN
C            IF( C(N2+1:N2+1) .EQ. 'e' ) THEN
C               WRITE( IOU,* ) 
C     *     '  **Non-standard exponential notation.  Use E instead of e.'
C               NDIAG = NDIAG + 1
C            ENDIF
            IF( C(N2+2:N2+2) .EQ. '+' .OR. C(N2+2:N2+2) .EQ. '-' ) THEN
               IF( C(N2+3:N2+3) .GE. '0' .AND. 
     *             C(N2+3:N2+3) .LE. '9' ) THEN
                  CALL CH2INT ( C, N2+3, I2, NS3, NE3, IVEXP )
                  NEXP   = N2 + 1
                  NSIGN2 = N2 + 2
                  N2     = NE3
               ELSE
                  NEXP   = N2 + 1
                  NSIGN2 = N2 + 2
                  IVEXP  = 0
                  N2     = N2 + 2
               ENDIF
            ELSE IF( C(N2+2:N2+2) .LT. '0' .OR. 
     *               C(N2+2:N2+2) .GT. '9' ) THEN
               NEXP  = N2 + 1
               IVEXP = 0
               N2    = N2 + 1
            ELSE
               CALL CH2INT ( C, N2+2, I2, NS3, NE3, IVEXP )
               NEXP = N2 + 1
               N2   = NE3
            ENDIF
         ENDIF
      ENDIF
C
C  Setup format for decoding the number, and decode it.
C
      NTOT = N2 - N1 + 1
      IF( NEXP .GT. 0 .AND. NDEC .GT. 0 ) THEN
         ND = NEXP - NDEC - 1
      ELSE IF( NEXP .GT. 0 ) THEN
         ND = 0
      ELSE IF( NDEC .GT. 0 ) THEN
         ND = N2 - NDEC
      ELSE
         ND = 0
      ENDIF
      WRITE(IFMT,FMT='(2H(F,I2,1H.,I2,1H))')  NTOT, ND
      READ (C(N1:N2),FMT=IFMT)  VAL
      IFLAG = 1
  100 CONTINUE
      RETURN
      END
      SUBROUTINE CH2INT ( C, I1, I2, N1, N2, IVAL )
C
C  Given a character string, C, and location limits to search (I1,I2),
C  this routine looks for and extracts the first positive integer 
C  number (IVAL) it can find.  The integer number starts with the first 
C  numeric character encountered within the search limits, and ends 
C  with the first non-numeric character encountered after a number.
C  N1 and N2 are the location limits within which it found the integer
C  number.
C  IVAL is returned as a negative number if no integer value can be
C  found.  Otherwise it contains the positive integer value.
C
      CHARACTER*(*)  C
      CHARACTER*5    IFMT
C
      IVAL = -1
C
C  Locate position of first numeric character.
C
      DO 20 I=I1,I2
         IF( C(I:I) .GE. '0' .AND. C(I:I) .LE. '9' ) THEN
            N1 = I
            GO TO 22
         ENDIF
   20 CONTINUE
      GO TO 50
   22 CONTINUE
C
C  Locate first non-numeric character.
C
      IF( N1 .EQ. I2 ) THEN
         N2 = N1
         GO TO 32
      ELSE
         DO 30 I=N1+1,I2
            IF( C(I:I) .LT. '0' .OR. C(I:I) .GT. '9' ) THEN
               N2 = I - 1
               GO TO 32
            ENDIF
   30    CONTINUE
         N2 = I2
      ENDIF
   32 CONTINUE
C
C  Setup format for decoding the number, and decode it.
C
      WRITE(IFMT,FMT='(2H(I,I2,1H))')  N2-N1+1
      READ (C(N1:N2),FMT=IFMT)  IVAL
   50 CONTINUE
      RETURN
      END
      SUBROUTINE CHFMT ( NCHAR, CWFMT )
C
C  Given NCHAR, the number of characters to be written, this 
C  routine defines a character variable CWFMT containing the required 
C  format for writing the character string as a left-justified string 
C  of the proper length.  
C  It is assumed that CWFMT is at least a CHARACTER*6 variable.
C
      CHARACTER*(*)   CWFMT
C
      IF( NCHAR .LE. 0 ) THEN
         CWFMT = '(A1)'
      ELSE
         WRITE(CWFMT,FMT='(2H(A,I3,1H))') NCHAR
      ENDIF
      RETURN
      END
      SUBROUTINE CKMISV ( V, VMISS, NV, X, 
     *                    VFLG, NVF, IVFLG, NIF, SFLG, NSF,
     *                    NDIAG, IOU )
C
C  Subroutine to test NV values of V(N) against their appropriate
C  missing values.
C
      CHARACTER*(*)  IVFLG
      CHARACTER*(*)   SFLG
      CHARACTER*(*)   VFLG
C
      DIMENSION  V( * ), VMISS( * )
C
      IF( NV .LT. 1 )  RETURN
      DO 30 N=1,NV
         IF( V(N) .GT. VMISS(N) ) THEN
           WRITE( IOU,* ) 
     *     '  **Error in CKMISV when called by ',SFLG(1:NSF)
           WRITE( IOU,* ) 
     *     '    ',VFLG(1:NVF),' .GT. its missing value for index ',N
           WRITE( IOU,* ) '    ',VFLG(1:NVF),'= ', V(N)
           WRITE( IOU,* ) '    at ',IVFLG(1:NIF),'= ', X
           NDIAG = NDIAG + 1
         ENDIF
   30 CONTINUE
      RETURN
      END
      SUBROUTINE CKMSXV ( V, IDIM, VMISS, NV, X, NX,
     *                    VFLG, NVF, IVFLG, NIF, SFLG, NSF,
     *                    NDIAG, IOU )
C
C  Subroutine to test values of V(I,N) against their appropriate
C  missing values.
C
      CHARACTER*(*)  IVFLG
      CHARACTER*(*)   SFLG
      CHARACTER*(*)   VFLG
C
      DIMENSION  V( IDIM,* ), VMISS( * )
C
      IF( NX .LT. 1 )  RETURN
      DO 50 N=1,NV
         BIG = -9.9E+20
         DO 30 I=1,NX
            BIG = AMAX1( V(I,N), BIG )
   30    CONTINUE
         IF( BIG .GT. VMISS(N) ) THEN
           WRITE( IOU,* ) 
     *             '  **Error in CKMSXV when called by ',SFLG(1:NSF)
           WRITE( IOU,* ) 
     *     '    ',VFLG(1:NVF),' .GT. its missing value for index ',N
           WRITE( IOU,* ) '    ',VFLG(1:NVF),'= ', BIG
           WRITE( IOU,* ) '    at ',IVFLG(1:NIF),'= ', X
           NDIAG = NDIAG + 1
         ENDIF
   50 CONTINUE
      RETURN
      END
      SUBROUTINE CKNPC ( CDUM, CFLG, KFLG, NFLG, MAXLEN, 
     *                   IREC, NDIAG, IUN, IOU )
C
C  Subroutine to check ASCII files for non-printable characters and
C  long records.
C  Record lengths greater than MAXLEN are flagged.
C  Characters with ASCII decimal values .LT. CMIN and .GT. CMAX 
C  are flagged.
C  The contents of CFLG(I) denote characters outside the limits of
C  CMIN and CMAX which are counted with the number of finds stored 
C  in KFLG(I).  This option is for unwanted characters which are likely 
C  to occur often.
C
C  Required routines:   LASTNB.
C
C  History:
C    92-01-18 (SEG) Modified to initialize CDUM=' ' before reading
C                   a record, so that last line of file is 
C                   properly checked.
C    91-08-13 (SEG) Modified to check last record.
C    91-07-03 (SEG) Modified to return IREC.
C
C
      CHARACTER*(*)  CFLG( * )
      CHARACTER*(*)  CDUM
      CHARACTER*1    CMAX
      CHARACTER*1    CMIN
      CHARACTER*6    CRFMT
C
      DIMENSION   KFLG( * )
C
      DATA   CMAX / '~' /
      DATA   CMIN / ' ' /
C
      IREC = 0
      DO 18 I=1,NFLG
         KFLG(I) = 0
   18 CONTINUE
      LCD = LEN( CDUM )
      WRITE( CRFMT,FMT='(2H(A,I3,1H))' )  LCD
   20 CONTINUE
         CDUM = ' '
         READ( IUN,FMT=CRFMT,END=200 )  CDUM
         CALL LASTNB ( CDUM, LCD, N )
         IREC = IREC + 1
         IF( N .GT. MAXLEN ) THEN
            WRITE( IOU,* )  
     *                '  **Line too long--line #, length=', IREC, N
            NDIAG = NDIAG + 1
         ENDIF
         DO 40 I=1,N
            IF( CDUM(I:I) .LT. CMIN .OR. CDUM(I:I) .GT. CMAX ) THEN
               IF( NFLG .GT. 0 ) THEN
                  DO 26 J=1,NFLG
                     IF( CDUM(I:I) .EQ. CFLG(J) ) THEN
                        KFLG(J) = KFLG(J) + 1
                        GO TO 40
                     ENDIF
   26             CONTINUE
               ENDIF
               WRITE( IOU,* ) 
     *    '  **Found non-printable character with ASCII decimal value=',
     *                         ICHAR(CDUM(I:I))
               WRITE( IOU,* ) '    at line number=',  IREC
               NDIAG = NDIAG + 1
            ENDIF
   40    CONTINUE
      GO TO 20
  200 CONTINUE
C
C  Check last line in the event that end-of-file characters are tacked
C  on to the end of the line without a proper end-of-line designator.
C
      CALL LASTNB ( CDUM, LCD, N )
      IF( N .GT. 0 ) THEN
         IF( N .GT. MAXLEN ) THEN
            WRITE( IOU,* )  
     *                '  **Last line too long--length=', N
            NDIAG = NDIAG + 1
         ENDIF
         DO 240 I=1,N
            IF( CDUM(I:I) .LT. CMIN .OR. CDUM(I:I) .GT. CMAX ) THEN
               IF( NFLG .GT. 0 ) THEN
                  DO 226 J=1,NFLG
                     IF( CDUM(I:I) .EQ. CFLG(J) ) THEN
                        KFLG(J) = KFLG(J) + 1
                        GO TO 240
                     ENDIF
  226             CONTINUE
               ENDIF
               WRITE( IOU,* ) 
     *    '  **Found non-printable character with ASCII decimal value=',
     *                         ICHAR(CDUM(I:I))
               WRITE( IOU,* ) '     in last line of file.'
               NDIAG = NDIAG + 1
            ENDIF
  240    CONTINUE
C
C        Flag last line if N>0.  There should only be an EOF.
C
         WRITE(IOU,*) '  **Last line improperly terminated'
         NDIAG = NDIAG + 1
      ENDIF
C
C  Print summary of flagged characters.
C
      IF( NFLG .GT. 0 ) THEN
         DO 250 I=1,NFLG
            IF( KFLG(I) .GT. 0 ) THEN
               WRITE( IOU,* ) 
     *    '  **Found non-printable character with ASCII decimal value=',
     *                         ICHAR(CFLG(I))
               WRITE(IOU,*) '    Number of occurrences=', KFLG(I)
               NDIAG = NDIAG + 1
            ENDIF
  250    CONTINUE
      ENDIF
      WRITE( IOU,* ) ' Number of lines read by CKNPC= ', IREC
      RETURN
      END
      SUBROUTINE CNTBLA ( C, I1, I2, NBLANK )
C
C  Given a character string, C, and location limits to search (I1,I2),
C  this routine counts the number of blank spaces within the search
C  limits.
C
      CHARACTER*(*)  C
C
      NBLANK = 0
      DO 30 I=I1,I2
         IF( C(I:I) .EQ. ' ' )  NBLANK = NBLANK + 1
   30 CONTINUE
      RETURN  
      END
      SUBROUTINE CNTNN ( C, I1, I2, NNN )
C
C  Given a character string, C, and location limits to search (I1,I2),
C  this routine counts the number of non-numeric printable characters 
C  within the search limits.
C  Numeric characters are 0 1 2 3 4 5 6 7 8 9 . + - e E (and space).
C
      CHARACTER*(*)  C
C
      NNN = 0
      DO 30 I=I1,I2
         IF( C(I:I) .GT. ' ' .AND. C(I:I) .LT. '0' ) THEN
            IF( C(I:I) .EQ. '+' .OR. 
     *          C(I:I) .EQ. '-' .OR. C(I:I) .EQ. '.' )  GO TO 30
            NNN = NNN + 1
         ELSE IF( C(I:I) .GT. '9' .AND. C(I:I) .LE. '~' ) THEN
            IF( C(I:I) .EQ. 'E' .OR. C(I:I) .EQ. 'e' )  GO TO 30
            NNN = NNN + 1
         ENDIF
   30 CONTINUE
      RETURN  
      END
      SUBROUTINE FGCTLZ ( FILSPC, NCFS, CRFMT, CDUM, NDIAG, IZU, IOU )
C
C  Subroutine to scan file in unit IZU for occurrences of ^Z and
C  note them in the output file.
C
C  Required routines:  LASTNB.
C
      CHARACTER*10   CD2
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  FILSPC
C
      REWIND IZU
   20 CONTINUE
         READ( IZU,FMT=CRFMT,END=200 ) CDUM
         L = INDEX( CDUM, FILSPC(1:NCFS) )
         IF( L .NE. 1 ) GOTO 20
         CALL LASTNB ( CDUM, LEN(CDUM), LNB )
         WRITE(CD2,FMT='(1H(,I3,3HX,I,I2,1H))') NCFS+1, LNB-NCFS-1
         READ( CDUM,FMT=CD2 ) LINO
         WRITE( IOU,* ) '  **Found ^Z in line number ', LINO
         NDIAG = NDIAG + 1
         GOTO 20
  200 CONTINUE
      RETURN
      END
      SUBROUTINE FNDFLT ( C, X, NX, MAXX, NDIAG, IOU )
C
C  Subroutine to find all floating point numbers in a character string.
C
C  Required routines:  CH2FLT,  LASTNB.
C             
      CHARACTER*(*)  C
C
      DIMENSION  X( * )
C
      NX = 0
      CALL LASTNB ( C, LEN(C), LNB )
      I1 = 1
      DO 100 I=1,MIN0(LNB/2+1,MAXX)
         CALL CH2FLT ( C, I1, LNB, N1, N2, X(I), IFLAG, NDIAG, IOU )
         IF( IFLAG .GT. 0 ) THEN
            NX = NX + 1
            I1 = N2 + 1
         ELSE
            GO TO 110
         ENDIF
  100 CONTINUE
  110 CONTINUE
      RETURN
      END        
      SUBROUTINE FRSTNB ( C, N, NB1 )
C                       
C  Subroutine to determine the location of the last non-blank character
C  in the string C.
C  This routine assumes the character string C is blank-filled, which
C  is not the case for strings read with the VAX Q-format--they are
C  null-filled.
C
      CHARACTER*(*)  C
C
      NB1 = 0
      DO 20 I=1,N
         IF( C(I:I) .NE. ' ' ) THEN
            NB1 = I
            GO TO 22
         ENDIF
   20 CONTINUE
   22 CONTINUE
      RETURN
      END
      SUBROUTINE L3CVAL ( X, LX, NVAL, CVAL )
C
C  Subroutine to store the last three values of character variable X,
C  of length LX, in the array CVAL.
C
      CHARACTER*(*)  CVAL( * )
      CHARACTER*(*)  X
C
      IF( NVAL .GT. 3 ) THEN
         CVAL(1) = CVAL(2)(1:LX)
         CVAL(2) = CVAL(3)(1:LX)
         CVAL(3) = X(1:LX)
      ELSE
         CVAL(NVAL) = X(1:LX)
      ENDIF
      RETURN
      END        
      SUBROUTINE L3RVAL ( X, NVAL, RVAL, X0 )
C
C  Subroutine to store the last three values of real variable X
C  in the array RVAL.
C
      DIMENSION   RVAL( * )
C
      IF( NVAL .GT. 3 ) THEN
         RVAL(1) = RVAL(2)
         RVAL(2) = RVAL(3)
         RVAL(3) = X
      ELSE
         RVAL(NVAL) = X
         X0 = RVAL(1)
      ENDIF
      RETURN
      END
      SUBROUTINE LASTNB ( C, N, LNB )
C                       
C  Subroutine to determine the location of the last non-blank character
C  in the string C.
C  This routine assumes the character string C is blank-filled, which
C  is not the case for strings read with the VAX Q-format--they are
C  null-filled.
C
      CHARACTER*(*)  C
C
      LNB = 0
      DO 20 I=N,1,-1
         IF( C(I:I) .NE. ' ' ) THEN
            LNB = I
            GO TO 22
         ENDIF
   20 CONTINUE
   22 CONTINUE
      RETURN
      END
      SUBROUTINE PARDAT ( V, NWANT, NFIND, SUBFLG, NSF, VALFLG, NVF,
     *                    LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read numeric values, flag non-numeric characters,
C  and flag lines with more data than expected.
C  This routine allows for records spanning more than one line.
C
C  Required routines:   PARFLT.
C             
      CHARACTER*(*)   CDUM
      CHARACTER*(*)   CRFMT
      CHARACTER*(*)   SUBFLG
      CHARACTER*(*)   VALFLG
C
      DIMENSION    V( * )
C                               
      NREAD = 0
      NFIND = 0
      I1    = 1
      DO 40 K=1,NWANT
         READ ( IUN,FMT=CRFMT,IOSTAT=IERR )  CDUM
         IF( IERR .LT. 0 ) THEN
            IERR = -1
            RETURN
         ELSE IF( IERR .GT. 0 ) THEN
            WRITE( IOU,* ) ' ***PARDAT error reading line ', LINE+1
            WRITE(IOU,*)   '    while reading ', VALFLG(1:NVF)
            WRITE( IOU,* ) '    PARDAT called by ',SUBFLG(1:NSF)
            WRITE( IOU,* ) '    IOSTAT=', IERR
            IERR  = 1
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         LINE  = LINE  + 1
         NREAD = NREAD + 1
         CALL PARFLT ( CDUM, V(I1), NVAL, NWANT+5, LN, NCIDR, NBIDR, 
     *                 NEXTRA, NDIAG, IOU )
         NFIND = NFIND + NVAL
         IF( NEXTRA .GT. 0 ) THEN
            WRITE(IOU,*) 
     *      '  **PARDAT found extraneous character in line ', LINE
            WRITE(IOU,*) '    Number of extraneous chars.= ', NEXTRA
            WRITE( IOU,* ) '    PARDAT called by ',SUBFLG(1:NSF)
            NDIAG = NDIAG + 1
         ENDIF
         IF( NFIND .EQ. NWANT ) THEN
            GOTO 42
         ELSE IF( NFIND .GT. NWANT ) THEN
            WRITE(IOU,*) 
     *               '  **PARDAT error--excess values in line ', LINE
            WRITE(IOU,*) '    while reading ', VALFLG(1:NVF)
            WRITE(IOU,*) '    PARDAT called by ',SUBFLG(1:NSF)
            NDIAG = NDIAG + 1
            GOTO 42
         ELSE IF( NVAL .LT. 1 ) THEN
            WRITE(IOU,*) '  **PARDAT error--no numbers in line ',LINE
            WRITE(IOU,*) '    while reading ', VALFLG(1:NVF)
            WRITE(IOU,*) '    PARDAT called by ',SUBFLG(1:NSF)
            NDIAG = NDIAG + 1
         ENDIF
         I1 = NFIND + 1
   40 CONTINUE
   42 CONTINUE
      RETURN     
      END     
      SUBROUTINE PARFLT ( C, X, NX, MAXX, LN, NCIDR, NBIDR, NEXTRA,
     *                    NDIAG, IOU )
C
C  Subroutine to find MAXX floating point numbers (integers included)
C  in a character string C(1:LN), and flag non-numeric characters in 
C  the string.
C  This routine also keeps a running talley of the number of characters
C  (NCIDR) and the number of blanks (NBIDR) in C(1:LN).
C
C  History:
C    92-02-11 - Modified to check for blank space between numeric
C               values.
C    91-12-17 - Modified to stop searching for numbers if NX=MAXX, and
C               to return the index of either the last numeric character
C               in the string (if NX=MAXX) or the last nonblank
C               character in the string (if NX<MAXX).
C
C
C  Required routines:  CH2FLT,  CHFMT,  CNTBLA,  LASTNB 
C             
      CHARACTER*(*)  C
      CHARACTER*6    CWFMT
C
      DIMENSION  X( * )
C
      NX = 0
      NC = 0
      NS = 0
      CALL LASTNB ( C, LEN(C), LNB )
      NCIDR = NCIDR + LNB
      I1 = 1
      I  = 0
   30 CONTINUE
         I = I + 1
         CALL CH2FLT ( C, I1, LNB, N1, N2, X(I), IFLAG, NDIAG, IOU )
         IF( IFLAG .GT. 0 ) THEN
            NX = NX + 1
            IF( N1 .GT. 1 ) THEN
               IF( C(N1-1:N1-1) .NE. ' ' )  NS = NS + 1
            ENDIF
            I1 = N2 + 1
            NC = NC + N2 - N1 + 1
            LN = N2
            IF( NX .EQ. MAXX )  GOTO 110
         ELSE
            LN = LNB
            GO TO 110
         ENDIF
         IF( I1 .LT. LNB ) GOTO 30
  110 CONTINUE
      CALL CNTBLA ( C, 1, LN, NBLANK )
      NBIDR  = NBIDR + NBLANK
      NEXTRA = LN - NC - NBLANK
      IF( NS .GT. 0 ) THEN
         WRITE(IOU,*) 
     * '  **PARFLT error--The following line contains values with '
         WRITE(IOU,*) '    no space between them:'
         CALL CHFMT ( LNB, CWFMT )
         WRITE(IOU,FMT=CWFMT) C(1:LNB)
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END
      SUBROUTINE PARHD ( V, NWANT, NFIND, SUBFLG, NSF, VALFLG, NVF,
     *                   LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                   CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read numeric values from file header records and
C  flag non-numeric characters within the fields where they should
C  not be.
C  This routine is essentially the same as PARDAT except that it
C  forces PARFLT to stop reading after it finds NWANT characters.
C  This behavior is to allow for the possibility of comments in the
C  file header records.
C  This routine allows for records spanning more than one line.
C
C  Required routines:   PARFLT.
C             
      CHARACTER*(*)   CDUM
      CHARACTER*(*)   CRFMT
      CHARACTER*(*)   SUBFLG
      CHARACTER*(*)   VALFLG
C
      DIMENSION    V( * )
C                               
      NREAD = 0
      NFIND = 0
      I1    = 1
      DO 40 K=1,NWANT
         READ ( IUN,FMT=CRFMT,IOSTAT=IERR )  CDUM
         IF( IERR .LT. 0 ) THEN
            IERR = -1
            RETURN
         ELSE IF( IERR .GT. 0 ) THEN
            WRITE( IOU,* ) ' ***PARHD error reading line ', LINE+1
            WRITE(IOU,*)   '    while reading ', VALFLG(1:NVF)
            WRITE( IOU,* ) '    PARHD called by ',SUBFLG(1:NSF)
            WRITE( IOU,* ) '    IOSTAT=', IERR
            IERR  = 1
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         LINE  = LINE  + 1
         NREAD = NREAD + 1
         CALL PARFLT ( CDUM, V(I1), NVAL, NWANT, LN, NCIDR, NBIDR, 
     *                 NEXTRA, NDIAG, IOU )
         NFIND = NFIND + NVAL
         IF( NEXTRA .GT. 0 ) THEN
            WRITE(IOU,*) 
     *      '  **PARHD found extraneous character in line ', LINE
            WRITE(IOU,*) '    Number of extraneous chars.= ', NEXTRA
            WRITE( IOU,* ) '    PARHD called by ',SUBFLG(1:NSF)
            NDIAG = NDIAG + 1
         ENDIF
         IF( NFIND .EQ. NWANT ) THEN
            GOTO 42
         ELSE IF( NVAL .LT. 1 ) THEN
            WRITE(IOU,*) '  **PARHD error--no numbers in line ',LINE
            WRITE(IOU,*) '    while reading ', VALFLG(1:NVF)
            WRITE(IOU,*) '    PARHD called by ',SUBFLG(1:NSF)
            NDIAG = NDIAG + 1
         ENDIF
         I1 = NFIND + 1
   40 CONTINUE
      IF( NFIND .LT. NWANT ) THEN
         WRITE(IOU,*) ' ***PARHD could not find all values of ',
     *                     VALFLG(1:NVF)
         WRITE(IOU,*) '    Started looking at line ',LINE-NREAD+1
         WRITE(IOU,*) '    Number of values to find= ', NWANT
         NDIAG = NDIAG + 1
         IERR  = 2
      ENDIF
   42 CONTINUE
      RETURN     
      END     
      SUBROUTINE PD1001 ( X1, V, VMISS, NV, CDUM, DUM, 
     *                    LINE, NCIDR, NBIDR, NVALS,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record for FFI=1001.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C  Required routines:   CKMISV,  PARDAT.
C
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION  DUM( * ),  V( * ),  VMISS( * )
C
      IERR = 0   
      CALL PARDAT ( DUM, NV+1, NFIND, 'PD1001', 6, 'X1,V(N)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X1 = DUM(1)
         DO 30 N=1,NV
            V(N) = DUM(N+1)
   30    CONTINUE
         CALL CKMISV ( V, VMISS, NV, X1, 
     *                 'V(N)', 4, 'X1', 2, 'PD1001', 6, NDIAG, IOU )
      ENDIF
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NV+1 ) THEN
         WRITE( IOU,* ) ' ***PD1001 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X1,V(N)'
         WRITE( IOU,* ) '    Last successfully read value of X1=', X1
         WRITE( IOU,* ) '    Number of values expected in record=',NV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END
      SUBROUTINE PD1010 ( X1, A, AMISS, NAUXV, V, VMISS, NV,
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=1010.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C  Required routines:  CKMISV,  PARDAT.
C
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION  A( * ), AMISS( * ), DUM( * ), V( * ), VMISS( * )
C
      IERR = 0   
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD1010', 6, 'X1,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X1 = DUM(1)
         IF( NAUXV .GT. 0 ) THEN
            DO 30 IA=1,NAUXV
               A(IA) = DUM(IA+1)
   30       CONTINUE
            CALL CKMISV ( A, AMISS, NAUXV, X1, 
     *                   'A(I)', 4, 'X1', 2, 'PD1010', 6, NDIAG, IOU )
         ENDIF
      ENDIF
      CALL PARDAT ( DUM, NV, NFIND, 'PD1010', 6, 'V(N)', 4,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 102
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         DO 40 N=1,NV
            V(N) = DUM(N)
   40    CONTINUE
         CALL CKMISV ( V, VMISS, NV, X1,
     *                'V(N)', 4, 'X1', 2, 'PD1010', 6, NDIAG, IOU )
      ENDIF
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD1010 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X1,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X1=', X1
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD1010 error--premature EOF in line',LINE+1
      WRITE( IOU,* ) '    while reading primary variables'
      WRITE( IOU,* ) '    Incomplete primary variable list at X1=',X1
      WRITE( IOU,* ) '    Number of values expected in record=', NV
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD1020 ( X1, DX, A, AMISS, NAUXV, 
     *                    V, VMISS, MAXX1, NVPM, NV, 
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=1020.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C  Required routines:   CKMISV,  CKMSXV,  PARDAT.
C
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION  A( * ), AMISS( * ), DUM( * )
      DIMENSION  V( MAXX1,* ), VMISS( * ),  X1( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD1020', 6, 'X1,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X1(1) = DUM(1)
         IF( NAUXV .GT. 0 ) THEN
            DO 20 IA=1,NAUXV
               A(IA) = DUM(IA+1)
   20       CONTINUE
            CALL CKMISV ( A, AMISS, NAUXV, X1, 
     *                   'A(I)', 4, 'X1', 2, 'PD1020', 6, NDIAG, IOU )
         ENDIF
      ENDIF
C
      DO 30 N=1,NV
         CALL PARDAT ( DUM, NVPM, NFIND, 'PD1020', 6, 'V(I,N)', 6,
     *                 LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
         NVALS = NVALS + NFIND
         IF( IERR .LT. 0 ) THEN
            GOTO 102
         ELSE IF( IERR .GT. 0 ) THEN
            RETURN
         ELSE
            DO 26 I=1,NVPM
               V(I,N) = DUM(I)
   26       CONTINUE
         ENDIF
   30 CONTINUE
      CALL CKMSXV ( V, MAXX1, VMISS, NV, X1, NVPM,
     *             'V(N)', 4, 'X1', 2, 'PD1020', 6, NDIAG, IOU )
C
C  Define X1 values.
C
      DO 40 I=2,NVPM
         X1(I) = X1(1) + DX * FLOAT( I-1 )
   40 CONTINUE
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD1020 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X1,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X1=', X1(1)
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD1010 error--premature EOF while reading'
      WRITE( IOU,* ) '    values of primary variable V(I,N), N=',N
      WRITE( IOU,* ) '    at independent variable mark X1(1)=', X1(1)
      WRITE( IOU,* ) '    NV, NVPM=', NV, NVPM
      WRITE( IOU,* ) '    Number of values expected in record=',NVPM
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD2010 ( X2, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV, 
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=2010.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C  Required routines:   CKMISV,  CKMSXV,  PARDAT.
C
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION  A( * ), AMISS( * ), DUM( * )
      DIMENSION  V( MAXX1,* ),  VMISS( * )
C                
      IERR = 0
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD2010', 6, 'X2,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X2 = DUM(1)
         IF( NAUXV .GT. 0 ) THEN
            DO 20 IA=1,NAUXV
               A(IA) = DUM(IA+1)
   20       CONTINUE
            CALL CKMISV ( A, AMISS, NAUXV, X2, 
     *                   'A(I)', 4, 'X2', 2, 'PD2010', 6, NDIAG, IOU )
         ENDIF
      ENDIF
C
      DO 30 N=1,NV
         CALL PARDAT ( DUM, NX, NFIND, 'PD2010', 6, 'V(I,N)', 6,
     *                 LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
         NVALS = NVALS + NFIND
         IF( IERR .LT. 0 ) THEN
            GOTO 102
         ELSE IF( IERR .GT. 0 ) THEN
            RETURN
         ELSE
            DO 26 I=1,NX
               V(I,N) = DUM(I)
   26       CONTINUE
         ENDIF
   30 CONTINUE
C
      CALL CKMSXV ( V, MAXX1, VMISS, NV, X2, NX,
     *             'V(N)', 4, 'X2', 2, 'PD2010', 6, NDIAG, IOU )
      RETURN
C
C  Flag EOF.
C                
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD2010 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X2,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X2=', X2
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD2010 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      WRITE( IOU,* ) '    Number of values expected in record=', NX
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD2110 ( X1, X2, A, AMISS, NAUXV, V, VMISS, MAXX1, 
     *                    NX, NV, CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=2110.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C       = +2 = error in value of NX
C
C  Required routines:   CKMISV,  CKMSXV,  PARDAT.
C
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION   A( * ), AMISS( * ), DUM( * )
      DIMENSION   V( MAXX1,* ), VMISS( * ), X1( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD2110', 6, 'X2,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X2 = DUM(1)
         NX = INT( DUM(2) + 0.5 )
         IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
            WRITE( IOU,* ) ' ***PD2110 error--NX(1) too large'
            WRITE( IOU,* ) '    MAXX1,NX(1)=', MAXX1, NX
            IERR  = 2
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         DO 20 IA=1,NAUXV
            A(IA) = DUM(IA+1)
   20    CONTINUE
         CALL CKMISV ( A, AMISS, NAUXV, X2, 
     *                'A(I)', 4, 'X2', 2, 'PD2110', 6, NDIAG, IOU )
      ENDIF
C
      IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
         DO 30 I=1,NX
            CALL PARDAT ( DUM, NV+1, NFIND, 'PD2110', 6, 
     *                   'X1(I),V(I,N)', 12,
     *                    LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
            NVALS = NVALS + NFIND
            IF( IERR .LT. 0 ) THEN
               GOTO 102
            ELSE IF( IERR .GT. 0 ) THEN
               RETURN
            ELSE
               X1(I) = DUM(1)
               DO 26 N=1,NV
                  V(I,N) = DUM(N+1)
   26          CONTINUE
            ENDIF
   30    CONTINUE
         CALL CKMSXV ( V, MAXX1, VMISS, NV, X2, NX, 'X1(I),V(I,N)', 12, 
     *                'X2', 2, 'PD2110', 6, NDIAG, IOU )
      ENDIF
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE   
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD2110 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X2,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X2=', X2
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD2110 encountered EOF'
      WRITE( IOU,* ) '    while reading record containing X1(I), I= ', I
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      WRITE( IOU,* ) '    Number of values expected in record=',NV+1
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD2160 ( X1, CX2, LENX, 
     *                    A, AMISS, NAUXV, CA, CAMISS, LENA, NAUXC, 
     *                    V, VMISS, MAXX1, NX, NV,
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C                         
C  Subroutine to read a data record group for FFI=2160.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C       = +2 = error in value of NX.
C
C  Required routines:   LASTNB,  PARDAT.
C
C  History:
C    91-10-25 (SEG) - Added code to test lengths of CX2 and CA.
C
C                
      CHARACTER*(*)  CA( * )
      CHARACTER*(*)  CAMISS( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  CX2
C
      DIMENSION   A( * ), AMISS( * ), V( MAXX1,* ), VMISS( * )
      DIMENSION   DUM( * ), LENX( * ), LENA( * ), X1( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      READ( IUN,FMT=CRFMT,ERR=200,END=100 )  CX2
      CALL LASTNB ( CX2, LEN(CX2), LX2 )
      IF( LX2 .GT. LENX(2) ) THEN
         WRITE( IOU,* ) '  **PR2160 error--string too long for'
         WRITE( IOU,* ) '    independent variable mark X2=', CX2(1:LX2)
         WRITE( IOU,* ) '    LENGTH, LENX= ', LX2, LENX(2)
         NDIAG = NDIAG + 1
      ENDIF
C
      CALL PARDAT ( DUM, NAUXV-NAUXC, NFIND, 'PD2160', 6, 
     *             'Real A(I)', 9,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 101
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         NX = INT( DUM(1)+0.5 )
         IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
            WRITE( IOU,* ) ' ***PD2160 error--NX(1) too large'
            WRITE( IOU,* ) '    MAXX1,NX(1)=', MAXX1, NX
            IERR  = 2
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         DO 16 IA=1,NAUXV-NAUXC
            A(IA) = DUM(IA)
            IF( A(IA) .GT. AMISS(IA) ) THEN
               WRITE( IOU,* ) 
     *    '  **PD2160 error--auxiliary variable .GT. its missing value'
               WRITE( IOU,* ) 
     *         '    at independent variable mark X2= ',CX2(1:LENX(2))
               WRITE( IOU,* ) 
     *         '    I, A(I), AMISS(I)= ', IA,A(IA),AMISS(IA)
               NDIAG = NDIAG + 1
            ENDIF
   16    CONTINUE
      ENDIF
C
      IF( NAUXC .GT. 0 ) THEN
         DO 20 IC=1,NAUXC
            READ( IUN,FMT=CRFMT,ERR=202,END=102 )  CA(IC)
            CALL LASTNB ( CA(IC), LEN(CA(IC)), LCA )
            IF( LCA .GT. LENA(IC) ) THEN
               WRITE( IOU,* ) '  **PD2160 error--string too long for'
               WRITE( IOU,* ) '    auxiliary variable A(I), I=', 
     *                             NAUXV-NAUXC+IC
               WRITE( IOU,* ) 
     *         '    At independent variable mark X2=', CX2(1:LENX(2))
               WRITE( IOU,* ) '    LENGTH, LENA(I)= ', LCA, LENA(IC)
               WRITE( IOU,* ) '    A(I)=', CA(IC)(1:LCA)
               NDIAG = NDIAG + 1
            ENDIF
            IF( LGT( CA(IC)(1:LENA(IC)), CAMISS(IC)(1:LENA(IC)) )) THEN
               WRITE( IOU,* ) 
     *    '  **PD2160 error--auxiliary variable .GT. its missing value'
               WRITE( IOU,* ) 
     *         '    at independent variable mark X2= ',CX2(1:LENX(2))
               WRITE( IOU,* ) '    Auxiliary variable index=',
     *                             NAUXV-NAUXC+IC
               WRITE( IOU,* ) '    A(I)= ', CA(IC)(1:LENA(IC))
               WRITE( IOU,* ) '    AMISS(I)= ', CAMISS(IC)(1:LENA(IC))
               NDIAG = NDIAG + 1
            ENDIF
   20    CONTINUE
      ENDIF
C
      IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
         DO 30 I=1,NX
            CALL PARDAT ( DUM, NV+1, NFIND, 'PD2160', 6, 'V(I,N)', 6,
     *                    LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
            NVALS = NVALS + NFIND
            IF( IERR .LT. 0 ) THEN
               GOTO 103
            ELSE IF( IERR .GT. 0 ) THEN
               RETURN
            ELSE
               X1(I) = DUM(1)
               DO 26 N=1,NV
                  V(I,N) = DUM(N+1)
                  IF( V(I,N) .GT. VMISS(N) ) THEN
                     WRITE( IOU,* ) 
     *    '  **PD2160 error--primary variable .GT. its missing value'
                     WRITE( IOU,* ) 
     *         '    at independent variable mark X2= ',CX2(1:LENX(2))
                     WRITE( IOU,* ) '    I, N, V(I,N), VMISS(N)=',
     *                                   I, N, V(I,N), VMISS(N)
                     NDIAG = NDIAG + 1
                  ENDIF
   26          CONTINUE
            ENDIF
   30    CONTINUE
      ENDIF
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE   
      IERR = -1
      RETURN
  101 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV-NAUXC ) THEN
         WRITE( IOU,* ) ' ***PD2160 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading real auxiliary variables'
         WRITE( IOU,* ) '    Last successfully read value of X2= ', 
     *                       CX2(1:LENX(2))
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV-NAUXC
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***PD2160 error--EOF while reading character'
      WRITE( IOU,* ) '    auxiliary variable number ', NAUXV-NAUXC+IC
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NAUXV, NAUXC=', NAUXV, NAUXC
      NDIAG = NDIAG + 1
      RETURN
  103 CONTINUE
      WRITE( IOU,* ) 
     *       ' ***PD2160 error--EOF while reading X1(I),V(I,N), I= ', I
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      WRITE( IOU,* ) '    Number of values expected in record=', NV
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***PD2160 error reading independent variable X2'
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***PD2160 error reading character'
      WRITE( IOU,* ) '    auxiliary variable number ', NAUXV-NAUXC+IC
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NAUXV, NAUXC=', NAUXV, NAUXC
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD2310 ( X2, A, AMISS, NAUXV, V, VMISS, X1, MAXX1, 
     *                    NX, NV, DX,
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=2310.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C       = +2 = error in value of NX.
C
C  Required routines:   CKMISV,  CKMSXV,  PARDAT.
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION   A( * ), AMISS( * ), DUM( * )
      DIMENSION   V( MAXX1,* ), VMISS( * ), X1( * ), DX( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD2310', 6, 'X2,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X2 = DUM(1)
         DO 20 I=1,NAUXV
            A(I) = DUM(I+1)
   20    CONTINUE
         NX = INT( A(1)+0.5 )
         DX(1) = A(3)
         IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
            WRITE( IOU,* ) ' ***PD2310 error--NX(1) too large'
            WRITE( IOU,* ) '    MAXX1,NX(1)=', MAXX1, NX
            IERR  = 2
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         CALL CKMISV ( A, AMISS, NAUXV, X2, 
     *                'A(I)', 4, 'X2', 2, 'PD2310', 6, NDIAG, IOU )
      ENDIF
C
      IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
         DO 30 N=1,NV
            CALL PARDAT ( DUM, NX, NFIND, 'PD2310', 6, 'V(I,N)', 6,
     *                    LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
            NVALS = NVALS + NFIND
            IF( IERR .LT. 0 ) THEN
               GOTO 102
            ELSE IF( IERR .GT. 0 ) THEN
               RETURN
            ELSE
               DO 26 I=1,NX
                  V(I,N) = DUM(I)
   26          CONTINUE
            ENDIF
   30    CONTINUE
         CALL CKMSXV ( V, MAXX1, VMISS, NV, X2, NX,
     *                'V(N)', 4, 'X2', 2, 'PD2310', 6, NDIAG, IOU )
C
C        Define X1(I). 
C
         DO 40 I=1,NX
            X1(I) = A(2) + A(3) * FLOAT( I-1 )
   40    CONTINUE
      ENDIF
      RETURN
C
C  Flag EOF.
C                  
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD2310 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X2,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X2=', X2
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD2310 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      WRITE( IOU,* ) '    Number of values expected in record=', NX
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD3010 ( X3, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV, 
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                    IUN, IOU, ISU, RETDAT, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=3010.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C  If RETDAT=.TRUE. then the primary variable values are written to
C  the scratch file unit ISU.
C
C  Required routines:   CKMISV,  CKMSXV,  PARDAT.
C
C
      LOGICAL  RETDAT
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION  A( * ), AMISS( * ), DUM( * )
      DIMENSION  V( MAXX1,* ), VMISS( * ), NX( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD3010', 6, 'X3,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X3 = DUM(1)
         IF( NAUXV .GT. 0 ) THEN
            DO 20 IA=1,NAUXV
               A(IA) = DUM(IA+1)
   20       CONTINUE
            CALL CKMISV ( A, AMISS, NAUXV, X3, 
     *                   'A(I)', 4, 'X3', 2, 'PD3010', 6, NDIAG, IOU )
         ENDIF
      ENDIF
C
      DO 30 N=1,NV
         DO 28 J=1,NX(2)
            CALL PARDAT ( DUM, NX, NFIND, 'PD3010', 6, 'V(I,J,N)', 8,
     *                    LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
            NVALS = NVALS + NFIND
            IF( IERR .LT. 0 ) THEN
               GOTO 102
            ELSE IF( IERR .GT. 0 ) THEN
               RETURN
            ELSE
               DO 26 I=1,NX(1)
                  V(I,1) = DUM(I)
   26          CONTINUE
            ENDIF
            CALL CKMSXV ( V, MAXX1, VMISS(N), 1, X3, NX,
     *                   'V(N)', 4, 'X3', 2, 'PD3010', 6, NDIAG, IOU )
            IF( RETDAT ) THEN
               WRITE( ISU )  ( V(I,1), I=1,NX(1) )
            ENDIF
   28    CONTINUE
   30 CONTINUE
      RETURN
C
C  Flag EOF.     
C
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD3010 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X3,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X3=', X3
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD3010 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,J,N), J,N=', J, N
      WRITE( IOU,* ) '    at independent variable mark X3=', X3
      WRITE( IOU,* ) '    NX(1), NX(2), NV=', NX(1), NX(2), NV
      WRITE( IOU,* ) '    Number of values expected in record=', NX(1)
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE PD4010 ( X4, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
     *                    CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                    IUN, IOU, ISU, RETDAT, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=4010.
C  This routine reads the expected number of values, checks for extra
C  values within the record, tests dependent variables against their
C  missing values, and counts the number of lines, number of characters,
C  and the number of blanks in the data records.
C
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C  If RETDAT=.TRUE. then the primary variable values are written to
C  the scratch file unit ISU.
C
C  Required routines:   CKMISV,  CKMSXV,  PARDAT.
C
C
      LOGICAL   RETDAT
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
C
      DIMENSION  A( * ), AMISS( * ), DUM( * )
      DIMENSION  V( MAXX1,* ), VMISS( * ), NX( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      CALL PARDAT ( DUM, NAUXV+1, NFIND, 'PD4010', 6, 'X4,A(I)', 7,
     *              LINE, NREAD, CDUM, NCIDR, NBIDR,
     *              CRFMT, IUN, IOU, NDIAG, IERR )
      NVALS = NVALS + NFIND
      IF( IERR .LT. 0 ) THEN
         GOTO 100
      ELSE IF( IERR .GT. 0 ) THEN
         RETURN
      ELSE
         X4 = DUM(1)
         IF( NAUXV .GT. 0 ) THEN
            DO 20 IA=1,NAUXV
               A(IA) = DUM(IA+1)
   20       CONTINUE
            CALL CKMISV ( A, AMISS, NAUXV, X4, 
     *                   'A(I)', 4, 'X4', 2, 'PD4010', 6, NDIAG, IOU )
         ENDIF
      ENDIF
C
      DO 30 N=1,NV
         DO 28 K=1,NX(3)
            DO 26 J=1,NX(2)
               CALL PARDAT ( DUM, NX, NFIND, 'PD4010', 6, 
     *                      'V(I,J,K,N)', 10,
     *                       LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                       CRFMT, IUN, IOU, NDIAG, IERR )
               NVALS = NVALS + NFIND
               IF( IERR .LT. 0 ) THEN
                  GOTO 102
               ELSE IF( IERR .GT. 0 ) THEN
                  RETURN
               ELSE
                  DO 24 I=1,NX(1)
                     V(I,1) = DUM(I)
   24             CONTINUE
               ENDIF
               CALL CKMSXV ( V, MAXX1, VMISS(N), 1, X4, NX,
     *                      'V(N)', 4, 'X4', 2, 'PD4010', 6, NDIAG, IOU)
               IF( RETDAT ) THEN
                  WRITE( ISU )  ( V(I,1), I=1,NX(1) )
               ENDIF
   26       CONTINUE
   28    CONTINUE
   30 CONTINUE
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IF( NFIND .GT. 0 .AND. NFIND .LT. NAUXV+1 ) THEN
         WRITE( IOU,* ) ' ***PD4010 error--premature EOF in line',LINE+1
         WRITE( IOU,* ) '    while reading X4,A(I)'
         WRITE( IOU,* ) '    Last successfully read value of X4=', X4
         WRITE( IOU,* ) '    Number of values expected in record=',
     *                       NAUXV+1
         WRITE( IOU,* ) '    Number of values found in record=', NFIND
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
  102 CONTINUE
      WRITE( IOU,* ) ' ***PD4010 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,J,K,N), J,K,N=', J,K,N
      WRITE( IOU,* ) '    at independent variable mark X4=', X4
      WRITE( IOU,* ) '    NX(1), NX(2), NX(3), NV=',(NX(M),M=1,3), NV
      WRITE( IOU,* ) '    Number of values expected in record=', NX(1)
      WRITE( IOU,* ) '    Number of values found in record=', NFIND
      NDIAG = NDIAG + 1
      RETURN
      END        
      SUBROUTINE PRDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
     *                    A, AMISS, CA, LENA, NAUXV, NAUXC, 
     *                    V, MAXX1, NV, NVPM, CWFMT, IOU, ISU,
     *                    ISUBV )
C
C  Subroutine to print data records.
C  ISUBV is defined in subroutine RHEAD and used in this routine.
C
C  Required routines:   CHFMT.
C            
C  History:
C    91-10-23 (SEG) - Omit printing records with X1 if NX(1)=AMISS(1)
C                     or NX(1)=0, for formats 2110, 2160, 2310.
C
C
      CHARACTER*(*)  CA( * )
      CHARACTER*(*)  CWFMT
      CHARACTER*(*)  CX2
C
      DIMENSION   A( * ), AMISS( * ), LENA( * ), V( MAXX1,* )
      DIMENSION   LENX( * ), X1( * ), X2( * ), X3( * )
      DIMENSION   DX( * ), NX( * )
C             
      GO TO ( 1001, 1010, 1020, 
     *        2010, 2110, 2160, 2310, 
     *        3010, 4010 )  ISUBV
      WRITE( IOU,* ) ' ***PRDATA error--improper value for ISUBV=',
     *                                                     ISUBV
      RETURN
 1001 CONTINUE
      WRITE(IOU,*) X1(1), ( V(N,1), N=1,NV )
      RETURN
 1010 CONTINUE
      WRITE(IOU,*) X1(1), ( A(IA), IA=1,NAUXV )
      WRITE(IOU,*) ( V(N,1), N=1,NV )
      RETURN
 1020 CONTINUE
      WRITE(IOU,*) ( X1(I), I=1,NVPM )
      WRITE(IOU,*) ( A(IA), IA=1,NAUXV )
      DO 30 N=1,NV
         WRITE(IOU,*) ( V(I,N), I=1,NVPM )
   30 CONTINUE
      RETURN
 2010 CONTINUE
      WRITE(IOU,*) X2(1), ( A(IA), IA=1,NAUXV )
      DO 40 N=1,NV
         WRITE(IOU,*) ( V(I,N), I=1,NX(1) )
   40 CONTINUE
      RETURN
 2110 CONTINUE
      WRITE(IOU,*) X2(1), ( A(IA), IA=1,NAUXV )
      WRITE(IOU,*) 'NX(1)=', NX(1)
      IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
         DO 50 I=1,NX(1)
            WRITE(IOU,*) X1(I), ( V(I,N), N=1,NV )
   50    CONTINUE
      ENDIF
      RETURN
 2160 CONTINUE
      CALL CHFMT ( LENX(2), CWFMT )
      WRITE(IOU,FMT=CWFMT)  CX2(1:LENX(2))
      WRITE(IOU,*) ( A(IA), IA=1,NAUXV-NAUXC )
      WRITE(IOU,*) 'NX(1)=', NX(1)
      DO 60 IA=1,NAUXC
         CALL CHFMT ( LENA(IA), CWFMT )
         WRITE(IOU,FMT=CWFMT)  CA(IA)(1:LENA(IA))
   60 CONTINUE
      IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
         DO 62 I=1,NX(1)
            WRITE(IOU,*) X1(I), ( V(I,N), N=1,NV )
   62    CONTINUE
      ENDIF
      RETURN
 2310 CONTINUE
      WRITE(IOU,*) X2(1), ( A(IA), IA=1,NAUXV )
      WRITE(IOU,*) 'NX(1),X1(1),DX(1)=', NX(1), X1(1), DX(1)
      IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
         DO 70 N=1,NV
            WRITE(IOU,*) ( V(I,N), I=1,NX(1) )
   70    CONTINUE
      ENDIF
      RETURN
 3010 CONTINUE
      WRITE(IOU,*) X3(1), ( A(IA), IA=1,NAUXV )
      DO 80 N=1,NV
         DO 78 J=1,NX(2)
            READ(ISU)    ( V(I,1), I=1,NX(1) )
            WRITE(IOU,*) ( V(I,1), I=1,NX(1) )
   78    CONTINUE
   80 CONTINUE
      RETURN
 4010 CONTINUE
      WRITE(IOU,*) X4, ( A(IA), IA=1,NAUXV )
      DO 90 N=1,NV
         DO 88 K=1,NX(3)
            DO 86 J=1,NX(2)
               READ(ISU)    ( V(I,1), I=1,NX(1) )
               WRITE(IOU,*) ( V(I,1), I=1,NX(1) )
   86       CONTINUE
   88    CONTINUE
   90 CONTINUE
      RETURN
      END                                             
      SUBROUTINE PRHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
     *                    NV, NVPM, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NAUXC, LENA, CAMISS, 
     *                    NSCOML, SCOM, NNCOML, NCOM, CWFMT, IOU )
C
C  Subroutine to print file header info.
C
C  Required routines:   CHFMT,   LASTNB.
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CAMISS( * )
      CHARACTER*(*)  CWFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   DX( * ), NX( * ), NXDEF( * )
      DIMENSION   X1( * ), X2( * ), X3( * )
      DIMENSION   AMISS( * ), ASCAL( * ), LENA( * )
      DIMENSION   VMISS( * ), VSCAL( * ), LENX( * )
C
C
C  Obtain NIV.
C                
      NIV = IFFI / 1000
C
      WRITE(IOU,*)  NLHEAD, IFFI
      CALL LASTNB ( ONAME, LEN(ONAME), LL )
      CALL CHFMT  ( LL, CWFMT )
      WRITE(IOU,FMT=CWFMT)  ONAME(1:LL)
      CALL LASTNB ( ORG, LEN(ORG), LL )
      CALL CHFMT  ( LL, CWFMT )
      WRITE(IOU,FMT=CWFMT)  ORG(1:LL)
      CALL LASTNB ( SNAME, LEN(SNAME), LL )
      CALL CHFMT  ( LL, CWFMT )
      WRITE(IOU,FMT=CWFMT)  SNAME(1:LL)
      CALL LASTNB  ( MNAME, LEN(MNAME), LL )
      CALL CHFMT ( LL, CWFMT )
      WRITE(IOU,FMT=CWFMT)  MNAME(1:LL)
      WRITE(IOU,*) IVOL, NVOL
      WRITE(IOU,*) IYR, IMO, IDY
      WRITE(IOU,*) IRYR, IRMO, IRDY
      IF( IFFI .EQ. 2160 ) THEN
         WRITE(IOU,*) DX(1)
         WRITE(IOU,*) LENX(2)
      ELSE IF( IFFI .EQ. 2310 ) THEN
         WRITE(IOU,*) DX(2)
      ELSE
         WRITE(IOU,*) ( DX(I), I=1,NIV )
      ENDIF
      IF( IFFI .EQ. 1020 ) THEN
         WRITE(IOU,*) NVPM
      ELSE IF( IFFI .EQ. 2010 .OR. 
     *         IFFI .EQ. 3010 .OR. IFFI .EQ. 4010 ) THEN
         WRITE(IOU,*) ( NX(I), I=1,NIV-1 )
         WRITE(IOU,*) ( NXDEF(I), I=1,NIV-1 )
         WRITE(IOU,*) ( X1(I), I=1,NX(1) )
         IF( IFFI .EQ. 3010 ) THEN
            WRITE(IOU,*) ( X2(J), J=1,NX(2) )
         ELSE IF( IFFI .EQ. 4010 ) THEN
            WRITE(IOU,*) ( X2(J), J=1,NX(2) )
            WRITE(IOU,*) ( X3(K), K=1,NX(3) )
         ENDIF
      ENDIF
      DO 20 IS=1,NIV
         CALL LASTNB ( XNAME(IS), LEN(XNAME(IS)), LL )
         CALL CHFMT  ( LL, CWFMT )
         WRITE(IOU,FMT=CWFMT)  XNAME(IS)(1:LL)
   20 CONTINUE
      WRITE(IOU,*) NV
      WRITE(IOU,*) ( VSCAL(N), N=1,NV )
      WRITE(IOU,*) ( VMISS(N), N=1,NV )
      DO 30 N=1,NV
         CALL LASTNB ( VNAME(N), LEN(VNAME(N)), LL )
         CALL CHFMT  ( LL, CWFMT )
         WRITE(IOU,FMT=CWFMT)  VNAME(N)(1:LL)
   30 CONTINUE
      IF( IFFI .EQ. 2160 ) THEN
         WRITE(IOU,*) NAUXV
         WRITE(IOU,*) NAUXC
         WRITE(IOU,*) ( ASCAL(IA), IA=1,NAUXV-NAUXC )
         WRITE(IOU,*) ( AMISS(IA), IA=1,NAUXV-NAUXC )
         WRITE(IOU,*) ( LENA(IA), IA=1,NAUXC )
         DO 40 IA=1,NAUXC
            CALL LASTNB ( CAMISS(IA), LEN(CAMISS(IA)), LL )
            CALL CHFMT  ( LL, CWFMT )
            WRITE(IOU,FMT=CWFMT)  CAMISS(IA)(1:LL)
   40    CONTINUE
      ELSE IF( IFFI .NE. 1001 ) THEN
         WRITE(IOU,*) NAUXV
         WRITE(IOU,*) ( ASCAL(IA), IA=1,NAUXV )
         WRITE(IOU,*) ( AMISS(IA), IA=1,NAUXV )
      ENDIF
      IF( IFFI .NE. 1001 ) THEN
         DO 50 IA=1,NAUXV
            CALL LASTNB ( ANAME(IA), LEN(ANAME(IA)), LL )
            CALL CHFMT  ( LL, CWFMT )
            WRITE(IOU,FMT=CWFMT)  ANAME(IA)(1:LL)
   50    CONTINUE
      ENDIF
      WRITE(IOU,*) NSCOML
      DO 60 K=1,NSCOML
         CALL LASTNB ( SCOM(K), LEN(SCOM(K)), LL )
         CALL CHFMT  ( LL, CWFMT )
         WRITE(IOU,FMT=CWFMT)  SCOM(K)(1:LL)
   60 CONTINUE
      WRITE(IOU,*) NNCOML
      DO 70 K=1,NNCOML
         CALL LASTNB ( NCOM(K), LEN(NCOM(K)), LL )
         CALL CHFMT  ( LL, CWFMT )
         WRITE(IOU,FMT=CWFMT)  NCOM(K)(1:LL)
   70 CONTINUE
      RETURN
      END
      SUBROUTINE RD1001 ( X1, V, NV, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record for FFI=1001.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C
      DIMENSION  V( * )
C
      IERR = 0   
      READ( IUN,*,ERR=200,END=100 )  X1, ( V(N), N=1,NV )
      RETURN
  100 CONTINUE
      IERR = -1
      RETURN
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD1001 read error'
      WRITE( IOU,* ) '    Last successfully read value of X1=', X1
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD1010 ( X1, A, NAUXV, V, NV, 
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=1010.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C
      DIMENSION  A( * ),  V( * )
C
      IERR = 0   
C
C  Read a group of data records.
C
      IF( NAUXV .GT. 0 ) THEN
         READ( IUN,*,ERR=200,END=100 )  X1, ( A(IA), IA=1,NAUXV )
      ELSE
         READ( IUN,*,ERR=201,END=100 )  X1
      ENDIF
      READ( IUN,*,ERR=202,END=102 )  ( V(N), N=1,NV )
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IERR = -1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) 
     *     ' ***RD1010 encountered EOF while reading primary variables.'
      WRITE( IOU,* ) '    Incomplete primary variable list at X1=', X1
      WRITE( IOU,* ) '    NV=', NV
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD1010 error reading independent and auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X1=', X1
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  201 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD1010 error reading independent variable X1'
      WRITE( IOU,* ) '    Last successfully read value of X1=', X1
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *            ' ***RD1010 error reading primary variables at X1=',X1
      WRITE( IOU,* ) '    NV=', NV
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD1020 ( X1, DX, A, NAUXV, V, MAXX1, NVPM, NV, 
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=1020.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C
      DIMENSION  A( * ),  V( MAXX1,* ),  X1( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      IF( NAUXV .GT. 0 ) THEN
         READ( IUN,*,ERR=201,END=100 )  X1(1), ( A(IA), IA=1,NAUXV )
      ELSE
         READ( IUN,*,ERR=200,END=100 )  X1(1)
      ENDIF
      DO 30 N=1,NV
         READ( IUN,*,ERR=202,END=102 )  ( V(I,N), I=1,NVPM )
   30 CONTINUE
C
C  Define X1 values.
C
      DO 40 I=2,NVPM
         X1(I) = X1(1) + DX * FLOAT( I-1 )
   40 CONTINUE
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IERR = -1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD1020 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X1(1)=', X1(1)
      WRITE( IOU,* ) '    NV, NVPM=', NV, NVPM
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD1020 error reading independent variable X1(1)'
      WRITE( IOU,* ) '    Last successfully read value of X1(1)=', X1(1)
      NDIAG = NDIAG + 1
      RETURN
  201 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD1020 error reading independent and auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X1(1)=', X1(1)
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD1020 error reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X1(1)=', X1(1)
      WRITE( IOU,* ) '    NV, NVPM=', NV, NVPM
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD2010 ( X2, A, NAUXV, V, MAXX1, NX, NV, 
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=2010.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C
C
      DIMENSION  A( * ),  V( MAXX1,1 )
C                
      IERR = 0
C
C  Read a group of data records.
C
      IF( NAUXV .GT. 0 ) THEN
         READ( IUN,*,ERR=201,END=100 )  X2, ( A(IA), IA=1,NAUXV )
      ELSE
         READ( IUN,*,ERR=200,END=100 )  X2
      ENDIF
      DO 30 N=1,NV
         READ( IUN,*,ERR=202,END=102 )  ( V(I,N), I=1,NX )
   30 CONTINUE
      RETURN
C
C  Flag EOF.
C                
  100 CONTINUE
      IERR = -1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD2010 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD2010 error reading independent variable X2'
      WRITE( IOU,* ) '    Last successfully read value of X2=', X2
      NDIAG = NDIAG + 1
      RETURN
  201 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD2010 error reading independent and auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X2=', X2
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD2010 error reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD2110 ( X1, X2, A, AMISS, NAUXV, V, MAXX1, NX, NV,
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=2110.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C       = +2 = error in value of NX
C
C
      DIMENSION   A( * ), AMISS( * ), V( MAXX1,* ), X1( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      IF( NAUXV .GT. 1 ) THEN
         READ( IUN,*,ERR=200,END=100 )  X2, NX, ( A(IA), IA=2,NAUXV )
      ELSE
         READ( IUN,*,ERR=200,END=100 )  X2, NX
      ENDIF
      A(1) = FLOAT( NX )
      IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5)) THEN
         WRITE( IOU,* ) ' ***RD2110 error--NX(1) too large'
         WRITE( IOU,* ) '    MAXX1,NX(1)=', MAXX1, NX
         IERR  = 2
         NDIAG = NDIAG + 1
         RETURN
      ENDIF
C
      IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
         DO 30 I=1,NX
            READ( IUN,*,ERR=202,END=102 )  X1(I), ( V(I,N), N=1,NV )
   30    CONTINUE
      ENDIF
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE   
      IERR = -1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD2110 encountered EOF'
      WRITE( IOU,* ) '    while reading record containing X1(I), I= ', I
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD2110 error reading independent and auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X2=', X2
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *   ' ***RD2010 error while reading record containing X1(I), I= ',I
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD2160 ( X1, CX2, LENX, 
     *                    A, AMISS, CA, NAUXV, NAUXC, 
     *                    V, MAXX1, NX, NV,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C                         
C  Subroutine to read a data record group for FFI=2160.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C       = +2 = error in value of NX.
C
C                
      CHARACTER*(*)  CA( * )
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  CX2
C
      DIMENSION   A( * ), AMISS( * ), V( MAXX1,* )
      DIMENSION   LENX( * ),  X1( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      READ( IUN,FMT=CRFMT,ERR=200,END=100 )  CX2
      IF( NAUXV-NAUXC .GT. 1 ) THEN
         READ( IUN,*,ERR=201,END=101 )  NX, ( A(IA), IA=2,NAUXV-NAUXC )
      ELSE
         READ( IUN,*,ERR=201,END=101 )  NX
      ENDIF
      A(1) = FLOAT( NX )
      IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
         WRITE( IOU,* ) ' ***RD2160 error--NX(1) too large'
         WRITE( IOU,* ) '    MAXX1,NX(1)=', MAXX1, NX
         IERR  = 2
         NDIAG = NDIAG + 1
         RETURN
      ENDIF
      IF( NAUXC .GT. 0 ) THEN
         DO 20 IC=1,NAUXC
            READ( IUN,FMT=CRFMT,ERR=202,END=102 )  CA(IC)
   20    CONTINUE
      ENDIF
      IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
         DO 30 I=1,NX
            READ( IUN,*,ERR=203,END=103 )  X1(I), ( V(I,N), N=1,NV )
   30    CONTINUE
      ENDIF
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE   
      IERR = -1
      RETURN
  101 CONTINUE
      IERR = -1
      WRITE( IOU,* ) 
     *     ' ***RD2160 EOF while reading real auxiliary variables.'
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NAUXV-NAUXC=', NAUXV-NAUXC
      NDIAG = NDIAG + 1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD2160 EOF while reading character'
      WRITE( IOU,* ) '    auxiliary variable number ', NAUXV-NAUXC+IC
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NAUXV, NAUXC=', NAUXV, NAUXC
      NDIAG = NDIAG + 1
      RETURN
  103 CONTINUE
      IERR = -1
      WRITE( IOU,* ) 
     *    ' ***RD2160 EOF while reading record containing X1(I), I= ', I
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD2160 error reading independent variable X2'
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      NDIAG = NDIAG + 1
      RETURN
  201 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD2160 error reading real auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NAUXV-NAUXC=', NAUXV-NAUXC
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD2160 error reading character'
      WRITE( IOU,* ) '    auxiliary variable number ', NAUXV-NAUXC+IC
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NAUXV, NAUXC=', NAUXV, NAUXC
      NDIAG = NDIAG + 1
      RETURN
  203 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *  ' ***RD2160 error while reading record containing X1(I), I= ', I
      WRITE( IOU,* ) '    Last successfully read value of X2 is:'
      WRITE( IOU,* ) '    ',CX2(1:LENX(2))
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD2310 ( X2, A, AMISS, NAUXV, V, X1, MAXX1, NX, NV, DX,
     *                    IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=2310.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C       = +2 = error in value of NX.
C
C  History:
C    91-10-23 (SEG) - Omit defining X1(I) if NX=AMISS(1) or NX=0.
C
C
      DIMENSION   A( * ), AMISS( * ), V( MAXX1,* ), X1( * ), DX( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      READ( IUN,*,ERR=200,END=100 )  X2, NX, ( A(IA), IA=2,NAUXV )
      A(1)  = FLOAT( NX )
      DX(1) = A(3)
      IF( NX .GT. MAXX1 .AND. NX .NE. INT(AMISS(1)+0.5) ) THEN
         WRITE( IOU,* ) ' ***RD2310 error--NX(1) too large'
         WRITE( IOU,* ) '    MAXX1,NX(1)=', MAXX1, NX
         IERR  = 2
         NDIAG = NDIAG + 1
         RETURN
      ENDIF
      IF( NX .GT. 0 .AND. NX .LT. INT(AMISS(1)+0.5) ) THEN
         DO 30 N=1,NV
            READ( IUN,*,ERR=202,END=102 )  ( V(I,N), I=1,NX )
   30    CONTINUE
C
C        Define X1(I). 
C
         DO 40 I=1,NX
            X1(I) = A(2) + A(3) * FLOAT( I-1 )
   40    CONTINUE
      ENDIF
      RETURN
C
C  Flag EOF.
C                  
  100 CONTINUE
      IERR = -1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD2310 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD2310 error reading independent variable X2'
      WRITE( IOU,* ) '    Last successfully read value of X2=', X2
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD2310 error while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,N), N=', N
      WRITE( IOU,* ) '    at independent variable mark X2=', X2
      WRITE( IOU,* ) '    NV, NX(1)=', NV, NX
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD3010 ( X3, A, NAUXV, V, MAXX1, NX, NV, 
     *                    IUN, IOU, ISU, RETDAT, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=3010.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C  If RETDAT=.TRUE. then the primary variable values are written to
C  the scratch file unit ISU.
C
      LOGICAL  RETDAT
C
      DIMENSION  A( * ),  V( MAXX1,* ), NX( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      IF( NAUXV .GT. 0 ) THEN
         READ( IUN,*,ERR=201,END=100 )  X3, ( A(IA), IA=1,NAUXV )
      ELSE
         READ( IUN,*,ERR=200,END=100 )  X3
      ENDIF
      DO 30 N=1,NV
         DO 28 J=1,NX(2)
            READ( IUN,*,ERR=202,END=102 )  ( V(I,1), I=1,NX(1) )
            IF( RETDAT ) THEN
               WRITE( ISU )  ( V(I,1), I=1,NX(1) )
            ENDIF
   28    CONTINUE
   30 CONTINUE
      RETURN
C
C  Flag EOF.     
C
  100 CONTINUE
      IERR = -1
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD3010 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,J,N), J,N=', J, N
      WRITE( IOU,* ) '    at independent variable mark X3=', X3
      WRITE( IOU,* ) '    NX(1), NX(2), NV=', NX(1), NX(2), NV
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD3010 error reading independent variable X3'
      WRITE( IOU,* ) '    Last successfully read value of X3=', X3
      NDIAG = NDIAG + 1
      RETURN
  201 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD3010 error reading independent and auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X3=', X3
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD3010 error while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,J,N), J,N=', J, N
      WRITE( IOU,* ) '    at independent variable mark X3=', X3
      WRITE( IOU,* ) '    NX(1), NX(2), NV=', NX(1), NX(2), NV
      NDIAG = NDIAG + 1
      RETURN
      END
      SUBROUTINE RD4010 ( X4, A, NAUXV, V, MAXX1, 
     *                    NX, NV, IUN, IOU, ISU, RETDAT, NDIAG, IERR )
C
C  Subroutine to read a data record group for FFI=4010.
C  IERR =  0 = successful read.
C       = -1 = EOF encountered.
C       = +1 = read error.
C  If RETDAT=.TRUE. then the primary variable values are written to
C  the scratch file unit ISU.
C
      LOGICAL   RETDAT
C
      DIMENSION  A( * ),  V( MAXX1,* ),  NX( * )
C
      IERR = 0
C
C  Read a group of data records.
C
      IF( NAUXV .GT. 0 ) THEN
         READ( IUN,*,ERR=201,END=100 )  X4, ( A(IA), IA=1,NAUXV )
      ELSE
         READ( IUN,*,ERR=200,END=100 )  X4
      ENDIF
      DO 30 N=1,NV
         DO 28 K=1,NX(3)
            DO 26 J=1,NX(2)
               READ( IUN,*,ERR=202,END=102 )  ( V(I,1), I=1,NX(1) )
               IF( RETDAT ) THEN
                  WRITE( ISU )  ( V(I,1), I=1,NX(1) )
               ENDIF
   26       CONTINUE
   28    CONTINUE
   30 CONTINUE
      RETURN
C
C  Flag EOF.
C
  100 CONTINUE
      IERR = -1  
      RETURN
  102 CONTINUE
      IERR = -1
      WRITE( IOU,* ) ' ***RD4010 encountered EOF while reading values'
      WRITE( IOU,* ) '    of primary variable V(I,J,K,N), J,K,N=', J,K,N
      WRITE( IOU,* ) '    at independent variable mark X4=', X4
      WRITE( IOU,* ) '    NX(1), NX(2), NX(3), NV=',(NX(M),M=1,3), NV
      NDIAG = NDIAG + 1
      RETURN
C
C  Flag read error.
C
  200 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD4010 error reading independent variable X4'
      WRITE( IOU,* ) '    Last successfully read value of X4=', X4
      NDIAG = NDIAG + 1
      RETURN
  201 CONTINUE
      IERR = 1
      WRITE( IOU,* ) 
     *     ' ***RD4010 error reading independent and auxilary variables'
      WRITE( IOU,* ) '    Last successfully read value of X4=', X4
      WRITE( IOU,* ) '    NAUXV=', NAUXV
      NDIAG = NDIAG + 1
      RETURN
  202 CONTINUE
      IERR = 1
      WRITE( IOU,* ) ' ***RD4010 error reading values'
      WRITE( IOU,* ) '    of primary variable V(I,J,K,N), J,K,N=', J,K,N
      WRITE( IOU,* ) '    at independent variable mark X4=', X4
      WRITE( IOU,* ) '    NX(1), NX(2), NX(3), NV=',(NX(M),M=1,3), NV
      NDIAG = NDIAG + 1
      RETURN            
      END        
      SUBROUTINE RDATA ( X1, X2, X3, X4, CX2, LENX, DX, NX,
     *                   A, AMISS, CA, CAMISS, LENA, NAUXV, NAUXC, 
     *                   V, VMISS, MAXX1, NV, NVPM, 
     *                   CDUM, DUM, LINE, NBIDR, NCIDR, NVALS,
     *                   CRFMT, RETDAT, PARSIT,
     *                   IUN, IOU, ISU, NIVM, 
     *                   ISUBV, NDIAG, IERR )
C
C  Subroutine to drive data reading routines and check independent
C  variable values.
C  ISUBV is defined in subroutine RHEAD and used in this routine
C  to determine which routine to call.
C
C  Required routines:   L3RVAL,
C                       PD1001,  PD1010,  PD1020,  
C                       PD2010,  PD2110,  PD2160,  PD2310,
C                       PD3010,  PD4010,
C                       RD1001,  RD1010,  RD1020,  
C                       RD2010,  RD2110,  RD2160,  RD2310,
C                       RD3010,  RD4010,
C                       TCIVM, TSTDX, TMON3, TMONO, TRIVM.
C
C  History:
C  91-10-23 (SEG) Added PARSIT code.
C                 Omit testing of X1 if NX(1)=AMISS(1) or NX(1)=0 for
C                 formats 2110, 2160.
C  91-06-26 (SEG) Improved DX(1) tests for FFI 1020.
C
      PARAMETER  ( MXVAL = 3 )
C
      LOGICAL   PARSIT,  RETDAT
C
      CHARACTER*(*)  CA( * )
      CHARACTER*(*)  CAMISS( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*255  CVAL( MXVAL )
      CHARACTER*(*)  CX2         
      CHARACTER*5    SUBFLG
C
      DIMENSION   A( * ), AMISS( * ), V( MAXX1,* ), VMISS( * )
      DIMENSION   LENA( * ), LENX( * ), X1( * ), X2( * ), X3( * )
      DIMENSION   DX( * ), NX( * )
      DIMENSION   RVAL( MXVAL ), TVAL( 2 )
      DIMENSION   DUM( * )
C
      DATA  NSF     /    5    /
      DATA  SUBFLG  / 'RDATA' /
C
      GO TO ( 1001, 1010, 1020, 
     *        2010, 2110, 2160, 2310, 
     *        3010, 4010 )  ISUBV
      WRITE( IOU,* ) ' ***RDATA error--improper value for ISUBV=',
     *                                                    ISUBV
      NDIAG = NDIAG + 1
      IERR  = 2
      RETURN
 1001 CONTINUE
      IF( PARSIT ) THEN
         CALL PD1001 ( X1, V, VMISS, NV, CDUM, DUM, 
     *                 LINE, NCIDR, NBIDR, NVALS,
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD1001 ( X1, V, NV, IUN, IOU, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X1, DX, RVAL, 'X1', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      RETURN
 1010 CONTINUE
      IF( PARSIT ) THEN
         CALL PD1010 ( X1, A, AMISS, NAUXV, V, VMISS, NV,
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                 IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD1010 ( X1, A, NAUXV, V(1,1), NV, 
     *                 IUN, IOU, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X1, DX, RVAL, 'X1', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      RETURN
 1020 CONTINUE
      IF( PARSIT ) THEN
         CALL PD1020 ( X1, DX, A, AMISS, NAUXV,
     *                 V, VMISS, MAXX1, NVPM, NV,
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                 IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD1020 ( X1, DX, A, NAUXV, V, MAXX1, NVPM, NV, 
     *                 IUN, IOU, NDIAG, IERR )
      ENDIF
      IF( IERR .EQ. 0 ) THEN
         NIVM = NIVM + 1
         CALL L3RVAL ( X1, NIVM, RVAL, XIV0 )
         CALL TMON3 ( RVAL, MIN0(NIVM,3), DX, SUBFLG, NSF, 
     *                'X1', 2, NBAD, IOU )
         NDIAG = NDIAG + NBAD
         TVAL(1) = XIV0
         TVAL(2) = RVAL(MIN0(3,NIVM))
         CALL TSTDX ( TVAL, MIN0(NIVM-1,2), (NIVM-1)*NVPM+1, DX, 
     *                SUBFLG, NSF, 'X1', 2, NDIAG, IOU )
      ENDIF
      RETURN
 2010 CONTINUE
      IF( PARSIT ) THEN
         CALL PD2010 ( X2, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV, 
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                 IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD2010 ( X2, A, NAUXV, V, MAXX1, NX, NV, 
     *                 IUN, IOU, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X2, DX(2), RVAL, 'X2', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      RETURN
 2110 CONTINUE
      IF( PARSIT ) THEN
         CALL PD2110 ( X1, X2, A, AMISS, NAUXV, V, VMISS, MAXX1, 
     *                 NX, NV, CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD2110 ( X1, X2, A, AMISS, NAUXV, V, MAXX1, NX, NV,
     *                 IUN, IOU, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X2, DX(2), RVAL, 'X2', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
         CALL TMONO  ( X1, NX, DX, SUBFLG, NSF, 'X1', 2, NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X1, NX, NX, DX, SUBFLG, NSF, 'X1', 2, NDIAG, IOU )
      ENDIF
      RETURN
 2160 CONTINUE
      IF( PARSIT ) THEN
         CALL PD2160 ( X1, CX2, LENX, 
     *                 A, AMISS, NAUXV, CA, CAMISS, LENA, NAUXC, 
     *                 V, VMISS, MAXX1, NX, NV,
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS,
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD2160 ( X1, CX2, LENX, A, AMISS, CA, NAUXV, NAUXC, 
     *                 V, MAXX1, NX, NV, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ENDIF
      CALL TCIVM  ( CX2, LENX(2), CVAL, 'X2', 2, NIVM,
     *              NDIAG, IOU, IERR )
      IF( NX(1) .GT. 0 .AND. NX(1) .LT. INT(AMISS(1)+0.5) ) THEN
         CALL TMONO  ( X1, NX, DX, SUBFLG, NSF, 'X1', 2, NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X1, NX, NX, DX, SUBFLG, NSF, 'X1', 2, NDIAG, IOU )
      ENDIF
      RETURN
 2310 CONTINUE
      IF( PARSIT ) THEN
         CALL PD2310 ( X2, A, AMISS, NAUXV, V, VMISS, X1, MAXX1, 
     *                 NX, NV, DX,
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                 IUN, IOU, NDIAG, IERR )
      ELSE
         CALL RD2310 ( X2, A, AMISS, NAUXV, V, X1, MAXX1, NX, NV, DX,
     *                 IUN, IOU, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X2, DX(2), RVAL, 'X2', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      RETURN
 3010 CONTINUE
      IF( PARSIT ) THEN
         CALL PD3010 ( X3, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV, 
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                 IUN, IOU, ISU, RETDAT, NDIAG, IERR )
      ELSE
         CALL RD3010 ( X3, A, NAUXV, V, MAXX1, NX, NV, 
     *                 IUN, IOU, ISU, RETDAT, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X3, DX(3), RVAL, 'X3', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      RETURN
 4010 CONTINUE
      IF( PARSIT ) THEN
         CALL PD4010 ( X4, A, AMISS, NAUXV, V, VMISS, MAXX1, NX, NV,
     *                 CDUM, DUM, LINE, NCIDR, NBIDR, NVALS, CRFMT,
     *                 IUN, IOU, ISU, RETDAT, NDIAG, IERR )
      ELSE
         CALL RD4010 ( X4, A, NAUXV, V, MAXX1, 
     *                 NX, NV, IUN, IOU, ISU, RETDAT, NDIAG, IERR )
      ENDIF
      CALL TRIVM  ( X4, DX(4), RVAL, 'X4', 2, NIVM, XIV0, 
     *              NDIAG, IOU, IERR )
      RETURN
      END
      SUBROUTINE RH1001 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXV, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=1010.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,  TIXN.
C
C
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME
C
      DIMENSION   VMISS( * ), VSCAL( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH1001' /
C
C
      IERR = 0
      LINE = 0
      NCIDR= 0
      NBIDR= 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( XNAME, 1, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( RNV, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( RNV + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH1001 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH1001 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END
      SUBROUTINE RH1010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXV, MAXA, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=1010.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,  TIXN.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME
C
      DIMENSION   AMISS( * ), ASCAL( * )
      DIMENSION   VMISS( * ), VSCAL( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH1010' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( XNAME, 1, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH1010 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NAUXV .GT. 0 ) THEN
         CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
         DO 50 NA=1,NAUXV
            IF( ASCAL(NA) .EQ. 0.0 ) THEN
               WRITE(IOU,*) '  **RH1010 error--ASCAL(I)=0, for I=', NA
            ENDIF
   50    CONTINUE
C
         CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
C
         CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH1010 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END        
      SUBROUTINE RH1020 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, NVPM, XNAME, NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXX1, MAXV, MAXA, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=1020.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,  TIXN.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME
C
      DIMENSION   AMISS( * ), ASCAL( * )
      DIMENSION   VMISS( * ), VSCAL( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH1020' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( DX .EQ. 0.0 ) THEN
         WRITE(IOU,*) '  **RH1020 error,  DX=0'
         NDIAG = NDIAG + 1
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NVPM', 4,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NVPM = INT( DUM + 0.5 )
      CALL TIXN ( NVPM, 1, MAXX1, SUBFLG, NSF, 'NVPM', 4,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( XNAME, 1, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH1020 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NAUXV .GT. 0 ) THEN
         CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
         DO 50 NA=1,NAUXV
            IF( ASCAL(NA) .EQ. 0.0 ) THEN
               WRITE(IOU,*) '  **RH1020 error--ASCAL(I)=0, for I=', NA
            ENDIF
   50    CONTINUE
C
         CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
C
         CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH1020 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END        
      SUBROUTINE RH2010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, NX, NXDEF, X1, XNAME, 
     *                    NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXX1, MAXV, MAXA, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=2010.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,
C                       TIXN,   TMONO,   TSTDX.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   AMISS( * ), ASCAL( * ), DX( * )
      DIMENSION   VMISS( * ), VSCAL( * ), X1( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH2010' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 2, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NX = INT( DUM + 0.5 )
      CALL TIXN ( NX, 1, MAXX1, SUBFLG, NSF, 'NX', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NXDEF', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NXDEF = INT( DUM + 0.5 )
      CALL TIXN ( NXDEF, 1, NX, SUBFLG, NSF, 'NXDEF', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF .GT. 1 .AND. NXDEF .LT. NX ) THEN
         WRITE( IOU,* ) ' ***RH2010 error--improper value for NXDEF'
         WRITE( IOU,* ) '    MAXX1,NXDEF,NX(1)=', MAXX1, NXDEF, NX
         IERR = 2
         NDIAG = NDIAG + 1
         RETURN
      ENDIF
C
      CALL PARHD ( X1, NXDEF, NFIND, SUBFLG, NSF, 'X1', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF .GT. 1 ) THEN
         CALL TMONO ( X1, NXDEF, DX, SUBFLG, NSF, 'X1', 2, NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X1, NXDEF, NX, DX, SUBFLG, NSF, 'X1', 2, 
     *                NDIAG, IOU )
      ELSE
         IF( NX .GT. 1 .AND. DX(1) .EQ. 0.0 ) THEN
            WRITE( IOU,* ) '  **RH2010 error--DX(1)=0 and NXDEF<NX'
            WRITE( IOU,* ) '    X1(I) can not be properly defined'
            WRITE( IOU,* ) '    NXDEF, NX =', NXDEF, NX
            NDIAG = NDIAG + 1
         ENDIF
         DO 26 I=2,NX
            X1(I) = X1(1) + FLOAT( I-1 ) * DX(1)
   26    CONTINUE
      ENDIF
C
      CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2010 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NAUXV .GT. 0 ) THEN
         CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
         DO 50 NA=1,NAUXV
            IF( ASCAL(NA) .EQ. 0.0 ) THEN
               WRITE(IOU,*) '  **RH2010 error--ASCAL(I)=0, for I=', NA
            ENDIF
   50    CONTINUE
C
         CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
C
         CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH2010 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END
      SUBROUTINE RH2110 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXV, MAXA, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=2110.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,  TIXN.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   AMISS( * ), ASCAL( * ), DX( * )
      DIMENSION   VMISS( * ), VSCAL( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH2110' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 2, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2110 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 1, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 50 NA=1,NAUXV
         IF( ASCAL(NA) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2110 error--ASCAL(I)=0, for I=', NA
         ENDIF
   50 CONTINUE
C
      CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH2110 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END
      SUBROUTINE RH2160 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, LENX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NAUXC, LENA, CAMISS, DUMLEN,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=2160.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    93-03-11 - Added code to test for NAUXV+NAUXC > MAXA.
C
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,  TIXN.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CAMISS( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   AMISS( * ), ASCAL( * ), LENA( * ), DUMLEN( * )
      DIMENSION   VMISS( * ), VSCAL( * ), LENX( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH2160' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 1, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'LENX(2)', 7,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      LENX(2) = INT( DUM + 0.5 )
      CALL TIXN ( LENX(2), 1, MAXCPL, SUBFLG, NSF, 'LENX(2)', 7,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2160 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 1, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXC', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXC = INT( DUM + 0.5 )
      CALL TIXN ( NAUXC, 0, MAXCA, SUBFLG, NSF, 'NAUXC', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
c      CALL TIXN ( NAUXV+NAUXC, 0, MAXA, SUBFLG, NSF, 'NAUXV+NAUXC', 11,
c     *            IUN, IOU, NDIAG, IERR )
c      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( ASCAL, NAUXV-NAUXC, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 50 NA=1,NAUXV-NAUXC
         IF( ASCAL(NA) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2160 error--ASCAL(I)=0, for I=', NA
         ENDIF
   50 CONTINUE
C
      CALL PARHD ( AMISS, NAUXV-NAUXC, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NAUXC .GT. 0 ) THEN
         CALL PARHD ( DUMLEN, NAUXC, NFIND, SUBFLG, NSF, 'LENA', 4,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
C
         DO 72 IC=1,NAUXC
            LENA(IC) = INT( DUMLEN(IC) + 0.5 )
            IF( LENA(IC) .LT. 1 .OR. LENA(IC) .GT. MAXCPL ) THEN
               WRITE( IOU,* ) ' ***RH2160 error--improper LENA', IC
               WRITE( IOU,* ) '    MAXCPL,LENA(IC)=', MAXCPL, LENA(IC)
               IERR  = 2
               NDIAG = NDIAG + 1
               RETURN
            ENDIF
   72    CONTINUE
C
         CALL RHSTRN ( CAMISS, NAUXC, SUBFLG, NSF, 'CAMISS', 6,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH2160 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END        
      SUBROUTINE RH2310 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXV, MAXA, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=2310.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,  TIXN.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   AMISS( * ), ASCAL( * ), DX( * )
      DIMENSION   VMISS( * ), VSCAL( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH2310' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX(2), 1, NFIND, SUBFLG, NSF, 'DX(2)', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( XNAME, 2, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2310 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 3, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 50 NA=1,NAUXV
         IF( ASCAL(NA) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH2310 error--ASCAL(I)=0, for I=', NA
         ENDIF
   50 CONTINUE
C
      CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH2310 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END        
      SUBROUTINE RH3010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, NX, NXDEF, X1, X2, XNAME, 
     *                    NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXX1, MAXX2, MAXV, MAXA, MAXCOM, CDUM, 
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=3010.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,
C                       TIXN,   TMONO,   TSTDX.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   AMISS( * ), ASCAL( * ), DX( * ), NXDEF( * ), NX( * )
      DIMENSION   VMISS( * ), VSCAL( * ), X1( * ), X2( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH3010' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 3, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, 2, NFIND, SUBFLG, NSF, 'NX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NX(1) = INT( VSCAL(1) + 0.5 )
      NX(2) = INT( VSCAL(2) + 0.5 )
      CALL TIXN ( NX(1), 1, MAXX1, SUBFLG, NSF, 'NX(1)', 5,
     *            IUN, IOU, NDIAG, IER1 )
      CALL TIXN ( NX(2), 1, MAXX2, SUBFLG, NSF, 'NX(2)', 5,
     *            IUN, IOU, NDIAG, IER2 )
      IF( IER1+IER2 .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, 2, NFIND, SUBFLG, NSF, 'NXDEF', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NXDEF(1) = INT( VSCAL(1) + 0.5 )
      NXDEF(2) = INT( VSCAL(2) + 0.5 )
      MAXX = MAXX1
      DO 22 N=1,2
         IF( NXDEF(N) .LT. 1 .OR.  NXDEF(N) .GT. NX(N) .OR.
     *      (NXDEF(N) .GT. 1 .AND. NXDEF(N) .LT. NX(N)) ) THEN
            WRITE( IOU,* ) 
     *           ' ***RH3010 error--improper value for NXDEF',N
            WRITE( IOU,* ) '    MAXX,NXDEF,NX=', MAXX, NXDEF(N), NX(N)
            IERR  = 2
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         MAXX = MAXX2
   22 CONTINUE
C
      CALL PARHD ( X1, NXDEF(1), NFIND, SUBFLG, NSF, 'X1', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF(1) .GT. 1 ) THEN
         CALL TMONO ( X1, NXDEF, DX, SUBFLG, NSF, 'X1', 2, 
     *                NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X1, NXDEF, NX, DX, SUBFLG, NSF, 'X1', 2, 
     *                NDIAG, IOU )
      ELSE
         IF( NX(1) .GT. 1 .AND. DX(1) .EQ. 0.0 ) THEN
            WRITE( IOU,* ) 
     *                    '  **RH3010 error--DX(1)=0 and NXDEF(1)<NX(1)'
            WRITE( IOU,* ) '    X1(I) can not be properly defined'
            WRITE( IOU,* ) '    NXDEF(1),NX(1)= ', NXDEF(1), NX(1)
            NDIAG = NDIAG + 1
         ENDIF
         DO 26 I=2,NX(1)
            X1(I) = X1(1) + FLOAT( I-1 ) * DX(1)
   26    CONTINUE
      ENDIF
C
      CALL PARHD ( X2, NXDEF(2), NFIND, SUBFLG, NSF, 'X2', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF(2) .GT. 1 ) THEN
         CALL TMONO ( X2, NXDEF(2), DX(2), SUBFLG, NSF, 'X2', 2, 
     *                NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X2, NXDEF(2), NX(2), DX(2), SUBFLG, NSF, 'X2', 2, 
     *                NDIAG, IOU )
      ELSE
         IF( NX(2) .GT. 1 .AND. DX(2) .EQ. 0.0 ) THEN
            WRITE( IOU,* ) 
     *                    '  **RH3010 error--DX(2)=0 and NXDEF(2)<NX(2)'
            WRITE( IOU,* ) '    X2(I) can not be properly defined'
            WRITE( IOU,* ) '    NXDEF(2), NX(2)= ', NXDEF(2), NX(2)
            NDIAG = NDIAG + 1
         ENDIF
         DO 28 I=2,NX(2)
            X2(I) = X2(1) + FLOAT( I-1 ) * DX(2)
   28    CONTINUE
      ENDIF
C
      CALL RHSTRN ( XNAME, 3, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH3010 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NAUXV .GT. 0 ) THEN
         CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
         DO 50 NA=1,NAUXV
            IF( ASCAL(NA) .EQ. 0.0 ) THEN
               WRITE(IOU,*) '  **RH3010 error--ASCAL(I)=0, for I=', NA
            ENDIF
   50    CONTINUE
C
         CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
C
         CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH3010 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END        
      SUBROUTINE RH4010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    DX, NX, NXDEF, X1, X2, X3, XNAME, 
     *                    NV, VSCAL, VMISS, VNAME,
     *                    NAUXV, ASCAL, AMISS, ANAME,
     *                    NSCOML, SCOM, NNCOML, NCOM, 
     *                    MAXX1, MAXX2, MAXX3, MAXV, MAXA, MAXCOM, CDUM,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read file header for FFI=4010.
C  IERR =  0 = successful read.
C       = <0 = EOF encountered.
C       = >0 = read error.
C
C  History:
C    91-12-17 - Replaced RHINT, RHMISS, RHSCAL routines with PARHD
C               and TIXN routines, to `parse' numeric values in the
C               file header records.
C
C  Required routines:   PARHD,  RHBGIN,  RHSTRN,
C                       TIXN,   TMONO,   TSTDX.
C
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*6    SUBFLG
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   AMISS( * ), ASCAL( * ), DX( * ), NXDEF( * ), NX( * )
      DIMENSION   VMISS( * ), VSCAL( * ), X1( * ), X2( * ), X3( * )
C
      DATA  NSF     /    6     /
      DATA  SUBFLG  / 'RH4010' /
C
C
      IERR = 0
      LINE = 0
      NCIDR = 0
      NBIDR = 0
C
      CALL RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *              IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *              LINE, SUBFLG, NSF, CDUM, CRFMT, 
     *              IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DX, 4, NFIND, SUBFLG, NSF, 'DX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, 3, NFIND, SUBFLG, NSF, 'NX', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NX(1) = INT( VSCAL(1) + 0.5 )
      NX(2) = INT( VSCAL(2) + 0.5 )
      NX(3) = INT( VSCAL(3) + 0.5 )
      CALL TIXN ( NX(1), 1, MAXX1, SUBFLG, NSF, 'NX(1)', 5,
     *            IUN, IOU, NDIAG, IER1 )
      CALL TIXN ( NX(2), 1, MAXX2, SUBFLG, NSF, 'NX(2)', 5,
     *            IUN, IOU, NDIAG, IER2 )
      CALL TIXN ( NX(3), 1, MAXX3, SUBFLG, NSF, 'NX(3)', 5,
     *            IUN, IOU, NDIAG, IER3 )
      IF( IER1+IER2+IER3 .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, 3, NFIND, SUBFLG, NSF, 'NXDEF', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NXDEF(1) = INT( VSCAL(1) + 0.5 )
      NXDEF(2) = INT( VSCAL(2) + 0.5 )
      NXDEF(3) = INT( VSCAL(3) + 0.5 )
      MAXX = MAXX1
      DO 22 N=1,3
         IF( N .EQ. 2 ) THEN
            MAXX = MAXX2
         ELSE IF( N .EQ. 3 ) THEN
            MAXX = MAXX3
         ENDIF
         IF( NXDEF(N) .LT. 1 .OR.  NXDEF(N) .GT. NX(N) .OR.
     *      (NXDEF(N) .GT. 1 .AND. NXDEF(N) .LT. NX(N)) ) THEN
            WRITE( IOU,* ) 
     *           ' ***RH4010 error--improper value for NXDEF',N
            WRITE( IOU,* ) '    MAXX,NXDEF,NX=', MAXX, NXDEF(N), NX(N)
            IERR  = 2
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
   22 CONTINUE
C
      CALL PARHD ( X1, NXDEF(1), NFIND, SUBFLG, NSF, 'X1', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF(1) .GT. 1 ) THEN
         CALL TMONO ( X1, NXDEF(1), DX(1), SUBFLG, NSF, 'X1', 2, 
     *                NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X1, NXDEF(1), NX, DX, SUBFLG, NSF, 'X1', 2, 
     *                NDIAG, IOU )
      ELSE
         IF( NX(1) .GT. 1 .AND. DX(1) .EQ. 0.0 ) THEN
            WRITE( IOU,* ) 
     *                    '  **RH4010 error--DX(1)=0 and NXDEF(1)<NX(1)'
            WRITE( IOU,* ) '    X1(I) can not be properly defined'
            WRITE( IOU,* ) '    NXDEF(1), NX(1)= ', NXDEF(1), NX(1)
            NDIAG = NDIAG + 1
         ENDIF
         DO 26 I=2,NX(1)
            X1(I) = X1(1) + FLOAT( I-1 ) * DX(1)
   26    CONTINUE
      ENDIF
C
      CALL PARHD ( X2, NXDEF(2), NFIND, SUBFLG, NSF, 'X2', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF(2) .GT. 1 ) THEN
         CALL TMONO ( X2, NXDEF(2), DX(2), SUBFLG, NSF, 'X2', 2, 
     *                NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X2, NXDEF(2), NX(2), DX(2), SUBFLG, NSF, 'X2', 2, 
     *                NDIAG, IOU )
      ELSE
         IF( NX(2) .GT. 1 .AND. DX(2) .EQ. 0.0 ) THEN
            WRITE( IOU,* ) 
     *                    '  **RH4010 error--DX(2)=0 and NXDEF(2)<NX(2)'
            WRITE( IOU,* ) '    X2(I) can not be properly defined'
            WRITE( IOU,* ) '    NXDEF(2), NX(2)= ', NXDEF(2), NX(2)
            NDIAG = NDIAG + 1
         ENDIF
         DO 28 I=2,NX(2)
            X2(I) = X2(1) + FLOAT( I-1 ) * DX(2)
   28    CONTINUE
      ENDIF
C
      CALL PARHD ( X3, NXDEF(3), NFIND, SUBFLG, NSF, 'X3', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IF( NXDEF(3) .GT. 1 ) THEN
         CALL TMONO ( X3, NXDEF(3), DX(3), SUBFLG, NSF, 'X3', 2, 
     *                NBAD, IOU )
         NDIAG = NDIAG + NBAD
         CALL TSTDX ( X3, NXDEF(3), NX(3), DX(3), SUBFLG, NSF, 'X3', 2, 
     *                NDIAG, IOU )
      ELSE
         IF( NX(3) .GT. 1 .AND. DX(3) .EQ. 0.0 ) THEN
            WRITE( IOU,* ) 
     *                    '  **RH4010 error--DX(3)=0 and NXDEF(3)<NX(3)'
            WRITE( IOU,* ) '    X3(I) can not be properly defined'
            WRITE( IOU,* ) '    NXDEF(3), NX(3)= ', NXDEF(3), NX(3)
            NDIAG = NDIAG + 1
         ENDIF
         DO 30 I=2,NX(3)
            X3(I) = X3(1) + FLOAT( I-1 ) * DX(3)
   30    CONTINUE
      ENDIF
C
      CALL RHSTRN ( XNAME, 4, SUBFLG, NSF, 'XNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NV', 2,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NV = INT( DUM + 0.5 )
      CALL TIXN ( NV, 1, MAXV, SUBFLG, NSF, 'NV', 2,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( VSCAL, NV, NFIND, SUBFLG, NSF, 'VSCAL', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      DO 40 N=1,NV
         IF( VSCAL(N) .EQ. 0.0 ) THEN
            WRITE(IOU,*) '  **RH4010 error--VSCAL(N)=0, for N=', N
         ENDIF
   40 CONTINUE
C
      CALL PARHD ( VMISS, NV, NFIND, SUBFLG, NSF, 'VMISS', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( VNAME, NV, SUBFLG, NSF, 'VNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NAUXV', 5,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NAUXV = INT( DUM + 0.5 )
      CALL TIXN ( NAUXV, 0, MAXA, SUBFLG, NSF, 'NAUXV', 5,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NAUXV .GT. 0 ) THEN
         CALL PARHD ( ASCAL, NAUXV, NFIND, SUBFLG, NSF, 'ASCAL', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
         DO 50 NA=1,NAUXV
            IF( ASCAL(NA) .EQ. 0.0 ) THEN
               WRITE(IOU,*) '  **RH4010 error--ASCAL(I)=0, for I=', NA
            ENDIF
   50    CONTINUE
C
         CALL PARHD ( AMISS, NAUXV, NFIND, SUBFLG, NSF, 'AMISS', 5,
     *                LINE, NREAD, CDUM, NCIDR, NBIDR,
     *                CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
C
         CALL RHSTRN ( ANAME, NAUXV, SUBFLG, NSF, 'ANAME', 5,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C          
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NSCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NSCOML = INT( DUM + 0.5 )
      CALL TIXN ( NSCOML, 0, MAXCOM, SUBFLG, NSF, 'NSCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NSCOML .GT. 0 ) THEN
         CALL RHSTRN ( SCOM, NSCOML, SUBFLG, NSF, 'SCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      CALL PARHD ( DUM, 1, NFIND, SUBFLG, NSF, 'NNCOML', 6,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NNCOML = INT( DUM + 0.5 )
      CALL TIXN ( NNCOML, 0, MAXCOM, SUBFLG, NSF, 'NNCOML', 6,
     *            IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      IF( NNCOML .GT. 0 ) THEN
         CALL RHSTRN ( NCOM, NNCOML, SUBFLG, NSF, 'NCOM', 4,
     *                 LINE, CRFMT, IUN, IOU, NDIAG, IERR )
         IF( IERR .NE. 0 )  RETURN
      ENDIF
C
      IF( LINE .NE. NLHEAD ) THEN
         WRITE(IOU,*) '  **RH4010 thinks NLHEAD may be in error'
         WRITE(IOU,*) '    NLHEAD,LINE=', NLHEAD, LINE
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END        
      SUBROUTINE RHBGIN ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME,
     *                    IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                    LINE, SUBFLG, NSF, CDUM,
     *                    CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read and return the first seven lines from file headers.
C
C  History:
C    91-12-17 - Modified to use PARHD to read numeric values, and
C               TIXN to test and diagnose them.
C
C
C  Required routines:   PARHD,  RHSTRN,  TIXN.
C
      CHARACTER*(*)   CDUM
      CHARACTER*(*)   CRFMT
      CHARACTER*(*)   MNAME
      CHARACTER*(*)   ONAME
      CHARACTER*(*)   ORG
      CHARACTER*(*)   SNAME
      CHARACTER*(*)   SUBFLG
C
      DIMENSION   DUM( 10 )
C
      NCIDR = 0
      NBIDR = 0
      CALL PARHD ( DUM, 2, NFIND, 'RHBGIN', 6, 'NLHEAD,FFI', 10,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      NLHEAD = INT( DUM(1) + 0.5 )
      IFFI   = INT( DUM(2) + 0.5 )
C
      CALL RHSTRN ( ONAME, 1, 'RHBGIN', 6, 'ONAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( ORG, 1, 'RHBGIN', 6, 'ORG', 3,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( SNAME, 1, 'RHBGIN', 6, 'SNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL RHSTRN ( MNAME, 1, 'RHBGIN', 6, 'MNAME', 5,
     *              LINE, CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 2, NFIND, 'RHBGIN', 6, 'IVOL,NVOL', 9,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IVOL = INT( DUM(1) + 0.5 )
      NVOL = INT( DUM(2) + 0.5 )
      CALL TIXN ( NVOL, 1, 9, 'RHBGIN', 6, 'NVOL', 4,
     *            IUN, IOU, NDIAG, IER1 )
      CALL TIXN ( IVOL, 1, NVOL, 'RHBGIN', 6, 'IVOL', 4,
     *            IUN, IOU, NDIAG, IER2 )
      IF( IER1+IER2 .NE. 0 )  RETURN
C
      CALL PARHD ( DUM, 6, NFIND, 'RHBGIN', 6, 'DATE,RDATE', 10,
     *             LINE, NREAD, CDUM, NCIDR, NBIDR,
     *             CRFMT, IUN, IOU, NDIAG, IERR )
      IF( IERR .NE. 0 )  RETURN
      IYR  = INT( DUM(1) + 0.5 )
      IMO  = INT( DUM(2) + 0.5 )
      IDY  = INT( DUM(3) + 0.5 )
      IRYR = INT( DUM(4) + 0.5 )
      IRMO = INT( DUM(5) + 0.5 )
      IRDY = INT( DUM(6) + 0.5 )
      IDATE  =  IYR * 10000 +  IMO * 100 +  IDY
      IRDATE = IRYR * 10000 + IRMO * 100 + IRDY
      IF( IDATE .GT. IRDATE .OR. IDATE .LT. 19000000 ) THEN
         WRITE( IOU,* ) '  **RHBGIN error--improper DATE, RDATE'
         WRITE( IOU,* ) '    RHBGIN called by ',SUBFLG(1:NSF)
         IF( IDATE .GT. IRDATE ) WRITE(IOU,*) '    RDATE .LT. DATE'
         WRITE( IOU,* ) '     IYR, IMO, IDY=',  IYR,  IMO,  IDY
         WRITE( IOU,* ) '    IRYR,IRMO,IRDY=', IRYR, IRMO, IRDY
         NDIAG = NDIAG + 1
      ENDIF
      RETURN
      END
      SUBROUTINE RHEAD ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                   IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                   DX, NX, NXDEF, LENX, XNAME, X1, X2, X3,
     *                   NV, NVPM, VSCAL, VMISS, VNAME,
     *                   NAUXV, ASCAL, AMISS, ANAME,
     *                   NAUXC, LENA, CAMISS, 
     *                   NSCOML, SCOM, NNCOML, NCOM, 
     *                   MAXX1, MAXX2, MAXX3,
     *                   MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM, 
     *                   MNAME0, CRFMT, IUN, IOU, ISUBV, NDIAG, IERR,
     *                   DBHEAD )
C  History:
C   96-02-29 (JDW)
C   Modified to skip over database header if DBHEAD = .TRUE.
C
C  Subroutine to drive file header reading routines.
C  ISUBV is defined in this routine and used in subroutine RDATA
C  to determine which data reading routine to call.
C
C  Required routines:   LASTNB,
C                       RH1001,  RH1010,  RH1020,
C                       RH2010,  RH2110,  RH2160,  RH2310,
C                       RH3010,  RH4010.
C
      CHARACTER*(*)  ANAME( * )
      CHARACTER*(*)  CAMISS( * )
      CHARACTER*(*)  CDUM
      CHARACTER*(*)  CRFMT
      CHARACTER*(*)  MNAME
      CHARACTER*(*)  MNAME0
      CHARACTER*(*)  NCOM( * )
      CHARACTER*(*)  ONAME
      CHARACTER*(*)  ORG
      CHARACTER*(*)  SCOM( * )
      CHARACTER*(*)  SNAME
      CHARACTER*(*)  VNAME( * )
      CHARACTER*(*)  XNAME( * )
C
      DIMENSION   DX( * ), NX( * ), NXDEF( * )
      DIMENSION   X1( * ), X2( * ), X3( * )
      DIMENSION   AMISS( * ), ASCAL( * ), LENA( * )
      DIMENSION   VMISS( * ), VSCAL( * ), LENX( * )
C
      LOGICAL DBHEAD
C
C  Initialize some variables that may otherwise cause problems
C  in the kluges at the end of this routine.
C
      NAUXV = 0
      NAUXC = 0
C
C  Obtain FFI.
C
      IF (DBHEAD) READ (IUN,*)
      READ( IUN,*,IOSTAT=IERR )  NLHEAD, JFFI
      IF( IERR .NE. 0 ) THEN
         WRITE( IOU,* ) ' ***RHEAD error reading FFI'
         NDIAG = NDIAG + 1
         RETURN
      ENDIF
      REWIND IUN
      IF (DBHEAD) READ (IUN,*)
      IF( JFFI .EQ. 1001 ) THEN
         ISUBV = 1
         CALL RH1001 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXV, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 1010 ) THEN
         ISUBV = 2
         CALL RH1010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 1020 ) THEN
         ISUBV = 3
         CALL RH1020 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, NVPM, XNAME, NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXX1, MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 2010 ) THEN
         ISUBV = 4
         CALL RH2010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, NX, NXDEF, X1, XNAME, 
     *                 NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXX1, MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 2110 ) THEN
         ISUBV = 5
         CALL RH2110 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 2160 ) THEN
         ISUBV = 6
         CALL RH2160 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, LENX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NAUXC, LENA, CAMISS, X1,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXV, MAXA, MAXCA, MAXCOM, MAXCPL, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 2310 ) THEN
         ISUBV = 7
         CALL RH2310 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, XNAME, NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 3010 ) THEN
         ISUBV = 8
         CALL RH3010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, NX, NXDEF, X1, X2, XNAME, 
     *                 NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXX1, MAXX2, MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE IF ( JFFI .EQ. 4010 ) THEN
         ISUBV = 9
         CALL RH4010 ( NLHEAD, IFFI, ONAME, ORG, SNAME, MNAME, 
     *                 IVOL, NVOL, IYR, IMO, IDY, IRYR, IRMO, IRDY,
     *                 DX, NX, NXDEF, X1, X2, X3, XNAME, 
     *                 NV, VSCAL, VMISS, VNAME,
     *                 NAUXV, ASCAL, AMISS, ANAME,
     *                 NSCOML, SCOM, NNCOML, NCOM, 
     *                 MAXX1, MAXX2, MAXX3, MAXV, MAXA, MAXCOM, CDUM, 
     *                 CRFMT, IUN, IOU, NDIAG, IERR )
      ELSE
         WRITE( IOU,* ) ' ***RHEAD error--unknown value for FFI=', JFFI
         NDIAG = NDIAG + 1
         IERR  = 2
         RETURN
      ENDIF
      IF( IERR .NE. 0 )  RETURN
C
C  Test for proper mission name.
C
c      CALL LASTNB  ( MNAME0, LEN(MNAME0), L0 )
c      IFOUND = INDEX( MNAME, MNAME0(1:L0) )
c      IF( IFOUND .LT. 1 ) THEN
c         CALL LASTNB  ( MNAME, LEN(MNAME), L )
c         WRITE( IOU,* ) '  **RHEAD error--improper mission name'
c         WRITE( IOU,* ) '    MNAME0=',MNAME0(1:L0)
c         WRITE( IOU,* ) '    MNAME =',MNAME(1:L)
c         NDIAG = NDIAG + 1
c      ELSE
c         CALL FRSTNB  ( MNAME, LEN(MNAME), L1 )
c         CALL LASTNB  ( MNAME, LEN(MNAME), L2 )
c         IF( L1 .NE. IFOUND ) THEN
c            WRITE( IOU,* ) '  **RHEAD error--improper mission name'
c            WRITE( IOU,* ) '    MNAME0=',MNAME0(1:L0)
c            WRITE( IOU,* ) '    MNAME =',MNAME(1:L2)
c            WRITE( IOU,* ) 
c     *      '    MNAME0 must be first non-blank character'
c            NDIAG = NDIAG + 1
c         ENDIF
c      ENDIF 
C
C  This is kluged test for improper missing values.
C  It would be better to test each data value to ensure it is .LE. the
C  appropriate missing value, but this kluge is less time consuming.
C
      DO 70 N=1,NV
         IF( VMISS(N) .LT. 0.0 ) THEN
            WRITE( IOU,* ) 
     *           '  **RHEAD error--improper VMISS value'
            WRITE( IOU,* )
     *           '    N, VMISS(N) = ', N, VMISS(N)
            WRITE( IOU,* ) 
     *           '    VMISS should be larger than "good" data values'
            NDIAG = NDIAG + 1
         ENDIF
   70 CONTINUE
      IF( NAUXV-NAUXC .GT. 0 ) THEN
         DO 72 IA=1,NAUXV-NAUXC
            IF( AMISS(IA) .LT. 0.0 ) THEN
               WRITE( IOU,* ) 
     *           '  **RHEAD error--improper AMISS value'
               WRITE( IOU,* )
     *           '    IA, AMISS(IA) = ', IA, AMISS(IA)
               WRITE( IOU,* ) 
     *           '    AMISS should be larger than "good" data values'
               NDIAG = NDIAG + 1
            ENDIF
   72    CONTINUE
      ENDIF
      RETURN
      END
      SUBROUTINE RHSTRN ( VNAME, NV, SUBFLG, NSF, VALFLG, NVF,
     *                    LINE, CRFMT, IUN, IOU, NDIAG, IERR )
C
C  Subroutine to read character string records.
C
C
      CHARACTER*(*)   CRFMT
      CHARACTER*(*)   SUBFLG
      CHARACTER*(*)   VALFLG
      CHARACTER*(*)   VNAME( * )
C
C
      DO 50 N=1,NV
         READ( IUN,FMT=CRFMT,IOSTAT=IERR )  VNAME(N)
         IF( IERR .NE. 0 ) THEN
            WRITE( IOU,* ) 
     *  ' ***RHSTRN error reading ',VALFLG(1:NVF),' at line ', LINE+1
            WRITE( IOU,* ) '    RHSTRN called by ',SUBFLG(1:NSF)
            NDIAG = NDIAG + 1
            RETURN
         ENDIF
         LINE = LINE + 1
   50 CONTINUE
      RETURN
      END        
      SUBROUTINE TCIVM ( CX, LENX, CVAL, VALFLG, NVF, NIVM,
     *                   NDIAG, IOU, IERR )
C
C  Subroutine to test character independent variable marks to see if 
C  they are monotonic.
C
C  Required routines:   L3CVAL,  TMONC.
C
      CHARACTER*(*)  CVAL( * )
      CHARACTER*(*)  CX
      CHARACTER*5    SUBFLG
      CHARACTER*(*)  VALFLG
C
      DATA  NSF     /    5    /
      DATA  SUBFLG  / 'TCIVM' /
C             
      IF( IERR .EQ. 0 ) THEN
         NIVM = NIVM + 1
         CALL L3CVAL ( CX, LENX, NIVM, CVAL )
         CALL TMONC  ( CVAL, LENX, NIVM, SUBFLG, NSF, VALFLG, NVF, 
     *                 NBAD, IOU )
         NDIAG = NDIAG + NBAD
      ENDIF
      RETURN
      END        
      SUBROUTINE TIXN ( N, NMIN, NMAX, SUBFLG, NSF, VALFLG, NVF,
     *                  IUN, IOU, NDIAG, IERR )
C
C  Subroutine to test range of integer value and print diagnostics.
C
      CHARACTER*(*)  SUBFLG
      CHARACTER*(*)  VALFLG
C
      IERR = 0
      IF( N .LT. NMIN .OR. N .GT. NMAX ) THEN
         WRITE(IOU,*) 
     *             ' ***TIXN error--improper value for ',VALFLG(1:NVF)
         WRITE(IOU,*) '    TIXN called by ',SUBFLG(1:NSF)
         WRITE(IOU,*) 
     *        '    ',VALFLG(1:NVF),'MIN,',VALFLG(1:NVF),'MAX=', 
     *               NMIN, NMAX
         WRITE(IOU,*) '    ',VALFLG(1:NVF),'=', N
         IERR = 2
         NDIAG = NDIAG + 1
         RETURN
      ENDIF
      RETURN                    
      END
      SUBROUTINE TMON3 ( X, N, DX, SUBFLG, NSF, VALFLG, NVF, NBAD, IOU )
C
C  Subroutine to test vector X, maximum length of three, to see if 
C  it is monotonically increasing or decreasing.
C
C     Required routines:    None.
C
C  History:
C    940803 (SEG) - Added loop to test each X.
C
C
      CHARACTER*(*)  SUBFLG
      CHARACTER*(*)  VALFLG
C
      DIMENSION    X( * )
C
      NBAD = 0
      IF( N .GT. 2 ) THEN
         IF( DX .EQ. 0.0 ) THEN
            DD = X(3) - X(1)
         ELSE
            DD = DX
         ENDIF
         J = 3
      ELSE IF( N .EQ. 2 ) THEN
         IF( DX .NE. 0.0 ) THEN
            DD = DX
            J  = 2
         ELSE
            RETURN
         ENDIF
      ELSE
         RETURN
      ENDIF
      DO 20 I=2,J
         IF( SIGN(1.0,DD)*(X(I)-X(I-1)) .LE. 0.0 ) THEN
            WRITE( IOU,* ) 
     *           '  **TMON3 error--',VALFLG(1:NVF),' not monotonic'
            WRITE( IOU,* ) '    TMON3 called by ',SUBFLG(1:NSF)
            WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I-1)=', X(I-1)
            WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I)  =', X(I)
            NBAD = NBAD + 1
         ENDIF
 20   CONTINUE
      RETURN
      END
      SUBROUTINE TMONC ( X, LX, N, SUBFLG, NSF, VALFLG, NVF, 
     *                   NBAD, IOU )
C
C  Subroutine to test vector X, maximum length of three, to see if 
C  it is monotonically increasing or decreasing.
C
C     Required routines:    None.
C
      CHARACTER*(*)  SUBFLG
      CHARACTER*(*)  VALFLG
      CHARACTER*(*)  X( * )
C                     
      NBAD = 0
      IF( N .LT. 3 )  RETURN
      IF( X(2)(1:LX) .GT. X(1)(1:LX) .AND. 
     *    X(3)(1:LX) .GT. X(2)(1:LX) )  RETURN
      IF( X(2)(1:LX) .LT. X(1)(1:LX) .AND. 
     *    X(3)(1:LX) .LT. X(2)(1:LX) )  RETURN
      WRITE( IOU,* ) 
     *           '  **TMONC error--',VALFLG(1:NVF),' not monotonic'
      WRITE( IOU,* ) '    TMONC called by ',SUBFLG(1:NSF)
      WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I-2)= ',X(1)(1:LX)
      WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I-1)= ',X(2)(1:LX)
      WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I)  = ',X(3)(1:LX)
      NBAD = NBAD + 1
      RETURN
      END
      SUBROUTINE TMONO ( X, N, DX, SUBFLG, NSF, VALFLG, NVF, NBAD, IOU )
C
C  Subroutine to test vector X to see if it is monotonically
C  increasing or decreasing.
C
C     Required routines:    None.
C
      CHARACTER*(*)  SUBFLG
      CHARACTER*(*)  VALFLG
C
      DIMENSION    X( * )
C
      NBAD = 0
      IF( N .LT. 2 )  RETURN
      IF( DX .EQ. 0.0 ) THEN
         DD = X(N) - X(1)
      ELSE
         DD = DX
      ENDIF
      DO 20 I=2,N
         IF( SIGN(1.0,DD)*(X(I)-X(I-1)) .LE. 0.0 ) THEN
            WRITE( IOU,* ) 
     *           '  **TMONO error--',VALFLG(1:NVF),' not monotonic'
            WRITE( IOU,* ) '    TMONO called by ',SUBFLG(1:NSF)
            WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I-1)=', X(I-1)
            WRITE( IOU,* ) '    ',VALFLG(1:NVF),'(I)  =', X(I)
            NBAD = NBAD + 1
         ENDIF                  
   20 CONTINUE
      RETURN
      END
      SUBROUTINE TRIVM ( X, DX, RVAL, VALFLG, NVF, NIVM, XIV0, 
     *                   NDIAG, IOU, IERR )
C
C  Subroutine to test real independent variable marks to see if they are
C  monotonic and if they are recorded at the proper interval.
C
C  Required routines:   L3RVAL,   TSTDX,   TMON3.
C
C  History:
C  91-06-26 (SEG) Improved DX tests.
C
      CHARACTER*5    SUBFLG
      CHARACTER*(*)  VALFLG
C
      DIMENSION   RVAL( * ),  TVAL( 2 )
C                                 
      DATA  NSF     /    5    /
      DATA  SUBFLG  / 'TRIVM' /
C
      IF( IERR .EQ. 0 ) THEN
         NIVM = NIVM + 1
         CALL L3RVAL ( X, NIVM, RVAL, XIV0 )
         CALL TMON3  ( RVAL, MIN0(NIVM,3), DX, SUBFLG, NSF, 
     *                 VALFLG, NVF, NBAD, IOU )
         NDIAG = NDIAG + NBAD
      ENDIF
      TVAL(1) = XIV0
      TVAL(2) = RVAL(MIN0(3,NIVM))
      CALL TSTDX ( TVAL, MIN0(NIVM-1,2), NIVM, DX, SUBFLG, NSF, 
     *             VALFLG, NVF, NDIAG, IOU )
      RETURN
      END
      SUBROUTINE TSTDX ( X, NXP, NX, DX, SUBFLG, NSF, VALFLG, NVF, 
     *                   NDIAG, IOU )
C
C  Subroutine to test vector X to see if its values are uniformly 
C  spaced.
C  NXP is the number of values of X passed to this routine (could be 
C  just the first and last value), whereas NX is the actual
C  number of defined values of X.
C  This routine only tests to see if  NX = ( X(NX) - X(1) ) / DX + 1 
C  so that the index of a particular X(I) can be calculated as
C  I = ( X(I) - X(1) ) / DX + 1
C  where I is evaluated as the nearest integer to the term on the rhs.
C
C     Required routines:    None.
C
C  History:
C  91-06-26 (SEG) Modified DX tests to loop over NXP-1 values of X, and
C           only test for ICAL=I.
C
      CHARACTER*(*)  SUBFLG
      CHARACTER*(*)  VALFLG
C
      DIMENSION    X( * )
C
C
      IF( NXP .LT. 2 .OR. DX .EQ. 0.0 )  RETURN
      IF( NXP .EQ. 2 ) THEN
         NCAL = INT( (X(NXP)-X(1))/DX + 0.5 ) + 1
         IF( NCAL .NE. NX ) THEN
            WRITE( IOU,* ) 
     *       '  **TSTDX error--Non-uniform ',VALFLG(1:NVF),' interval'
            WRITE( IOU,* ) '    TSTDX called by ',SUBFLG(1:NSF)
            WRITE( IOU,* ) '    NCAL,NX=', NCAL, NX
            WRITE( IOU,* ) '    X(1),X(NX),DX=', X(1),X(NXP),DX
            NDIAG = NDIAG + 1
         ENDIF
      ELSE
         DO 40 I=2,NXP
            ICAL = INT( (X(I)-X(1))/DX + 0.5 ) + 1
            IF( ICAL .NE. I ) THEN
               WRITE( IOU,* ) 
     *       '  **TSTDX error--Non-uniform ',VALFLG(1:NVF),' interval'
               WRITE( IOU,* ) '    TSTDX called by ',SUBFLG(1:NSF)
               WRITE( IOU,* ) '    ICAL,I=', ICAL, I
               WRITE( IOU,* ) '    NXP,NX=', NXP, NX
               WRITE( IOU,* ) '    X(1),X(I),DX=', X(1),X(I),DX
               NDIAG = NDIAG + 1
            ENDIF
   40    CONTINUE
      ENDIF
      RETURN  
      END