      SUBROUTINE DPRCSN(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX SCRIPT NUMERIC.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRCSN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.9)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCSN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.10)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCSN2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRCSN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCSU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX SCRIPT UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRCSU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.6)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCSU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(7.LE.ICHARN.AND.ICHARN.LE.13)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCSU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(14.LE.ICHARN.AND.ICHARN.LE.20)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRCSU3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IF(ICHARN.GE.21)GOTO1040
      GOTO1049
 1040 CONTINUE
      CALL DRCSU4(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1049 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRCSU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRCU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN COMPLEX UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.14)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRCU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.15)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRCU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRCU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRDL(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN DUPLEX LOWER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRDL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.11)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRDL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(12.LE.ICHARN.AND.ICHARN.LE.24)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRDL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(ICHARN.GE.25)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRDL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRDL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRDN(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN DUPLEX NUMERIC.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRDN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.8)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRDN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.9)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRDN2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRDN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRDS(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN DUPLEX SYMBOLS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MARCH     1987.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRDS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHSY(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.9)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRDS1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.10)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRDS2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRDS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRDU(ICHAR2,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE AND SET THE HERSHEY CHARACTER SET COORDINATES
C              FOR ROMAN DUPLEX UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
C
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRDU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.14)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRDU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.15)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRDU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRDU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,IFOUND,IERROR
 9012 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,ICHARN
 9013 FORMAT('ICHAR2,ICHARN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ISTART,ISTOP,NC,NUMCO
 9014 FORMAT('ISTART,ISTOP,NC,NUMCO = ',4I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMCO.GE.1.AND.NUMCO.LE.1000)GOTO9019
      DO9015I=1,NUMCO
      WRITE(ICOUT,9016)I,IOP(I),X(I),Y(I)
 9016 FORMAT('I,IOP(I),X(I),Y(I) = ',I8,2X,A4,2F10.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9019 CONTINUE
      WRITE(ICOUT,9021)IXMINS,IXMAXS,IXDELS
 9021 FORMAT('IXMINS,IXMAXS,IXDELS = ',3I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPREAD(IFROW1,IFROW2,IFCOL1,IFCOL2,ISKIP,INTINF,
CCCCC MARCH 1996.  ADD IMALEV TO ARGUMENT LIST
     1IMACRO,IMACNU,IMACCS,IMALEV,IOSW,ICREAF,NCREAF,
     1IREARW,
     1ICOMCH,ICOMSW,
CCCCC APRIL 1995.  ADD FOLLOWING LINE
     1IUNFOF,IUNFNR,IUNFMC,
CCCCC FEBRUARY 2003.  ADD FOLLOWING LINE
     1NUMRCM,
     1IFCOLL,IFCOLU,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
CCCCC ICOMCH, ICOMSW ARGUMENTS ADDED MAY 1990.
C
C     PURPOSE--READ IN THE VALUES OF A VARIABLE.
C              THE DATA IS LISTED ACROSS
C              A LINE IMAGE.
C              (E.G., X(1) Y(1) Z(1) ETC.)
C              THE DATA IS READ FORM A MASS STORAGE FILE
C              OR (IF NO FILE GIVEN) FROM THE DEFAULT INPUT UNIT
C              (WHICH WILL BE THE TERMINAL).
C     ASSUMPTION--THE INPUT  FILE ALREADY EXISTS;
C                 (THAT IS, DATAPLOT WILL AUTOMATICALLY
C                 OPEN THE FILE
C                 VIA (ON THE UNIVAC 1108), BY AN @ASG,AX ...)
C                 BUT WILL NOT AUTOMATICALLY CREATE THE FILE
C                 VIA (ON THE UNIVAC 1108), BY AN @ASG,UP ...))
C     ASSUMPTION--THE COMPUTER SYSTEM IS SUCH THAT
C                 EQUATING THE FILE NAME TO
C                 THE FORTRAN NUMERIC DESIGNATION
C                 OF 31 (OR HOWEVER THE VARIABLE    IREANU    IS DEFINED
C                 IN INITFO) IS PERMISSIBLE.
C     NOTE--INPUT FOR THE READ COMMAND MAY POTENTIALLY
C           COME FROM 2 DIFFERENT SOURCES--
C                1) THE TERMINAL ITSELF;
C                2) A FILE;
C           DIFFERENT SYSTEMS ALLOW DIFFERENT COMBINATIONS
C           OF THE ABOVE.
C           ALL SYSTEMS WILL ALLOW INPUT FROM THER TERMINAL ITSELF;
C           MOST SYSTEMS WILL ALLOW INPUT FROM A FILE;
C     NOTE--ICOMCH = THE ALLOWABLE COMMENT CHARACTER
C           ICOMSW = THE COMMENT CHARACTER FLAG/SWITCH (ON/OFF)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --JANUARY   1978.
C     UPDATED         --FEBRUARY  1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --JUNE      1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --JANUARY   1982.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1985.
C     UPDATED         --SEPTEMBER 1987.    (READ MATRIX)
C     UPDATED         --FEBRUARY  1988.    (DEACT. COL. LIM. IF READ NON-FILE)
C     UPDATED         --JUNE      1988.    (CORRECT DOUBLE ENTRY BY READ FUNCT
C     UPDATED         --DECEMBER  1988.    CORRECT BOMB ON 2ND   READ PARAMETER
C     UPDATED         --MAY       1989.    FIX IRIS PROBLEM--LOOP MAX & CPUMAX
C     UPDATED         --MAY       1990.    CHECK FOR COMMENT CHARACTER (UNIX)
C     UPDATED         --MAY       1990.    ERROR CHECK FOR FORMATTED READ
C     UPDATED         --JUNE      1990.    FIX FORMATTED READ/1 LINE BUG
C     UPDATED         --JULY      1990.    UPDATED WRITE/FORMAT STATEMENT
C     UPDATED         --JULY      1990.    BUG/TRACE PRINT OF ICOMCH/FL
C     UPDATED         --JULY      1990.    COMMENT CHECK BUG FIXED
C     UPDATED         --JULY      1990.    RENAME ICOMFL TO ICOMSW
C     UPDATED         --JULY      1993.    FIX MATRIX READ (ALAN)
C     UPDATED         --JULY      1993.    FIX BOMB IF GOOD READ AFTER
C                                          READ NON-EXISTENT FILE
C     UPDATED         --MARCH     1994.    FIX BUG WHERE DELETE AND 
C                                          RETAIN WIPED OUT PARAMETERS
C                                          CREATED VIA READ PARAMETER
C     UPDATED         --APRIL     1995.  SUPPORT FOR UNFORMATTED READ
C     UPDATED         --SEPTEMBER 1995.  ROW LIMITS & BLANK LINES PROBLEM
C     UPDATED         --MARCH     1996.  FIX BUG WHERE TERMINAL READ
C                                        NESTED WITHIN A MACRO
C     UPDATED         --APRIL     1996.  FOR READ STRING, IGNORE SET
C                                        READ FORMAT
C     UPDATED         --OCTOBER   1997.  SUPPORT "SKIP AUTOMATIC",
C                                        READ UNTIL FIND "----"
C     UPDATED         --NOVEMBER  1998.  READ MORE THAN 100 VARIABLES
C                                        (MAKE PARAMETER SETTABLE)
C     UPDATED         --DECEMBER  1999.  READ ROWID
C     UPDATED         --MARCH     2001.  FIX BUGS:
C                                        A) UPDATE LIMIT ON MAX COLUMNS
C                                        B) OFFSET FOR UNFORMATTED READ
C                                        C) MAX FOR ROW LIMITS
C     UPDATED         --JULY      2002.  SUPPORT FOR QUOTES ON
C                                        FILE NAMES.
C     UPDATED         --FEBRUARY  2003.  UP MAXIMUM NUMBER OF
C                                        CHARACTERS READ FROM ONE
C                                        RECORD OF DATA FILE (MAKE
C                                        SETTABLE TO PARAMETER)
C     UPDATED         --FEBRUARY  2003.  AUTOMATICALLY DETERMINE
C                                        NUMBER OF VARIABLES IF NO
C                                        LIST GIVEN.
C     UPDATED         --JUNE      2003.  HANDLE HYPHENS INSIDE OF QUOTED
C                                        FILE NAMES CORRECTLY.
C     UPDATED         --JULY      2003.  BUG WHEN FILE NAME < 80
C                                        CHARACTERS, BUT COMMAND LINE
C                                        > 80 CHARACTERS 
C     UPDATED         --AUGUST    2003.  QUOTES ON FILE NAMES
C                                        AUTOMATIC FOR READ
C     UPDATED         --JANUARY   2004.  IF AUTOMATICALLY DETERMINE
C                                        VARIABLE LIST, CHECK FIRST
C                                        LINE FOR VARIABLE LIST
C     UPDATED         --JANUARY   2004.  SOME RECODING FOR BETTER
C                                        CLARITY
C     UPDATED         --JANUARY   2004.  HANDLE CHARACTER DATA
C     UPDATED         --OCTOBER   2004.  WHEN READING VARIABLES, IF
C                                        NUMBER OF ITEMS IS GREATER
C                                        THAN NUMBER OF ITEMS READ,
C                                        PAD WITH "MISSING VALUE"
C                                        (BASED ON VALUE OF IREAPD)
C     UPDATED         --OCTOBER   2004.  SET READ SUBSET
C                                        <PACK/DISPERSE>  <PACK/DISPERSE>
C     UPDATED         --DECEMBER  2004.  IF GUI RUNNING (SET GUI), THEN
C                                        DO NOT ALLOW TERMINAL READ
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IMACRO
      CHARACTER*12 IMACCS
C
      CHARACTER*4 IOSW
C
      CHARACTER*80 ICREAF
C
      CHARACTER*4 IREARW
C
      CHARACTER*4 IGRPA2
      CHARACTER*4 ICFLAG
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
      CHARACTER*4 ICASEA
      CHARACTER*4 IECASE
      CHARACTER*4 ISTOR1
      CHARACTER*4 ISTOR2
      CHARACTER*4 ISTOR3
      CHARACTER*4 IB
      CHARACTER*4 IEND
      CHARACTER*4 JVNAM1
      CHARACTER*4 JPNAM1
      CHARACTER*4 JMNAM1
      CHARACTER*4 JFNAM1
      CHARACTER*4 JUNAM1
      CHARACTER*4 JENAM1
      CHARACTER*4 JVNAM2
      CHARACTER*4 JPNAM2
      CHARACTER*4 JMNAM2
      CHARACTER*4 JFNAM2
      CHARACTER*4 JUNAM2
      CHARACTER*4 JENAM2
      CHARACTER*4 IH1
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICASRE
      CHARACTER*4 IOFILE
      CHARACTER*4 IOTERM
C
      CHARACTER*4 IFILQ2
C
      CHARACTER*80 IFILE
      CHARACTER*12 ISTAT
      CHARACTER*12 IFORM
      CHARACTER*12 IACCES
      CHARACTER*12 IPROT
      CHARACTER*12 ICURST
      CHARACTER*4 IENDFI
      CHARACTER*4 IREWIN
      CHARACTER*4 ISUBN0
      CHARACTER*4 IERRFI
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
CCCCC CHARACTER*80 ICANS
      CHARACTER*200 ICANS
CCCCC CHARACTER*80 ISTRIN
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 NEWNAM
C
      CHARACTER*4 ICASTO
C
      CHARACTER*4 IHMAT1
      CHARACTER*4 IHMAT2
C  FOLLOWING 3 LINES MAY 1990.
      CHARACTER*80 IAJUNK
      CHARACTER*4 ICOMCH
      CHARACTER*4 ICOMSW
C
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1995
      CHARACTER*4 LINETY
C
CCCCC NOVEMBER 1998.  DEFINE MAXRDV TO DEFINE MAXIMUM NUMBER OF
CCCCC VARIABLES.
C
CCCCC MARCH 2001.  UP LIMIT (MATRICES IN PARTICULAR CAN HAVBE MORE)
CCCCC PARAMETER(MAXRDV=250)
      PARAMETER(MAXRDV=1000)
      PARAMETER(MAXCHV=20)
C
CCCCC THE FOLLOWING LINES ADDED    FEBRUARY  2003.
      CHARACTER*4 IVRLST
      CHARACTER*4 IVLIST(MAXRDV)
      CHARACTER*4 IVLIS2(MAXRDV)
      CHARACTER*4 IASAVE(MAXRDV)
C
      INTEGER IFCOLL(50)
      INTEGER IFCOLU(50)
      INTEGER ITYPE(MAXRDV)
      CHARACTER*4 ICLIST(MAXRDV)
      CHARACTER*4 ICLIS2(MAXRDV)
C
      DIMENSION JVNAM1(MAXRDV)
      DIMENSION JPNAM1(MAXRDV)
      DIMENSION JMNAM1(MAXRDV)
      DIMENSION JFNAM1(MAXRDV)
      DIMENSION JUNAM1(MAXRDV)
      DIMENSION JENAM1(MAXRDV)
C
      DIMENSION NIV(MAXRDV)
C
      DIMENSION JVNAM2(MAXRDV)
      DIMENSION JPNAM2(MAXRDV)
      DIMENSION JMNAM2(MAXRDV)
      DIMENSION JFNAM2(MAXRDV)
      DIMENSION JUNAM2(MAXRDV)
      DIMENSION JENAM2(MAXRDV)
C
      DIMENSION IEN(MAXRDV)
      DIMENSION IECOL2(MAXRDV)
      DIMENSION IECASE(MAXRDV)
      DIMENSION PVAL(MAXRDV)
      DIMENSION IFSTA2(MAXRDV)
      DIMENSION IFSTO2(MAXRDV)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOST.INC'
CCCCC MARCH 2001.  ADD FOLLOWING LINE
      INCLUDE 'DPCOMC.INC'
CCCCC APRIL 1995.  ADD FOLLOWING 4 LINES
      INCLUDE 'DPCOZ2.INC'
      DIMENSION XSCRT(3*MAXOBW)
C
      DIMENSION X0(MAXRCL)
      CHARACTER*24 IXC(MAXCHV)
C
      DIMENSION ISTOR1(MAXRCL)
      DIMENSION ISTOR2(MAXRCL)
      DIMENSION ISTOR3(MAXRCL)
      DIMENSION IB(MAXRCL)
C
      EQUIVALENCE (G2RBAG(1),XSCRT(1))
      CHARACTER*4 IFMFLG
      CHARACTER*4 ICRFLG
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRE'
      ISUBN2='AD  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='YES'
      IERROR='NO'
C
      ICASRE='-999'
      IOFILE='-999'
      IOTERM='-999'
C
      IFILQ2=IFILQU
      IFILQU='ON'
C
CCCCC FEBRUARY 2003: ADD FOLLOWING LINE.
CCCCC IF NO VARIABLE LIST GIVEN, THEN TWO CASES:
CCCCC    1) IF SKIP AUTOMATIC ON, THEN READ PREVIOUS LINE TO
CCCCC       DETERMINE VARIABLE LIST. 
CCCCC    2) IF SKIP AUTOMATIC OFF, THEN READ FIRST LINE TO
CCCCC       DETERMINE NUMBER OF VARIABLES.  NAME THEM X1, X2, ETC.
C
      IVRLST='YES'
      DO10I=1,132
        IASAVE(I)='    '
   10 CONTINUE
      DO15I=1,MAXRDV
        IVLIST(I)='    '
        IVLIS2(I)='    '
        ITYPE(I)=0
   15 CONTINUE
      DO13I=1,MAXCHV
        IXC(I)=' '
        ICLIST(I)=' '
        ICLIS2(I)=' '
   13 CONTINUE
      IGRPA2=IGRPAU
C
CCCCC THE FOLLOWING LINE WAS INSERTED MAY 1989
CCCCC MARCH 2001.  SET VALUE TO MAX INTEGER
CCCCC IBILLI=10**9
      IBILLI=I1MACH(9)
      I2=0
      NUMVRD=0
      NUMPRD=0
      NUMFRD=0
C
      AFROW2=IFROW2
C
      MAXN2=MAXCHF
C
      IMATC1=(-999)
      IMATNR=(-999)
      IMATNC=(-999)
CCCCC THE FOLLOWING LINE WAS ADDED    SEPTEMBER 1995
      LINETY='-999'
      NCALL=0
      NCOLS=0
C
C               ***************************
C               **  TREAT THE READ CASE  **
C               ***************************
C
CCCCC NOVEMBER 1998.  DEFINE MAXRDV TO DEFINE MAXIMUM NUMBER OF
CCCCC VARIABLES.
C
      MAXV2=MAXRDV
      MAXP2=MAXRDV
      MAXM2=MAXRDV
      MAXF2=MAXRDV
      MAXU2=MAXRDV
      MAXE2=MAXRDV
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IFROW1,AFROW2
   52   FORMAT('IFROW1,AFROW2 = ',I8,2X,E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IFCOL1,IFCOL2,NUMRCM
   53   FORMAT('IFCOL1,IFCOL2,NUMRCM = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,54)ISKIP,IBUGS2,IBUGQ
   54   FORMAT('ISKIP,IBUGS2,IBUGQ = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,55)IOSW
   55   FORMAT('IOSW = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,56)IMACRO,IMACNU,IMACCS
   56   FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,58)IRD,IRD2
   58   FORMAT('IRD,IRD2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,63)IBUGS2,ISUBRO,IERROR
   63   FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,64)IWIDTH
   64   FORMAT('IWIDTH = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,65)(IANSLC(I),I=1,MIN(100,IWIDTH))
   65     FORMAT('(IANSLC(I),I=1,IWIDTH) = ',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,71)IREANU
   71   FORMAT('IREANU = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)IREANA
   72   FORMAT('IREANA = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,73)IREAST
   73   FORMAT('IREAST = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,74)IREAFO
   74   FORMAT('IREAFO = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,75)IREAAC
   75   FORMAT('IREAAC = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,76)IREAFO
   76   FORMAT('IREAFO = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,77)IREACS
   77   FORMAT('IREACS = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,81)NUMNAM
   81   FORMAT('NUMNAM = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,82)N2,MAXN2
   82   FORMAT('N2,MAXN2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,84)NCREAF
   84   FORMAT('NCREAF = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(NCREAF.GE.1)THEN
          WRITE(ICOUT,85)(ICREAF(I:I),I=1,NCREAF)
   85     FORMAT('(ICREAF(I:I),I=1,NCREAF) = ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,86)IREARW
   86   FORMAT('IREARW = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,87)ICOMCH,ICOMSW
   87   FORMAT('ICOMCH,ICOMSW = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LT.1)THEN
        IERROR='YES'
        GOTO8800
      ENDIF
C
C               *****************************************
C               **  STEP 1B--                          **
C               **  DETERMINE THE TYPE OF READ CASE--  **
C               **     1) VARIABLE                     **
C               **     2) PARAMETER                    **
C               **     3) FUNCTION (= STRING)          **
C               **     4) MATRIX                       **
C               *****************************************
C
      ICASRE='VARI'
      IF(IHARG(1).EQ.'PARA'.AND.IHARG2(1).EQ.'METE')ICASRE='PARA'
      IF(IHARG(1).EQ.'FUNC'.AND.IHARG2(1).EQ.'TION')ICASRE='FUNC'
      IF(IHARG(1).EQ.'STRI'.AND.IHARG2(1).EQ.'NG')ICASRE='FUNC'
      IF(IHARG(1).EQ.'MATR'.AND.IHARG2(1).EQ.'IX')ICASRE='MATR'
      IF(IHARG(1).EQ.'ROW '.AND.IHARG2(1).EQ.' '.AND.
     1   IHARG(2).EQ.'LABE'.AND.IHARG2(2).EQ.'LS')ICASRE='ROWI'
      IF(IHARG(1).EQ.'ROW '.AND.IHARG2(1).EQ.' '.AND.
     1   IHARG(2).EQ.'LABE'.AND.IHARG2(2).EQ.'L ')ICASRE='ROWI'
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,155)ICASRE
  155   FORMAT('ICASRE = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************************
C               **  STEP 2A--                                       **
C               **  DETERMINE THE TYPE OF READ CASE--               **
C               **       1) FROM TERMINAL;                          **
C               **       2) FROM FILE;                              **
C               **  NOTE--IOTERM  WILL = 'YES' ONLY IN EXPLICIT     **
C               **        TERMINAL CASE                             **
C               **        (THAT IS, ONLY WHEN INPUT IOSW            **
C               **                             = 'TERM')            **
C               **  NOTE--IOFILE  WILL = 'YES' ONLY IN FILE CASE.   **
C               ******************************************************
C
      ISTEPN='2A'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
  200 CONTINUE
      IWORD=2
      IF(ICASRE.EQ.'PARA')IWORD=3
      IF(ICASRE.EQ.'FUNC')IWORD=3
      IF(ICASRE.EQ.'MATR')IWORD=3
      IF(ICASRE.EQ.'ROWI')THEN
        IWORD=4
        IF(NUMARG.LE.2)THEN
          IOFILE='NO'
          GOTO202
        ENDIF
      ENDIF
      CALL DPFILE(IANSLC,IWIDTH,IWORD,
     1IOFILE,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
  202 CONTINUE
C
      IOTERM='NO'
      IF(IOFILE.EQ.'NO'.AND.IOSW.EQ.'TERM')IOTERM='YES'
C
CCCCC DECEMBER 2004.  IF GUI RUNNING, DO NOT ALLOW TERMINAL READ.
C
      IF(IOFILE.EQ.'NO' .AND. IGUIFL.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,211)
  211   FORMAT('***** ERROR FROM READ--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,213)
  213   FORMAT('      TERMINAL READS (I.E., READ WITH NO FILE NAME ',
     1         'SPECIFIED)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,215)
  215   FORMAT('      ARE NOT PERMITTED WHEN RUNNING DATAPLOT FROM ',
     1         'THE GRAPHICAL USER INTERFACE)')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,217)
  217   FORMAT('      ALTERNATIVELY, YOU CAN DO ONE OF THE FOLLOWING:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,219)
  219   FORMAT('      1) YOU CAN ENTER THE DATA DIRECTLY FROM THE ',
     1         'DATASHEET.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,221)
  221   FORMAT('      2) FROM THE COMMAND LINE WINDOW, YOU CAN USE ',
     1         'THE DATA COMMAND AS FOLLOWS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,223)
  223   FORMAT('         LET Y = DATA value1 value2 ...')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,225)
  225   FORMAT('      3) THE FIRST TWO METHODS ARE USEFUL FOR SMALL ',
     1         'AMOUNTS OF DATA.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,227)
  227   FORMAT('         FOR MORE THAN A FEW DATA POINTS, IT IS ',
     1         'RECOMMENDED THAT YOU')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,229)
  229   FORMAT('         CREATE THE DATA IN AN ASCII FILE AND THEN')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,231)
  231   FORMAT('         READ THE DATA FROM THAT FILE.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *************************************
C               **  STEP 2B--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  COPY OVER VARIABLES            **
C               *************************************
C
      ISTEPN='2B'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')THEN
C
        IOUNIT=IREANU
        IFILE=IREANA
        ISTAT=IREAST
        IFORM=IREAFO
        IACCES=IREAAC
        IPROT=IREAPR
        ICURST=IREACS
C
        ISUBN0='READ'
        IERRFI='NO'
C
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
          WRITE(ICOUT,1183)IOUNIT
 1183     FORMAT('IOUNIT = ',I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1184)IFILE
 1184     FORMAT('IFILE = ',A80)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1185)ISTAT,IFORM,IACCES,IPROT,ICURST
 1185     FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1           A12,2X,A12,2X,A12,2X,A12,2X,A12)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1186)ISUBN0,IERRFI
 1186     FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
C               ***********************************************
C               **  STEP 2C--                                **
C               **  IF HAVE THE FILE INPUT CASE--            **
C               **  CHECK TO SEE IF THE READ FILE MAY EXIST  **
C               ***********************************************
C
      ISTEPN='2C'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')THEN
C
        IF(ISTAT.EQ.'NONE')THEN
          IERROR='YES'
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1211)
 1211     FORMAT('***** IMPLEMENTATION ERROR IN DPREAD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1212)
 1212     FORMAT('      THE DESIRED READING CANNOT BE CARRIED OUT')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1214)
 1214     FORMAT('      BECAUSE THE INTERNAL VARIABLE   IREAST   WHICH')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1215)
 1215     FORMAT('      ALLOWS SUCH READING HAS BEEN SET TO    NONE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1217)ISTAT,IREAST
 1217     FORMAT('ISTAT,IREAST = ',A12,2X,A12)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1218)
 1218     FORMAT('      ALL READING MUST BE DONE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1219)
 1219     FORMAT('      DIRECTLY FROM THE TERMINAL.')
          CALL DPWRST('XXX','BUG ')
          GOTO9000
        ENDIF
      ENDIF
C
C               *************************************
C               **  STEP 2D--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  EXTRACT THE FILE NAME          **
C               *************************************
C
      ISTEPN='2D'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')THEN
C
        DO1310I=1,200
          ICANS(I:I)=IANSLC(I)
 1310   CONTINUE
C
        ISTART=1
        ISTOP=IWIDTH
        IWORD=2
        IF(ICASRE.EQ.'PARA')IWORD=3
        IF(ICASRE.EQ.'FUNC')IWORD=3
        IF(ICASRE.EQ.'MATR')IWORD=3
        IF(ICASRE.EQ.'ROWI')IWORD=4
        CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1              ICOL1,ICOL2,IFILE,NCFILE,
     1              IBUGS2,ISUBRO,IERROR)
C
        IF(NCFILE.LT.1)THEN
          IERROR='YES'
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1341)
 1341     FORMAT('***** ERROR IN DPREAD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1342)
 1342     FORMAT('      A USER FILE NAME IS REQUIRED IN THE READ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1344)
 1344     FORMAT('      COMMAND (FOR EXAMPLE,    READ CALIB.DAT X Y Z)')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1345)
 1345     FORMAT('      BUT NONE WAS GIVEN HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1346)
 1346     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,1347)(IANSLC(I),I=1,MIN(100,IWIDTH))
 1347       FORMAT('      ',100A1)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            GOTO9000
          ENDIF
        ENDIF
C
      ENDIF
C
C               *************************************
C               **  STEP 2E--                      **
C               **  IF HAVE THE FILE INPUT CASE--  **
C               **  OPEN THE FILE                  **
C               *************************************
C
      ISTEPN='2E'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES')THEN
C
        IREWIN='ON'
        ICRFLG='ROW'
        IF(NCREAF.GT.0.AND.IOFILE.EQ.'YES')THEN
          IF(ICREAF(1:5).EQ.'(UNFO'.AND.ICASRE.EQ.'VARI')THEN
            IFORM='UNFORMATTED'
            IFMFLG='ON'
            IF(ICREAF(13:16).EQ.'COLU')ICRFLG='COLU'
            IF(ICREAF(1:5).EQ.'(COLU')ICRFLG='COLU'
          ELSEIF(ICREAF(1:5).EQ.'(UNFO'.AND.ICASRE.EQ.'MATR')THEN
            IF(IUNFMC.GT.0)THEN
              IFORM='UNFORMATTED'
              IFMFLG='ON'
            ELSE
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1441)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1442)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1443)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,1444)
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO9000
            ENDIF
          ELSE
            IFORM='FORMATTED'
            IFMFLG='OFF'
          ENDIF
        ELSE
          IFORM='FORMATTED'
          IFMFLG='OFF'
        ENDIF
 1441   FORMAT('***** ERROR IN DPREAD--')
 1442   FORMAT('      FOR UNFORMATTED READS OF MATRICES, THE ',
     1         ' FOLLOWING COMMAND IS REQUIRED:')
 1443   FORMAT('         SET UNFORMATTED COLUMNS <VALUE>')
 1444   FORMAT('      WHERE <VALUE> IS THE NUMBER OF COLUMNS IN THE ',
     1         'MATRTIX.')
C
        IF(IREACS(1:4).EQ.'CLOS')
     1    CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1    IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
        IF(IERRFI.EQ.'YES')GOTO9000
        IF(IREACS(1:4).EQ.'CLOS')IREACS='OPEN'
C
      ENDIF
C
C               ******************************************
C               **  STEP 2F--                           **
C               **  FOR THE 2 CASES--                   **
C               **      1) TERMINAL INPUT;              **
C               **      2) FILE INPUT;                  **
C               **  DEFINE THE INPUT READ UNIT NUMBER,  **
C               **  AND OTHER VARIABLES NEEDED          **
C               **  FOR UPCOMING READS.                 **
C               ******************************************
C
      ISTEPN='2F'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IRD2=IRD
      IF(IMACCS.EQ.'OPEN'.OR.IMALEV.GE.1)THEN
        IRD2=IMACNU
      ENDIF
      IF(IOFILE.EQ.'YES')IRD2=IREANU
      IF(IOTERM.EQ.'YES')IRD2=IRD
C
      IOUNIT=IRD2
C
C               *****************************************
C               **  STEP 3--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET; OR                    **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='3'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO390
      DO300J=1,NUMARG
        J1=J
        IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO390
        ELSEIF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')THEN
          ICASEQ='SUBS'
          ILOCQ=J1
          GOTO390
        ELSEIF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')THEN
          ICASEQ='FOR'
          ILOCQ=J1
          GOTO390
        ENDIF
  300 CONTINUE
  390 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,391)NUMARG,ILOCQ
  391   FORMAT('NUMARG,ILOCQ = ',2I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
  490 CONTINUE
C
C               ******************************************************
C               **  STEP 4--                                        **
C               **  DETERMINE THE TYPE AND NUMBER OF ITEMS          **
C               **  TO BE READ   .                                  **
C               **  NUMALL = TOTAL NUMBER OF READ  ITEMS            **
C               **           (AS DETERMINED BY INCLUDING ONLY ALL   **
C               **           BEFORE 'SUBSET' OR 'EXCEPT' OR 'FOR')  **
C               **  NUMV   = NUMBER OF VARIABLES TO BE READ    ;    **
C               **  NUMP   = NUMBER OF PARAMETERS TO BE READ    ;   **
C               **  NUMM   = NUMBER OF MODELS TO BE READ            **
C               **           (SHOULD = 0 OR 1)                      **
C               **  NUMF   = NUMBER OF FUNCTIONS TO BE READ         **
C               **  NUMU   = NUMBER OF UNKNOWNS TO BE READ    ;     **
C               **  NUME   = TOTAL NUMBER OF READ  ITEMS            **
C               **           (SHOULD = NUMALL);                     **
C               ******************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IV=0
      IP=0
      IM=0
      IF=0
      IU=0
      IE=0
C
      JMIN=1
      IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'PARA')JMIN=2
      IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'FUNC')JMIN=2
      IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'MATR')JMIN=2
      IF(IOFILE.EQ.'NO'.AND.ICASRE.EQ.'ROWI')JMIN=3
      IF(IOFILE.EQ.'YES')JMIN=2
      IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'PARA')JMIN=3
      IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'FUNC')JMIN=3
      IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'MATR')JMIN=3
      IF(IOFILE.EQ.'YES'.AND.ICASRE.EQ.'ROWI')JMIN=4
C
CCCCC JULY 2002: QUOTED FILE NAMES MAY CONTAIN SPACES.
CCCCC DETERMINE HOW MANY ARGUMENTS FILE NAME MAY CONTAIN.
CCCCC JUNE 2003: UPDATE TO INCLUDE HYPHENS AS WELL AS SPACES.
C
      IF(IFILE(1:1).EQ.'"')THEN
        DO421I=80,1,-1
          IF(IFILE(I:I).NE.' ')THEN
            ILAST=I
            GOTO424
          ENDIF
  421   CONTINUE
  424   CONTINUE
        ICOUNT=0
        ISPAC=0
        DO426I=1,ILAST
          IF((IFILE(I:I).EQ.' '.OR.IFILE(I:I).EQ.'-') .AND.
     1      ISPAC.EQ.0)THEN
            ISPAC=1
            ICOUNT=ICOUNT+1
          ELSEIF((IFILE(I:I).NE.' '.AND.IFILE(I:I).NE.'-') .AND.
     1      ISPAC.EQ.1)THEN
            ISPAC=0
          ENDIF
  426   CONTINUE
        JMIN=JMIN+ICOUNT
      ENDIF
C
      JMAX=ILOCQ-1
      IF(ICASRE.EQ.'ROWI')JMAX=JMIN
      IF(ICASRE.EQ.'MATR')JMAX=JMIN+MAXCOM-1
C
      IF(ICASRE.EQ.'MATR')THEN
        IF(JMAX.GT.JMIN+MAXRDV-1)JMAX=JMIN+MAXRDV-1
      ENDIF
C
      IF(ICASRE.EQ.'MATR')IHMAT1=IHARG(JMIN)
      IF(ICASRE.EQ.'MATR')IHMAT2=IHARG2(JMIN)
C
      IVALMA=0
      NUMALL=0
      NUMALL=JMAX-JMIN+1
      IF(ICASRE.EQ.'VARI'.AND.NUMALL.LE.0)IVRLST='NO'
      IF(IVRLST.EQ.'NO' .AND. ICASRE.EQ.'VARI')THEN
C
CCCCC FIRST, CASE WHERE SKIP AUTOMATIC IS ON, RETRIEVE
CCCCC VARIABLE LIST FROM LINE JUST BEFORE THE "----".
C
        IF(ISKIP.EQ.-1.AND.IOFILE.EQ.'YES')THEN
          DO4578I=1,MAXOBV
            ILINE=I
            NUMCHA=-1
            CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                  IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
            IF(IERROR.EQ.'YES')GOTO8800
            IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1        NUMCHA.EQ.3)THEN
              REWIND IOUNIT
              GOTO8800
            ELSEIF(IA(1).EQ.'-'.AND.IA(2).EQ.'-'.AND.IA(3).EQ.'-'.AND.
     1        IA(4).EQ.'-')THEN
              GOTO4581
            ELSE
              DO4511J=1,132
                IASAVE(J)=IA(J)
 4511         CONTINUE
            ENDIF
 4578     CONTINUE
 4581     CONTINUE
          IF(ILINE.GT.1)THEN
            IFRST=0
            ILAST=0
            INEW=0
            IVAR=0
            CALL DPUPPE(IASAVE,132,IASAVE,IBUGS2,IERROR)
            DO4583J=1,132
              IF(IASAVE(J)(1:1).EQ.' ')THEN
                IF(INEW.EQ.1)THEN
                  IVAR=IVAR+1
                  ILAST=J
                  NCHAR=ILAST-IFRST+1
                  DO4585K=1,MIN(4,NCHAR)
                    IVLIST(IVAR)(K:K)=IASAVE(IFRST+K-1)(1:1)
 4585             CONTINUE
                  IF(NCHAR.GE.5)THEN
                    DO4587K=5,MIN(8,NCHAR)
                      IVLIS2(IVAR)(K-4:K-4)=IASAVE(IFRST+K-1)(1:1)
 4587               CONTINUE
                  ENDIF
                  INEW=0
                ENDIF
              ELSE
                ILAST=J
                IF(INEW.EQ.0)THEN
                  INEW=1
                  IFRST=J
                ENDIF
              ENDIF
 4583       CONTINUE
            REWIND IOUNIT 
            JMIN=1
            JMAX=IVAR
          ENDIF
C
CCCCC SECOND CASE: SKIP AUTOMATIC IS OFF
CCCCC 1) SET COLUMN LIMITS, ROW LIMITS
CCCCC 2) SKIP OVER HEADER LINES (IF NEEDED)
CCCCC 3) READ SINGLE LINE OF DATA
CCCCC 4) DETERMINE NUMBER OF COLUMNS OF DATA IN THAT LINE
CCCCC 5) SET VARIABLE NAMES TO X1, ..., XK
CCCCC    IF IVARLA="ON", FIRST LINE READ SHOULD BE VARIABLE NAMES
CCCCC 6) REWIND
C
        ELSEIF(IOFILE.EQ.'YES')THEN
          IF(ISKIP.GE.0)THEN
            IFRMIN=IFROW1
            IFRMAX=IFROW1+ISKIP
            IF(IFRMAX.LT.IFRMIN)IFRMAX=IFRMIN
            MINCO2=1
            MAXCO2=NUMRCM
            IFCOL3=IFCOL1
            IFCOL4=IFCOL2
            IF(IFRMIN.LT.IFRMAX)THEN
              DO4591IFROW=IFRMIN,IFRMAX-1
                NUMCHA=-1
                CALL DPREFI(
     1              IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1              IA,NUMCHA,
     1              ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
 4591         CONTINUE
            ENDIF
C
            IF(IVARLA.EQ.'OFF')THEN
              NUMLRD=0
 4592         CONTINUE
              DO4597I=1,MAXRCL
                ISTOR1(I)='    '
                ISTOR2(I)='    '
                ISTOR3(I)='    '
                IB(I)='    '
 4597         CONTINUE
              CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2,X0,NUMDPL,
     1             IXC,NXC,
     1             ICASRE,IFUNC2,N2,MAXN2,
     1             IMACRO,IMACNU,IMACCS,
     1             IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD,
     1             IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1             ICOMCH,ICOMSW,LINETY,IGRPA2,
     1             IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL,IREADL,PREAMV,
     1             MAXRDV,MAXCHV,
     1             IDECPT,
     1             IB,
     1             IERRFI,IBUGS2,ISUBRO,IERROR)
              IF(LINETY.EQ.'BLAN')GOTO4592
              NUMLRD=0
              IF(NUMDPL.GT.0)THEN
                DO4593J=1,NUMDPL
                  IVLIST(J)='X   '
                  IVLIS2(J)='    '
                  IF(J.LE.9)THEN
                    WRITE(IVLIST(J)(2:2),'(I1)')J
                  ELSEIF(J.LE.99)THEN
                    WRITE(IVLIST(J)(2:3),'(I2)')J
                  ELSE
                    WRITE(IVLIST(J)(2:4),'(I3)')J
                  ENDIF
 4593           CONTINUE
              ENDIF
              REWIND IOUNIT 
              NCALL=0
              NCOLS=0
              JMIN=1
              JMAX=NUMDPL
            ELSEIF(IVARLA.EQ.'ON')THEN
              NUMCHA=-1
              CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1             IASAVE,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
              IF(IERROR.EQ.'YES')GOTO8800
C
              IFRST=0
              ILAST=0
              INEW=0
              IVAR=0
              CALL DPUPPE(IASAVE,132,IASAVE,IBUGS2,IERROR)
              DO34583J=1,132
                IF(IASAVE(J)(1:1).EQ.' ')THEN
                  IF(INEW.EQ.1)THEN
                    IVAR=IVAR+1
                    ILAST=J
                    NCHAR=ILAST-IFRST+1
                    DO34585K=1,MIN(4,NCHAR)
                      IVLIST(IVAR)(K:K)=IASAVE(IFRST+K-1)(1:1)
34585               CONTINUE
                    IF(NCHAR.GE.5)THEN
                      DO34587K=5,MIN(8,NCHAR)
                        IVLIS2(IVAR)(K-4:K-4)=IASAVE(IFRST+K-1)(1:1)
34587                 CONTINUE
                    ENDIF
                    INEW=0
                  ENDIF
                ELSE
                  ILAST=J
                  IF(INEW.EQ.0)THEN
                    INEW=1
                    IFRST=J
                  ENDIF
                ENDIF
34583         CONTINUE
CCCCC DON'T REWIND FILE, DON'T WANT TO READ VARIABLE LABELS AS DATA
CCCCC         REWIND IOUNIT 
              JMIN=1
              JMAX=IVAR
            ENDIF
C
          ENDIF
        ENDIF
      ENDIF
 4589 CONTINUE
C
      IF(JMIN.GT.JMAX)GOTO4290
      IF(ICASRE.EQ.'ROWI')GOTO4290
C
C  JANUARY 2004.  THE DPREAL ROUTINE CAN NOW RETURN CHARACTER AS
C  WELL AS NUMERIC DATA.  FOR THE VARIABLE READ CASE, READ FIRST
C  LINE OF FILE TO EXTRACT THE TYPES FOR EACH OF THE VARIABLES.
C  FOLLOWING CONDITIONS NEED TO APPLY:
C
C  1. THIS IS THE VARIABLE (AS OPPOSSED TO STRING, PARAMETER, MATRIX)
C     READ CASE.
C
C  2. THE CONVERT CHARACTER CASE IS SET TO CHARACTER (AS OPPOSSED
C     TO IGNORE OR ERROR).  THIS IS DETERMINED BY VALUE OF IGRPAU.
C
C  3. THE READ IS FROM FILE RATHER THAN THE KEYBOARD.  FOR THE
C     KEYBOARD READ CASE, IGRPAU IS SET TO IGNORE.
C
C  4. IF A SET READ FORMAT HAS BEEN SET, NO CHARACTER DATA WILL
C     BE READ.
C
      ICFLAG='YES'
      IF(IGRPAU.NE.'CHAR')ICFLAG='NO'
      IF(IOFILE.NE.'YES')ICFLAG='NO'
      IF(ICASRE.NE.'VARI')ICFLAG='NO'
      IF(NCREAF.GT.0)ICFLAG='NO'
C
      IF(ICFLAG.EQ.'YES')THEN
C
        MINCO2=1
        MAXCO2=NUMRCM
        IFCOL3=IFCOL1
        IFCOL4=IFCOL2
        ITEMP=IFROW1+ISKIP-1
        IF(ITEMP.GT.0)THEN
          DO17380IFROW=1,ITEMP
            NUMCHA=-1
            CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                  IA,NUMCHA,
     1                  ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
            IF(IERROR.EQ.'YES')THEN
              IGRPA2='IGNO'
              ICFLAG='NO'
              GOTO17399
            ENDIF
            IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1        NUMCHA.EQ.3)THEN
              IGRPA2='IGNO'
              ICFLAG='NO'
              GOTO17399
            ENDIF
17380     CONTINUE
        ENDIF
C
17391   CONTINUE
        NCALL=0
        NCOLS=0
        CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2,X0,NUMDPL,
     1              IXC,NXC,
     1              ICASRE,IFUNC2,N2,MAXN2,
     1              IMACRO,IMACNU,IMACCS,
     1              IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD,
     1              IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1              ICOMCH,ICOMSW,LINETY,IGRPA2,
     1              IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL,IREADL,PREAMV,
     1              MAXRDV,MAXCHV,
     1              IDECPT,
     1              IB,
     1              IERRFI,IBUGS2,ISUBRO,IERROR)
        IF(LINETY.EQ.'BLAN')GOTO17391
C
        IF(NXC.LE.0)THEN
          ICFLAG='NO'
          IGRPA2='IGNO'
          GOTO17399
        ENDIF
C
17399   CONTINUE
        REWIND(IOUNIT)
        NCALL=0
        NCOLS=0
      ENDIF
C
      ICNTNU=0
      ICNTCH=0
      ICOUNT=0
C
      DO4200J=JMIN,JMAX
        ICOUNT=ICOUNT+1
        IF(IVRLST.EQ.'NO')THEN
          IH1=IVLIST(J)
          IH2=IVLIS2(J)
        ELSE
          IH1=IHARG(J)
          IH2=IHARG2(J)
        ENDIF
C
C     **********
C     THE FOLLOWING 5 LINES OF CODE IS FOR      READ MATRIX.
C     IT ALLOWS COLUMN VECTOR NAMES TO BE FORMED
C     FROM THE BASE MATRIX NAME
C     BY THE APPENDING OF NUMBERS 1, 2, 3, ...
C     SEPTEMBER 1987
C     **********
C
        IF(ICASRE.EQ.'MATR')THEN
          IVALMA=IVALMA+1
          CALL DPAPN2(IHMAT1,IHMAT2,IVALMA,
     1                IH1,IH2,IBUGS2,ISUBRO,IERROR)
        ENDIF
C
C     ***************
C     THE FOLLOWING CODE ALLOWS THE    TO    KEYWORD
C     TO BE ACTIVATED, AS IN
C     READ FILE.EXT Y1 TO Y10
C     DECEMBER 1986
C     ***************
C
        ICASTO='OFF'
        IF(IH1.EQ.'TO  ')THEN
          ICASTO='ON'
          JM1=J-1
          JP1=J+1
          CALL DPEXTL(IHARG(JM1),IHARG2(JM1),IHARG(JP1),IHARG2(JP1),
     1                KNUMB,IVAL1,IVAL2,IBUGS2,ISUBRO,IERROR)
C
          IVA1P1=IVAL1+1
          IVA2M1=IVAL2-1
          IF(IVA1P1.GT.IVA2M1)GOTO4200
          IVAL=IVAL1
        ELSE
          GOTO4219
        ENDIF
 4215   CONTINUE
        IVAL=IVAL+1
        IF(IVAL.GE.IVAL2)GOTO4200
C
        CALL DPAPNU(IHARG(JM1),IHARG2(JM1),KNUMB,IVAL,
     1              IH1,IH2,IBUGS2,ISUBRO,IERROR)
 4219   CONTINUE
C
C  JANUARY 2004: CHECK WHETHER NAME SHOULD BE ADDED TO
C  REGULAR NAME LIST OR CHARACTER VARIABLE NAME LIST.
C
        IF(ICFLAG.EQ.'YES')THEN
          IF(ITYPE(ICOUNT).EQ.1)THEN
            ICNTCH=ICNTCH+1
            IF(ICNTCH.GT.MAXCHV)GOTO4200
            ICLIST(ICNTCH)=IH1
            ICLIS2(ICNTCH)=IH2
            GOTO4200
          ELSE
            ICNTNU=ICNTNU+1
          ENDIF
        ENDIF
C
        ICASEA='    '
        DO4300I=1,NUMNAM
          I2=I
          IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
            IF(IUSE(I).EQ.'V')THEN
              ICASEA='V'
              IV=IV+1
              IF(IV.GT.MAXV2)GOTO4370
              JVNAM1(IV)=IH1
              JVNAM2(IV)=IH2
              NIV(IV)=IN(I2)
C
              IF(ICASRE.EQ.'VARI')GOTO4370
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4311)
 4311         FORMAT('***** ERROR IN DPREAD--')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4312)
 4312         FORMAT('      A NAME IN THE LIST ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4313)
 4313         FORMAT('      OF VARIABLES TO BE READ ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4314)
 4314         FORMAT('      INCLUDED THE NAME OF A ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4315)
 4315         FORMAT('      PREVIOUSLY-DEFINED PARAMETER OR FUNCTION.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4316)IH1,IH2
 4316         FORMAT('      THE NAME OF THE PARAMETER OR FUNCTION WAS ',
     1               2A4,'   .')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4317)
 4317         FORMAT('      NO READ WAS CARRIED OUT.')
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO8800
C
            ELSEIF(IUSE(I).EQ.'P')THEN
              ICASEA='P'
              IP=IP+1
              IF(IP.GT.MAXP2)GOTO4370
              JPNAM1(IP)=IH1
              JPNAM2(IP)=IH2
              PVAL(IP)=VALUE(I2)
C
              IF(ICASRE.EQ.'PARA')GOTO4370
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4321)
 4321         FORMAT('***** ERROR IN DPREAD--')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4322)
 4322         FORMAT('      A NAME IN THE LIST ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4323)
 4323         FORMAT('      OF PARAMETERS TO BE READ ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4324)
 4324         FORMAT('      INCLUDED THE NAME OF A ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4325)
 4325         FORMAT('      PREVIOUSLY-DEFINED VARIABLE OR FUNCTION.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4326)IH1,IH2
 4326         FORMAT('      THE NAME OF THE VARIABLE OR FUNCTION WAS ',
     1               2A4,'   .')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4327)
 4327         FORMAT('      NO READ WAS CARRIED OUT.')
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO8800
C
            ELSEIF(IUSE(I).EQ.'M')THEN
              ICASEA='M'
              IM=IM+1
              IF(IM.GT.MAXM2)GOTO4370
              JMNAM1(IM)=IH1
              JMNAM2(IM)=IH2
C
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4331)
 4331         FORMAT('***** ERROR IN DPREAD--')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4332)
 4332         FORMAT('      A NAME IN THE LIST OF VARIABLES TO BE')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4334)
 4334         FORMAT('      READ INCLUDED THE NAME OF A ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4335)
 4335         FORMAT('      PREVIOUSLY-DEFINED MODEL.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4336)IH1,IH2
 4336         FORMAT('      THE NAME OF THE MODEL WAS ',2A4,'  .')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4337)
 4337         FORMAT('      NO READ WAS CARRIED OUT.')
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO8800
C
            ELSEIF(IUSE(I).EQ.'F')THEN
              ICASEA='F'
              IF=IF+1
              IF(IF.GT.MAXF2)GOTO4370
              JFNAM1(IF)=IH1
              JFNAM2(IF)=IH2
              IFSTA2(IF)=IVSTAR(I2)
              IFSTO2(IF)=IVSTOP(I2)
C
              IF(ICASRE.EQ.'FUNC')GOTO4370
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4341)
 4341         FORMAT('***** ERROR IN DPREAD--')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4342)
 4342         FORMAT('      A NAME IN THE LIST ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4343)
 4343         FORMAT('      OF FUNCTIONS (= STRINGS) TO BE READ ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4344)
 4344         FORMAT('      INCLUDED THE NAME OF A ')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4345)
 4345         FORMAT('      PREVIOUSLY-DEFINED VARIABLE OR PARAMETER.')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4346)IH1,IH2
 4346         FORMAT('      THE NAME OF THE VARIABLE OR PARAMETER WAS ',
     1               2A4,'   .')
              CALL DPWRST('XXX','BUG ')
              WRITE(ICOUT,4347)
 4347         FORMAT('      NO READ WAS CARRIED OUT.')
              CALL DPWRST('XXX','BUG ')
              IERROR='YES'
              GOTO8800
C
            ENDIF
          ENDIF
 4300   CONTINUE
C
        ICASEA='U'
        IU=IU+1
        IF(IU.GT.MAXU2)GOTO4370
        JUNAM1(IU)=IH1
        JUNAM2(IU)=IH2
        GOTO4370
C
 4370   CONTINUE
        IE=IE+1
        IF(IE.GT.MAXE2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4381)
 4381     FORMAT('***** ERROR IN DPREAD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4382)
 4382     FORMAT('      THE NUMBER OF NAMES IN THE READ COMMAND')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4383)
 4383     FORMAT('      HAS JUST EXCEEDED THE ALLOWABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4384)MAXE2
 4384     FORMAT('      MAXIMUM (',I5,')')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO8800
        ENDIF
C
        JENAM1(IE)=IH1
        JENAM2(IE)=IH2
        IECASE(IE)='NEW'
        IF(ICASEA.EQ.'V')IECASE(IE)='OLD'
        IECOL2(IE)=-1
        IF(ICASEA.EQ.'V')IECOL2(IE)=IVALUE(I2)
        IF(ICASEA.EQ.'P')IECASE(IE)='OLD'
        IF(ICASEA.EQ.'F')IECASE(IE)='OLD'
C
        IF(ICASTO.EQ.'ON')GOTO4215
C
 4200 CONTINUE
 4290 CONTINUE
C
CCCCC FEBRUARY 2003: IF NO VARIABLES GIVEN, THEN WILL
CCCCC DETERMINE AUTOMATICALLY LATER ON.
C
      NUMV=IV
      NUMP=IP
      NUMM=IM
      NUMF=IF
      NUMU=IU
      NUME=IE
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,4411)NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME
 4411   FORMAT('NUMALL,NUMV,NUMP,NUMM,NUMF,NUMU,NUME = ',7I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4412)
 4412   FORMAT('I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I),
     1  JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)')
        CALL DPWRST('XXX','BUG ')
        DO4420I=1,15
          WRITE(ICOUT,4421)I,JVNAM1(I),JVNAM2(I),JPNAM1(I),JPNAM2(I),
     1    JMNAM1(I),JMNAM2(I),JFNAM1(I),JFNAM2(I),JUNAM1(I),JUNAM2(I)
 4421     FORMAT(I8,5X,2A4,1X,2A4,1X,2A4,1X,2A4,1X,2A4)
          CALL DPWRST('XXX','BUG ')
 4420   CONTINUE
      ENDIF
C
C               ***************************************************
C               **  STEP 5--                                     **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (1 TO 100) OF VARIABLES TO BE READ           **
C               **  (NOTE--THIS DOES NOT INCLUDE PARAMETERS      **
C               **  OR MODELS IN THE ABOVE COUNT--               **
C               **  ONLY VARIABLES.)                             **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF CONSTANTS TO BE READ   .       **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF MODELS TO BE READ   .          **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (0 TO 100) OF FUNCTIONS TO BE READ   .       **
C               **  CHECK FOR A VALID NUMBER                     **
C               **  (1 TO 100) OF UNKNOWNS TO BE READ   .        **
C               ***************************************************
C
      IF(NUMV.LT.0 .OR. NUMV.GT.MAXV2)THEN
C
        WRITE(ICOUT,511)
  511   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,512)
  512   FORMAT('      FOR A READ, ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,513)
  513   FORMAT('      THE NUMBER OF VARIABLES (NOT COUNTING ',
     1         'PARAMETERS OR MODELS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,514)MAXV2
  514   FORMAT('      MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,515)
  515   FORMAT('      SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,516)
  516   FORMAT('      THE SPECIFIED NUMBER')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,517)NUMV
  517   FORMAT('      OF VARIABLES TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,518)MAXV2
  518   FORMAT('      NOTE--ONLY THE FIRST ',I8,' VARIABLES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,519)
  519   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,520)
  520   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,521)(IANSLC(I),I=1,MIN(80,IWIDTH))
  521     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IF(NUMP.LT.0 .OR. NUMP.GT.MAXP2)THEN
C
        WRITE(ICOUT,531)
  531   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,532)
  532   FORMAT('      FOR A READ, THE NUMBER OF PARAMETERS ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,534)MAXP2
  534   FORMAT('      (CONSTANTS) MUST BE AT MOST ',I8,'  ;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,535)
  535   FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,537)NUMP
  537   FORMAT('      NUMBER OF PARAMETERS TO BE READ    WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,538)MAXP2
  538   FORMAT('      NOTE--ONLY THE FIRST ',I8,' PARAMETERS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,539)
  539   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,540)
  540   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,541)(IANSLC(I),I=1,MIN(80,IWIDTH))
  541     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IF(NUMM.LT.0 .OR. NUMM.GT.MAXM2)THEN
C
        WRITE(ICOUT,551)
  551   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,553)
  553   FORMAT('      FOR A READ, THE NUMBER OF MODELS MUST BE AT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,555)MAXM2
  555   FORMAT('      MOST ',I8,'  ;  SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,556)NUMM
  556   FORMAT('      THE SPECIFIED NUMBER OF MODELS TO BE READ WAS ',
     1         I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,558)MAXM2
  558   FORMAT('      NOTE--ONLY THE FIRST ',I8,' MODELS WILL BE ',
     1         'READ.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,560)
  560   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,561)(IANSLC(I),I=1,MIN(80,IWIDTH))
  561     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IF(NUMF.LT.0 .OR. NUMM.GT.MAXF2)THEN
C
        WRITE(ICOUT,571)
  571   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,572)
  572   FORMAT('      FOR A READ, THE NUMBER OF FUNCTIONS MUST BE AT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,575)MAXF2
  575   FORMAT('      MOST ',I8,'  ;  SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,576)NUMF
  576   FORMAT('      THE SPECIFIED NUMBER OF FUNCTIONS TO BE READ ',
     1         'WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,578)MAXF2
  578   FORMAT('      NOTE--ONLY THE FIRST ',I8,' FUNCTIONS WILL BE ',
     1         'READ.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,560)
  580   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,581)(IANSLC(I),I=1,MIN(80,IWIDTH))
  581     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
      ENDIF
C
      IF(NUMU.LT.0 .OR. NUMU.GT.MAXU2)THEN
C
        WRITE(ICOUT,611)
  611   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,612)
  612   FORMAT('      FOR A READ, THE NUMBER OF UNKNOWNS MUST BE AT')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,614)MAXU2
  614   FORMAT('      MUST BE AT MOST ',I8,';  SUCH WAS NOT THE CASE ',
     1         'HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,617)NUMU
  617   FORMAT('      THE SPECIFIED NUMBER OF UNKNOWNS TO BE READ WAS ',
     1         I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,618)MAXU2
  618   FORMAT('      NOTE--ONLY THE FIRST ',I8,' UNKNOWNS')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,619)
  619   FORMAT('      WILL BE READ   .')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,620)
  620   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,621)(IANSLC(I),I=1,MIN(80,IWIDTH))
  621     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
      ENDIF
C
      IF(ICASRE.NE.'ROWI' .AND. NUME.LT.1 .AND. ICNTCH.LT.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4451)
 4451   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4452)
 4452   FORMAT('      NO VARIABLE NAMES WERE PROVIDED IN THE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4453)
 4453   FORMAT('      READ STATEMENT, HENCE NO READ WAS CARRIED OUT.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4454)
 4454   FORMAT('      ILLUSTRATIVE EXAMPLE TO DEMONSTRATE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4455)
 4455   FORMAT('      THE PROPER FORM FOR THE READ COMMAND--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4456)
 4456   FORMAT('      SUPPOSE THE ANALYST WISHES TO READ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4457)
 4457   FORMAT('      DATA FROM THE FILE    CALIB.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4458)
 4458   FORMAT('      INTO THE INTERNAL VARIABLES Y, X1, AND X2;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4459)
 4459   FORMAT('      THIS IS DONE BY ENTERING THE COMMAND')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4460)
 4460   FORMAT('      READ CALIB. Y X1 X2')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
      ENDIF
C
C               *******************************************************
C               **  STEP 6--                                         **
C               **  THOSE NAMES WHICH ARE OF THE UNKNOWN CATEGORY    **
C               **  WILL BECOME  FUTURE VARIABLES/PARAMETERS/FUNCTIONS.*
C               **  ASSIGN THESE VARIABLES TO THE NEXT AVAILABLE     **
C               **  COLUMNS, AND UPDATE THE NAME TABLE ACCORDINGLY.  **
C               *******************************************************
C
      IF(NUME.GT.0)THEN
        INAM=NUMNAM
        IF(ICASRE.EQ.'VARI')ICOL=NUMCOL
        DO700IE=1,NUME
          IF(ICASRE.EQ.'VARI'.AND.IECASE(IE).EQ.'OLD')GOTO700
          IF(ICASRE.EQ.'PARA'.AND.IECASE(IE).EQ.'OLD')GOTO700
          IF(ICASRE.EQ.'FUNC'.AND.IECASE(IE).EQ.'OLD')GOTO700
          IF(ICASRE.EQ.'MATR'.AND.IECASE(IE).EQ.'OLD')GOTO700
          IF(ICASRE.EQ.'VARI'.AND.IECOL2(IE).GE.1)GOTO700
          IF(ICASRE.EQ.'MATR')GOTO700
          INAM=INAM+1
          IF(ICASRE.EQ.'VARI')ICOL=ICOL+1
C
          IF(INAM.GT.MAXNAM)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,711)
  711       FORMAT('***** ERROR IN DPREAD--')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,712)
  712       FORMAT('      THE NUMBER OF NAMES')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,713)
  713       FORMAT('      (VARIABLES + PARAMETERS + FUNCTIONS)')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,714)
  714       FORMAT('      HAS JUST EXCEEDED THE MAXIMUM SIZE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,715)MAXNAM
  715       FORMAT('      (',I5,') OF THE INTERNAL NAME TABLE.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO8800
          ENDIF
C
          IF(ICASRE.NE.'PARA' .AND. ICASRE.NE.'FUNC' .AND.
     1       ICASRE.NE.'ROWI' .AND. ICOL.GT.MAXCOL)THEN
             WRITE(ICOUT,999)
             CALL DPWRST('XXX','BUG ')
             WRITE(ICOUT,721)
  721        FORMAT('***** ERROR IN DPREAD--')
             CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,722)
  722       FORMAT('      THE NUMBER OF COLUMNS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,723)
  723       FORMAT('      IN THE INTERNAL DATAPLOT DATA ARRAY')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,724)
  724       FORMAT('      HAS JUST EXCEEDED THE ALLOWABLE')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,725)MAXCOL
  725       FORMAT('      MAXIMUM (',I5,')')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO8800
          ENDIF
C
          IHNAME(INAM)=JENAM1(IE)
          IHNAM2(INAM)=JENAM2(IE)
          IF(ICASRE.EQ.'PARA')IUSE(INAM)='P'
          IF(ICASRE.EQ.'FUNC')IUSE(INAM)='F'
          IF(ICASRE.EQ.'VARI')THEN
            IUSE(INAM)='V'
            IVALUE(INAM)=ICOL
            IECOL2(IE)=ICOL
            IN(INAM)=0
          ENDIF
  700   CONTINUE
        NUMNAM=INAM
        IF(ICASRE.EQ.'VARI')NUMCOL=ICOL
      ENDIF
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,791)NUMNAM,NUMCOL,NUMNAM,ICASRE
  791   FORMAT('NUMNAM,NUMCOL,NUMNAM,ICASRE = ',3I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ********************************************************
C               **  STEP 7--                                          **
C               **  FIRST, BRANCH TO THE APPROPRIATE SUBCASE          **
C               **  (DEPENDING ON WHETHER UNQUALIFIED, SUBSET OR FOR);**
C               **  THE DETERMINE THE LENGTH OF THE LONGEST           **
C               **  VARIABLE TO BE READ    IN ;                       **
C               **  THEN READ IN  THE VARIABLES                       **
C               **  THAT WERE SPECIFIED.                              **
C               ********************************************************
C
      ISTEPN='7'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MAXNRD=MAXN
      IF(IREASB.EQ.'P-P ')ICASEQ='FULL'
      IF(ICASEQ.EQ.'FULL')THEN
        DO7315I=1,MAXNRD
          ISUB(I)=1
 7315   CONTINUE
        NQ2=MAXNRD
      ELSEIF(ICASEQ.EQ.'SUBS')THEN
        NIOLD=MAXNRD
        CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
        NQ2=NIOLD
      ELSEIF(ICASEQ.EQ.'FOR')THEN
        NIOLD=MAXNRD
        CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1             NLOCAL,ILOCS,NS,IBUGQ,IERROR)
        NQ2=NFOR
      ENDIF
C
C               *******************************************
C               **  STEP 8--                             **
C               **  IF A DATA ROW MINIMUM EXISTS AND SO  **
C               **  OUR ATTENTION IS FOCUSED ONLY ON     **
C               **  CERTAIN ROWS OF THE DATA FILE,       **
C               **  THEN GO DOWN TO THE FIRST SUCH ROW   **
C               **  IN THE FILE.                         **
C               *******************************************
C
      ISTEPN='8'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFMFLG.EQ.'ON' .OR. IFROW1.LE.1)GOTO7369
        IFRMIN=1
        IFRMAX=IFROW1-1
        IF(IFRMIN.GT.IFRMAX)GOTO7369
        MINCO2=1
        MAXCO2=NUMRCM
        IF(IRD2.EQ.IRD)MAXCO2=80
        IFCOL3=IFCOL1
        IFCOL4=IFCOL2
C       THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988
C       TO "TURN OFF" THE    COLUMN LIMITS    IF READING FROM A NON-FILE
C       (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO).
        IF(IOFILE.EQ.'NO')THEN
          IFCOL3=MINCO2
          IFCOL4=MAXCO2
        ENDIF
        IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
C
        DO7360IFROW=IFRMIN,IFRMAX
          IF(IOFILE.EQ.'NO')THEN
            READ(IRD2,7361,END=7363,ERR=7363)IJUNK
 7361       FORMAT(A1)
          ELSEIF(IOFILE.EQ.'YES')THEN
            NUMCHA=-1
            CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                  IA,NUMCHA,
     1                  ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
            IF(IERROR.EQ.'YES')GOTO8800
            IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1        NUMCHA.EQ.3)GOTO7363
          ENDIF
          GOTO7360
C
 7363     CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7364)
 7364     FORMAT('***** ERROR IN DPREAD--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7365)
 7365     FORMAT('      END OF FILE ENCOUNTERED WHILE SKIPPING OVER',
     1           'HEADER LINES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7367)
 7367     FORMAT('      NOTE SKIP AND ROW LIMITS SETTINGS--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7368)ISKIP,IFROW1,AFROW2
 7368     FORMAT('      ISKIP,IFROW1,IFROW2 = ',2I8,2X,E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO8800
C
 7360   CONTINUE
 7369 CONTINUE
C
C               *******************************************
C               **  STEP 9--                             **
C               **  IN ADDITION, IF HEADER (= NON-DATA)  **
C               **  LINES EXIST WHICH ARE TO BE SKIPPED  **
C               **  OVER IN THE READ, DO SO HERE.        **
C               *******************************************
C
      ISTEPN='9'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFMFLG.EQ.'ON' .OR. IOFILE.EQ.'NO')GOTO7389
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IF(IFROW1.LE.1)THEN
          WRITE(ICOUT,7371)
 7371     FORMAT('THE NUMBER OF HEADER LINES')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFROW1.GE.2)THEN
          WRITE(ICOUT,7372)
 7372     FORMAT('THE NUMBER OF (ADDITIONAL) HEADER LINES')
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,7373)ISKIP
 7373   FORMAT('    BEING SKIPPED = ',I6)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
CCCCC OCTOBER 1997.  SUPPORT "SKIP AUTOMATIC", DENOTED BY ISKIP = -1.
CCCCC READ UNTIL FIND "----".  IF "----" IS NOT FOUND, REWIND THE
CCCCC FILE, AND START READ FROM LINE 1.  ALSO, IF READING FROM
CCCCC THE TERMINAL, THEN THIS OPTION DOESN'T MAKE SENSE, SO
CCCCC ASSUME ISKIP = 0 IN THIS CASE.
C
      IF(ISKIP.EQ.-1.AND.IOFILE.EQ.'YES')THEN
        IFRMIN=1
        MINCO2=1
        MAXCO2=NUMRCM
        IF(IRD2.EQ.IRD)MAXCO2=80
        IFCOL3=IFCOL1
        IFCOL4=IFCOL2
        IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
        DO7378I=1,50000
          NUMCHA=-1
          CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
          IF(IERROR.EQ.'YES')GOTO8800
          IF(IA(1).EQ.'-'.AND.IA(2).EQ.'-'.AND.IA(3).EQ.'-'.AND.
     1      IA(4).EQ.'-')THEN
            GOTO7389
          ENDIF
          IF(NUMCHA.GE.5)THEN
            DO7379LL=1,NUMCHA-3
              IF(IA(LL).EQ.'-'.AND.IA(LL+1).EQ.'-'.AND.
     1          IA(LL+2).EQ.'-'.AND.IA(LL+3).EQ.'-')THEN
                GOTO7389
              ENDIF
 7379       CONTINUE
          ENDIF
          IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1      NUMCHA.EQ.3)THEN
            REWIND IOUNIT
            GOTO7389
          ENDIF
 7378   CONTINUE
      ENDIF
C
      IF(ISKIP.LE.0)GOTO7389
      IFRMIN=IFROW1
      IFRMAX=IFROW1+ISKIP-1
      IF(IFRMIN.GT.IFRMAX)GOTO7389
      MINCO2=1
      MAXCO2=NUMRCM
      IF(IRD2.EQ.IRD)MAXCO2=80
      IFCOL3=IFCOL1
      IFCOL4=IFCOL2
C     THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988
C     TO "TURN OFF" THE    COLUMN LIMITS    IF READING FROM A NON-FILE
C     (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO).
      IF(IOFILE.EQ.'NO')THEN
        IFCOL3=MINCO2
        IFCOL4=MAXCO2
      ENDIF
      IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
      DO7380IFROW=IFRMIN,IFRMAX
        IF(IOFILE.EQ.'NO')THEN
          READ(IRD2,7382,END=7383)IJUNK
 7382     FORMAT(A1)
        ELSEIF(IOFILE.EQ.'YES')THEN
          NUMCHA=-1
          CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                IA,NUMCHA,
     1                ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
          IF(IERROR.EQ.'YES')GOTO8800
          IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1      NUMCHA.EQ.3)GOTO7383
        ENDIF
        GOTO7380
C
 7383   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7384)
 7384   FORMAT('***** ERROR IN DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7385)
 7385   FORMAT('      END OF FILE ENCOUNTERED')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7386)
 7386   FORMAT('      WHILE SKIPPING OVER HEADER LINES')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7387)
 7387   FORMAT('      NOTE SKIP AND ROW LIMITS SETTINGS--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7388)ISKIP,IFROW1,AFROW2
 7388   FORMAT('      ISKIP,IFROW1,AFROW2 = ',2I8,2X,E15.7)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO8800
C
 7380 CONTINUE
 7389 CONTINUE
C
C               ************************
C               **  STEP 10--         **
C               **  READ IN THE DATA  **
C               ************************
C
      ISTEPN='10'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7210)NUME
 7210   FORMAT('NUME = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,7211)IRD,IRD2
 7211   FORMAT('IRD,IRD2 = ',I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      DO7260I=1,MAXRCL
        ISTOR1(I)=' '
        ISTOR2(I)=' '
        ISTOR3(I)=' '
        IB(I)=' '
 7260 CONTINUE
C
      IF(NUME.GT.0)THEN
        DO7300I=1,NUME
          IEN(I)=0
 7300   CONTINUE
      ENDIF
C
      MINCO2=1
      MAXCO2=NUMRCM
      IF(IRD2.EQ.IRD)MAXCO2=80
      IFCOL3=IFCOL1
      IFCOL4=IFCOL2
C     THE FOLLOWING 2 LINES WERE INSERTED FEBRUARY 1988
C     TO "TURN OFF" THE    COLUMN LIMITS    IF READING FROM A NON-FILE
C     (THAT IS, IF READING FROM THE TERMINAL OR WITHIN A MACRO).
      IF(IOFILE.EQ.'NO')THEN
        IFCOL3=MINCO2
        IFCOL4=MAXCO2
      ENDIF
      IF(IRD2.EQ.IRD.AND.IFCOL4.GT.MAXCO2)IFCOL4=MAXCO2
C
      I=0
      IIN=0
      NUMLRD=0
      IENDTY=1
CCCCC THE FOLLOWING LINE WAS ADDED    JUNE 1990
CCCCC TO FIX FORMATTED READ YIELDING ONLY 1 LINE   JUNE 1990
      IEND='NO'
      IF(ISKIP.GE.0)THEN
        IFRMIN=IFROW1+ISKIP
        IF(ICASEQ.EQ.'FOR')IFRMIN=IFROW1+ISKIP+IROW1-1
      ELSE
        IFRMIN=1
        IF(ICASEQ.EQ.'FOR')IFRMIN=IROW1
      ENDIF
C
CCCCC OCTOBER 2004: ACCOUNT FOR SUBSET/FOR CLAUSE LIMITS
C
      IFRMAX=IFROW2
      IF(ICASEQ.EQ.'FOR')THEN
        IFRMAX=MIN(IFROW2,IROWN)
      ENDIF
C
      IF(ICASRE.EQ.'PARA' .OR. ICASRE.EQ.'FUNC')IFRMAX=IFRMIN
      IF(IHOST1.EQ.'CDC'.AND.IFRMAX.GT.130000)IFRMAX=130000
      IF(IFRMAX.GE.IBILLI)IFRMAX=IBILLI
      IF(IFRMIN.GT.IFRMAX)GOTO7470
CCCCC APRIL 1995.  CHECK FOR UNFORMATTED READ CASE.
CCCCC INITIAL IMPLEMENTATION ONLY APPLIES TO VARIABLES (NOT
CCCCC STRINGS, FUNCTIONS, MATRICES).
CCCCC 1) THE FOLLOWING COMMAND:
CCCCC        SET UNFORMATTED COLUMNS <N>
CCCCC    SPECIFIES THE NUMBER OF COLUMNS WHEN READING A MATRIX
CCCCC 2) UNFORMATTED READ ASSUMES A "SQUARE MATRIX" OF NUMBERS 
CCCCC    CONTAINING ONLY REAL NUMBERS WAS WRITTEN (THAT IS, ASSUME
CCCCC    A SINGLE WRITE PERFORMED, NOT A MIXTURE OF DIFFERENT TYPES
CCCCC    ETC.).  THE FOLLOWING 2 COMMANDS PROVIDE A LIMITED AMOUNT
CCCCC    OF FLEXIBILITY:
CCCCC        SET UNFORMATTED OFFSET <VALUE>
CCCCC        SET UNFORMATTED RECORDS <VALUE>
CCCCC    THE FIRST COMMAND SPECIFIES THE NUMBER OF DATA VALUES TO
CCCCC    SKIP AT THE BEGINING OF THE FILE.  THE SECOND COMMAND 
CCCCC    SPECIFIES THE NUMBER OF DATA VALUES TO READ.
CCCCC 3) THERE ARE ESSENTIALLY 2 WAYS TO CREATE THE UNFORMATTED
CCCCC    FILE.  FOR EXAMPLE, ASSUME WRITING 10,000 ROWS OF VARIABLES
CCCCC    X AND Y.  THEN CAN WRITE AS:
CCCCC    A)    WRITE(IUNIT) X,Y
CCCCC    B)    WRITE(IUNIT) (X(I),Y(I),I=1,N)
CCCCC    THE DISTINCTION IS THAT (A) WRITES ALL OF X AND THEN ALL OF
CCCCC    Y WHEREAS (B) WRITES X(1), Y(1), X(2), Y(2), ..., X(N), Y(N).
CCCCC    INITIAL IMPLEMENTATION ASSUMES (B) SINCE THIS CORRESPONDS
CCCCC    TO DATAPLOT'S STORING BY COLUMN.  THE
CCCCC    "SET READ UNFORMATTED-COLUMNWISE" COMMAND SPECIFIES THAT
CCCCC    METHOD (A) WAS USED TO CREATE THE FILE.
CCCCC DATAPLOT WILL READ ENTIRE UNFORMATTED FILE INTO "XSCRT"
CCCCC ARRAY.  IT WILL CHECK HOW MANY DATA VALUES WERE READ.  IT THEN
CCCCC DIVIDES THIS BY NUMBER OF VARIABLES TO BE READ.  THE DO7400
CCCCC LOOP BELOW THEN EXTRACTS EACH ROW OF DATA FROM THIS XSCRT
CCCCC ARRAY.
C
      IF(IFMFLG.EQ.'ON')THEN
C
        IF(IUNFOF.GT.2*MAXOBV)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11212)IUNFOF,2*MAXOBW
11212     FORMAT('****** ERROR: OFFSET OF ',I8,' IS GREATER THAN ',
     1           'MAXIMUM ALLOWED OF ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
        DO11002JJ=1,3*MAXOBW
          XSCRT(JJ)=CPUMIN
11002   CONTINUE
C
        IF(ICASRE.EQ.'MATR')NUME=IUNFMC
C
CCCCC   JULY 1996.  SGI DOESN'T READ IF XSCRT DIMENSIONED BIGGER
CCCCC   THAN NUMBER OF DATA POINTS IN FILE.  USER MAY NEED TO SPECIFY
CCCCC   THE COMMAND "SET UNFORMATTED RECORDS <N>".
C
        IF(IUNFNR.GT.0)THEN
          READ(IRD2,ERR=11080,END=11090,IOSTAT=JSTATS)
     1    (XSCRT(LL),LL=1,IUNFNR+IUNFOF)
        ELSE
          READ(IRD2,ERR=11080,END=11090,IOSTAT=JSTATS)XSCRT
        ENDIF
        GOTO11090
C
11080   CONTINUE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,11081)JSTATS
11081     FORMAT('****** ERROR TRYING TO READ AN UNFORMATTED FILE, ',
     1           'STATUS NUMBER = ',I8,'.')
          CALL DPWRST('XXX','BUG ')
        GOTO11090
C
11090   CONTINUE
        NSTOP=MAXOBW+IUNFOF
        IF(IUNFNR.GT.0)NSTOP=IUNFNR+IUNFOF
        DO11100JJ=NSTOP,1,-1
          NPTS=JJ
          IF(XSCRT(JJ).NE.CPUMIN)GOTO11109
11100   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,11111)
11111   FORMAT('****** ERROR: NO DATA FOUND IN THE UNFORMATTED FILE.')
        CALL DPWRST('XXX','BUG ')
        GOTO9000
11109   CONTINUE
        NPTS=NPTS-IUNFOF
        IFRMIN=1
        IFRMAX=NPTS/NUME
      ENDIF
C
      IF(ICASRE.EQ.'ROWI')THEN
         DO17411II=1,MAXOBV
           IROWLB(II)=' '
17411    CONTINUE
      ENDIF
C
CCCCC OCTOBER 2004: SUBSET/FOR/EXPECT CLAUSES ON READ HAVE SOME
CCCCC AMBIGUITY.  THAT IS, DOES THE SUBSET REFER TO THE LINES THAT
CCCCC ARE READ FROM THE FILE OR DOES THE SUBSET REFER TO HOW THE
CCCCC DATA ARE SAVED IN THE OUTPUT VECTORS.  WE ADDRESS THIS WITH
CCCCC THE COMMAND
CCCCC
CCCCC     SET READ SUBSET  <PACK/DISPERSE>   <PACK/DISPERSE>
CCCCC
CCCCC THE FIRST SETTING SPECIFIES HOW THE DATA FILE IS HANDLED
CCCCC (PACK MEANS SUBSET/FOR CLAUSE DOES NOT APPLY TO LINES IN
CCCCC FILE WHILE DISPERSE MEANS THAT IT DOES).  LIKEWISE, THE SECOND
CCCCC SETTING SPECIFIES HOW THE SUBSET/FOR CLAUSE APPLIES TO THE
CCCCC OUTPUT VARIABLES (PACK MEANS SUBSET IGNORED ON OUTPUT VECTOR,
CCCCC DISPERSE MEAMS THAT IT DOES).  THESE SETTINGS ARE CODED AS
CCCCC   "P-D", "P-P", "D-P", "D-D".  THE DEFAULT IS "P-D" (I.E.,
CCCCC THE SUBSET APPLIES TO THE OUTPUT VECTORS, BUT NOT THE INPUT
CCCCC FILE).  FOR EXAMPLE, THE COMMAND
CCCCC
CCCCC            READ X  FOR I = 1  2  10
CCCCC
CCCCC     X      P-D       P-P          D-P      D-D
CCCCC    ===========================================
CCCCC     1       1         1            1        1
CCCCC     2       0         2            3        0
CCCCC     3       2         3            5        3
CCCCC     4       0         4            7        0
CCCCC     5       3         5            9        5
CCCCC     6       0         -            -        0
CCCCC     7       4         -            -        7
CCCCC     8       0         -            -        0
CCCCC     9       5         -            -        9
CCCCC    10       0         -            -        0
C
      NCALL=0
      IMAXRW=IFRMAX-IFRMIN+1
      DO7400IFROW=IFRMIN,IFRMAX
C
        IIN=IIN+1
        IF(ISUB(IIN).NE.1)THEN
          IF(IREASB(1:1).EQ.'D')THEN
            IF(IREASB(3:3).EQ.'D')THEN
              I=I+1
            ENDIF
            NUMCHA=-1
            CALL DPREFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                  IA,NUMCHA,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
            IF(IA(1).EQ.'E'.AND.IA(2).EQ.'O'.AND.IA(3).EQ.'F'.AND.
     1         NUMCHA.EQ.3)THEN
               REWIND IOUNIT
               IENDTY=1
               GOTO7490
            ENDIF
            GOTO7400
          ENDIF
        ENDIF
C
        IF(NCREAF.LE.0 .OR. ICASRE.EQ.'FUNC' .OR. ICASRE.EQ.'ROWI')THEN
          CALL DPREAL(IRD2,IFCOL3,IFCOL4,MINCO2,MAXCO2,X0,NUMDPL,
     1                IXC,NXC,
     1                ICASRE,IFUNC2,N2,MAXN2,
     1                IMACRO,IMACNU,IMACCS,
     1                IANSLC,IWIDTH,IREACS,ISTOR1,ISTOR2,IEND,NUMLRD,
     1                IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1                ICOMCH,ICOMSW,LINETY,IGRPA2,
     1                IFCOLL,IFCOLU,ITYPE,NCOLS,NCALL,IREADL,PREAMV,
     1                MAXRDV,MAXCHV,
     1                IDECPT,
     1                IB,
     1                IERRFI,IBUGS2,ISUBRO,IERROR)
          IF(LINETY.EQ.'BLAN')GOTO7400
          NUMLRD=NUMLRD+1
          NCALL=NCALL+1
C
C  IF CHARACTER DATA ENCOUNTERED, WRITE IT TO FILE
C
          IF(NXC.GT.0 .AND. IGRPAU.EQ.'CHAR')THEN
            IF(NUMLRD.EQ.1)THEN
C
              IOUNI2=IZCHNU
              IFILE2=IZCHNA
              ISTAT2=IZCHST
              IFORM2=IZCHFO
              IACCE2=IZCHAC
              IPROT2=IZCHPR
              ICURS2=IZCHCS
C
              ISUBN0='READ'
              IERRFI='NO'
              CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,
     1                    ICURS2,
     1                    IREWI2,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
              IF(IERRFI.EQ.'YES')GOTO9000
              IZCHCS=ICURS2
C
              WRITE(IOUNI2,'(I8)')NXC
              DO27810ICNT=1,MIN(ICNTCH,MAXCHV)
                WRITE(IOUNI2,'(A4,A4)')ICLIST(ICNT),ICLIS2(ICNT)
27810         CONTINUE
            ENDIF
            WRITE(IOUNI2,'(20(A24,1X))')(IXC(J)(1:24),J=1,NXC)
          ENDIF
        ELSEIF(IFMFLG.EQ.'ON')THEN
C
          NUMLRD=NUMLRD+1
          IF(IUNFNR.GT.0.AND.NUMLRD*NUME.GT.IUNFNR)GOTO7400 
          NUMDPL=NUME
          IF(ICRFLG.EQ.'ROW')THEN
            IPTR1=(NUMLRD-1)*NUME+1+IUNFOF
            IPTR2=IPTR1+NUME-1
            ICOUNT=0
            DO17415JJ=IPTR1,IPTR2
              ICOUNT=ICOUNT+1
              X0(ICOUNT)=XSCRT(JJ)
17415       CONTINUE
          ELSE
            IPTR1=NUMLRD+IUNFOF
            IPTR2=IFRMAX
            DO17515JJ=1,NUME
              ICOUNT=IPTR1+(JJ-1)*IPTR2
              X0(JJ)=XSCRT(ICOUNT)
17515       CONTINUE
          ENDIF
        ELSE
          NUMLRD=NUMLRD+1
          NUMDPL=NUME
          IF(ICOMSW.EQ.'ON')THEN
 7417       CONTINUE
            READ(IRD2,'(A80)',END=7480)IAJUNK
            IF(IAJUNK(1:1).EQ.ICOMCH(1:1))GOTO7417
            BACKSPACE(UNIT=IRD2,IOSTAT=IOS,ERR=7413)
            GOTO7415
 7413       CONTINUE
            WRITE(ICOUT,743)
 743        FORMAT('ERROR TRYING TO BACKSPACE FILE ON FORMATTED READ')
            CALL DPWRST('XXX','BUG ')
            GOTO7417
          ENDIF
          READ(IRD2,ICREAF,END=7480,ERR=7480)(X0(K),K=1,NUME)
          GOTO7415
        ENDIF
C
 7415   CONTINUE
        IF(IERROR.EQ.'YES')GOTO8800
        IF(IFROW.EQ.IFRMIN)THEN
          DO7425K=1,132
            ISTOR3(K)=ISTOR2(K)
 7425     CONTINUE
          GOTO7430
        ENDIF
        IF(IEND.EQ.'YES')GOTO7480
C
 7430   CONTINUE
        I=I+1
C
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7431)
 7431     FORMAT('***** FROM THE MIDDLE OF DPREAD--')
          CALL DPWRST('XXX','BUG ')
          AFRMAX=IFRMAX
          WRITE(ICOUT,7432)IFROW,IFRMIN,AFRMAX,IBUGS2,ISUBRO
 7432     FORMAT('IFROW,IFRMIN,AFRMAX,IBUGS2,ISUBRO = ',2I8,E15.7,
     1           2X,A4,2X,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7433)I,ISUB(I),NUME,IBUGS2,ISUBRO
 7433     FORMAT('I,ISUB(I),NUME,IBUGS2,ISUBRO = ',3I8,2X,A4,2X,A4)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7434)MAXN,MAXCOL,MAXCP1,MAXCP2
 7434     FORMAT('MAXN,MAXCOL,MAXCP1,MAXCP2 = ',4I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7435)X0(1),X0(2),X0(3)
 7435     FORMAT('X0(1),X0(2),X0(3) = ',3E15.7)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7436)IECOL2(1),IECOL2(2),IECOL2(3)
 7436     FORMAT('IECOL2(1),IECOL2(2),IECOL2(3) = ',3I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7437)IEN(1),IEN(2),IEN(3)
 7437     FORMAT('IEN(1),IEN(2),IEN(3) = ',3I8)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7438)ICASRE,NUMVRD,NUMPRD,NUMFRD
 7438     FORMAT('ICASRE,NUMVRD,NUMPRD,NUMFRD = ',A4,3I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
C
CCCCC   OCTOBER 2004: IS OUTPUT VECTOR PACKED OR DISPERSED?
C
        IF(I.GT.MAXN .OR. I.GT.IMAXRW)GOTO7480
        IJUNK=I
        IF(IREASB(3:3).EQ.'P' .AND. IREASB(1:1).EQ.'D')IJUNK=IIN
        IF(ISUB(IJUNK).EQ.1)THEN
          GOTO7440
        ELSE
          IF(IREASB(3:3).EQ.'D')THEN
            GOTO7430
          ELSE
            GOTO7400
          ENDIF
        ENDIF
C
 7440   CONTINUE
        IF(ICASRE.EQ.'PARA')THEN
          NUMPRD=NUME
          GOTO7400
        ELSEIF(ICASRE.EQ.'FUNC')THEN
           NUMFRD=NUME
           GOTO7400
        ELSEIF(ICASRE.EQ.'MATR')THEN
C
C     -----BEGIN MATRIX COPY-----
C          IHMAT1 = FIRST  HALF OF MATRIX NAME
C          IHMAT2 = SECOND HALF OF MATRIX NAME
C          INAMMA = NAME INDEX FOR MATRIX
C          IMATC1 = FIRST COLUMN OF THE MATRIX
C          IMATNR = NUMBER OF ROWS    IN THE MATRIX
C          IMATNC = NUMBER OF COLUMNS IN THE NATRIX
C
          IF(NUMLRD.EQ.1)THEN
C
            INAM=NUMNAM
            ICOL=NUMCOL
C
            INAM=INAM+1
            ICOL=ICOL+1
C
            INAMMA=INAM
            IMATC1=ICOL
C
            IHNAME(INAMMA)=IHMAT1
            IHNAM2(INAMMA)=IHMAT2
            IUSE(INAMMA)='M'
            IVALUE(INAMMA)=ICOL
            IN(INAMMA)=0
            IVALU2(INAMMA)=ICOL+NUMDPL-1
            IMATNC=NUMDPL
            NUMNAM=INAM
            NUMCOL=ICOL
C
            ICOL=ICOL-1
            IF(NUMDPL.GT.0)THEN
              DO7452IE=1,NUMDPL
                INAM=INAM+1
                ICOL=ICOL+1
                IHNAME(INAM)=JENAM1(IE)
                IHNAM2(INAM)=JENAM2(IE)
                IUSE(INAM)='V'
                IVALUE(INAM)=ICOL
                IN(INAM)=0
                IECOL2(IE)=ICOL
                IF(IBUGS2.EQ.'ON')THEN
                  WRITE(ICOUT,7453)IE,IECOL2(IE),NUMDPL,INAM,NUMNAM
 7453             FORMAT('IE,IECOL2(IE),NUMDPL,INAM,NUMNAM = ',5I8)
                  CALL DPWRST('XXX','BUG ')
                ENDIF
 7452         CONTINUE
              NUMNAM=INAM
              NUMCOL=ICOL
            ENDIF
          ENDIF
C
          IE2=0
          IMATNR=0
          IF(NUMDPL.GT.0)THEN
            DO7455IE=1,NUMDPL
              IE2=IE
              Z0=X0(IE)
              IF(IBUGS2.EQ.'ON')THEN
                WRITE(ICOUT,7456)IE,IECOL2(IE),NUMDPL,INAM,NUMNAM
 7456           FORMAT('IE,IECOL2(IE),NUMDPL,INAM,NUMNAM = ',5I8)
                CALL DPWRST('XXX','BUG ')
              ENDIF
              ICOLVJ=IECOL2(IE)
              IJ=MAXN*(ICOLVJ-1)+I
              IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0
              IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0
              IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0
              IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0
              IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0
              IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0
              IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0
              IEN(IE)=I
              IN(INAM)=I
              IN(INAMMA)=I
              IMATNR=I
 7455       CONTINUE
            NUMVRD=IE2
            GOTO7400
          ENDIF
          NUMVRD=IE2-1
          GOTO7400
C
C     -----END MATRIX COPY-----
C
        ELSEIF(ICASRE.EQ.'ROWI')THEN
          IF(I.GT.MAXN)GOTO7480
          IROWLB(I)=' '
          IF(ISUB(I).NE.1)GOTO7400
          ILEN=24
          IF(N2.LT.ILEN)ILEN=N2
          DO7442KK=1,ILEN
            IROWLB(I)(KK:KK)=IFUNC2(KK)(1:1)
7442      CONTINUE
          GOTO7400
        ENDIF
C
C  OCTOBER 2004.  IF NUMBER OF REQUESTED ITEMS IS GREATER THAN
C                 NUMBER OF ITEMS ON THE LINE, PAD WITH MISSING
C                 VALUE (PREAMV).
C
C                 THE SET READ PAD MISSING COLUMNS COMMANDS
C                 DETERMINES WHETHER WE PAD OR USE THE PREVIOUS
C                 BEHAVIOR (I.E., IN SOME CASES, A MISSING COLUMN
C                 MAY INDICATE AN ERROR).
C
        IE2=0
        IF(NUME.LE.0)GOTO7448
        DO7445IE=1,NUME
          IE2=IE
CCCCCC    IF(IE2.GT.NUMDPL)GOTO7448
          IF(IREAPD.EQ.'OFF')THEN
            IF(IE2.GT.NUMDPL)GOTO7448
            Z0=X0(IE)
          ELSE
            IF(IE2.GT.NUMDPL)THEN
              Z0=PREAMV
            ELSE
              Z0=X0(IE)
            ENDIF
          ENDIF
          ICOLVJ=IECOL2(IE)
          IJ=MAXN*(ICOLVJ-1)+I
          IF(ICOLVJ.LE.MAXCOL)V(IJ)=Z0
          IF(ICOLVJ.EQ.MAXCP1)PRED(I)=Z0
          IF(ICOLVJ.EQ.MAXCP2)RES(I)=Z0
          IF(ICOLVJ.EQ.MAXCP3)YPLOT(I)=Z0
          IF(ICOLVJ.EQ.MAXCP4)XPLOT(I)=Z0
          IF(ICOLVJ.EQ.MAXCP5)X2PLOT(I)=Z0
          IF(ICOLVJ.EQ.MAXCP6)TAGPLO(I)=Z0
          IEN(IE)=I
 7445   CONTINUE
        NUMVRD=IE2
        GOTO7400
 7448   CONTINUE
        NUMVRD=IE2-1
 7400 CONTINUE
 7470 CONTINUE
      IENDTY=2
      GOTO7490
C
 7480 CONTINUE
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,7481)NUME
 7481   FORMAT('AT 7480: ERROR OR END OF FILE FOR FORMATTED READ, ',
     1         'NUME = ',I8,'.')
        CALL DPWRST('XXX','BUG ')
        DO7485K=1,NUME
        WRITE(ICOUT,7487)X0(K)
 7487   FORMAT('K, X0(K) = ',I8,2X,G15.7)
        CALL DPWRST('XXX','BUG ')
 7485   CONTINUE
      ENDIF 
      IENDTY=1
      NUMLRD=NUMLRD-1
      GOTO7490
C
 7490 CONTINUE
C
C               *****************************
C               **  STEP 11--              **
C               **  UPDATE THE NAME TABLE  **
C               *****************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASRE.EQ.'PARA')THEN
        ISTEPN='7700'
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        IF(NUMPRD.GT.0)THEN
          DO7710IE=1,NUMPRD
            IH1=JENAM1(IE)
            IH2=JENAM2(IE)
            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
              WRITE(ICOUT,7711)IE,JENAM1(IE),JENAM2(IE),X0(IE)
 7711         FORMAT('IE,JENAM1(IE),JENAM2(IE),X0(IE) = ',
     1               I8,2X,2A4,E15.7)
              CALL DPWRST('XXX','BUG ')
            ENDIF
            DO7720J=1,NUMNAM
              IF(IUSE(J).EQ.'P'.AND.
     1          IHNAME(J).EQ.IH1.AND.IHNAM2(J).EQ.IH2)THEN
                IECOL2(IE)=J
                IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
                  WRITE(ICOUT,7731)IE,J,IECOL2(IE),X0(IE)
 7731             FORMAT('IE,J,IECOL2(IE),X0(IE) = ',3I8,E15.7)
                  CALL DPWRST('XXX','BUG ')
                ENDIF
                VALUE(J)=X0(IE)
                IVALUE(J)=VALUE(J)
CCCCC           FOLLOWING LINE ADDED SO THAT DELETE AND RETAIN WILL NOT 
CCCCC           DELETE PARAMETER CREATED VIA READ PARAMETER.  MARCH 1994.
                IN(J)=1
              ENDIF
 7720       CONTINUE
 7710     CONTINUE
 7790   ENDIF
        GOTO7900
      ELSEIF(ICASRE.EQ.'FUNC')THEN
        ISTEPN='7800'
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1    CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
        IF(NUMFRD.GT.0)THEN
          CALL DPUPPE(IFUNC2,N2,IFUNC3,IBUGS2,IERROR)
          ISTART=IFCOL1
          ISTOP=N2
          DO7810IE=1,NUMFRD
            IH1=JENAM1(IE)
            IH2=JENAM2(IE)
            IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
               WRITE(ICOUT,7811)IE,JENAM1(IE),JENAM2(IE),IECASE(IE)
 7811          FORMAT('IE,JENAM1(IE),JENAM2(IE),IECASE(IE) = ',
     1                I8,2X,2A4,2X,A4)
               CALL DPWRST('XXX','BUG ')
            ENDIF
            DO7820J=1,NUMNAM
              IF(IUSE(J).EQ.'F'.AND.
     1          IHNAME(J).EQ.IH1.AND.IHNAM2(J).EQ.IH2)THEN
                IECOL2(IE)=J
                IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
                  WRITE(ICOUT,7826)IE,J
 7826             FORMAT('IE,J = ',2I8)
                  CALL DPWRST('XXX','BUG ')
                ENDIF
                IHLEFT=IH1
                IHLEF2=IH2
                NEWNAM='NO'
                IF(IECASE(IE).EQ.'NEW')NEWNAM='YES'
                ILISTL=J
C
                IF(NUMFRD.EQ.1)THEN
                  IF(N2.LE.0)GOTO7832
                  ICOL1=1
                  ICOL2=N2
                  IF(ICOL2.GT.ICOL1+N2-1)ICOL2=ICOL1+N2-1
                  I2=0
                  DO7831I=ICOL1,ICOL2
                    I2=I2+1
                    IFUNC3(I2)=IFUNC2(I2)
 7831             CONTINUE
 7832             CONTINUE
                  N3=I2
C
                ELSE
                  IWORD=IE
                  IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
                    WRITE(ICOUT,7841)ICOL1,ICOL2,ISTART,ISTOP,N2,N3,
     1                               IE,IWORD
 7841               FORMAT('ICOL1,ICOL2,ISTART,ISTOP,N2,N3,IE,IWORD = ',
     1                     8I8)
                    CALL DPWRST('XXX','BUG ')
                  ENDIF
                  CALL DPEXW2(IFUNC2,N2,ISTART,ISTOP,IWORD,
     1                        ICOL1,ICOL2,IFUNC3,N3,
     1                        IBUGS2,ISUBRO,IERROR)
                  IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
                    WRITE(ICOUT,7841)ICOL1,ICOL2,ISTART,ISTOP,N2,N3,
     1                               IE,IWORD
                    CALL DPWRST('XXX','BUG ')
                  ENDIF
                ENDIF
C
                CALL DPINFU(IFUNC3,N3,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1                      NUMNAM,IANSLC,IWIDTH,IHLEFT,IHLEF2,ILISTL,
     1                      NEWNAM,MAXN2,
     1                      IFUNC,NUMCHF,MAXCHF,IBUGS2,IERROR)
C
                IF(NEWNAM.EQ.'YES'.AND.IERROR.EQ.'NO')NUMNAM=NUMNAM-1
C
              ENDIF
 7820       CONTINUE
 7810     CONTINUE
        ENDIF
        GOTO7900
C
      ELSEIF(ICASRE.EQ.'ROWI')THEN
        GOTO7900
      ELSE
C
        ISTEPN='7600'
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
          CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
          WRITE(ICOUT,7601)ICASRE,NUMVRD,NUMNAM,NUME
 7601     FORMAT('ICASRE,NUMVRD,NUMNAM,NUME = ',A4,3I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NUMVRD.GT.0)THEN
          DO7610IE=1,NUMVRD
            N=IEN(IE)
            ICOLVJ=IECOL2(IE)
            DO7620J=1,NUMNAM
              IF(IUSE(J).EQ.'V'.AND.IVALUE(J).EQ.ICOLVJ)THEN
                IUSE(J)='V'
                IVALUE(J)=ICOLVJ
                IF(N.GT.IN(J))IN(J)=N
                IVSTAR(J)=MAXN*(ICOLVJ-1)+1
                IVSTOP(J)=MAXN*(ICOLVJ-1)+N
              ENDIF
 7620       CONTINUE
 7610     CONTINUE
        ENDIF
C
        NUMVRP=NUMVRD+1
        IF(ICASRE.EQ.'MATR')GOTO7690
        IF(NUMVRP.GT.NUME)GOTO7690
        DO7650IE=NUMVRP,NUME
          IEREV=NUME-IE+NUMVRP
          IF(IECASE(IEREV).EQ.'NEW')THEN
            INAM=NUMNAM
            IHNAME(INAM)='    '
            IHNAM2(INAM)='    '
            IUSE(INAM)='    '
            IVALUE(INAM)=0
            IN(INAM)=0
            NUMNAM=NUMNAM-1
            NUMCOL=NUMCOL-1
          ENDIF
 7650   CONTINUE
 7690   CONTINUE
        GOTO7900
      ENDIF
C
 7900 CONTINUE
C
C               *************************************
C               **  STEP 12--                      **
C               **  WRITE OUT SUMMARY INFORMATION  **
C               **  ABOUT THE FILE THAT WAS READ   **
C               *************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8000)
 8000   FORMAT('INPUT DATA FILE SUMMARY INFORMATION--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8001)IRD2
 8001   FORMAT('INPUT UNIT DEVICE NUMBER         = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8002)IFCOL3,IFCOL4
 8002   FORMAT('INPUT FILE COLUMN     LIMITS     = ',I8,4X,I8)
        CALL DPWRST('XXX','BUG ')
        IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
          WRITE(ICOUT,1111)AFROW2
 1111     FORMAT('AFROW2 = ',E15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(IFROW2.EQ.INTINF)THEN
          WRITE(ICOUT,8003)IFROW1
 8003     FORMAT('INPUT FILE ROW        LIMITS     = ',I8,4X,'INFINITY')
          CALL DPWRST('XXX','BUG ')
        ELSEIF(IFROW2.NE.INTINF)THEN
          WRITE(ICOUT,8004)IFROW1,IFROW2
 8004     FORMAT('INPUT FILE ROW        LIMITS     = ',I8,4X,I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,8005)ISKIP
 8005   FORMAT('NUMBER OF HEADER LINES SKIPPED   = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,8006)NUMLRD
 8006   FORMAT('NUMBER OF DATA   LINES READ      = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(NUMVRD.GE.1)THEN
          WRITE(ICOUT,8007)NUMVRD
 8007     FORMAT('NUMBER OF VARIABLES    READ      = ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NUMPRD.GE.1)THEN
          WRITE(ICOUT,8008)NUMPRD
 8008     FORMAT('NUMBER OF PARAMETERS   READ      = ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NUMFRD.GE.1)THEN
          WRITE(ICOUT,8009)NUMFRD
 8009     FORMAT('NUMBER OF FUNCTIONS/STRINGS READ = ',I8)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IF(NCREAF.LE.0)THEN
C
          IFRST=IFCOL3
          IF(IFRST+240-1.GE.IFCOL4)THEN
            ILAST=IFCOL4
          ELSE
            ILAST=IFRST+240-1
          ENDIF
C
          WRITE(ICOUT,8011)
 8011     FORMAT('THE SCANNED REGION OF THE FIRST DATA LINE READ ',
     1           '(TO A MAXIMUM OF 240 CHARACTERS) = ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8012)(ISTOR3(J),J=IFRST,MIN(240,ILAST))
 8012     FORMAT(240A1)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8013)
 8013     FORMAT('THE SCANNED REGION OF THE LAST  DATA LINE READ ',
     1           '(TO A MAXIMUM OF 240 CHARACTERS) = ')
          CALL DPWRST('XXX','BUG ')
          IF(IENDTY.EQ.1)THEN
            WRITE(ICOUT,8014)(ISTOR1(J),J=IFRST,MIN(240,ILAST))
            CALL DPWRST('XXX','BUG ')
          ELSEIF(IENDTY.EQ.2)THEN
            WRITE(ICOUT,8014)(ISTOR2(J),J=IFRST,MIN(240,ILAST))
 8014       FORMAT(240A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ENDIF
C
C               *********************************************
C               **  STEP 13--                              **
C               **  PRINT OUT SUMMARY INFORMATION          **
C               **  VARIABLES/PARAMETERS/FUNCTIONS         **
C               **  THAT WERE READ IN.                     **
C               *********************************************
C
      IF(ICASRE.EQ.'PARA')THEN
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8201)
 8201     FORMAT('PARAMETER     VALUE')
          CALL DPWRST('XXX','BUG ')
C
          DO8210IE=1,NUME
            IH1=JENAM1(IE)
            IH2=JENAM2(IE)
            DO8220I=1,NUMNAM
              I2=I
              IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
                WRITE(ICOUT,8226)IH1,IH2,VALUE(I2)
 8226           FORMAT(A4,A4,4X,E15.7)
                CALL DPWRST('XXX','BUG ')
              ENDIF
 8220       CONTINUE
 8210     CONTINUE
        ENDIF
C
      ELSEIF(ICASRE.EQ.'FUNC')THEN
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8301)
 8301     FORMAT('FUNCTION (= STRING)     CONTENT')
          CALL DPWRST('XXX','BUG ')
C
          DO8310IE=1,NUME
            IH1=JENAM1(IE)
            IH2=JENAM2(IE)
            DO8320I=1,NUMNAM
              I2=I
              IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
                JMIN=IVSTAR(I2)
                JMAX=IVSTOP(I2)
                WRITE(ICOUT,8326)IH1,IH2,(IFUNC(J),J=JMIN,JMAX)
 8326           FORMAT(A4,A4,10X,80A1)
                CALL DPWRST('XXX','BUG ')
              ENDIF
 8320       CONTINUE
 8310     CONTINUE
        ENDIF
C
      ELSEIF(ICASRE.EQ.'MATR')THEN
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8401)IHMAT1,IHMAT2,IMATNR
 8401     FORMAT('        MATRIX ',A4,A4,'--     ',I8,' ROWS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8402)IMATNC
 8402     FORMAT('               ',4X,4X,'--     ',I8,' COLUMNS')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8404)
 8404     FORMAT('     VARIABLES        COLUMN    OBS/VARIABLE')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8405)
 8405     FORMAT('(= COLUMN VECTORS)')
          CALL DPWRST('XXX','BUG ')
C
          DO8410IE=1,NUME
            IH1=JENAM1(IE)
            IH2=JENAM2(IE)
            DO8420I=1,NUMNAM
              I2=I
              IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
                WRITE(ICOUT,8426)IH1,IH2,IVALUE(I2),IN(I2)
 8426           FORMAT(8X,A4,A4,1X,I8,5X,I8)
                CALL DPWRST('XXX','BUG ')
              ENDIF
 8420       CONTINUE
 8410     CONTINUE
        ENDIF
      ELSEIF(ICASRE.EQ.'ROWI')THEN
        CONTINUE
      ELSE
C
        IF(IFEEDB.EQ.'ON')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,8101)
 8101     FORMAT('VARIABLE     COLUMN    OBS/VARIABLE')
          CALL DPWRST('XXX','BUG ')
C
          DO8110IE=1,NUME
            IH1=JENAM1(IE)
            IH2=JENAM2(IE)
            DO8120I=1,NUMNAM
              I2=I
              IF(IH1.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I))THEN
                WRITE(ICOUT,8126)IH1,IH2,IVALUE(I2),IN(I2)
 8126           FORMAT(A4,A4,1X,I8,5X,I8)
                CALL DPWRST('XXX','BUG ')
              ENDIF
 8120       CONTINUE
 8110     CONTINUE
        ENDIF
        GOTO8800
      ENDIF
C
C               ***************************************
C               **  STEP 88--                        **
C               **  FOR THE FILE CASE,               **
C               **  CLOSE THE FILE.                  **
C               ***************************************
C
 8800 CONTINUE
      ISTEPN='88'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IOFILE.EQ.'YES'.AND.ICURST.EQ.'OPEN')GOTO8810
      GOTO8890
 8810 CONTINUE
      IENDFI='OFF'
      IREWIN='ON'
      IF(IREARW.EQ.'ON')THEN
         CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1   IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
         IREACS='CLOSED'
      ENDIF
 8890 CONTINUE
C
C               ******************************************
C               **  STEP 89--                           **
C               **  IF THE MACRO STATUS IS OPEN         **
C               **  THEN CHANGE IDEV FROM READ TO MACR  **
C               ******************************************
C
 8900 CONTINUE
CCCCC IF(IMACST.EQ.'OPFI')IDEV='MACR'
CCCCC IF(IMACCS.EQ.'OPEN')IDEV='MACR'
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
C
      IF(IZCHCS.EQ.'OPEN')THEN
         CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1               IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
         IZCHCS='CLOSED'
      ENDIF
C
      IFILQU=IFILQ2
C
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'READ')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPREAD--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFROW1,AFROW2,ICASRE
 9012   FORMAT('IFROW1,AFROW2,ICASRE = ',I8,2X,E15.7,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IFCOL1,IFCOL2
 9013   FORMAT('IFCOL1,IFCOL2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)ISKIP,IBUGS2,IBUGQ
 9014   FORMAT('ISKIP,IBUGS2,IBUGQ = ',I8,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)IFOUND,IERROR
 9015   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)NUMVRD,NUMPRD,NUMFRD
 9016   FORMAT('NUMVRD,NUMPRD,NUMFRD = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9017)IMACRO,IMACNU,IMACCS
 9017   FORMAT('IMACRO,IMACNU,IMACCS = ',A4,I8,2X,A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9018)IRD,IRD2
 9018   FORMAT('IRD,IRD2 = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9019)IOSW,IOFILE,IOTERM
 9019   FORMAT('IOSW,IOFILE,IOTERM = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9020)IBUGS2,ISUBRO,IERROR
 9020   FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9021)IOUNIT
 9021   FORMAT('IOUNIT = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9022)IFILE
 9022   FORMAT('IFILE  = ',A80)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9023)ISTAT
 9023   FORMAT('ISTAT  = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9024)IFORM
 9024   FORMAT('IFORM  = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9025)IACCES
 9025   FORMAT('IACCES = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9026)IPROT
 9026   FORMAT('IPROT  = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9027)ICURST
 9027   FORMAT('ICURST = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9028)IENDFI
 9028   FORMAT('IENDFI = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9029)IREWIN
 9029   FORMAT('IREWIN = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9031)ISUBN0
 9031   FORMAT('ISUBN0 = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9032)IERRFI
 9032   FORMAT('IERRFI = ',A12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9033)NUMNAM
 9033   FORMAT('NUMNAM = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9041)N2,MAXN2,N3
 9041   FORMAT('N2,MAXN2,N3 = ',3I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9042)(IFUNC2(I),I=1,100)
 9042   FORMAT('(IFUNC2(I),I=1,100) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9043)(IFUNC3(I),I=1,100)
 9043   FORMAT('(IFUNC3(I),I=1,100) = ',100A1)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9051)IHMAT1,IHMAT2,INAMMA,IMATC1,IMATNR,IMATNC
 9051   FORMAT('IHMAT1,IHMAT2,INAMMA,IMATC1,IMATNR,IMATNC = ',
     1         A4,2X,A4,2X,4I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9061)NCREAF
 9061   FORMAT('NCREAF = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(NCREAF.GE.1)THEN
          WRITE(ICOUT,9062)(ICREAF(I:I),I=1,NCREAF)
 9062     FORMAT('(ICREAF(I:I),I=1,NCREAF) = ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,9071)IREARW
 9071   FORMAT('IREARW = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9072)ICOMCH,ICOMSW
 9072   FORMAT('ICOMCH,ICOMSW = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
