       SUBROUTINE DPRTL(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 TRIPLEX 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 DPRTL--')
      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 DRTL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(7.LE.ICHARN.AND.ICHARN.LE.12)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRTL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(13.LE.ICHARN.AND.ICHARN.LE.18)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRTL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IF(ICHARN.GE.19)GOTO1040
      GOTO1049
 1040 CONTINUE
      CALL DRTL4(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 DPRTL--')
      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 DPRTN(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 TRIPLEX 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 DPRTN--')
      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.6)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRTN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.7)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRTN2(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 DPRTN--')
      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 DPRTS(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 TRIPLEX 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 DPRTS--')
      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.8)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRTS1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.9)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRTS2(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 DPRTS--')
      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
      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 DPRTU(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 TRIPLEX 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 DPRTU--')
      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 DRTU1(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 DRTU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(14.LE.ICHARN.AND.ICHARN.LE.19)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRTU3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IF(ICHARN.GE.20)GOTO1040
      GOTO1049
 1040 CONTINUE
      CALL DRTU4(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 DPRTU--')
      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 DPRUN(XTEMP1,XTEMP2,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A RUNS ANALYSIS
C              TO TEST FOR RANDOMNENSS.
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--82/7
C     ORIGINAL VERSION--JULY      1984.
C     UPDATED         --JUNE      1990.      TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION W(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
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='DPRU'
      ISUBN2='N   '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************
C               **  TREAT THE RUNS ANALYSIS CASE  **
C               ********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRUN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPRUN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A RUNS ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPRUN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FROM WHICH A RUNS ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPRUN2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE RUNS ANALYSIS **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPRUN, AS WE ARE ABOUT TO CALL DPRUN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL DPRUN2(Y,W,NS,XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRUN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRUN2(Y,W,N,XTEMP1,XTEMP2,MAXNXT,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A RUNS ANALYSIS
C              FOR THE DATA IN THE INPUT VECTOR Y.
C     NOTE--ASSUMPTION--DATA COLLECTED SEQUENTIALLY IN TIME.
C     INPUT  ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                OF EQUALLY-SPACED OBSERVATIONS
C                                TO BE SMOOTHED.
C                       N      = THE INTEGER NUMBER OF
C                                OBSERVATIONS IN THE VECTOR Y.
C     NOTE--THE ANALYSIS CONSISTS OF FIRST DETERMINING
C           THE OBSERVED NUMBER OF RUNS FROM THE DATA,
C           AND THEN COMPUTING
C           THE EXPECTED NUMBER OF RUNS,
C           THE STANDARD DEVIATION OF THE NUMBER OF RUNS,
C           AND THE RESULTING STANDARDIZED STATISTIC
C           FOR THE NUMBER OF RUNS FOR RUNS OF VARIOUS
C           LENGTHS.
C           THIS IS DONE FOR RUNS UP, RUNS DOWN, AND
C           RUNS UP AND DOWN.
C           THIS RUNS ANSLYSIS IS A USEFUL DISTRIBUTION-FREE
C           TEST OF THE RANDOMNESS OF A DATA SET.
C     OUTPUT--4 PAGES OF AUTOMATIC PRINTOUT
C             CONSISTING OF THE OBSERVED NUMBER,
C             EXPECTED NUMBER, STANDARD DEVIATION
C             AND RESULTING STANDARDIZED STATISTIC
C             FOR RUNS OF VARIOUS LENGTHS.
C             AND THE CUMULATIVE FREQUENCY.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI 77 FORTRAN.
C     REFERENCES--LEVENE AND WOLFOWITZ, ANNALS OF MATHEMATICAL
C                 STATISTICS, 1944, PAGES 58-69;
C                 ESPECIALLY PAGES 60, 63, AND 64.
C     REFERENCES--BRADLEY, DISTRIBUTION-FREE STATISTICAL TESTS,
C                 1968, CHAPTER 12, PAGES 271-282.
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--82/7
C     ORIGINAL VERSION--JULY      1984.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION W(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION  NRUL(16), NRDL(16), NRTL(16), NRULG(16), NRDLG(16)
      DIMENSION  NRTLG(16)
      DIMENSION ENRUL(16),ENRTL(16),ENRULG(16),ENRTLG(16)
      DIMENSION SNRUL(16),SNRTL(16),SNRULG(16),SNRTLG(16)
      DIMENSION ZNRUL(16),ZNRDL(16),ZNRTL(16),ZNRULG(16),ZNRDLG(16)
      DIMENSION ZNRTLG(16)
      DIMENSION C1(15),C2(15),C3(15),C4(15)
      DIMENSION ANRUL(16),ANRDL(16),ANRTL(16)
      DIMENSION ANRULG(16),ANRDLG(16),ANRTLG(16)
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------DATA STATEMENTS------------------------------------------------
C
      DATA C1(1),C1(2),C1(3),C1(4),C1(5),C1(6),C1(7),C1(8),C1(9),C1(10),
     1C1(11),C1(12),C1(13),C1(14),C1(15)
     1/ .4236111111E+00,  .1126675485E+00,  .4191688713E-01,
     1  .1076912487E-01,  .2003959238E-02,  .3023235799E-03,
     1  .3911555473E-04,  .4459038843E-05,  .4551105210E-06,
     1  .4207466837E-07,  .3555930927E-08,  .2768273257E-09,
     1  .1997821524E-10,  .1343876568E-11,  .8465610177E-13/
      DATA C2(1),C2(2),C2(3),C2(4),C2(5),C2(6),C2(7),C2(8),C2(9),C2(10),
     1C2(11),C2(12),C2(13),C2(14),C2(15)
     1/-.4819444444E+00, -.1628284832E+00, -.9690696649E-01,
     1 -.3778106786E-01, -.9289228716E-02, -.1724429252E-02,
     1 -.2638557888E-03, -.3466965096E-04, -.4004129153E-05,
     1 -.4130382587E-06, -.3851876069E-07, -.3279103786E-08,
     1 -.2568491117E-09, -.1863433868E-10, -.1259220466E-11/
      DATA C3(1),C3(2),C3(3),C3(4),C3(5),C3(6),C3(7),C3(8),C3(9),C3(10),
     1C3(11),C3(12),C3(13),C3(14),C3(15)
     1/ .1777777778E+00,  .7916666667E-01,  .4738977072E-01,
     1  .1274801587E-01,  .2338606059E-02,  .3461358734E-03,
     1  .4407121770E-04,  .4960020603E-05,  .5010387575E-06,
     1  .4592883352E-07,  .3854170274E-08,  .2982393839E-09,
     1  .2141205844E-10,  .1433843200E-11,  .8996663214E-13/
      DATA C4(1),C4(2),C4(3),C4(4),C4(5),C4(6),C4(7),C4(8),C4(9),C4(10),
     1C4(11),C4(12),C4(13),C4(14),C4(15)
     1/-.3222222222E+00, -.5972222222E-01, -.1130268959E+00,
     1 -.4696428571E-01, -.1123273065E-01, -.2025170849E-02,
     1 -.3029410411E-03, -.3912824548E-04, -.4459234519E-05,
     1 -.4551128785E-06, -.4207469124E-07, -.3555931110E-08,
     1 -.2768273269E-09, -.1997821525E-10, -.1343876568E-11/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPRU'
      ISUBN2='N2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPRUN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,IBUGA3
   52 FORMAT('N,IBUGA3 = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I),W(I)
   57 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LT.1)GOTO110
      GOTO119
  110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPRUN2--THE NUMBER OF OBSERVATIONS ',
     1'IN THE RESPONSE VARIABLE IS NON-POSITIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)N
  112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)
  121 FORMAT('***** NOTE FROM DPRUN2--THE RESPONSE VARIABLE ',
     1'ONLY HAS 1 ELEMENT')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  129 CONTINUE
C
      HOLD=Y(1)
      DO135I=2,N
      IF(Y(I).NE.HOLD)GOTO139
  135 CONTINUE
  130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)HOLD
  131 FORMAT('***** NOTE FROM DPRUN2--THE RESPONSE VARIABLE ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  139 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  FORM THE SEQUENTIAL DIFFERENCE TABLE  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      AN=N
      NM1=N-1
      DO100I=1,NM1
      IP1=I+1
      XTEMP1(I)=Y(IP1)-Y(I)
  100 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  ZERO-OUT THE 6 'NUMBER OF RUNS' VECTORS  **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO200I=1,16
      NRUL(I)=0
      NRDL(I)=0
      NRTL(I)=0
      NRULG(I)=0
      NRDLG(I)=0
      NRTLG(I)=0
  200 CONTINUE
C
C               ***********************************************************
C               **  STEP 13--                                            **
C               **  DETERMINE THE NUMBER OF RUNS UP OF LENGTH EXACTLY I  **
C               **  AND THE NUMBER OF RUNS DOWN OF LENGTH EXACTLY I      **
C               **  DETERMINE THE LENGTH OF THE LONGEST RUN UP           **
C               **  AND THE LENGTH OF THE LONGEST RUN DOWN               **
C               ***********************************************************
C
      ISTEPN='13'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      LENUP=0
      LENDN=0
      MAXLNU=0
      MAXLND=0
      DO300I=1,NM1
      IF(XTEMP1(I).EQ.0.0.AND.LENUP.GE.1)LENUP=LENUP+1
      IF(XTEMP1(I).EQ.0.0.AND.LENDN.GE.1)LENDN=LENDN+1
      IF(XTEMP1(I).EQ.0.0.AND.LENUP.EQ.0.AND.LENDN.EQ.0)LENUP=LENUP+1
CCCCC IF(XTEMP1(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.LE.N)
      IF(XTEMP1(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.LE.15)
     1NRDL(LENDN)=NRDL(LENDN)+1
      IF(XTEMP1(I).GT.0.0.AND.LENDN.GE.1.AND.LENDN.GE.16)
     1NRDL(16)=NRDL(16)+1
      IF(XTEMP1(I).GT.0.0)LENDN=0
      IF(XTEMP1(I).GT.0.0)LENUP=LENUP+1
CCCCC IF(XTEMP1(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.LE.N)
      IF(XTEMP1(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.LE.15)
     1NRUL(LENUP)=NRUL(LENUP)+1
      IF(XTEMP1(I).LT.0.0.AND.LENUP.GE.1.AND.LENUP.GE.16)
     1NRUL(16)=NRUL(16)+1
      IF(XTEMP1(I).LT.0.0)LENUP=0
      IF(XTEMP1(I).LT.0.0)LENDN=LENDN+1
CCCCC IF(I.EQ.NM1.   AND.LENDN.GE.1.AND.LENDN.LE.N)
      IF(I.EQ.NM1.   AND.LENDN.GE.1.AND.LENDN.LE.15)
     1NRDL(LENDN)=NRDL(LENDN)+1
      IF(I.EQ.NM1.   AND.LENDN.GE.1.AND.LENDN.GE.16)
     1NRDL(16)=NRDL(16)+1
CCCCC IF(I.EQ.NM1.   AND.LENUP.GE.1.AND.LENUP.LE.N)
      IF(I.EQ.NM1.   AND.LENUP.GE.1.AND.LENUP.LE.15)
     1NRUL(LENUP)=NRUL(LENUP)+1
      IF(I.EQ.NM1.   AND.LENUP.GE.1.AND.LENUP.GE.16)
     1NRUL(16)=NRUL(16)+1
      IF(LENUP.GT.MAXLNU)MAXLNU=LENUP
      IF(LENDN.GT.MAXLND)MAXLND=LENDN
  300 CONTINUE
C
C               **************************************************************
C               **  STEP 14--                                               **
C               **  DETERMINE THE NUMBER OF RUNS TOTAL OF LENGTH EXACTLY I  **
C               **  AND THE LENGTH OF THE LONGEST RUN UP OR DOWN            **
C               **************************************************************
C
      ISTEPN='14'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO400I=1,16
      NRTL(I)=NRUL(I)+NRDL(I)
  400 CONTINUE
      MAXLNT=MAXLNU
      IF(MAXLND.GT.MAXLNU)MAXLNT=MAXLND
C
C               ***********************************************************
C               **  STEP 15--                                            **
C               **  DETERMINE THE NUMBER OF RUNS UP OF LENGTH I OR MORE  **
C               **  AND THE NUMBER OF RUNS DOWN OF LENGTH I OR MORE      **
C               **  AND THE NUMBER OF RUNS TOTAL OF LENGTH I OR MORE     **
C               ***********************************************************
C
      ISTEPN='15'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NRULG(16)=NRUL(16)
      NRDLG(16)=NRDL(16)
      NRTLG(16)=NRTL(16)
      DO500I=1,15
      J=16-I
      JP1=J+1
      NRULG(J)=NRULG(JP1)+NRUL(J)
      NRDLG(J)=NRDLG(JP1)+NRDL(J)
      NRTLG(J)=NRTLG(JP1)+NRTL(J)
  500 CONTINUE
C
C               ****************************************************************
C               **  STEP 16--
C               **  DETERMINE THE NUMBER OF POSITIVE, ZERO, AND NEGATIVE ENTRIES
C               **  IN THE DIFFERENCE TABLE.  IF RANDOM, THE NUMBER OF POSITIVE
C               **  APPROXIMATELY EQUAL TO THE NUMBER OF NEGATIVE
C               ****************************************************************
C
      ISTEPN='16'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NNEG=0
      NZER=0
      NPOS=0
      DO800I=1,NM1
      IF(XTEMP1(I).LT.0.0)NNEG=NNEG+1
      IF(XTEMP1(I).EQ.0.0)NZER=NZER+1
      IF(XTEMP1(I).GT.0.0)NPOS=NPOS+1
  800 CONTINUE
C
C               ****************************************************************
C               **  STEP 17--
C               **  COMPUTE THE EXPECTED NUMBER OF RUNS UP OF LENGTH EXACTLY I =
C               **  THE EXPECTED NUMBER OF RUNS DOWN OF LENGTH EXACTLY I =
C               **  ONE HALF THE EXPECTED NUMBER OF RUNS TOTAL OF LENGTH EXACTLY
C               ****************************************************************
C
      ISTEPN='17'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DEN=6.0
      DO2000I=1,15
      AI=I
      ENRUL(I)=AN*(AI*AI+3.0*AI+1.0)-(AI*AI*AI+3.0*AI*AI-AI-4.0)
      DEN=DEN*(AI+3.0)
      ENRUL(I)=ENRUL(I)/DEN
      ENRTL(I)=2.0*ENRUL(I)
 2000 CONTINUE
C
C               ****************************************************************
C               **  STEP 18-
C               **  COMPUTE THE EXPECTED NUMBER OF RUNS UP OF LENGTH I OR MORE =
C               **  THE EXPECTED NUMBER OF RUNS DOWN OF LENGTH I OR MORE =
C               **  ONE HALF THE EXPECTED NUMBER OF RUNS TOTAL OF LENGTH I OR MO
C               ****************************************************************
C
      ISTEPN='18'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DEN=2.0
      DO2100I=1,15
      AI=I
      ENRULG(I)=AN*(AI+1.0)-(AI*AI+AI-1.0)
      DEN=DEN*(AI+2.0)
      ENRULG(I)=ENRULG(I)/DEN
      ENRTLG(I)=2.0*ENRULG(I)
 2100 CONTINUE
C
C               ****************************************************************
C               **  STEP 19--
C               **  COMPUTE THE STANDARD DEV. OF THE NUMBER OF RUNS UP OF LENGTH
C               **  THE STANDARD DEV. OF THE NUMBER OF RUNS DOWN OF LENGTH EXACT
C               **  SQRT(0.5)* THE STAND. DEV. OF THE NUMBER OF RUNS TOTAL OF LE
C               ****************************************************************
C
      ISTEPN='19'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2500I=1,15
      ARG=C1(I)*AN+C2(I)
      SNRTL(I)=0.0
      IF(ARG.GT.0.0)SNRTL(I)=SQRT(ARG)
      SNRUL(I)=SQRT(0.5)*SNRTL(I)
 2500 CONTINUE
C
C               ****************************************************************
C               **  STEP 20--
C               **  COMPUTE THE STAND. DEV. OF THE NUMBER OF RUNS UP OF LENGTH I
C               **  THE STAND. DEV. OF THE NUMBER OF RUNS DOWN OF LENGTH I OR MO
C               **  SQRT(0.5)* THE STAND. DEV. OF THE NUMBER OF RUNS TOTAL OF LE
C               ****************************************************************
C
      ISTEPN='20'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2600I=1,15
      ARG=C3(I)*AN+C4(I)
      SNRTLG(I)=0.0
      IF(ARG.GT.0.0)SNRTLG(I)=SQRT(ARG)
      SNRULG(I)=SQRT(0.5)*SNRTLG(I)
 2600 CONTINUE
C
C               *************************
C               **  STEP 21--          **
C               **  FORM Z STATISTICS  **
C               *************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO3100I=1,15
C
      STAT=NRUL(I)
      ZNRUL(I)=(-99999.99)
      IF(SNRUL(I).GT.0.0)ZNRUL(I)=(STAT   -ENRUL(I))/SNRUL(I)
C
      STAT=NRDL(I)
      ZNRDL(I)=(-99999.99)
      IF(SNRUL(I).GT.0.0)ZNRDL(I)=(STAT   -ENRUL(I))/SNRUL(I)
C
      STAT=NRTL(I)
      ZNRTL(I)=(-99999.99)
      IF(SNRTL(I).GT.0.0)ZNRTL(I)=(STAT   -ENRTL(I))/SNRTL(I)
C
      STAT=NRULG(I)
      ZNRULG(I)=(-99999.99)
      IF(SNRULG(I).GT.0.0)ZNRULG(I)=(STAT    -ENRULG(I))/SNRULG(I)
C
      STAT=NRDLG(I)
      ZNRDLG(I)=(-99999.99)
      IF(SNRULG(I).GT.0.0)ZNRDLG(I)=(STAT    -ENRULG(I))/SNRULG(I)
C
      STAT=NRTLG(I)
      ZNRTLG(I)=(-99999.99)
      IF(SNRTLG(I).GT.0.0)ZNRTLG(I)=(STAT    -ENRTLG(I))/SNRTLG(I)
C
 3100 CONTINUE
C
      DO3200I=1,15
      ANRUL(I)=NRUL(I)
      ANRDL(I)=NRDL(I)
      ANRTL(I)=NRTL(I)
      ANRULG(I)=NRULG(I)
      ANRDLG(I)=NRDLG(I)
      ANRTLG(I)=NRTLG(I)
 3200 CONTINUE
C
C               ****************************
C               **  STEP 22--             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='22'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO4990
C
      IMAX=15
      IF(IMAX.GT.N)IMAX=N
      IMAX2=10
      IF(IMAX2.GT.N)IMAX2=N
CCCCC WRITE(ICOUT,998)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4102)
 4102 FORMAT('                      RUNS UP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4104)
 4104 FORMAT('           STATISTIC = NUMBER OF RUNS UP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4105)
 4105 FORMAT('               OF LENGTH EXACTLY I')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
 4106 FORMAT('   I         STAT     EXP(STAT)    SD(STAT)       Z ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4110I=1,IMAX2
      WRITE(ICOUT,4111)I,ANRUL(I),ENRUL(I),SNRUL(I),ZNRUL(I)
 4111 FORMAT(I4,F12.1,F12.4,F12.4,F12.2)
      CALL DPWRST('XXX','BUG ')
 4110 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4124)
 4124 FORMAT('           STATISTIC = NUMBER OF RUNS UP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4125)
 4125 FORMAT('               OF LENGTH I OR MORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4130I=1,IMAX2
      WRITE(ICOUT,4111)I,ANRULG(I),ENRULG(I),SNRULG(I),ZNRULG(I)
      CALL DPWRST('XXX','BUG ')
 4130 CONTINUE
C
CCCCC WRITE(ICOUT,998)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4202)
 4202 FORMAT('                     RUNS DOWN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4204)
 4204 FORMAT('           STATISTIC = NUMBER OF RUNS DOWN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4205)
 4205 FORMAT('               OF LENGTH EXACTLY I')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4210I=1,IMAX2
      WRITE(ICOUT,4111)I,ANRDL(I),ENRUL(I),SNRUL(I),ZNRDL(I)
      CALL DPWRST('XXX','BUG ')
 4210 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4224)
 4224 FORMAT('           STATISTIC = NUMBER OF RUNS DOWN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4225)
 4225 FORMAT('               OF LENGTH I OR MORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4230I=1,IMAX2
      WRITE(ICOUT,4111)I,ANRDLG(I),ENRULG(I),SNRULG(I),ZNRDLG(I)
      CALL DPWRST('XXX','BUG ')
 4230 CONTINUE
C
CCCCC WRITE(ICOUT,998)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4302)
 4302 FORMAT('           RUNS TOTAL = RUNS UP + RUNS DOWN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4304)
 4304 FORMAT('         STATISTIC = NUMBER OF RUNS TOTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE (IPR,4305)
 4305 FORMAT('               OF LENGTH EXACTLY I')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4310I=1,IMAX2
      WRITE(ICOUT,4111)I,ANRTL(I),ENRTL(I),SNRTL(I),ZNRTL(I)
      CALL DPWRST('XXX','BUG ')
 4310 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4324)
 4324 FORMAT('         STATISTIC = NUMBER OF RUNS TOTAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4325)
 4325 FORMAT('               OF LENGTH I OR MORE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4106)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO4330I=1,IMAX2
      WRITE(ICOUT,4111)I,ANRTLG(I),ENRTLG(I),SNRTLG(I),ZNRTLG(I)
      CALL DPWRST('XXX','BUG ')
 4330 CONTINUE
C
CCCCC WRITE(ICOUT,998)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4401)MAXLNU
 4401 FORMAT('          LENGTH OF THE LONGEST RUN UP         = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4402)MAXLND
 4402 FORMAT('          LENGTH OF THE LONGEST RUN DOWN       = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4403)MAXLNT
 4403 FORMAT('          LENGTH OF THE LONGEST RUN UP OR DOWN = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4411)NPOS
 4411 FORMAT('          NUMBER OF POSITIVE DIFFERENCES = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4412)NNEG
 4412 FORMAT('          NUMBER OF NEGATIVE DIFFERENCES = ',I5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4413)NZER
 4413 FORMAT('          NUMBER OF ZERO     DIFFERENCES = ',I5)
      CALL DPWRST('XXX','BUG ')
CC998 FORMAT(1H1)
C
 4990 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRUN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),W(I)
 9017 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRUNS(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM A RUN-SEQUENCE PLOT.
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--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         --JANUARY   1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
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
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPRU'
      ISUBN2='NS  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=1
      MINN2=1
C
C               ****************************************
C               **  TREAT THE RUN-SEQUENCE PLOT CASE  **
C               ****************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPRUNS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
      ICASPL='RUNS'
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 2      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(3)
      IHLEF2=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 3--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPRUNS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A RUN-SEQUENCE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,2X,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE D(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE  **
C               **  (FOR THE TIME BEING ONLY).             **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPRUNS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FOR WHICH A RUN-SEQUENCE PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)D(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)D(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)D(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)D(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)D(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)D(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)D(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               *************************************************************
C               **  STEP 6--                                               **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.  **
C               **  RESET THE D(.) VARIABLE TO ONES.                       **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NPLOTP=NS
C
      IF(NPLOTP.LE.0)GOTO650
      DO600I=1,NPLOTP
      Y(I)=D(I)
      X(I)=I
  600 CONTINUE
C
      DO610I=1,NPLOTP
      D(I)=1.0
  610 CONTINUE
C
  650 CONTINUE
      NPLOTV=1
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRUNS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRUPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A RUNS PLOT.
C
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
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
      ISUBN1='DPRU'
      ISUBN2='PL  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IFOUND='YES'
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('***** ERROR IN DPRUPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)
  102 FORMAT('      RUNS PLOT CAPABILITY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)
  103 FORMAT('      NOT YET AVAILABLE')
      CALL DPWRST('XXX','BUG ')
C
      RETURN
      END
      SUBROUTINE DPSACO(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IANSSV,IREPMX,IPOINT,
     1ISACNC,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--SAVE (FOR FUTURE USE BY THE REEXECUTE COMMAND)
C              SELECTED COMMANDS IN THE (RECENT) COMMAND LIST.
C              THE RECENT COMMAND LIST CONSISTS OF THE
C              LAST IREPMX (= 50) COMMANDS.
C              LAST MAXLIS (==> 200) COMMANDS.  APRIL 1993
C
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--86/1
C     ORIGINAL VERSION--APRIL     1986.
C     UPDATED         --APRIL     1993. SOFT-CODE DIMEN. FOR IANSSV()
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1993
      INCLUDE 'DPCOPA.INC'
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*1 IANSSV
      CHARACTER*80 ISACNC
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
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*1 IC1
      CHARACTER*4 IC4
      CHARACTER*80 ISTRIN
      CHARACTER*80 ISTRI2
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
CCCCC THE FOLLOWING 2 LINES WERE CHANGED APRIL 1993
CCCCC DIMENSION IANSSV(50,80)
CCCCC DIMENSION ITAB(50)
      DIMENSION IANSSV(MAXLIS,MAXCIS)
      DIMENSION ITAB(MAXLIS)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOF2.INC'
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='DPSA'
      ISUBN2='CO  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SACO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPSACO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IFOUND,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,54)(IANSLC(I),I=1,IWIDTH)
   54 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO58
      DO56I=1,NUMARG
      WRITE(ICOUT,57)I,IHARG(I)
   57 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   58 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE CHANGED APRIL 1993
CCCCC WRITE(ICOUT,61)IREPMX,IPOINT
CCC61 FORMAT('IREPMX,IPOINT = ',I8,2X,I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)MAXLIS,IPOINT
   61 FORMAT('MAXLIS,IPOINT = ',I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993
CCCCC DO62J=1,IREPMX
      DO62J=1,MAXLIS
      WRITE(ICOUT,63)J,(IANSSV(J,I),I=1,80)
   63 FORMAT('J,(IANSSV(J,I),I=1,80) = ',I8,2X,80A1)
      CALL DPWRST('XXX','BUG ')
   62 CONTINUE
      WRITE(ICOUT,71)ISACNU
   71 FORMAT('ISACNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ISACNA
   72 FORMAT('ISACNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ISACST
   73 FORMAT('ISACST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)ISACFO
   74 FORMAT('ISACFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ISACAC
   75 FORMAT('ISACAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)ISACFO
   76 FORMAT('ISACFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)ISACCS
   77 FORMAT('ISACCS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)ISACNC
   81 FORMAT('ISACNC = ',A80)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  DETERMINE IF HAVE AN EXPLICIT FILE REFERENCE    **
C               **  WHERE THE COMMANDS WILL BE SAVED, OR WILL THEY  **
C               **  BE SAVED IN THE DEFAULT FILE (DPSACF.TEX)?      **
C               ******************************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SACO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFILWD=(-999)
C
      DO1100I=1,80
      IC4=IANSLC(I)
      ISTRIN(I:I)=IC4(1:1)
 1100 CONTINUE
C
      IWORD=1
      ISTART=1
      ISTOP=80
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NUMARG.LE.0)GOTO1129
      IWORD=2
      ISTART=1
      ISTOP=80
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1129
      DO1121I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1122
 1121 CONTINUE
      GOTO1129
 1122 CONTINUE
      IFILWD=2
      GOTO1190
 1129 CONTINUE
C
      IF(NUMARG.LE.1)GOTO1139
      IWORD=3
      ISTART=1
      ISTOP=80
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1139
      DO1131I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1132
 1131 CONTINUE
      GOTO1139
 1132 CONTINUE
      IFILWD=3
      GOTO1190
 1139 CONTINUE
C
 1190 CONTINUE
      ISTAM1=0
      IF(IFILWD.EQ.2.OR.IFILWD.EQ.3)ISTAM1=1
C
C               *******************************
C               **  STEP 12--                **
C               **  COPY OVER FILE VARIABLES **
C               *******************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SACO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISACNC=ISACNA
      IF(IFILWD.EQ.2.OR.IFILWD.EQ.3)ISACNC=ISTRI2
C
      IOUNIT=ISACNU
      IFILE=ISACNA
      IF(IFILWD.EQ.2.OR.IFILWD.EQ.3)IFILE=ISTRI2
      ISTAT=ISACST
      IFORM=ISACFO
      IACCES=ISACAC
      IPROT=ISACPR
      ICURST=ISACCS
C
      ISUBN0='SACO'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SACO')GOTO1299
      WRITE(ICOUT,1293)IOUNIT
 1293 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1294)IFILE
 1294 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1295)ISTAT,IFORM,IACCES,IPROT,ICURST
 1295 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1296)ISUBN0,IERRFI
 1296 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1299 CONTINUE
C
C               ***********************************************************
C               **  STEP 13--                                            **
C               **  CHECK TO SEE IF THE SAVE-CONCLUSIONS FILE MAY EXIST  **
C               ***********************************************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SACO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1300
      GOTO1390
 1300 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** IMPLEMENTATION ERROR IN DPSACO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE DESIRED SAVING OF COMMANDS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1313)
 1313 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1314)
 1314 FORMAT('      THE INTERNAL VARIABLE    ISACST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1315)
 1315 FORMAT('      WHICH ALLOWS SUCH COMMAND-SAVINGING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1316)
 1316 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1317)ISTAT,ISACST
 1317 FORMAT('ISTAT,ISACST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1390 CONTINUE
C
C               *********************************************************
C               **  STEP 21--                                          **
C               **  FROM THE RECALL-LIST OF THE PREVIOUS 30 COMMANDS,  **
C               **  STRIP OUT THE DESIRED COMMAND LINE NUMBERS         **
C               **  THE LIST THAT THE ANALYST HAS SPECIFIED            **
C               **  SHOULD BE IN THE ORDER THAT THE ANALYST            **
C               **  WANTS THE COMMANDS EXECUTED                        **
C               **  (USUALLY--BUT NOT NECESSARILY--IT IS FROM LARGEST  **
C               **  (MOST DISTANT) TO SMALLEST (MOST RECENT))          **
C               *********************************************************
C
CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993
CCCCC MAXTAB=IREPMX
      MAXTAB=MAXLIS
      MININT=1
CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993
CCCCC MAXINT=IREPMX
      MAXINT=MAXLIS
      ISTART=ISTAM1+1
      ISTOP=NUMARG
      IF(ISTART.GT.ISTOP)GOTO2110
      GOTO2120
C
 2110 CONTINUE
      I=1
      ITAB(I)=1
      NTAB=I
      GOTO2190
C
 2120 CONTINUE
      CALL DPEXIN(IHARG,IARGT,IARG,NUMARG,ISTART,ISTOP,
     1MININT,MAXINT,
     1ITAB,NTAB,MAXTAB,
     1IBUGS2,ISUBRO,IERROR)
      GOTO2190
C
 2190 CONTINUE
C
C               **************************
C               **  STEP 31--           **
C               **  OPEN  THE FILE      **
C               **************************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SACO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
 3190 CONTINUE
C
C               ******************************************************
C               **  STEP 41--                                       **
C               **  PRINT OUT THE SPECIFIED COMMANDS                **
C               **  (BOTH TO SCREEN AND TO FILE)                    **
C               **  IN ORDER OF EXECUTION                           **
C               ******************************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SACO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFEEDB.EQ.'OFF')GOTO4109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4101)
 4101 FORMAT('THE SAVED COMMAND LINES--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4109 CONTINUE
C
      DO4110I=1,NTAB
      I2=ITAB(I)
CCCCC I3=IPOINT-I2-1
      I3=IPOINT-I2
CCCCC THE FOLLOWING LINE WAS CHANGED APRIL 1993
CCCCC IF(I3.LE.0)I3=I3+IREPMX
      IF(I3.LE.0)I3=I3+MAXLIS
      DO4120J=1,80
      IC1=IANSSV(I3,J)
      ISTRIN(J:J)=IC1
 4120 CONTINUE
      WRITE(IOUNIT,4125)(ISTRIN(J:J),J=1,80)
 4125 FORMAT(80A1)
      IF(IFEEDB.EQ.'OFF')GOTO4129
      CALL DPDB80(ISTRIN,J2MAX,IBUGS2,ISUBRO,IERROR)
      WRITE(ICOUT,4126)I2,(ISTRIN(J:J),J=1,J2MAX)
 4126 FORMAT(4X,I2,'--',80A1)
      CALL DPWRST('XXX','BUG ')
 4129 CONTINUE
 4110 CONTINUE
C
C               **************************
C               **  STEP 51--           **
C               **  CLOSE THE FILE      **
C               **************************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SACO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='OFF'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
 5190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SACO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPSACO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IWIDTH
 9013 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9014)(IANSLC(I),I=1,IWIDTH)
 9014 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMARG
 9015 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9018
      DO9016I=1,NUMARG
      WRITE(ICOUT,9017)I,IHARG(I)
 9017 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9018 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE CHANGED APRIL 1993
CCCCC WRITE(ICOUT,9021)IREPMX,IPOINT
C9021 FORMAT('IREPMX,IPOINT = ',I8,2X,I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)MAXLIS,IPOINT
 9021 FORMAT('MAXLIS,IPOINT = ',I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
      DO9022J=1,IREPMX
      WRITE(ICOUT,9023)J,(IANSSV(J,I),I=1,80)
 9023 FORMAT('J,(IANSSV(J,I),I=1,80) = ',I8,2X,80A1)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
      WRITE(ICOUT,9041)IOUNIT
 9041 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)IFILE
 9042 FORMAT('IFILE  = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)ISTAT
 9043 FORMAT('ISTAT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)IFORM
 9044 FORMAT('IFORM  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)IACCES
 9045 FORMAT('IACCES = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)IPROT
 9046 FORMAT('IPROT  = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)ICURST
 9047 FORMAT('ICURST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9048)IENDFI
 9048 FORMAT('IENDFI = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9049)IREWIN
 9049 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,9061)IFILWD,ISTAM1
 9061 FORMAT('IFILWD,ISTAM1 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)ISTART,ISTOP
 9062 FORMAT('ISTART,ISTOP = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9063)MININT,MAXINT
 9063 FORMAT('MININT,MAXINT = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9071)NTAB,MAXTAB
 9071 FORMAT('NTAB,MAXTAB = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NTAB.LE.0)GOTO9079
      DO9072I=1,NTAB
      WRITE(ICOUT,9073)I,ITAB(I)
 9073 FORMAT('I,ITAB(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9072 CONTINUE
 9079 CONTINUE
      WRITE(ICOUT,9081)ISACNC
 9081 FORMAT('ISACNC = ',A80)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSAPC(IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GUI SAVE PLOT CONTROL (= LIST OUT PLOT CONTROL
C              SETTINGS TO SCREEN SO TCL/TK CAN READ THEM.
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--97/11
C     ORIGINAL VERSION--NOVEMBER  1997.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 ITEMP
      CHARACTER*4 ITITFL
      CHARACTER*4 ILABFL
      CHARACTER*4 ILEGFL
      CHARACTER*4 ILINFL
      CHARACTER*4 ICHAFL
      CHARACTER*4 ISPIFL
      CHARACTER*4 IBARFL
      CHARACTER*4 IBACFL
      CHARACTER*4 ILIMFL
C
      CHARACTER*4 ITMP1
      CHARACTER*4 ITMP2
      CHARACTER*4 ITMP3
      CHARACTER*4 ITMP4
C
      CHARACTER*4 ITEMPH(10)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
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='DPSA'
      ISUBN2='PC  '
C
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAPC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSAPC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      ISTART=1
      ISTOP=100
      ITITFL='OFF'
      ILABFL='OFF'
      ILEGFL='OFF'
      ILINFL='OFF'
      ICHAFL='OFF'
      ISPIFL='OFF'
      IBARFL='OFF'
      IBACFL='OFF'
      ILIMFL='OFF'
C
      IJUNK1=NUMARG
      IJUNK2=NUMARG-1
      IJUNK3=NUMARG-2
      IF(NUMARG.GE.2.AND.IARGT(IJUNK1).EQ.'NUMB'.AND.
     1  IARGT(IJUNK2).EQ.'NUMB')THEN
         ISTART=IARG(IJUNK2)
         ISTOP=IARG(IJUNK1)
         IF(ISTART.LT.1)ISTART=1
         IF(ISTOP.GT.100)ISTOP=100
         IF(ISTART.GT.ISTOP)THEN
           IJUNK4=ISTOP
           ISTOP=ISTART
           ISTART=IJUNK4
         ENDIF
      ELSEIF(NUMARG.GE.2.AND.IARGT(IJUNK1).EQ.'NUMB'.AND.
     1  IARGT(IJUNK2).NE.'NUMB')THEN
        ISTART=1
        ISTOP=IARG(IJUNK1)
        IF(ISTOP.GT.100)ISTOP=100
        IJUNK3=IJUNK2
      ELSE
        IJUNK3=IJUNK1
      ENDIF
C
      IF(IJUNK3.GE.1)THEN
        ITEMP=IHARG(IJUNK3)
        IF(ITEMP.EQ.'TITL')ITITFL='ON'
        IF(ITEMP.EQ.'LABE')ILABFL='ON'
        IF(ITEMP.EQ.'LEGE')ILEGFL='ON'
        IF(ITEMP.EQ.'LINE')ILINFL='ON'
        IF(ITEMP.EQ.'CHAR')ICHAFL='ON'
        IF(ITEMP.EQ.'SPIK')ISPIFL='ON'
        IF(ITEMP.EQ.'BAR ')IBARFL='ON'
        IF(ITEMP.EQ.'BACK')IBACFL='ON'
        IF(ITEMP.EQ.'LIMI')ILIMFL='ON'
        IF(ITEMP.EQ.'ALL ')THEN
          ITITFL='ON'
          ILABFL='ON'
          ILEGFL='ON'
          ILINFL='ON'
          ICHAFL='ON'
          ISPIFL='ON'
          IBARFL='ON'
          IBACFL='ON'
          ILIMFL='ON'
        ENDIF
      ENDIF
C
      LINC=5
C
C               ******************************************************
C               **  STEP 41--
C               **  WRITE OUT TO THE SAVE FILE;
C               ******************************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAPC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     -----WRITE OUT COMMON FOR PLOT CONTROL-----
C
      IF(IBACFL.EQ.'OFF')GOTO199
      WRITE(ICOUT,101)IBACCO
  101 FORMAT('BACKGROUND COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
  199 CONTINUE
C
      IF(ITITFL.EQ.'OFF')GOTO299
      WRITE(ICOUT,201)
  201 FORMAT('TITLE ATTRIBUTES')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,202)(ITITTE(I)(1:1),I=1,MIN(NCTITL,130))
  202 FORMAT('   TITLE = ',130A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,203)ITITFO
  203 FORMAT('   TITLE FONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,204)ITITCA
  204 FORMAT('   TITLE CASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,205)ITITFI
  205 FORMAT('   TITLE FILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,206)ITITCO
  206 FORMAT('   TITLE COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,207)PTITHE
  207 FORMAT('   TITLE SIZE = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,208)PTITTH
  208 FORMAT('   TITLE THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,209)PTITDS
  209 FORMAT('   TITLE DISPLACEMENT = ',E12.5)
      CALL DPWRST('XXX','BUG ')
  299 CONTINUE
C
      IF(ILABFL.EQ.'OFF')GOTO399
      WRITE(ICOUT,301)
  301 FORMAT('AXIS LABEL ATTRIBUTES')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,311)(IX1LTE(I)(1:1),I=1,NCX1LA)
  311 FORMAT('    X1LABEL = ',130A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)(IX2LTE(I)(1:1),I=1,NCX2LA)
  312 FORMAT('    X2LABEL = ',130A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)(IX3LTE(I)(1:1),I=1,NCX3LA)
  313 FORMAT('    X3LABEL = ',130A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)(IY1LTE(I)(1:1),I=1,NCY1LA)
  314 FORMAT('    Y1LABEL = ',130A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)(IY2LTE(I)(1:1),I=1,NCY2LA)
  315 FORMAT('    Y2LABEL = ',130A1)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,321)IX1LFO
  321 FORMAT('   X1LABEL FONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)IX1LCA
  322 FORMAT('   X1LABEL CASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)IX1LFI
  323 FORMAT('   X1LABEL FILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)IX1LCO
  324 FORMAT('   X1LABEL COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)PX1LDS
  325 FORMAT('   X1LABEL DISPLACEMENT = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)PX1LHE
  326 FORMAT('   X1LABEL SIZE = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)PX1LTH
  327 FORMAT('   X1LABEL THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,331)IX2LFO
  331 FORMAT('   X2LABEL FONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,332)IX2LCA
  332 FORMAT('   X2LABEL CASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,333)IX2LFI
  333 FORMAT('   X2LABEL FILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,334)IX2LCO
  334 FORMAT('   X2LABEL COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,335)PX2LDS
  335 FORMAT('   X2LABEL DISPLACEMENT = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,336)PX2LHE
  336 FORMAT('   X2LABEL SIZE = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,337)PX2LTH
  337 FORMAT('   X2LABEL THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,341)IX3LFO
  341 FORMAT('   X3LABEL FONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)IX3LCA
  342 FORMAT('   X3LABEL CASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)IX3LFI
  343 FORMAT('   X3LABEL FILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)IX3LCO
  344 FORMAT('   X3LABEL COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)PX3LDS
  345 FORMAT('   X3LABEL DISPLACEMENT = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)PX3LHE
  346 FORMAT('   X3LABEL SIZE = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)PX3LTH
  347 FORMAT('   X3LABEL THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,351)IY1LFO
  351 FORMAT('   Y1LABEL FONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)IY1LCA
  352 FORMAT('   Y1LABEL CASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)IY1LFI
  353 FORMAT('   Y1LABEL FILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,354)IY1LCO
  354 FORMAT('   Y1LABEL COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,355)PY1LDS
  355 FORMAT('   Y1LABEL DISPLACEMENT = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,356)PY1LHE
  356 FORMAT('   Y1LABEL SIZE = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,357)PY1LTH
  357 FORMAT('   Y1LABEL THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,361)IY2LFO
  361 FORMAT('   Y2LABEL FONT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,362)IY2LCA
  362 FORMAT('   Y2LABEL CASE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,363)IY2LFI
  363 FORMAT('   Y2LABEL FILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,364)IY2LCO
  364 FORMAT('   Y2LABEL COLOR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,365)PY2LDS
  365 FORMAT('   Y2LABEL DISPLACEMENT = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,366)PY2LHE
  366 FORMAT('   Y2LABEL SIZE = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,367)PY2LTH
  367 FORMAT('   Y2LABEL THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
  399 CONTINUE
C
      IF(ILEGFL.EQ.'OFF')GOTO499
      WRITE(ICOUT,401)
  401 FORMAT('LEGEND ATTRIBUTES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,402)NUMLEG
  402 FORMAT('    NUMBER OF CURRENTLY DEFINED LEGENDS = ',I10)
      CALL DPWRST('XXX','BUG ')
C
      DO491LL=1,20 
      LSTRT=(LL-1)*LINC+1
      LSTOP=LL*LINC
      IF(LSTRT.GT.NUMLEG)GOTO498
      IF(LSTOP.GT.NUMLEG)LSTOP=NUMLEG
C
      DO490L=LSTRT,LSTOP
      ISTRT=ILEGST(L)
      ISTP=ILEGSP(L)
      IF(ISTP-ISTRT+1.GT.80)ISTP=ISTRT+79
      WRITE(ICOUT,411)L,L,(ILEGTE(J)(1:1),J=ISTRT,ISTP)
  411 FORMAT('    LEGEND ',2I5,' = ',80A1)
      CALL DPWRST('XXX','BUG ')
  490 CONTINUE
  491 CONTINUE
  498 CONTINUE
C
      DO492LL=1,20
      LSTRT=(LL-1)*LINC+1
      LSTOP=LL*LINC
      IF(LSTRT.GT.ISTOP)GOTO492
      IF(LSTRT.LT.ISTART)LSTRT=ISTART
      IF(LSTOP.GT.ISTOP)LSTOP=ISTOP
C
      WRITE(ICOUT,412)LSTRT,LSTOP,(ILEGFO(I),I=LSTRT,LSTOP)
  412 FORMAT('    LEGEND FONT ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,413)LSTRT,LSTOP,(ILEGCA(I),I=LSTRT,LSTOP)
  413 FORMAT('    LEGEND CASE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,414)LSTRT,LSTOP,(ILEGJU(I),I=LSTRT,LSTOP)
  414 FORMAT('    LEGEND JUSTIFICATION ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,415)LSTRT,LSTOP,(ILEGDI(I),I=LSTRT,LSTOP)
  415 FORMAT('    LEGEND DIRECTION ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,416)LSTRT,LSTOP,(ILEGFI(I),I=LSTRT,LSTOP)
  416 FORMAT('    LEGEND FILL ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,417)LSTRT,LSTOP,(ILEGCO(I),I=LSTRT,LSTOP)
  417 FORMAT('    LEGEND COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
C
      DO1418I=LSTRT,LSTOP
      WRITE(ICOUT,418)I,I,PLEGXC(I),PLEGYC(I)
  418 FORMAT('    LEGEND COORDINATES ',I5,1X,I5,' = ',2(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
 1418 CONTINUE
C
      WRITE(ICOUT,419)LSTRT,LSTOP,(PLEGHE(I),I=LSTRT,LSTOP)
  419 FORMAT('    LEGEND SIZE  ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,420)LSTRT,LSTOP,(PLEGWI(I),I=LSTRT,LSTOP)
  420 FORMAT('    LEGEND WIDTH ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,421)LSTRT,LSTOP,(PLEGTH(I),I=LSTRT,LSTOP)
  421 FORMAT('    LEGEND THICKNESS ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,422)LSTRT,LSTOP,(ALEGAN(I),I=LSTRT,LSTOP)
  422 FORMAT('    LEGEND ANGLE ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
  492 CONTINUE
C
  499 CONTINUE
C
      DO1990LL=1,20
      LSTRT=(LL-1)*LINC+1
      LSTOP=LL*LINC
      IF(LSTRT.GT.ISTOP)GOTO1999
      IF(LSTRT.LT.ISTART)LSTRT=ISTART
      IF(LSTOP.GT.ISTOP)LSTOP=ISTOP
C
      IF(ILINFL.EQ.'OFF')GOTO599
CCCCC WRITE(ICOUT,501)
CC501 FORMAT('LINE ATTRIBUTES')
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)LSTRT,LSTOP,(ILINPA(I),I=LSTRT,LSTOP)
  512 FORMAT('    LINE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,513)LSTRT,LSTOP,(ILINCO(I),I=LSTRT,LSTOP)
  513 FORMAT('    LINE COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,514)LSTRT,LSTOP,(PLINTH(I),I=LSTRT,LSTOP)
  514 FORMAT('    LINE THICKNESS ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
  590 CONTINUE
  599 CONTINUE
C
      IF(ICHAFL.EQ.'OFF')GOTO699
CCCCC WRITE(ICOUT,601)
CC601 FORMAT('CHARACTER ATTRIBUTES')
CCCCC CALL DPWRST('XXX','BUG ')
      ICOUNT=0
      DO601I=LSTRT,LSTOP
         ICOUNT=ICOUNT+1
         ITEMPH(ICOUNT)='BLAN'
         IF(ICHAPA(I).NE.'    ')ITEMPH(ICOUNT)=ICHAPA(I)
  601 CONTINUE
C
      WRITE(ICOUT,611)LSTRT,LSTOP,(ITEMPH(I),I=1,ICOUNT)
  611 FORMAT('    CHARACTER ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,612)LSTRT,LSTOP,(ICHAFO(I),I=LSTRT,LSTOP)
  612 FORMAT('   CHARACTER FONT ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,613)LSTRT,LSTOP,(ICHACO(I),I=LSTRT,LSTOP)
  613 FORMAT('   CHARACTER COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,614)LSTRT,LSTOP,(ICHACA(I),I=LSTRT,LSTOP)
  614 FORMAT('   CHARACTER CASE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,615)LSTRT,LSTOP,(ICHAJU(I),I=LSTRT,LSTOP)
  615 FORMAT('   CHARACTER JUSTIFICATION ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,616)LSTRT,LSTOP,(ICHADI(I),I=LSTRT,LSTOP)
  616 FORMAT('   CHARACTER DIRECTION ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,617)LSTRT,LSTOP,(ICHAFI(I),I=LSTRT,LSTOP)
  617 FORMAT('   CHARACTER FILL ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,618)LSTRT,LSTOP,(PCHAHE(I),I=LSTRT,LSTOP)
  618 FORMAT('   CHARACTER SIZE ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,619)LSTRT,LSTOP,(PCHAWI(I),I=LSTRT,LSTOP)
  619 FORMAT('   CHARACTER WIDTH ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,620)LSTRT,LSTOP,(ACHAAN(I),I=LSTRT,LSTOP)
  620 FORMAT('   CHARACTER ANGLE ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,621)LSTRT,LSTOP,(PCHATH(I),I=LSTRT,LSTOP)
  621 FORMAT('   CHARACTER THICKNESS ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
  690 CONTINUE
  699 CONTINUE
C
      IF(ISPIFL.EQ.'OFF')GOTO799
CCCCC WRITE(ICOUT,701)
CC701 FORMAT('SPIKE ATTRIBUTES')
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,711)LSTRT,LSTOP,(ISPISW(I),I=LSTRT,LSTOP)
  711 FORMAT('   SPIKE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,712)LSTRT,LSTOP,(ISPILI(I),I=LSTRT,LSTOP)
  712 FORMAT('   SPIKE LINE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,713)LSTRT,LSTOP,(ISPICO(I),I=LSTRT,LSTOP)
  713 FORMAT('   SPIKE COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,714)LSTRT,LSTOP,(PSPITH(I),I=LSTRT,LSTOP)
  714 FORMAT('   SPIKE THICKNESS ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,715)LSTRT,LSTOP,(ASPIBA(I),I=LSTRT,LSTOP)
  715 FORMAT('   SPIKE BASE ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
  790 CONTINUE
  799 CONTINUE
C
      IF(IBARFL.EQ.'OFF')GOTO899
CCCCC WRITE(ICOUT,801)
CC801 FORMAT('BAR ATTRIBUTES')
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,811)LSTRT,LSTOP,(IBARSW(I),I=LSTRT,LSTOP)
  811 FORMAT('   BAR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,812)LSTRT,LSTOP,(ABARBA(I),I=LSTRT,LSTOP)
  812 FORMAT('   BAR BASE ',I5,1X,I5,' ',' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,813)LSTRT,LSTOP,(ABARWI(I),I=LSTRT,LSTOP)
  813 FORMAT('   BAR WIDTH ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,821)LSTRT,LSTOP,(IBABLI(I),I=LSTRT,LSTOP)
  821 FORMAT('   BAR BORDER LINE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,822)LSTRT,LSTOP,(IBABCO(I),I=LSTRT,LSTOP)
  822 FORMAT('   BAR BORDER COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,823)LSTRT,LSTOP,(PBABTH(I),I=LSTRT,LSTOP)
  823 FORMAT('   BAR BORDER THICKNESS ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,831)LSTRT,LSTOP,(IBAFSW(I),I=LSTRT,LSTOP)
  831 FORMAT('   BAR FILL ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,832)LSTRT,LSTOP,(IBAFCO(I),I=LSTRT,LSTOP)
  832 FORMAT('   BAR FILL COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,841)LSTRT,LSTOP,(IBAPTY(I),I=LSTRT,LSTOP)
  841 FORMAT('   BAR PATTERN ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,842)LSTRT,LSTOP,(IBAPLI(I),I=LSTRT,LSTOP)
  842 FORMAT('   BAR PATTERN LINE ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,843)LSTRT,LSTOP,(IBAPCO(I),I=LSTRT,LSTOP)
  843 FORMAT('   BAR PATTERN COLOR ',I5,1X,I5,' = ',10(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,844)LSTRT,LSTOP,(PBABTH(I),I=LSTRT,LSTOP)
  844 FORMAT('   BAR PATTERN THICKNESS ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,845)LSTRT,LSTOP,(PBAPSP(I),I=LSTRT,LSTOP)
  845 FORMAT('   BAR PATTERN SPACING ',I5,1X,I5,' = ',10(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
  890 CONTINUE
  899 CONTINUE
C
 1990 CONTINUE
 1999 CONTINUE
C
      IF(ILIMFL.EQ.'OFF')GOTO990
      WRITE(ICOUT,901)
  901 FORMAT('LIMIT AND TIC MARK ATTRIBUTES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,902)FX1MNZ,FX1MXZ
  902 FORMAT('    X1 LIMITS = ',E12.5,1X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,904)FX2MNZ,FX2MXZ
  904 FORMAT('    X2 LIMITS = ',E12.5,1X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,906)FY1MNZ,FY1MXZ
  906 FORMAT('    Y1 LIMITS = ',E12.5,1X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,908)FY2MNZ,FY2MXZ
  908 FORMAT('    Y2 LIMITS = ',E12.5,1X,E15.7)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,911)IX1FSW,IX2FSW,IY1FSW,IY2FSW
  911 FORMAT('    X1, X2, Y1, Y2 FRAME = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1911)IX1FPA,IX2FPA,IY1FPA,IY2FPA
 1911 FORMAT('    X1, X2, Y1, Y2 FRAME PATTERN = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1912)IX1FCO,IX2FCO,IY1FCO,IY2FCO
 1912 FORMAT('    X1, X2, Y1, Y2 FRAME COLOR = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1913)PFRATH
 1913 FORMAT('    FRAME THICKNESS = ',E12.5)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1915)PXMIN,PXMAX,PYMIN,PYMAX
 1915 FORMAT('    FRAME COORDINATES = ',4E12.5)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,912)IVGRSW,IHGRSW
  912 FORMAT('    X, Y GRID = ',2(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,913)IVGRPA,IHGRPA
  913 FORMAT('    X, Y GRID PATTERN = ',2(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,914)IVGRCO,IHGRCO
  914 FORMAT('    X, Y GRID COLOR = ',2(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,915)PVGRTH,PHGRTH
  915 FORMAT('    X, Y GRID THICKNESS = ',2(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,921)IX1TSW,IX2TSW,IY1TSW,IY2TSW
  921 FORMAT('    X1, X2, Y1, Y2 TIC = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,922)IX1TJU,IX2TJU,IY1TJU,IY2TJU
  922 FORMAT('    X1, X2, Y1, Y2 TIC POSITION = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,923)IX1TCO,IX2TCO,IY1TCO,IY2TCO
  923 FORMAT('    X1, X2, Y1, Y2 TIC COLOR = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,924)PX1TLE,PX2TLE,PY1TLE,PY2TLE
  924 FORMAT('    X1, X2, Y1, Y2 TIC SIZE = ',4(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      ITMP1='OFF'
      ITMP2='OFF'
      ITMP3='OFF'
      ITMP4='OFF'
      IF(IX1TSC.EQ.'LOG')ITMP1='ON'
      IF(IX2TSC.EQ.'LOG')ITMP2='ON'
      IF(IY1TSC.EQ.'LOG')ITMP3='ON'
      IF(IY2TSC.EQ.'LOG')ITMP4='ON'
      WRITE(ICOUT,925)ITMP1,ITMP2,ITMP3,ITMP4
  925 FORMAT('    X1, X2, Y1, Y2 LOG = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,931)PX1TOL,PX1TOR
  931 FORMAT('    X1 TIC OFFSET = ',2(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,932)PX2TOL,PX2TOR
  932 FORMAT('    X2 TIC OFFSET = ',2(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,933)PY1TOB,PY1TOT
  933 FORMAT('    Y1 TIC OFFSET = ',2(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,934)PY2TOB,PY2TOT
  934 FORMAT('    Y2 TIC OFFSET = ',2(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,935)ITICUN
  935 FORMAT('    TIC OFFSET UNITS = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,941)NMJX1T,NMJX2T,NMJY1T,NMJY2T
  941 FORMAT('    X1, X2, Y1, Y2 TIC NUMBER MAJOR = ',4(I5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,942)NMNX1T,NMNX2T,NMNY1T,NMNY2T
  942 FORMAT('    X1, X2, Y1, Y2 TIC NUMBER MINOR = ',4(I5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,951)IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
  951 FORMAT('    X1, X2, Y1, Y2 TIC LABEL = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,952)IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO
  952 FORMAT('    X1, X2, Y1, Y2 TIC LABEL COLOR = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,953)IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA
  953 FORMAT('    X1, X2, Y1, Y2 TIC LABEL CASE = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,954)IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO
  954 FORMAT('    X1, X2, Y1, Y2 TIC LABEL FONT = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,955)IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
  955 FORMAT('    X1, X2, Y1, Y2 TIC LABEL JUSTIFICATION = ',
     14(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,956)IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
  956 FORMAT('    X1, X2, Y1, Y2 TIC LABEL DIRECTION = ',
     14(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,957)IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI
  957 FORMAT('    X1, X2, Y1, Y2 TIC LABEL FILL = ',4(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,958)IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
  958 FORMAT('    X1, X2, Y1, Y2 TIC LABEL DECIMALS = ',4(I5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,959)PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS
  959 FORMAT('    X1, X2, Y1, Y2 TIC LABEL DISPLACEMENT = ',
     14(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,960)AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN
  960 FORMAT('    X1, X2, Y1, Y2 TIC LABEL ANGLE = ',4(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,961)PX1ZHE,PX2ZHE,PY1ZHE,PY2ZHE
  961 FORMAT('    X1, X2, Y1, Y2 TIC LABEL SIZE = ',4(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,971)PTIZTH
  971 FORMAT('    TIC LABEL THICKNESS = ',4(E12.5,1X))
      CALL DPWRST('XXX','BUG ')
C
  990 CONTINUE
C
C     -----END WRITING OUT-----------------------
C
C               ***************************
C               **  STEP 42--            **
C               **  WRITE OUT A MESSAGE  **
C               ***************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAPC')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSAPL(IANSLC,IWIDTH,IHARG,IARGT,IARG,NUMARG,
     1IBUGS2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--SAVE (FOR FUTURE USE BY THE REPEAT GRAPH COMMAND)
C              SELECTED PLOTS.  IT SUPPORTS THE FOLLOWING:
C
C                  SAVE PLOT <FILE NAME>:
C                      SAVES THE CURRENT PIXMAP TO THE SPECIFIED FILE
C                  SAVE PLOT AUTOMATIC <FILENAME>:
C                      AUTOMATICALLY SAVE ALL SUBSEQUENT FILES, USING
C                      <FILE NAME> AS THE BASE FILE NAME (APPEND A
C                      ".1", ".2", ETC.)
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGU
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--97/4
C     ORIGINAL VERSION--APRIL     1997.
C     UPDATED         --AUGUST    1997. MOVE SOME CODE TO A LOWER LEVEL
C                                       TO SUPPORT NON-X11 DEVICES
C                                       (SPECIFICALLY PC FOR NOW)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      INCLUDE 'DPCOPA.INC'
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
CCCCC CHARACTER*1 IANSSV
CCCCC CHARACTER*80 ISACNC
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
      CHARACTER*4 IFOUND
C
      CHARACTER*4 IC4
      CHARACTER*4 ICODE
C  DIMENSION FOLLOWING 2 LINES TO MAXSTR
      CHARACTER*256 ISTRIN
      CHARACTER*256 ISTRI2
      CHARACTER*128 CTEMP
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
      CHARACTER*4 ISAVFL
C
      DIMENSION IANSLC(*)
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
CCCCC DIMENSION IADE(128)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPM.INC'
      INCLUDE 'DPCOF2.INC'
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='DPSA'
      ISUBN2='PL  '
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('AT THE BEGINNING OF DPSAPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IFOUND,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IWIDTH
   53 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,54)(IANSLC(I),I=1,IWIDTH)
   54 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO58
      DO56I=1,NUMARG
      WRITE(ICOUT,57)I,IHARG(I)
   57 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   56 CONTINUE
   58 CONTINUE
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFOUND='YES'
C
C               ******************************************************
C               **  STEP 10--                                       **
C               **  DETERMINE IF HAVE SAVE PLOT AUTOMATIC CASE      **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISAVFL='OFF'
      IF(NUMARG.GE.1)THEN
        DO1010I=1,NUMARG
          IF(IHARG(I).EQ.'AUTO' .OR. IHARG(I).EQ.'ON' .OR.
     1       IHARG(I).EQ.'YES' )THEN
            ISAVFL='ON'
            IPXMFL='ON'
            GOTO1019
          ENDIF
 1010   CONTINUE
 1019   CONTINUE
      ENDIF
C
C               ******************************************************
C               **  STEP 11--                                       **
C               **  DETERMINE IF HAVE AN EXPLICIT FILE REFERENCE    **
C               **  WHERE THE PIXMAPS  WILL BE SAVED, OR WILL THEY  **
C               **  BE SAVED IN THE DEFAULT FILE (PIXMAP.<n>?       **
C               ******************************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFILWD=(-999)
C
      DO1100I=1,MAXSTR
      IC4=IANSLC(I)
      ISTRIN(I:I)=IC4(1:1)
 1100 CONTINUE
C
      IWORD=1
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NUMARG.LE.0)GOTO1129
      IWORD=2
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1129
      DO1121I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1122
 1121 CONTINUE
      GOTO1129
 1122 CONTINUE
      IFILWD=2
      GOTO1190
 1129 CONTINUE
C
      IF(NUMARG.LE.1)GOTO1139
      IWORD=3
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1139
      DO1131I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1132
 1131 CONTINUE
      GOTO1139
 1132 CONTINUE
      IFILWD=3
      GOTO1190
 1139 CONTINUE
C
      IF(NUMARG.LE.2)GOTO1149
      IWORD=4
      ISTART=1
      ISTOP=MAXSTR-1
      CALL DPEXWO(ISTRIN,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,ISTRI2,NCSTR2,
     1IBUGS2,ISUBRO,IERROR)
      IF(NCSTR2.LE.0)GOTO1149
      DO1141I=1,NCSTR2
      IF(ISTRI2(I:I).EQ.'.')GOTO1142
 1141 CONTINUE
      GOTO1149
 1142 CONTINUE
      IFILWD=4
      GOTO1190
 1149 CONTINUE
C
 1190 CONTINUE
C
      IF(ISAVFL.EQ.'ON')THEN
        IF(IFILWD.GE.1)THEN
          IPXMFB=' '
          IPXMFB(1:NCSTR2)=ISTRI2(1:NCSTR2)
          IPXMNC=NCSTR2
        ENDIF
        IF(IHARG(NUMARG).EQ.'OFF'.OR.IHARG(NUMARG).EQ.'DEFA'.OR.
     1     IHARG(NUMARG).EQ.'NO')THEN
          ISAVFL='OFF'
        ENDIF
        GOTO9000
      ENDIF
C
      NUMPXM=NUMPXM+1
      IF(NUMPXM.GT.MAXPM)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1191)MAXPM
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 1191 FORMAT('***** ERROR IN DPSAPL: MAXIMUM NUMBER OF PIXMAPS (',I5,
     1') EXCEEDED.')
C
      IF(IFILWD.LE.0)THEN
        ISTRI2=' '
        ISTRI2(1:7)='pixmap.'
        IF(NUMPXM.LE.9)THEN
          WRITE(ISTRI2(8:8),'(I1)')NUMPXM
          NCSTR2=8
        ELSEIF(NUMPXM.LE.99)THEN
          WRITE(ISTRI2(8:9),'(I2)')NUMPXM
          NCSTR2=9
        ELSEIF(NUMPXM.LE.999)THEN
          WRITE(ISTRI2(8:10),'(I3)')NUMPXM
          NCSTR2=10
        ENDIF
      ENDIF
      IPXMFN(NUMPXM)=' '
      IPXMFN(NUMPXM)(1:128)=ISTRI2(1:128)
      IF(IPXMCM(NUMPXM).EQ.' ')THEN
        IPXMCM(NUMPXM)(1:128)=IPXMFN(NUMPXM)(1:128) 
      ENDIF
C
C               *******************************
C               **  STEP 12--                **
C               **  CALL XSAVEG              **
C               *******************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NCSTR2.GT.127)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1209)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
 1209 FORMAT('***** ERROR IN DPSAPL--FILE NAME EXCEEDS 127 ',
     1'CHARACTERS.')
      ENDIF
c
C  AUGUST 1997.  TO MAKE CODE MORE GENERAL, CALL A LOW LEVEL
C  GRAPHICS ROUTINE.  MOVE THIS CODE TO THAT SUBROUTINE.
C
      ICODE='SAVE'
      CTEMP=' '
      NCTEMP=0
      CALL GRSAGR(ICODE,ISTRI2,NCSTR2,CTEMP,NCTEMP)
C
CCCCC DO1220I=1,NCSTR2
CCCCC   CALL DPCOAN(ISTRI2(I:I),IJUNK)
CCCCC   IADE(I)=IJUNK
C1220 CONTINUE
CCCCC IADE(NCSTR2+1)=0
C
CCCCC IERR=0
CCCCC CALL XSAVEG(IADE,IERR)
CCCCC IF(IERR.EQ.1)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1251)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1251 FORMAT('***** ERROR IN DPSAPL--WRITING BIT MAP UNSUCCESSFUL.')
CCCCC ELSEIF(IERR.EQ.2)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1261)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1261 FORMAT('***** ERROR IN DPSAPL--NO CURRENT PIXMAP TO SAVE.')
CCCCC ELSEIF(IERR.EQ.3)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1271)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1271 FORMAT('***** ERROR IN DPSAPL--X11 HAS NOT BEEN OPENED.')
CCCCC ELSEIF(IERR.EQ.4)THEN
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1281)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1281 FORMAT('***** ERROR IN DPSAPL--X11 NOT INSTALLED ON THIS ',
CCCCC1'IMPLEMENTATION.')
CCCCC ELSE
CCCCC   WRITE(ICOUT,999)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1291)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   WRITE(ICOUT,1292)ISTRI2(1:NCSTR2)
CCCCC   CALL DPWRST('XXX','BUG ')
CCCCC   IERROR='YES'
CCCCC   GOTO9000
C1291 FORMAT('***** CURRENT PIXMAP SUCCESSFULLY SAVED TO FILE ')
C1292 FORMAT('      ',A128)
CCCCC ENDIF
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAPL')GOTO1299
      WRITE(ICOUT,1293)ISTRI2(1:NCSTR2)
 1293 FORMAT('ISTRI2 = ',A128)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1294)NCSTR2
 1294 FORMAT('NCSTR2 = ',I4)
      CALL DPWRST('XXX','BUG ')
 1299 CONTINUE
C
 5190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPSAPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IWIDTH
 9013 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,9014)(IANSLC(I),I=1,IWIDTH)
 9014 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NUMARG
 9015 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9018
      DO9016I=1,NUMARG
      WRITE(ICOUT,9017)I,IHARG(I)
 9017 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9016 CONTINUE
 9018 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSAVE(IFOUND,IERROR)
C
C     PURPOSE--SAVE (= WRITE OUT TO FILE) ALL INTERNAL DATAPLOT
C              SETTINGS.  THE MASS STORAGE FILE
C              IS DESIGNATED BY THE ANALYST.
C              THIS IS USEFUL WHEN A RUN MUST BE
C              INTERRUPTED (E.G., LUNCH) (SEE THE SAVE COMMAND)
C              AND IT IS DESIRED
C              TO PICK UP THE RUN LATER AT THE POINT
C              OF INTERRUPTION (SEE THE RESTORE COMMAND).
C     NOTE--THE SAVE COMMAND (AND ITS COMPLEMENT, THE RESTORE COMMAND)
C           BOTH USE UNFORMATTED FORTRAN I/O STATEMENTS
C           (FOR SPEED AND EFFICIENCY).
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--86/1
C     ORIGINAL VERSION--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         --JUNE      1986.
C     UPDATED         --NOVEMBER  1987.  (DIMENSION FOR I1DATA--1100 TO 100)
C     UPDATED         --DECEMBER  1987.  (DIMENSION FOR V--10000 TO MAXOBW)
C     UPDATED         --FEBRUARY  1989.  SOFT-CODE ALL (ALAN)
C     UPDATED         --OCTOBER   1991.  SUN HAS LIMIT ON # OF WORDS
C     UPDATED                            FOR UNFORMATTED I/O (2,046)
C     UPDATED         --APRIL     1992.  INCLUDE DPCO3D.INC (ALAN)
C     UPDATED         --APRIL     1992.  PPEDHE TO APEDSZ (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
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*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*80 ICANS
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCODB.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOFO.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOSO.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOTR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCODG.INC'
      INCLUDE 'DPCOCO.INC'
C  APRIL 1992.  ADD FOLLOWING INCLUDE FILE.
      INCLUDE 'DPCO3D.INC'
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='DPSA'
      ISUBN2='VE  '
C
      ISUBRO='-999'
      IFOUND='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAVE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSAVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ISAVNU
   61 FORMAT('ISAVNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ISAVNA
   62 FORMAT('ISAVNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ISAVST
   63 FORMAT('ISAVST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ISAVFO
   64 FORMAT('ISAVFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ISAVAC
   65 FORMAT('ISAVAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ISAVFO
   66 FORMAT('ISAVFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ISAVCS
   67 FORMAT('ISAVCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ISAVNU
      IFILE=ISAVNA
      ISTAT=ISAVST
      IFORM=ISAVFO
      IACCES=ISAVAC
      IPROT=ISAVPR
      ICURST=ISAVCS
C
      ISUBN0='SAVE'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAVE')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               *******************************************
C               **  STEP 12--                            **
C               **  CHECK TO SEE IF SAVE FILE MAY EXIST  **
C               *******************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPSAVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED SAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE GIVEN BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE REQUIRED SYSTEM MASS STORAGE FILE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH STORES SUCH SAVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      IS NOT AVAILABLE AT THIS INSTALLATION.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,ISAVST
 1217 FORMAT('ISTAT,ISAVST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ****************************
C               **  STEP 13--             **
C               **  EXTRACT THE FILE NAME **
C               **  (THE THIRD WORD)      **
C               ****************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1310I=1,80
      IFILE(I:I)=' '
 1310 CONTINUE
C
      DO1320I=1,80
      ICANS(I:I)=IANSLC(I)
 1320 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IF(NUMARG.LE.1)
     1CALL DPW280(ICANS,ISTART,ISTOP,ICOL3,IBUGS2,ISUBRO,IERROR)
      IF(NUMARG.GE.2)
     1CALL DPW380(ICANS,ISTART,ISTOP,ICOL3,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      J=0
      IF(ICOL3.GT.IWIDTH)GOTO1339
      DO1330I=ICOL3,IWIDTH
      J=J+1
      IFILE(J:J)=ICANS(I:I)
 1330 CONTINUE
 1339 CONTINUE
C
      CALL DPDB80(IFILE,JMAX,IBUGS2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      NCFILE=JMAX
C
      IF(NCFILE.GE.1)GOTO1349
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1341)
 1341 FORMAT('***** ERROR IN DPSAVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1342)
 1342 FORMAT('      A FILE NAME IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1343)
 1343 FORMAT('      IN THE SAVE COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1344)
 1344 FORMAT('      (FOR EXAMPLE,    SAVE MEMORY DPRUN.DAT)')
      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)WRITE(ICOUT,1347)(IANSLC(I),I=1,IWIDTH)
 1347 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1349 CONTINUE
C
 1390 CONTINUE
C
C               *********************
C               **  STEP 31--      **
C               **  OPEN THE FILE  **
C               *********************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 41--
C               **  WRITE OUT TO THE SAVE FILE;
C               ****************************************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C     -----BEGIN WRITING OUT-----------------------
C
C     -----WRITE OUT COMMON FOR STANDARD I/O-----
C
      WRITE(IOUNIT)IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      WRITE(IOUNIT)IFEEDB,IPRINT
C
C     -----WRITE OUT COMMON FOR MACHINE CONSTANTS-----
C
      WRITE(IOUNIT)(I1MACH(I),I=1,16)
      WRITE(IOUNIT)(R1MACH(I),I=1,5)
      WRITE(IOUNIT)(D1MACH(I),I=1,5)
C
C     -----WRITE OUT COMMON FOR BUGS-----
C
      WRITE(IOUNIT)(I1BUG(I),I=1,10)
      WRITE(IOUNIT)(IH1BUG(I),I=1,100)
C
C     -----WRITE OUT COMMON FOR HOUSEKEEPING-----
C
C     WRITE(IOUNIT)(I1HOUS(I),I=1,1050)
      WRITE(IOUNIT)(I1HOUS(I),I=1,5*MAXSTR+50)
C     WRITE(IOUNIT)(IH1HOU(I),I=1,2320)
      WRITE(IOUNIT)(IH1HOU(I),I=1,11*MAXSTR+120)
C     WRITE(IOUNIT)(R1HOUS(I),I=1,400)
      WRITE(IOUNIT)(R1HOUS(I),I=1,2*MAXSTR)
C
C     -----WRITE OUT COMMON FOR DATA-----
C
C  OCTOBER 1991.  FOLLOWING BLOCK OF CODE HEAVILY MODIFIED TO HANDLE
C  PROBLEM ON SUN.  SUN APPEARS TO LIMIT UNFORMATTED I/O TO 2,046 WORDS.
C  NEED TO BREAK INTO CHUNKS FOR MANY OF THESE WRITE OPERATIONS.
C
      MAXWRD=100000
      IF(IHOST1.EQ.'SUN')MAXWRD=2046
      NLOOP1=(MAXOBV/MAXWRD)+1
      NLOOP2=(MAXPOP/MAXWRD)+1
      NLOOP3=(MAXOBW/MAXWRD)+1
C
CCCC  WRITE(IOUNIT)(I1DATA(I),I=1,1100)
CCCCC WRITE(IOUNIT)(I1DATA(I),I=1,MAXOBS+100)
      WRITE(IOUNIT)(I1DATA(I),I=1,100)
CCCCC WRITE(IOUNIT)(ISUB(I),I=1,MAXOBV)
      DO9112IK=1,NLOOP1
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBV)GOTO9117
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBV)JSTOP=MAXOBV
      WRITE(IOUNIT)(ISUB(I),I=JSTART,JSTOP)
 9112 CONTINUE
 9117 CONTINUE
CCCCC WRITE(IOUNIT)(IH1DAT(I),I=1,3500)
CCCCC WRITE(IOUNIT)(IH1DAT(I),I=1,3*MAXF1+3*MAXFN2+MAXF3)
      WRITE(IOUNIT)(IPARNC(I),I=1,MAXFN2)
      WRITE(IOUNIT)(IPANC2(I),I=1,MAXFN2)
      WRITE(IOUNIT)(IPAROP(I),I=1,MAXFN2)
      WRITE(IOUNIT)(MODEL(I),I=1,MAXF3)
      WRITE(IOUNIT)(IFUNC(I),I=1,MAXF1)
      WRITE(IOUNIT)(IFUNC2(I),I=1,MAXF1)
      WRITE(IOUNIT)(IFUNC3(I),I=1,MAXF1)
CCCCC WRITE(IOUNIT)(R1DATA(I),I=1,10200)
CCCCC WRITE(IOUNIT)(R1DATA(I),I=1,42200)
      WRITE(IOUNIT)(PARLIM(I),I=1,100)
CCCCC WRITE(IOUNIT)(PRED(I),I=1,MAXOBV)
      DO9122IK=1,NLOOP1
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBV)GOTO9127
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBV)JSTOP=MAXOBV
      WRITE(IOUNIT)(PRED(I),I=JSTART,JSTOP)
 9122 CONTINUE
 9127 CONTINUE
CCCCC WRITE(IOUNIT)(RES(I),I=1,MAXOBV)
      DO9132IK=1,NLOOP1
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBV)GOTO9137
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBV)JSTOP=MAXOBV
      WRITE(IOUNIT)(RES(I),I=JSTART,JSTOP)
 9132 CONTINUE
 9137 CONTINUE
CCCCC WRITE(IOUNIT)(Y(I),I=1,MAXPOP)
      DO9142IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9147
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(Y(I),I=JSTART,JSTOP)
 9142 CONTINUE
 9147 CONTINUE
CCCCC WRITE(IOUNIT)(X(I),I=1,MAXPOP)
      DO9152IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9157
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(X(I),I=JSTART,JSTOP)
 9152 CONTINUE
 9157 CONTINUE
CCCCC WRITE(IOUNIT)(X3D(I),I=1,MAXPOP)
      DO9162IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9167
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(X3D(I),I=JSTART,JSTOP)
 9162 CONTINUE
 9167 CONTINUE
CCCCC WRITE(IOUNIT)(D(I),I=1,MAXPOP)
      DO9172IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9177
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(D(I),I=JSTART,JSTOP)
 9172 CONTINUE
 9177 CONTINUE
CCCCC WRITE(IOUNIT)(YPLOT(I),I=1,MAXPOP)
      DO9182IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9187
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(YPLOT(I),I=JSTART,JSTOP)
 9182 CONTINUE
 9187 CONTINUE
CCCCC WRITE(IOUNIT)(XPLOT(I),I=1,MAXPOP)
      DO9192IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9197
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(XPLOT(I),I=JSTART,JSTOP)
 9192 CONTINUE
 9197 CONTINUE
CCCCC WRITE(IOUNIT)(X2PLOT(I),I=1,MAXPOP)
      DO9212IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9217
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(X2PLOT(I),I=JSTART,JSTOP)
 9212 CONTINUE
 9217 CONTINUE
CCCCC WRITE(IOUNIT)(TAGPLO(I),I=1,MAXPOP)
      DO9222IK=1,NLOOP2
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXPOP)GOTO9227
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXPOP)JSTOP=MAXPOP
      WRITE(IOUNIT)(TAGPLO(I),I=JSTART,JSTOP)
 9222 CONTINUE
 9227 CONTINUE
CCCCC WRITE(IOUNIT)(V(I),I=1,MAXOBW)
      DO9232IK=1,NLOOP3
      JSTART=(IK-1)*MAXWRD+1
      IF(JSTART.GT.MAXOBW)GOTO9237
      JSTOP=IK*MAXWRD
      IF(JSTOP.GT.MAXOBW)JSTOP=MAXOBW
      WRITE(IOUNIT)(V(I),I=JSTART,JSTOP)
 9232 CONTINUE
 9237 CONTINUE
CCCCC WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=1,100)
      ITEMP=100*100
      IF(ITEMP.LE.MAXWRD)THEN
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=1,100)
      ELSE
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=1,10)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=11,20)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=21,30)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=31,40)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=41,50)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=51,60)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=61,70)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=71,80)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=81,90)
        WRITE(IOUNIT)((AMATR1(I,J),I=1,100),J=91,100)
      END IF
CCCCC WRITE(IOUNIT)(R1DATA(I),I=1,2*MAXOBS+8*MAXPLP+200)
CCCCC WRITE(IOUNIT)(V(I),I=1,10000)
CCCCC WRITE(IOUNIT)(V(I),I=1,MAXWS)
C
C     -----WRITE OUT COMMON FOR SUPPORT-----
C
      WRITE(IOUNIT)(I1SUPP(I),I=1,50)
      WRITE(IOUNIT)(IH1SUP(I),I=1,70)
      WRITE(IOUNIT)(R1SUPP(I),I=1,60)
C
C     -----WRITE OUT COMMON FOR SUBFILE I/O (UNIVAC ONLY)-----
C
      WRITE(IOUNIT)(IBUF(I),I=1,504)
C
C     -----WRITE OUT COMMON FOR DIAGRAMMATIC GRAPHICS-----
C
      WRITE(IOUNIT)(IH1DIA(I),I=1,40)
      WRITE(IOUNIT)(R1DIAG(I),I=1,40)
C
C     -----WRITE OUT COMMON FOR COLOR-----
C
      WRITE(IOUNIT)ICOLOR
      WRITE(IOUNIT)IPLOTF
C
C     -----WRITE OUT COMMON FOR BUGS AND ERROR-----
C
      WRITE(IOUNIT)IBUGG4
      WRITE(IOUNIT)ISUBG4
      WRITE(IOUNIT)IERRG4
C
C     -----WRITE OUT COMMON FOR HOST-----
C
      WRITE(IOUNIT)IHOST1
      WRITE(IOUNIT)IHOST2
      WRITE(IOUNIT)IHMOD1
      WRITE(IOUNIT)IHMOD2
      WRITE(IOUNIT)IOPSY1
      WRITE(IOUNIT)IOPSY2
      WRITE(IOUNIT)ICOMPI
      WRITE(IOUNIT)ISITE
C
C     -----WRITE OUT COMMON FOR TRANSLATOR-----
C
      WRITE(IOUNIT)ITRANS
      WRITE(IOUNIT)NCTRA1
      WRITE(IOUNIT)NCTRA2
      WRITE(IOUNIT)NUMTRA
      WRITE(IOUNIT)ICTRA1
      WRITE(IOUNIT)ICTRA2
C
C     -----WRITE OUT COMMON FOR NON-PRINTING CHARACTERS-----
C
      WRITE(IOUNIT)INULC
      WRITE(IOUNIT)ISOHC
      WRITE(IOUNIT)ISTXC
      WRITE(IOUNIT)IETXC
      WRITE(IOUNIT)IEOTC
      WRITE(IOUNIT)IENQC
      WRITE(IOUNIT)IACKC
      WRITE(IOUNIT)IBELC
      WRITE(IOUNIT)IBSC
      WRITE(IOUNIT)IHTC
      WRITE(IOUNIT)ILFC
      WRITE(IOUNIT)IVTC
      WRITE(IOUNIT)IFFC
      WRITE(IOUNIT)ICRC
      WRITE(IOUNIT)ISOC
      WRITE(IOUNIT)ISIC
      WRITE(IOUNIT)IDLEC
      WRITE(IOUNIT)IDC1C
      WRITE(IOUNIT)IDC2C
      WRITE(IOUNIT)IDC3C
      WRITE(IOUNIT)IDC4C
      WRITE(IOUNIT)INAKC
      WRITE(IOUNIT)ISYNC
      WRITE(IOUNIT)IETBC
      WRITE(IOUNIT)ICANC
      WRITE(IOUNIT)IEMC
      WRITE(IOUNIT)ISUBC
      WRITE(IOUNIT)IESCC
      WRITE(IOUNIT)IFSC
      WRITE(IOUNIT)IGSC
      WRITE(IOUNIT)IRSC
      WRITE(IOUNIT)IUSC
C
C     -----WRITE OUT COMMON FOR GRAPHICS-----
C
      WRITE(IOUNIT)IMANUF
      WRITE(IOUNIT)IMODEL
      WRITE(IOUNIT)IMODE2
      WRITE(IOUNIT)IMODE3
      WRITE(IOUNIT)IGCODE
      WRITE(IOUNIT)IGUNIT
      WRITE(IOUNIT)IGCONT
      WRITE(IOUNIT)NUMHPP
      WRITE(IOUNIT)NUMVPP
      WRITE(IOUNIT)ANUMHP
      WRITE(IOUNIT)ANUMVP
      WRITE(IOUNIT)IGCOLO
      WRITE(IOUNIT)IGBAUD
      WRITE(IOUNIT)AGERDE
      WRITE(IOUNIT)AGCODE
      WRITE(IOUNIT)ISOFT
      WRITE(IOUNIT)ISOFT2
      WRITE(IOUNIT)ISOFT3
C
C     -----WRITE OUT COMMON FOR FILE OPERATIONS-----
C
      WRITE(IOUNIT)(I1FILO(I),I=1,10)
      WRITE(IOUNIT)(IH1FIL(I),I=1,200)
C
C     -----WRITE OUT COMMON FOR FILE OPERATIONS, PART 2-----
C
      WRITE(IOUNIT)IMESNU
      WRITE(IOUNIT)IMESNA
      WRITE(IOUNIT)IMESST
      WRITE(IOUNIT)IMESFO
      WRITE(IOUNIT)IMESAC
      WRITE(IOUNIT)IMESPR
      WRITE(IOUNIT)IMESCS
C
      WRITE(IOUNIT)INEWNU
      WRITE(IOUNIT)INEWNA
      WRITE(IOUNIT)INEWST
      WRITE(IOUNIT)INEWFO
      WRITE(IOUNIT)INEWAC
      WRITE(IOUNIT)INEWPR
      WRITE(IOUNIT)INEWCS
C
      WRITE(IOUNIT)IMAINU
      WRITE(IOUNIT)IMAINA
      WRITE(IOUNIT)IMAIST
      WRITE(IOUNIT)IMAIFO
      WRITE(IOUNIT)IMAIAC
      WRITE(IOUNIT)IMAIPR
      WRITE(IOUNIT)IMAICS
C
      WRITE(IOUNIT)IHELNU
      WRITE(IOUNIT)IHELNA
      WRITE(IOUNIT)IHELST
      WRITE(IOUNIT)IHELFO
      WRITE(IOUNIT)IHELAC
      WRITE(IOUNIT)IHELPR
      WRITE(IOUNIT)IHELCS
C
      WRITE(IOUNIT)IBUGNU
      WRITE(IOUNIT)IBUGNA
      WRITE(IOUNIT)IBUGST
      WRITE(IOUNIT)IBUGFO
      WRITE(IOUNIT)IBUGAC
      WRITE(IOUNIT)IBUGPR
      WRITE(IOUNIT)IBUGCS
C
      WRITE(IOUNIT)IQUENU
      WRITE(IOUNIT)IQUENA
      WRITE(IOUNIT)IQUEST
      WRITE(IOUNIT)IQUEFO
      WRITE(IOUNIT)IQUEAC
      WRITE(IOUNIT)IQUEPR
      WRITE(IOUNIT)IQUECS
C
      WRITE(IOUNIT)ILOGNU
      WRITE(IOUNIT)ILOGNA
      WRITE(IOUNIT)ILOGST
      WRITE(IOUNIT)ILOGFO
      WRITE(IOUNIT)ILOGAC
      WRITE(IOUNIT)ILOGPR
      WRITE(IOUNIT)ILOGCS
C
      WRITE(IOUNIT)IREANU
      WRITE(IOUNIT)IREANA
      WRITE(IOUNIT)IREAST
      WRITE(IOUNIT)IREAFO
      WRITE(IOUNIT)IREAAC
      WRITE(IOUNIT)IREAPR
      WRITE(IOUNIT)IREACS
C
      WRITE(IOUNIT)IWRINU
      WRITE(IOUNIT)IWRINA
      WRITE(IOUNIT)IWRIST
      WRITE(IOUNIT)IWRIFO
      WRITE(IOUNIT)IWRIAC
      WRITE(IOUNIT)IWRIPR
      WRITE(IOUNIT)IWRICS
C
      WRITE(IOUNIT)ISAVNU
      WRITE(IOUNIT)ISAVNA
      WRITE(IOUNIT)ISAVST
      WRITE(IOUNIT)ISAVFO
      WRITE(IOUNIT)ISAVAC
      WRITE(IOUNIT)ISAVPR
      WRITE(IOUNIT)ISAVCS
C
      WRITE(IOUNIT)ILISNU
      WRITE(IOUNIT)ILISNA
      WRITE(IOUNIT)ILISST
      WRITE(IOUNIT)ILISFO
      WRITE(IOUNIT)ILISAC
      WRITE(IOUNIT)ILISPR
      WRITE(IOUNIT)ILISCS
C
      WRITE(IOUNIT)ICRENU
      WRITE(IOUNIT)ICRENA
      WRITE(IOUNIT)ICREST
      WRITE(IOUNIT)ICREFO
      WRITE(IOUNIT)ICREAC
      WRITE(IOUNIT)ICREPR
      WRITE(IOUNIT)ICRECS
C
      WRITE(IOUNIT)ISCRNU
      WRITE(IOUNIT)ISCRNA
      WRITE(IOUNIT)ISCRST
      WRITE(IOUNIT)ISCRFO
      WRITE(IOUNIT)ISCRAC
      WRITE(IOUNIT)ISCRPR
      WRITE(IOUNIT)ISCRCS
C
      WRITE(IOUNIT)IDATNU
      WRITE(IOUNIT)IDATNA
      WRITE(IOUNIT)IDATST
      WRITE(IOUNIT)IDATFO
      WRITE(IOUNIT)IDATAC
      WRITE(IOUNIT)IDATPR
      WRITE(IOUNIT)IDATCS
C
      WRITE(IOUNIT)IPL1NU
      WRITE(IOUNIT)IPL1NA
      WRITE(IOUNIT)IPL1ST
      WRITE(IOUNIT)IPL1FO
      WRITE(IOUNIT)IPL1AC
      WRITE(IOUNIT)IPL1PR
      WRITE(IOUNIT)IPL1CS
C
      WRITE(IOUNIT)IPL2NU
      WRITE(IOUNIT)IPL2NA
      WRITE(IOUNIT)IPL2ST
      WRITE(IOUNIT)IPL2FO
      WRITE(IOUNIT)IPL2AC
      WRITE(IOUNIT)IPL2PR
      WRITE(IOUNIT)IPL2CS
C
      WRITE(IOUNIT)IPRONU
      WRITE(IOUNIT)IPRONA
      WRITE(IOUNIT)IPROST
      WRITE(IOUNIT)IPROFO
      WRITE(IOUNIT)IPROAC
      WRITE(IOUNIT)IPROPR
      WRITE(IOUNIT)IPROCS
C
      WRITE(IOUNIT)ICONNU
      WRITE(IOUNIT)ICONNA
      WRITE(IOUNIT)ICONST
      WRITE(IOUNIT)ICONFO
      WRITE(IOUNIT)ICONAC
      WRITE(IOUNIT)ICONPR
      WRITE(IOUNIT)ICONCS
C
      WRITE(IOUNIT)ISACNU
      WRITE(IOUNIT)ISACNA
      WRITE(IOUNIT)ISACST
      WRITE(IOUNIT)ISACFO
      WRITE(IOUNIT)ISACAC
      WRITE(IOUNIT)ISACPR
      WRITE(IOUNIT)ISACCS
C
      WRITE(IOUNIT)IEX1NU
      WRITE(IOUNIT)IEX1NA
      WRITE(IOUNIT)IEX1ST
      WRITE(IOUNIT)IEX1FO
      WRITE(IOUNIT)IEX1AC
      WRITE(IOUNIT)IEX1PR
      WRITE(IOUNIT)IEX1CS
C
      WRITE(IOUNIT)IEX2NU
      WRITE(IOUNIT)IEX2NA
      WRITE(IOUNIT)IEX2ST
      WRITE(IOUNIT)IEX2FO
      WRITE(IOUNIT)IEX2AC
      WRITE(IOUNIT)IEX2PR
      WRITE(IOUNIT)IEX2CS
C
      WRITE(IOUNIT)IEX3NU
      WRITE(IOUNIT)IEX3NA
      WRITE(IOUNIT)IEX3ST
      WRITE(IOUNIT)IEX3FO
      WRITE(IOUNIT)IEX3AC
      WRITE(IOUNIT)IEX3PR
      WRITE(IOUNIT)IEX3CS
C
      WRITE(IOUNIT)IEX4NU
      WRITE(IOUNIT)IEX4NA
      WRITE(IOUNIT)IEX4ST
      WRITE(IOUNIT)IEX4FO
      WRITE(IOUNIT)IEX4AC
      WRITE(IOUNIT)IEX4PR
      WRITE(IOUNIT)IEX4CS
C
      WRITE(IOUNIT)IEX5NU
      WRITE(IOUNIT)IEX5NA
      WRITE(IOUNIT)IEX5ST
      WRITE(IOUNIT)IEX5FO
      WRITE(IOUNIT)IEX5AC
      WRITE(IOUNIT)IEX5PR
      WRITE(IOUNIT)IEX5CS
C
      WRITE(IOUNIT)IFCHAR
C
C     -----WRITE OUT COMMON FOR PLOT CONTROL-----
C
      WRITE(IOUNIT)(IDMANU(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDMODE(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDMOD2(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDMOD3(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDPOWE(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDCONT(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDCOLO(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDSCRE(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDSCRO(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDPAER(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDSEGM(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDSOFT(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDSOF2(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDSOF3(I),I=1,MAXDV)
C
      WRITE(IOUNIT)(IDCODE(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDUNIT(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDNHPP(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDNVPP(I),I=1,MAXDV)
      WRITE(IOUNIT)(IDBAUD(I),I=1,MAXDV)
      WRITE(IOUNIT)NUMDEV,MAXDEV
C
      WRITE(IOUNIT)IERASW,IBELSW,ISORSW,ICOPSW
      WRITE(IOUNIT)IPENSW
      WRITE(IOUNIT)IBACCO,IMARCO
      WRITE(IOUNIT)IDEFXC,IDEFBK,IDEFMC,IDEPEC
      WRITE(IOUNIT)ISEQSW
      WRITE(IOUNIT)IFENSW
      WRITE(IOUNIT)INEGSW
      WRITE(IOUNIT)IVISSW,IPEDSW,IPEDCO
      WRITE(IOUNIT)IDEFMA,IDEFMO,IDEFM2,IDEFM3
      WRITE(IOUNIT)IDEFPO,IDEFCN,IDEFDC
C
      WRITE(IOUNIT)NUMRIN,NUMCOP
      WRITE(IOUNIT)NUMSEQ
      WRITE(IOUNIT)IDEFVP,IDEFHP,IDEFUN
C
      WRITE(IOUNIT)BAWIDT,BARSPA,DEFBAS
      WRITE(IOUNIT)AORIXC,AORIYC,AORIZC
      WRITE(IOUNIT)AEYEXC,AEYEYC,AEYEZC
CCCCC THE FOLLOWING LINE WAS FIXED    APRIL 1992 (ALAN)
CCCCC WRITE(IOUNIT)PPEDHE
      WRITE(IOUNIT)APEDSZ
      WRITE(IOUNIT)DEFSZ,DEFTL
C
      WRITE(IOUNIT)IGRASW
C
      WRITE(IOUNIT)PGRAXO,PGRAYO,PGRAXC,PGRAYC,PGRAXN,PGRAYN
      WRITE(IOUNIT)PMARXC
      WRITE(IOUNIT)PGRAXF,PGRAYF
      WRITE(IOUNIT)PCROXC,PCROYC
C
      WRITE(IOUNIT)IDIASW
C
      WRITE(IOUNIT)PDIAXC,PDIAYC,PDIAX2,PDIAY2
      WRITE(IOUNIT)PDIAHE,PDIAWI,PDIAVG,PDIAHG
C
      WRITE(IOUNIT)PWXMIN,PWXMAX,PWYMIN,PWYMAX
      WRITE(IOUNIT)WWXMIN,WWXMAX,WWYMIN,WWYMAX
C
      WRITE(IOUNIT)IX1MIN,IX1MAX,IY1MIN,IY1MAX
      WRITE(IOUNIT)IX2MIN,IX2MAX,IY2MIN,IY2MAX
C
      WRITE(IOUNIT)PXMIN,PXMAX,PYMIN,PYMAX
      WRITE(IOUNIT)PDXMIN,PDXMAX,PDYMIN,PDYMAX
      WRITE(IOUNIT)PGXMIN,PGXMAX,PGYMIN,PGYMAX
      WRITE(IOUNIT)GX1MIN,GX1MAX,GY1MIN,GY1MAX
      WRITE(IOUNIT)GX2MIN,GX2MAX,GY2MIN,GY2MAX
      WRITE(IOUNIT)DX1MIN,DX1MAX,DY1MIN,DY1MAX
      WRITE(IOUNIT)DX2MIN,DX2MAX,DY2MIN,DY2MAX
      WRITE(IOUNIT)FX1MIN,FX1MAX,FY1MIN,FY1MAX
      WRITE(IOUNIT)FX2MIN,FX2MAX,FY2MIN,FY2MAX
C
      WRITE(IOUNIT)IX1FSW,IX2FSW,IY1FSW,IY2FSW
      WRITE(IOUNIT)IX1FPA,IX2FPA,IY1FPA,IY2FPA
      WRITE(IOUNIT)IX1FCO,IX2FCO,IY1FCO,IY2FCO
C
      WRITE(IOUNIT)PFRATH
C
      WRITE(IOUNIT)IX1TSW,IX2TSW,IY1TSW,IY2TSW
      WRITE(IOUNIT)IX1JSW,IX2JSW,IY1JSW,IY2JSW
      WRITE(IOUNIT)IX1NSW,IX2NSW,IY1NSW,IY2NSW
      WRITE(IOUNIT)IX1TSC,IX2TSC,IY1TSC,IY2TSC
      WRITE(IOUNIT)IX1TJU,IX2TJU,IY1TJU,IY2TJU
      WRITE(IOUNIT)IX1TCO,IX2TCO,IY1TCO,IY2TCO
C
      WRITE(IOUNIT)NMJX1T,NMJX2T,NMJY1T,NMJY2T
      WRITE(IOUNIT)NMNX1T,NMNX2T,NMNY1T,NMNY2T
      WRITE(IOUNIT)NX1COO,NX2COO,NY1COO,NY2COO
      WRITE(IOUNIT)NX1CMN,NX2CMN,NY1CMN,NY2CMN
      WRITE(IOUNIT)MAXTIC
C
      WRITE(IOUNIT)(PX1COO(I),I=1,MAXTC)
      WRITE(IOUNIT)(PX2COO(I),I=1,MAXTC)
      WRITE(IOUNIT)(PY1COO(I),I=1,MAXTC)
      WRITE(IOUNIT)(PY2COO(I),I=1,MAXTC)
      WRITE(IOUNIT)(X1COOR(I),I=1,MAXTC)
      WRITE(IOUNIT)(X2COOR(I),I=1,MAXTC)
      WRITE(IOUNIT)(Y1COOR(I),I=1,MAXTC)
      WRITE(IOUNIT)(Y2COOR(I),I=1,MAXTC)
      WRITE(IOUNIT)(PX1CMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(PX2CMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(PY1CMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(PY2CMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(X1COMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(X2COMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(Y1COMN(I),I=1,MAXTC)
      WRITE(IOUNIT)(Y2COMN(I),I=1,MAXTC)
      WRITE(IOUNIT)PX1TLE,PX2TLE,PY1TLE,PY2TLE
      WRITE(IOUNIT)PTICTH,PMNTFA
C
      WRITE(IOUNIT)IX1ZSW,IX2ZSW,IY1ZSW,IY2ZSW
      WRITE(IOUNIT)IX1ZFO,IX2ZFO,IY1ZFO,IY2ZFO
      WRITE(IOUNIT)IX1ZCA,IX2ZCA,IY1ZCA,IY2ZCA
      WRITE(IOUNIT)IX1ZJU,IX2ZJU,IY1ZJU,IY2ZJU
      WRITE(IOUNIT)IX1ZDI,IX2ZDI,IY1ZDI,IY2ZDI
      WRITE(IOUNIT)IX1ZFI,IX2ZFI,IY1ZFI,IY2ZFI
      WRITE(IOUNIT)IX1ZCO,IX2ZCO,IY1ZCO,IY2ZCO
C
      WRITE(IOUNIT)IX1ZDP,IX2ZDP,IY1ZDP,IY2ZDP
C
      WRITE(IOUNIT)PX1ZDS,PX2ZDS,PY1ZDS,PY2ZDS
      WRITE(IOUNIT)AX1ZAN,AX2ZAN,AY1ZAN,AY2ZAN
      WRITE(IOUNIT)PX1ZHE,PX1ZWI,PX1ZVG,PX1ZHG
      WRITE(IOUNIT)PX2ZHE,PX2ZWI,PX2ZVG,PX2ZHG
      WRITE(IOUNIT)PY1ZHE,PY1ZWI,PY1ZVG,PY1ZHG
      WRITE(IOUNIT)PY2ZHE,PY2ZWI,PY2ZVG,PY2ZHG
      WRITE(IOUNIT)PTIZTH
C
      WRITE(IOUNIT)IVGRSW,IHGRSW
      WRITE(IOUNIT)IVGRPA,IHGRPA
      WRITE(IOUNIT)IVGRCO,IHGRCO
C
      WRITE(IOUNIT)PVGRTH,PHGRTH
C
      WRITE(IOUNIT)(ITITTE(I),I=1,MAXCH)
      WRITE(IOUNIT)ITITFO,ITITCA,ITITFI,ITITCO
C
      WRITE(IOUNIT)NCTITL
C
      WRITE(IOUNIT)PTITHE,PTITWI,PTITVG,PTITHG,PTITTH,PTITDS
C
      WRITE(IOUNIT)(IX1LTE(I),I=1,MAXCH)
      WRITE(IOUNIT)IX1LFO,IX1LCA,IX1LFI,IX1LCO
      WRITE(IOUNIT)(IX2LTE(I),I=1,MAXCH)
      WRITE(IOUNIT)IX2LFO,IX2LCA,IX2LFI,IX2LCO
      WRITE(IOUNIT)(IX3LTE(I),I=1,MAXCH)
      WRITE(IOUNIT)IX3LFO,IX3LCA,IX3LFI,IX3LCO
      WRITE(IOUNIT)(IY1LTE(I),I=1,MAXCH)
      WRITE(IOUNIT)IY1LFO,IY1LCA,IY1LFI,IY1LCO
      WRITE(IOUNIT)(IY2LTE(I),I=1,MAXCH)
      WRITE(IOUNIT)IY2LFO,IY2LCA,IY2LFI,IY2LCO
C
      WRITE(IOUNIT)NCX1LA,NCX2LA,NCX3LA,NCY1LA,NCY2LA
C
      WRITE(IOUNIT)PX1LHE,PX1LWI,PX1LVG,PX1LHG,PX1LTH,PX1LDS
      WRITE(IOUNIT)PX2LHE,PX2LWI,PX2LVG,PX2LHG,PX2LTH,PX2LDS
      WRITE(IOUNIT)PX3LHE,PX3LWI,PX3LVG,PX3LHG,PX3LTH,PX3LDS
      WRITE(IOUNIT)PY1LHE,PY1LWI,PY1LVG,PY1LHG,PY1LTH,PY1LDS
      WRITE(IOUNIT)PY2LHE,PY2LWI,PY2LVG,PY2LHG,PY2LTH,PY2LDS
C
      WRITE(IOUNIT)(ILEGTE(I),I=1,MAXLG2)
      WRITE(IOUNIT)(ILEGFO(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGCA(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGJU(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGDI(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGFI(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGCO(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGNA(I),I=1,MAXLG)
C
      WRITE(IOUNIT)(ILEGST(I),I=1,MAXLG)
      WRITE(IOUNIT)(ILEGSP(I),I=1,MAXLG)
      WRITE(IOUNIT)NCLEG,MXCLEG
      WRITE(IOUNIT)NUMLEG,MAXLEG
C
      WRITE(IOUNIT)(PLEGXC(I),I=1,MAXLG)
      WRITE(IOUNIT)(PLEGYC(I),I=1,MAXLG)
      WRITE(IOUNIT)(PLEGHE(I),I=1,MAXLG)
      WRITE(IOUNIT)(PLEGWI(I),I=1,MAXLG)
      WRITE(IOUNIT)(PLEGVG(I),I=1,MAXLG)
      WRITE(IOUNIT)(PLEGHG(I),I=1,MAXLG)
      WRITE(IOUNIT)(PLEGTH(I),I=1,MAXLG)
      WRITE(IOUNIT)(ALEGAN(I),I=1,MAXLG)
C
      WRITE(IOUNIT)(IBOBFI(I),I=1,MAXBX)
      WRITE(IOUNIT)(IBOBCO(I),I=1,MAXBX)
      WRITE(IOUNIT)(IBOPPA(I),I=1,MAXBX)
      WRITE(IOUNIT)(IBOPCO(I),I=1,MAXBX)
      WRITE(IOUNIT)(IBOFPA(I),I=1,MAXBX)
      WRITE(IOUNIT)(IBOFCO(I),I=1,MAXBX)
C
      WRITE(IOUNIT)NUMBOX,MAXBOX
C
      WRITE(IOUNIT)((PBOXXC(I,J),I=1,MAXBX),J=1,2)
      WRITE(IOUNIT)((PBOXYC(I,J),I=1,MAXBX),J=1,2)
      WRITE(IOUNIT)(PBOPTH(I),I=1,MAXBX)
      WRITE(IOUNIT)(PBOPGA(I),I=1,MAXBX)
      WRITE(IOUNIT)(PBOFTH(I),I=1,MAXBX)
C
      WRITE(IOUNIT)(IARRPA(I),I=1,MAXAR)
      WRITE(IOUNIT)(IARRCO(I),I=1,MAXAR)
      WRITE(IOUNIT)(IARHFI(I),I=1,MAXAR)
C
      WRITE(IOUNIT)NUMARR,MAXARR
C
      WRITE(IOUNIT)((PARRXC(I,J),I=1,MAXAR),J=1,2)
      WRITE(IOUNIT)((PARRYC(I,J),I=1,MAXAR),J=1,2)
      WRITE(IOUNIT)(PARRTH(I),I=1,MAXAR)
      WRITE(IOUNIT)(PARHLE(I),I=1,MAXAR)
      WRITE(IOUNIT)(PARHWI(I),I=1,MAXAR)
C
      WRITE(IOUNIT)(ISEGPA(I),I=1,MAXSG)
      WRITE(IOUNIT)(ISEGCO(I),I=1,MAXSG)
C
      WRITE(IOUNIT)NUMSEG,MAXSEG
C
      WRITE(IOUNIT)((PSEGXC(I,J),I=1,MAXSG),J=1,2)
      WRITE(IOUNIT)((PSEGYC(I,J),I=1,MAXSG),J=1,2)
      WRITE(IOUNIT)(PSEGTH(I),I=1,MAXSG)
C
      WRITE(IOUNIT)(ILINPA(I),I=1,MAXLN)
      WRITE(IOUNIT)(ILINCO(I),I=1,MAXLN)
C
      WRITE(IOUNIT)MAXLIN
C
      WRITE(IOUNIT)(PLINTH(I),I=1,MAXLN)
      WRITE(IOUNIT)(PLINLE(I),I=1,MAXLN)
      WRITE(IOUNIT)(PLINL2(I),I=1,MAXLN)
      WRITE(IOUNIT)(PLINL3(I),I=1,MAXLN)
      WRITE(IOUNIT)(PLINGA(I),I=1,MAXLN)
      WRITE(IOUNIT)(PLING2(I),I=1,MAXLN)
      WRITE(IOUNIT)(PLING3(I),I=1,MAXLN)
C
      WRITE(IOUNIT)(ICHAPA(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ICHAFO(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ICHACA(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ICHAJU(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ICHADI(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ICHAFI(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ICHACO(I),I=1,MAXCH2)
C
      WRITE(IOUNIT)MAXCHA
C
      WRITE(IOUNIT)(PCHAHE(I),I=1,MAXCH2)
      WRITE(IOUNIT)(PCHAWI(I),I=1,MAXCH2)
      WRITE(IOUNIT)(PCHAVG(I),I=1,MAXCH2)
      WRITE(IOUNIT)(PCHAHG(I),I=1,MAXCH2)
      WRITE(IOUNIT)(PCHATH(I),I=1,MAXCH2)
      WRITE(IOUNIT)(ACHAAN(I),I=1,MAXCH2)
C
      WRITE(IOUNIT)(ITEXTE(I),I=1,MAXCH)
      WRITE(IOUNIT)ITEXPA,ITEXFO,ITEXCA,ITEXJU,ITEXDI,ITEXAU,ITEXFI,
     1ITEXCO
      WRITE(IOUNIT)IDEFPA,IDEFFO,IDEFCA,IDEFJU,IDEFDI,IDEFAU,IDEFFI,
     1IDEFCO
      WRITE(IOUNIT)ITEXCR,ITEXLF
      WRITE(IOUNIT)IDEFCR,IDEFLF
      WRITE(IOUNIT)ITEXSY,ITEXSP
      WRITE(IOUNIT)IDEFSY,IDEFSP
C
      WRITE(IOUNIT)NCTEXT,MXCTEX
C
      WRITE(IOUNIT)PTEXHE,PTEXWI,PTEXVG,PTEXHG
      WRITE(IOUNIT)PTEXTH,PTEXLE,ATEXAN
      WRITE(IOUNIT)PDEFHE,PDEFWI,PDEFVG,PDEFHG
      WRITE(IOUNIT)PDEFTH,PDEFLE,ADEFAN
      WRITE(IOUNIT)PTEXMR
      WRITE(IOUNIT)PDEFMR
      WRITE(IOUNIT)PXSTAR,PYSTAR
      WRITE(IOUNIT)PXEND,PYEND
C
      WRITE(IOUNIT)(IFILSW(I),I=1,MAXFL)
      WRITE(IOUNIT)(IFILPA(I),I=1,MAXFL)
      WRITE(IOUNIT)(IFILCO(I),I=1,MAXFL)
      WRITE(IOUNIT)IDEFFS
      WRITE(IOUNIT)IDEFFP
      WRITE(IOUNIT)IDEFFC
C
      WRITE(IOUNIT)MAXFIL
C
      WRITE(IOUNIT)(PFILSP(I),I=1,MAXFL)
      WRITE(IOUNIT)(PFILTH(I),I=1,MAXFL)
      WRITE(IOUNIT)(AFILBA(I),I=1,MAXFL)
      WRITE(IOUNIT)PDEFFG
      WRITE(IOUNIT)PDEFFT
      WRITE(IOUNIT)ADEFFB
C
      WRITE(IOUNIT)(IPATSW(I),I=1,MAXPT)
      WRITE(IOUNIT)(IPATPA(I),I=1,MAXPT)
      WRITE(IOUNIT)(IPATLI(I),I=1,MAXPT)
      WRITE(IOUNIT)(IPATCO(I),I=1,MAXPT)
      WRITE(IOUNIT)IDEFPS
      WRITE(IOUNIT)IDEFPP
      WRITE(IOUNIT)IDEFPL
      WRITE(IOUNIT)IDEFPC
C
      WRITE(IOUNIT)MAXPAT
C
      WRITE(IOUNIT)(PPATHE(I),I=1,MAXPT)
      WRITE(IOUNIT)(PPATWI(I),I=1,MAXPT)
      WRITE(IOUNIT)(PPATSP(I),I=1,MAXPT)
      WRITE(IOUNIT)(PPATTH(I),I=1,MAXPT)
      WRITE(IOUNIT)PDEFPH
      WRITE(IOUNIT)PDEFPW
      WRITE(IOUNIT)PDEFPG
      WRITE(IOUNIT)PDEFPT
C
      WRITE(IOUNIT)(ISPISW(I),I=1,MAXSP)
      WRITE(IOUNIT)(ISPILI(I),I=1,MAXSP)
      WRITE(IOUNIT)(ISPICO(I),I=1,MAXSP)
      WRITE(IOUNIT)IDEFSS
      WRITE(IOUNIT)IDEFSL
      WRITE(IOUNIT)IDEFSC
C
      WRITE(IOUNIT)MAXSPI
C
      WRITE(IOUNIT)(PSPITH(I),I=1,MAXSP)
      WRITE(IOUNIT)(ASPIBA(I),I=1,MAXSP)
      WRITE(IOUNIT)PDEFST
      WRITE(IOUNIT)ADEFSB
C
      WRITE(IOUNIT)(IBARSW(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBABLI(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBABCO(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBAFSW(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBAFCO(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBAPTY(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBAPLI(I),I=1,MAXBA)
      WRITE(IOUNIT)(IBAPCO(I),I=1,MAXBA)
      WRITE(IOUNIT)IDEBSW
      WRITE(IOUNIT)IDEBBL
      WRITE(IOUNIT)IDEBBC
      WRITE(IOUNIT)IDEBFS
      WRITE(IOUNIT)IDEBFC
      WRITE(IOUNIT)IDEBPT
      WRITE(IOUNIT)IDEBPL
      WRITE(IOUNIT)IDEBPC
C
      WRITE(IOUNIT)MAXBAR
C
      WRITE(IOUNIT)(ABARBA(I),I=1,MAXBA)
      WRITE(IOUNIT)(ABARWI(I),I=1,MAXBA)
      WRITE(IOUNIT)(PBABTH(I),I=1,MAXBA)
      WRITE(IOUNIT)(PBAPTH(I),I=1,MAXBA)
      WRITE(IOUNIT)(PBAPSP(I),I=1,MAXBA)
      WRITE(IOUNIT)ADEBBA
      WRITE(IOUNIT)ADEBWI
      WRITE(IOUNIT)PDEBBT
      WRITE(IOUNIT)PDEBPT
      WRITE(IOUNIT)PDEBPS
C
      WRITE(IOUNIT)(IREGSW(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREBLI(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREBCO(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREFSW(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREFCO(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREPTY(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREPLI(I),I=1,MAXRG)
      WRITE(IOUNIT)(IREPCO(I),I=1,MAXRG)
      WRITE(IOUNIT)IDERSW
      WRITE(IOUNIT)IDERBL
      WRITE(IOUNIT)IDERBC
      WRITE(IOUNIT)IDERFS
      WRITE(IOUNIT)IDERFC
      WRITE(IOUNIT)IDERPT
      WRITE(IOUNIT)IDERPL
      WRITE(IOUNIT)IDERPC
C
      WRITE(IOUNIT)MAXREG
C
      WRITE(IOUNIT)(AREGBA(I),I=1,MAXRG)
      WRITE(IOUNIT)(AREGWI(I),I=1,MAXRG)
      WRITE(IOUNIT)(PREBTH(I),I=1,MAXRG)
      WRITE(IOUNIT)(PREPTH(I),I=1,MAXRG)
      WRITE(IOUNIT)(PREPSP(I),I=1,MAXRG)
      WRITE(IOUNIT)ADERBA
      WRITE(IOUNIT)ADERWI
      WRITE(IOUNIT)PDERBT
      WRITE(IOUNIT)PDERPT
      WRITE(IOUNIT)PDERPS
C
      WRITE(IOUNIT)(IMARSW(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMABLI(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMABCO(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMAFSW(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMAFCO(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMAPTY(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMAPLI(I),I=1,MAXMR)
      WRITE(IOUNIT)(IMAPCO(I),I=1,MAXMR)
      WRITE(IOUNIT)IDEMSW
      WRITE(IOUNIT)IDEMBL
      WRITE(IOUNIT)IDEMBC
      WRITE(IOUNIT)IDEMFS
      WRITE(IOUNIT)IDEMFC
      WRITE(IOUNIT)IDEMPT
      WRITE(IOUNIT)IDEMPL
      WRITE(IOUNIT)IDEMPC
C
      WRITE(IOUNIT)MAXMAR
C
      WRITE(IOUNIT)(AMARBA(I),I=1,MAXMR)
      WRITE(IOUNIT)(AMARWI(I),I=1,MAXMR)
      WRITE(IOUNIT)(PMABTH(I),I=1,MAXMR)
      WRITE(IOUNIT)(PMAPTH(I),I=1,MAXMR)
      WRITE(IOUNIT)(PMAPSP(I),I=1,MAXMR)
      WRITE(IOUNIT)ADEMBA
      WRITE(IOUNIT)ADEMWI
      WRITE(IOUNIT)PDEMBT
      WRITE(IOUNIT)PDEMPT
      WRITE(IOUNIT)PDEMPS
C
      WRITE(IOUNIT)(ITEXSW(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEBLI(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEBCO(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEFSW(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEFCO(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEPTY(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEPLI(I),I=1,MAXTX)
      WRITE(IOUNIT)(ITEPCO(I),I=1,MAXTX)
      WRITE(IOUNIT)IDETSW
      WRITE(IOUNIT)IDETBL
      WRITE(IOUNIT)IDETBC
      WRITE(IOUNIT)IDETFS
      WRITE(IOUNIT)IDETFC
      WRITE(IOUNIT)IDETPT
      WRITE(IOUNIT)IDETPL
      WRITE(IOUNIT)IDETPC
C
      WRITE(IOUNIT)MAXTEX
C
      WRITE(IOUNIT)(ATEXBA(I),I=1,MAXTX)
      WRITE(IOUNIT)(ATEXWI(I),I=1,MAXTX)
      WRITE(IOUNIT)(PTEBTH(I),I=1,MAXTX)
      WRITE(IOUNIT)(PTEPTH(I),I=1,MAXTX)
      WRITE(IOUNIT)(PTEPSP(I),I=1,MAXTX)
      WRITE(IOUNIT)ADETBA
      WRITE(IOUNIT)ADETWI
      WRITE(IOUNIT)PDETBT
      WRITE(IOUNIT)PDETPT
      WRITE(IOUNIT)PDETPS
C
C     -----END WRITING OUT-----------------------
C
C               ***************************
C               **  STEP 42--            **
C               **  WRITE OUT A MESSAGE  **
C               ***************************
C
      ISTEPN='42'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IERROR.EQ.'YES')GOTO4290
      IF(IFEEDB.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4211)
 4211 FORMAT('THE SAVING OF ALL INTERNAL DATAPLOT VARIABLES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4212)
 4212 FORMAT('    PARAMETERS, ETC. HAS JUST BEEN COMPLETED')
      CALL DPWRST('XXX','BUG ')
 4290 CONTINUE
C
C               ***********************
C               **  STEP 51--        **
C               **  CLOSE THE FILE.  **
C               ***********************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SAVE')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='ON'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SAVE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSAVE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 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 ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSBLI(ICOM,IHARG,IARGT,ARG,NUMARG,
     1ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1MAXSUB,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE LIMITS FOR SUBREGIONS.
C                 SUBREGION XLIMITS 10 20
C                 SUBREGION YLIMITS 10 20
C                 SUBREGION 1 YLIMITS 10 20
C                 SUBREGION 2 YLIMITS 10 20
C     INPUT  ARGUMENTS--ICOM  (A  HOLLERITH VARIABLE)
C                     --IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--
C                     --ASUBXL = COORDINATE FOR LOWER X LIMIT
C                     --ASUBXU = COORDINATE FOR UPPER X LIMIT
C                     --ASUBYL = COORDINATE FOR LOWER Y LIMIT
C                     --ASUBYU = COORDINATE FOR UPPER Y LIMIT
C                     --MAXSUB = MAXIMUM NUMBER OF SUBREGIONS
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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-2899
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--99/11
C     ORIGINAL VERSION--NOVEMBER  1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICOM
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ASUBXL(*)
      DIMENSION ASUBXU(*)
      DIMENSION ASUBYL(*)
      DIMENSION ASUBYU(*)
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
      IF(ICOM.NE.'SUBR')THEN
        IFOUND='NO'
        GOTO9000
      ENDIF
C
      IF(NUMARG.LE.0)THEN
        GOTO9000
      ENDIF
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
 1090 CONTINUE
C
C               *****************************************************
C               **  CHECK IF THE FIRST ARGUMENT IS NUMERIC         **
C               **  (THIS SHOULD DEFINE WHICH SUBREGION IS BEING   **
C               **  SET)                                           **
C               *****************************************************
C
      IF(IARGT(1).EQ.'NUMB')THEN
        ISUBID=INT(ARG(1)+0.5)
        IF(ISUBID.LT.1 .OR. ISUBID.GT.MAXSUB)ISUBID=1
        IWORD=2
      ELSE
        IWORD=1
        ISUBID=1
      ENDIF
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE HORIZONTAL SUBREGION LIMITS ARE TO BE FIXED**
C               *****************************************************
C
      IF(IHARG(IWORD).EQ.'XLIM')GOTO1100
      GOTO1199
C
 1100 CONTINUE
      IF(NUMARG.LE.IWORD)GOTO1110
      IF(IHARG(IWORD+1).EQ.'DEFA')GOTO1110
      IF(IARGT(IWORD+1).EQ.'NUMB'.AND.IARGT(IWORD+2).EQ.'NUMB')GOTO1120
      GOTO1110
C
 1110 CONTINUE
      IFOUND='YES'
      ASUBXL(ISUBID)=CPUMIN
      ASUBXU(ISUBID)=CPUMAX
 1113 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)ISUBID
 1115 FORMAT('THE X LIMITS FOR SUB-REGION ',I8,' HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)
 1117 FORMAT('TO THE FULL PLOT AREA.')
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
      GOTO9000
C
 1120 CONTINUE
      IFOUND='YES'
      ASUBXL(ISUBID)=ARG(IWORD+1)
      ASUBXU(ISUBID)=ARG(IWORD+2)
      IF(ASUBXL(ISUBID).GT.ASUBXU(ISUBID))THEN
        ATEMP=ASUBXL(ISUBID)
        ASUBXL(ISUBID)=ASUBXU(ISUBID)
        ASUBXU(ISUBID)=ATEMP
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)ISUBID
 1125 FORMAT('THE SUBREGION X LIMITS FOR SUBREGION ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)ASUBXL(ISUBID),ASUBXU(ISUBID)
 1126 FORMAT('HAVE JUST BEEN SET TO ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 1129 CONTINUE
      GOTO9000
C
 1199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN                            **
C               **  THE VERTICAL   SUBREGION LIMITS ARE TO BE FIXED**
C               *****************************************************
C
      IF(IHARG(IWORD).EQ.'YLIM')GOTO2100
      GOTO2199
C
 2100 CONTINUE
      IF(NUMARG.LE.IWORD)GOTO2110
      IF(IHARG(IWORD+1).EQ.'DEFA')GOTO2110
      IF(IARGT(IWORD+1).EQ.'NUMB'.AND.IARGT(IWORD+2).EQ.'NUMB')GOTO2120
      GOTO2110
C
 2110 CONTINUE
      IFOUND='YES'
      ASUBYL(ISUBID)=CPUMIN
      ASUBYU(ISUBID)=CPUMAX
 2113 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO2119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)ISUBID
 2115 FORMAT('THE Y LIMITS FOR SUB-REGION ',I8,' HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)
 2117 FORMAT('TO THE FULL PLOT AREA.')
      CALL DPWRST('XXX','BUG ')
 2119 CONTINUE
      GOTO9000
C
 2120 CONTINUE
      IFOUND='YES'
      ASUBYL(ISUBID)=ARG(IWORD+1)
      ASUBYU(ISUBID)=ARG(IWORD+2)
      IF(ASUBYL(ISUBID).GT.ASUBYU(ISUBID))THEN
        ATEMP=ASUBYL(ISUBID)
        ASUBYL(ISUBID)=ASUBYU(ISUBID)
        ASUBYU(ISUBID)=ATEMP
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO2129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2125)ISUBID
 2125 FORMAT('THE SUBREGION Y LIMITS FOR SUBREGION ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2126)ASUBYL(ISUBID),ASUBYU(ISUBID)
 2126 FORMAT('HAVE JUST BEEN SET TO ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
 2129 CONTINUE
      GOTO9000
C
 2199 CONTINUE
C
C               *****************************************************
C               **  TREAT THE CASE WHEN BOTH THE HORIZONTAL AND    **
C               **  VERTICAL SUBREGION LIMITS ARE TO BE FIXED      **
C               *****************************************************
C
      IF(IHARG(IWORD).EQ.'LIMI')GOTO3100
      GOTO3199
C
 3100 CONTINUE
      IF(NUMARG.LE.IWORD)GOTO3110
      IF(IHARG(IWORD+1).EQ.'DEFA')GOTO3110
      IF(IARGT(IWORD+1).EQ.'NUMB'.AND.IARGT(IWORD+2).EQ.'NUMB')GOTO3120
      GOTO3110
C
 3110 CONTINUE
      IFOUND='YES'
      ASUBXL(ISUBID)=CPUMIN
      ASUBXU(ISUBID)=CPUMAX
      ASUBYL(ISUBID)=CPUMIN
      ASUBYU(ISUBID)=CPUMAX
 3113 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO3119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3115)ISUBID
 3115 FORMAT('THE LIMITS FOR SUB-REGION ',I8,' HAVE JUST BEEN SET')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3117)
 3117 FORMAT('TO THE FULL PLOT AREA.')
      CALL DPWRST('XXX','BUG ')
 3119 CONTINUE
      GOTO9000
C
 3120 CONTINUE
      IFOUND='YES'
      ASUBXL(ISUBID)=ARG(IWORD+1)
      ASUBXU(ISUBID)=ARG(IWORD+2)
      ASUBYL(ISUBID)=ARG(IWORD+1)
      ASUBYU(ISUBID)=ARG(IWORD+2)
      IF(ASUBYL(ISUBID).GT.ASUBYU(ISUBID))THEN
        ATEMP=ASUBYL(ISUBID)
        ASUBYL(ISUBID)=ASUBYU(ISUBID)
        ASUBYU(ISUBID)=ATEMP
      ENDIF
      IF(ASUBXL(ISUBID).GT.ASUBXU(ISUBID))THEN
        ATEMP=ASUBXL(ISUBID)
        ASUBXL(ISUBID)=ASUBXU(ISUBID)
        ASUBXU(ISUBID)=ATEMP
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO3129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3125)ISUBID
 3125 FORMAT('THE SUBREGION Y LIMITS FOR SUBREGION ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3126)ASUBYL(ISUBID),ASUBYU(ISUBID)
 3126 FORMAT('HAVE JUST BEEN SET TO ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3135)ISUBID
 3135 FORMAT('THE SUBREGION X LIMITS FOR SUBREGION ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3126)ASUBXL(ISUBID),ASUBXU(ISUBID)
      CALL DPWRST('XXX','BUG ')
 3129 CONTINUE
      GOTO9000
C
 3199 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      DO8105I=1,MAXSUB
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)I
 8111 FORMAT('THE CURRENT SUBREGION ',I5,' LIMITS ARE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)ASUBXL(I),ASUBXU(I)
 8112 FORMAT('            --XLIMITS        = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8113)ASUBYL(I),ASUBYU(I)
 8113 FORMAT('            --YLIMITS        = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 8105 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPSBSP(IFOUNO,IOP,XEND,YEND,HEIGHT,WIDTH,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANGLE,AMAX,
     1IBUGD2,IERROR)
C
C     PURPOSE--ADJUST XEND, YEND, HEIGHT, AND WIDTH
C              WHEN ENTERING OR EXITING
C              SUBSCRIPT OR SUPERSCRIPT MODE.
C     NOTE--THE INPUT ARGUMENTS XEND, YEND, HEIGHT, AND WIDTH
C           MAY BE CHANGED BY THIS SUBROUTINE.
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--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     2001. ALLOW SCALE FACTORS FOR
C                                       SIZE OF SUPER/SUB/SCRIPTS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFOUNO
      CHARACTER*4 IOP
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
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
      SUBFAC=0.15
      SUPFAC=0.50
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SBSP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSBSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IFOUNO,IOP
   52 FORMAT('IFOUNO,IOP = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)XEND,YEND
   53 FORMAT('XEND,YEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)HEIGHT,WIDTH
   54 FORMAT('HEIGHT,WIDTH = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)SUBFAC,SUPFAC,PSUPXS,PSUPYS
   55 FORMAT('SUBFAC,SUPFAC,PSUPXS,PSUPYS = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PHEIGH,PWIDTH,PVEGAP,PHOGAP
   56 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)PHEIG2,PWIDT2,PVEGA2,PHOGA2
   57 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)ANGLE,AMAX
   58 FORMAT('ANGLE,AMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      THETA=(ANGLE/AMAX)*2.0*3.1315926
C
      IF(IFOUNO.EQ.'NO')GOTO1190
C
      IF(IOP.EQ.'SUB')GOTO1110
      IF(IOP.EQ.'UNSB')GOTO1120
      IF(IOP.EQ.'SUP')GOTO1130
      IF(IOP.EQ.'UNSP')GOTO1140
      GOTO1190
C
 1110 CONTINUE
CCCCC YEND=YEND-SUBFAC*HEIGHT
      XEND=XEND+SUBFAC*HEIGHT*SIN(THETA)
      YEND=YEND-SUBFAC*HEIGHT*COS(THETA)
CCCCC HEIGHT=HEIGHT/2.0
CCCCC WIDTH=WIDTH/2.0
CCCCC PHEIGH=PHEIGH/2.0
CCCCC PWIDTH=PWIDTH/2.0
CCCCC PVEGAP=PVEGAP/2.0
CCCCC PHOGAP=PHOGAP/2.0
CCCCC PHEIG2=PHEIG2/2.0
CCCCC PWIDT2=PWIDT2/2.0
CCCCC PVEGA2=PVEGA2/2.0
CCCCC PHOGA2=PHOGA2/2.0
      HEIGHT=HEIGHT/2.0
      WIDTH=WIDTH*PSUPXS
      PHEIGH=PHEIGH*PSUPYS
      PWIDTH=PWIDTH*PSUPXS
      PVEGAP=PVEGAP*PSUPYS
      PHOGAP=PHOGAP*PSUPXS
      PHEIG2=PHEIG2*PSUPYS
      PWIDT2=PWIDT2*PSUPXS
      PVEGA2=PVEGA2*PSUPYS
      PHOGA2=PHOGA2*PSUPXS
      GOTO1190
C
 1120 CONTINUE
CCCCC HEIGHT=HEIGHT*2.0
CCCCC WIDTH=WIDTH*2.0
CCCCC PHEIGH=PHEIGH*2.0
CCCCC PWIDTH=PWIDTH*2.0
CCCCC PVEGAP=PVEGAP*2.0
CCCCC PHOGAP=PHOGAP*2.0
CCCCC PHEIG2=PHEIG2*2.0
CCCCC PWIDT2=PWIDT2*2.0
CCCCC PVEGA2=PVEGA2*2.0
CCCCC PHOGA2=PHOGA2*2.0
      HEIGHT=HEIGHT*(1.0/PSUPYS)
      WIDTH=WIDTH*(1.0/PSUPXS)
      PHEIGH=PHEIGH*(1.0/PSUPYS)
      PWIDTH=PWIDTH*(1.0/PSUPXS)
      PVEGAP=PVEGAP*(1.0/PSUPYS)
      PHOGAP=PHOGAP*(1.0/PSUPXS)
      PHEIG2=PHEIG2*(1.0/PSUPYS)
      PWIDT2=PWIDT2*(1.0/PSUPXS)
      PVEGA2=PVEGA2*(1.0/PSUPYS)
      PHOGA2=PHOGA2*(1.0/PSUPXS)
CCCCC YEND=YEND+SUBFAC*HEIGHT
      XEND=XEND-SUBFAC*HEIGHT*SIN(THETA)
      YEND=YEND+SUBFAC*HEIGHT*COS(THETA)
      GOTO1190
C
 1130 CONTINUE
CCCCC YEND=YEND+SUPFAC*HEIGHT
      XEND=XEND-SUPFAC*HEIGHT*SIN(THETA)
      YEND=YEND+SUPFAC*HEIGHT*COS(THETA)
CCCCC HEIGHT=HEIGHT/2.0
CCCCC WIDTH=WIDTH/2.0
CCCCC PHEIGH=PHEIGH/2.0
CCCCC PWIDTH=PWIDTH/2.0
CCCCC PVEGAP=PVEGAP/2.0
CCCCC PHOGAP=PHOGAP/2.0
CCCCC PHEIG2=PHEIG2/2.0
CCCCC PWIDT2=PWIDT2/2.0
CCCCC PVEGA2=PVEGA2/2.0
CCCCC PHOGA2=PHOGA2/2.0
      HEIGHT=HEIGHT*PSUPYS
      WIDTH=WIDTH*PSUPXS
      PHEIGH=PHEIGH*PSUPYS
      PWIDTH=PWIDTH*PSUPXS
      PVEGAP=PVEGAP*PSUPYS
      PHOGAP=PHOGAP*PSUPXS
      PHEIG2=PHEIG2*PSUPYS
      PWIDT2=PWIDT2*PSUPXS
      PVEGA2=PVEGA2*PSUPYS
      PHOGA2=PHOGA2*PSUPXS
      GOTO1190
C
 1140 CONTINUE
CCCCC HEIGHT=HEIGHT*2.0
CCCCC WIDTH=WIDTH*2.0
CCCCC PHEIGH=PHEIGH*2.0
CCCCC PWIDTH=PWIDTH*2.0
CCCCC PVEGAP=PVEGAP*2.0
CCCCC PHOGAP=PHOGAP*2.0
CCCCC PHEIG2=PHEIG2*2.0
CCCCC PWIDT2=PWIDT2*2.0
CCCCC PVEGA2=PVEGA2*2.0
CCCCC PHOGA2=PHOGA2*2.0
      HEIGHT=HEIGHT*(1.0/PSUPYS)
      WIDTH=WIDTH*(1.0/PSUPXS)
      PHEIGH=PHEIGH*(1.0/PSUPYS)
      PWIDTH=PWIDTH*(1.0/PSUPXS)
      PVEGAP=PVEGAP*(1.0/PSUPYS)
      PHOGAP=PHOGAP*(1.0/PSUPXS)
      PHEIG2=PHEIG2*(1.0/PSUPYS)
      PWIDT2=PWIDT2*(1.0/PSUPXS)
      PVEGA2=PVEGA2*(1.0/PSUPYS)
      PHOGA2=PHOGA2*(1.0/PSUPXS)
CCCCC YEND=YEND-SUPFAC*HEIGHT
      XEND=XEND+SUPFAC*HEIGHT*SIN(THETA)
      YEND=YEND-SUPFAC*HEIGHT*COS(THETA)
      GOTO1190
C
 1190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SBSP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSBSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUNO,IOP
 9012 FORMAT('IFOUNO,IOP = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)XEND,YEND
 9013 FORMAT('XEND,YEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)HEIGHT,WIDTH
 9014 FORMAT('HEIGHT,WIDTH = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)SUBFAC,SUPFAC
 9015 FORMAT('SUBFAC,SUPFAC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9016 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9017 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ANGLE,AMAX
 9018 FORMAT('ANGLE,AMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)THETA
 9019 FORMAT('THETA = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSBSW(IHARG,NUMARG,IDEFSB,MAXSUB,ISUBSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SUB-REGION SWITCHES.
C              THESE ARE LOCATED IN THE VECTOR ISUBSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSB
C                     --MAXSUB
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ISUBSW (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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--99/11
C     ORIGINAL VERSION--NOVEMBER  1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSB
      CHARACTER*4 ISUBSW
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION ISUBSW(*)
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
      ISUBN1='DPSB'
      ISUBN2='SW  '
C
      NUMSUB=0
      IHOLD1='-999'
      IHOLD2='-999'
C
      IF(IBUGP2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSBSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGP2,IFOUND,IERROR
   52 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)MAXSUB,NUMSUB
   53 FORMAT('MAXSUB,NUMSUB = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,IHOLD2
   54 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)IDEFSB
   55 FORMAT('IDEFSB = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I)
   66 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)ISUBSW(1)
   70 FORMAT('ISUBSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ISUBSW(I)
   76 FORMAT('I,ISUBSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1100
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      GOTO1130
C
 1100 CONTINUE
      GOTO1200
C
 1110 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1='OFF'
      IF(IHARG(1).EQ.'ALL')GOTO1300
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(1).EQ.'ALL')GOTO1300
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(1)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMSUB=1
      ISUBSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMSUB=NUMARG
      IF(NUMSUB.GT.MAXSUB)NUMSUB=MAXSUB
      DO1225I=1,NUMSUB
      J=I
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      ISUBSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSUB
      WRITE(ICOUT,1276)I,ISUBSW(I)
 1276 FORMAT('SUBREGION ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSUB=MAXSUB
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
      DO1315I=1,NUMSUB
      ISUBSW(I)=IHOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)ISUBSW(I)
 1316 FORMAT('ALL SPIKES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSBSW--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGP2,IFOUND,IERROR
 9012 FORMAT('IBUGP2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)MAXSUB,NUMSUB
 9013 FORMAT('MAXSUB,NUMSUB = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,IHOLD2
 9014 FORMAT('IHOLD1,IHOLD2 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IDEFSB
 9015 FORMAT('IDEFSB = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I)
 9026 FORMAT('IHARG(I) = ',A4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)ISUBSW(1)
 9030 FORMAT('ISUBSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ISUBSW(I)
 9036 FORMAT('I,ISUBSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSCAN(ISTART,ISTRIN,NUMCHS,ILOCR2,
     1ICHAR2,IOP,IFONT,ICASE,IJUST,ISEQUE,ISUBSU,
     1HMAX,VMAX,AMAX,X0,Y0,ANGLE,WIDTH,HEIGHT,
     1IEND,IFOUNC,IFOUNO,IBUGD2,IERROR)
C
C     PURPOSE--SCAN THE STRING IN ISTRIN(.) STARTING WITH POSITION ISTART.
C                EXAMINE THE NEXT 6 CHARACTERS AT MOST.
C                COPY AND PACK THE NEXT 4 CHARACTERS INTO IWORD1.
C           IF () FOUND IN NEXT 6 CHARACTERS, THEN STRIP OFF ()
C            AND SAVE PREVIOUS INTO IWORD1 (PACKED).
C      |      IF() NOT FOUND, THEN OUTPUT A SINGLE CHARACTER IN IWORD1.
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--82/7
C     ORIGINAL VERSION--JANUARY   1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --APRIL     1987.
C     UPDATED         --AUGUST    1992.  ADDITIONAL SYMBOLS
C     UPDATED         --FEBRUARY  1995.  CONVERT IWORD1 TO UPPER CASE
C                                        (CASE ASIS COMPLICATION)
C     UPDATED         --NOVEMBER  1996.  COMPILE ERROR FOR LINIX G77
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISTRIN
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 ISEQUE
      CHARACTER*4 ISUBSU
      CHARACTER*4 IFOUNC
      CHARACTER*4 IFOUNO
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWORD1
      CHARACTER*4 IXXXXX
      CHARACTER*4 IFOULR
      CHARACTER*4 IOPERT
      CHARACTER*4 IGREET
      CHARACTER*4 IMATHT
C
CCCCC CHARACTER*4 ICHAR3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION ISTRIN(*)
C
      DIMENSION IOPERT(50)
      DIMENSION IGREET(25)
      DIMENSION IMATHT(200)
C
      DIMENSION IOPERN(50)
      DIMENSION IGREEN(25)
      DIMENSION IMATHN(200)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
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-----DATA STATEMENTS-------------------------------------------------
C
C               *************************
C               **  DEFINE OPERATIONS  **
C               *************************
C
      DATA IOPERT( 1)   /'SIMP'/
      DATA IOPERT( 2)   /'DUPL'/
      DATA IOPERT( 3)   /'TRIP'/
      DATA IOPERT( 4)   /'COMP'/
      DATA IOPERT( 5)   /'TRII'/
      DATA IOPERT( 6)   /'COMI'/
      DATA IOPERT( 7)   /'SIMS'/
      DATA IOPERT( 8)   /'COMS'/
C
      DATA IOPERT( 9)   /'UC  '/
      DATA IOPERT(10)   /'CAP '/
      DATA IOPERT(11)   /'CAPS'/
      DATA IOPERT(12)   /'LC  '/
C
      DATA IOPERT(13)   /'LJUS'/
      DATA IOPERT(14)   /'CJUS'/
      DATA IOPERT(15)   /'RJUS'/
C
      DATA IOPERT(16)   /'SEQ '/
      DATA IOPERT(17)   /'UNSQ'/
C
      DATA IOPERT(18)   /'SUB '/
      DATA IOPERT(19)   /'UNSB'/
      DATA IOPERT(20)   /'SUP '/
      DATA IOPERT(21)   /'UNSP'/
C
      DATA IOPERT(22)   /'HMAX'/
      DATA IOPERT(23)   /'VMAX'/
      DATA IOPERT(24)   /'ANGL'/
      DATA IOPERT(25)   /'HEIG'/
      DATA IOPERT(26)   /'WIDT'/
      DATA IOPERT(27)   /'ANGL'/
C
      DATA IOPERT(28)   /'MOVE'/
      DATA IOPERT(29)   /'DRAW'/
      DATA IOPERT(30)   /'RELM'/
      DATA IOPERT(31)   /'RELD'/
C
      DATA IOPERT(32)   /'BACK'/
      DATA IOPERT(33)   /'OVER'/
      DATA IOPERT(34)   /'UP  '/
      DATA IOPERT(35)   /'DOWN'/
      DATA IOPERT(36)   /'TAB '/
      DATA IOPERT(37)   /'RETU'/
C
C               *******************************
C               **  DEFINE GREEK CHARACTERS  **
C               *******************************
C
      DATA IGREET( 1)   /'ALPH'/
      DATA IGREET( 2)   /'BETA'/
      DATA IGREET( 3)   /'GAMM'/
      DATA IGREET( 4)   /'DELT'/
      DATA IGREET( 5)   /'EPSI'/
      DATA IGREET( 6)   /'ZETA'/
      DATA IGREET( 7)   /'ETA '/
      DATA IGREET( 8)   /'THET'/
      DATA IGREET( 9)   /'IOTA'/
      DATA IGREET(10)   /'KAPP'/
      DATA IGREET(11)   /'LAMB'/
      DATA IGREET(12)   /'MU  '/
      DATA IGREET(13)   /'NU  '/
      DATA IGREET(14)   /'XI  '/
      DATA IGREET(15)   /'OMIC'/
      DATA IGREET(16)   /'PI  '/
      DATA IGREET(17)   /'RHO '/
      DATA IGREET(18)   /'SIGM'/
      DATA IGREET(19)   /'TAU '/
      DATA IGREET(20)   /'UPSI'/
      DATA IGREET(21)   /'PHI '/
      DATA IGREET(22)   /'CHI '/
      DATA IGREET(23)   /'PSI '/
      DATA IGREET(24)   /'OMEG'/
C
C               ***************************
C               **  DEFINE MATH SYMBOLS  **
C               ***************************
C
      DATA IMATHT( 1)   /'HASP'/
      DATA IMATHT( 2)   /'SPAC'/
      DATA IMATHT( 3)   /'SP  '/
      DATA IMATHT( 4)   /'LAPO'/
      DATA IMATHT( 5)   /'RAPO'/
      DATA IMATHT( 6)   /'LBRA'/
      DATA IMATHT( 7)   /'RBRA'/
      DATA IMATHT( 8)   /'LCBR'/
      DATA IMATHT( 9)   /'RCBR'/
      DATA IMATHT(10)   /'LELB'/
      DATA IMATHT(11)   /'RELB'/
      DATA IMATHT(12)   /'+-  '/
      DATA IMATHT(13)   /'-+  '/
      DATA IMATHT(14)   /'TIME'/
      DATA IMATHT(15)   /'DOTP'/
      DATA IMATHT(16)   /'DIVI'/
      DATA IMATHT(17)   /'NOT='/
      DATA IMATHT(18)   /'EQUI'/
      DATA IMATHT(19)   /'LT  '/
      DATA IMATHT(20)   /'GT  '/
      DATA IMATHT(21)   /'LTEQ'/
      DATA IMATHT(22)   /'GTEQ'/
      DATA IMATHT(23)   /'VARI'/
      DATA IMATHT(24)   /'APPR'/
      DATA IMATHT(25)   /'TILD'/
      DATA IMATHT(26)   /'CARA'/
      DATA IMATHT(27)   /'RACC'/
      DATA IMATHT(28)   /'PRIM'/
      DATA IMATHT(29)   /'LACC'/
      DATA IMATHT(30)   /'BREV'/
      DATA IMATHT(31)   /'RQUO'/
      DATA IMATHT(32)   /'LQUO'/
      DATA IMATHT(33)   /'NASP'/
      DATA IMATHT(34)   /'IASP'/
      DATA IMATHT(35)   /'RADI'/
      DATA IMATHT(36)   /'LRAD'/
      DATA IMATHT(37)   /'BRAD'/
      DATA IMATHT(38)   /'SUBS'/
      DATA IMATHT(39)   /'SUPE'/
      DATA IMATHT(40)   /'UNIO'/
      DATA IMATHT(41)   /'INTR'/
      DATA IMATHT(42)   /'ELEM'/
      DATA IMATHT(43)   /'RARR'/
      DATA IMATHT(44)   /'LARR'/
      DATA IMATHT(45)   /'UARR'/
      DATA IMATHT(46)   /'DARR'/
      DATA IMATHT(47)   /'PART'/
      DATA IMATHT(48)   /'INTE'/
      DATA IMATHT(49)   /'CINT'/
      DATA IMATHT(50)   /'SUMM'/
      DATA IMATHT(51)   /'PROD'/
      DATA IMATHT(52)   /'INFI'/
      DATA IMATHT(53)   /'PARA'/
      DATA IMATHT(54)   /'DAGG'/
      DATA IMATHT(55)   /'DDAG'/
      DATA IMATHT(56)   /'THEX'/
      DATA IMATHT(57)   /'THFO'/
      DATA IMATHT(58)   /'VBAR'/
      DATA IMATHT(59)   /'DVBA'/
      DATA IMATHT(60)   /'LVBA'/
      DATA IMATHT(61)   /'HBAR'/
      DATA IMATHT(62)   /'LHBA'/
      DATA IMATHT(63)   /'HHBA'/
      DATA IMATHT(64)   /'BAR '/
      DATA IMATHT(65)   /'DEL '/
C
      DATA IMATHT(66)   /'ZZZZ'/
      DATA IMATHT(67)   /'ZZZZ'/
      DATA IMATHT(68)   /'ZZZZ'/
      DATA IMATHT(69)   /'ZZZZ'/
      DATA IMATHT(70)   /'ZZZZ'/
C
      DATA IMATHT(71)   /'.   '/
      DATA IMATHT(72)   /'POIN'/
      DATA IMATHT(73)   /'PO  '/
      DATA IMATHT(74)   /'PT  '/
      DATA IMATHT(75)   /'CIRC'/
      DATA IMATHT(76)   /'CI  '/
      DATA IMATHT(77)   /'SQUA'/
      DATA IMATHT(78)   /'SQ  '/
      DATA IMATHT(79)   /'TRIA'/
      DATA IMATHT(80)   /'TR  '/
      DATA IMATHT(81)   /'DIAM'/
      DATA IMATHT(82)   /'DI  '/
      DATA IMATHT(83)   /'STAR'/
      DATA IMATHT(84)   /'ST  '/
      DATA IMATHT(85)   /'*   '/
      DATA IMATHT(86)   /'ASTE'/
      DATA IMATHT(87)   /'AS  '/
      DATA IMATHT(88)   /'TRIR'/
      DATA IMATHT(89)   /'TRII'/
      DATA IMATHT(90)   /'BARU'/
      DATA IMATHT(91)   /'BU  '/
      DATA IMATHT(92)   /'BARV'/
      DATA IMATHT(93)   /'BV  '/
      DATA IMATHT(94)   /'BARH'/
      DATA IMATHT(95)   /'BH  '/
      DATA IMATHT(96)   /'ARRU'/
      DATA IMATHT(97)   /'AU  '/
      DATA IMATHT(98)   /'ARRD'/
      DATA IMATHT(99)   /'AD  '/
      DATA IMATHT(100)  /'ARRL'/
      DATA IMATHT(101)  /'AL  '/
      DATA IMATHT(102)  /'ARRR'/
      DATA IMATHT(103)  /'AR  '/
CCCCC NOVEMBER 1996.  FOLLOWING LINE CAUSES COMPILE ERROR ON LINUX
CCCCC G77 COMPILER. 
CLINX DATA IMATHT(104)  /'\   '/
      DATA IMATHT(105)  /'BASL'/
      DATA IMATHT(106)  /'BACK'/
      DATA IMATHT(107)  /'BS  '/
      DATA IMATHT(108)  /'_   '/
      DATA IMATHT(109)  /'UNDE'/
      DATA IMATHT(110)  /'CUBE'/
      DATA IMATHT(111)  /'PYRA'/
C  AUGUST 1992.  ADD REVT, RT (FOR REVERSE TRIANGLE, TO AGREE WITH
C  DOCUMENTATION), AND ARRO, ARRH, VECT FOR THE ARROW COMMAND
      DATA IMATHT(112)  /'REVT'/
      DATA IMATHT(113)  /'RT  '/
      DATA IMATHT(114)  /'ARRO'/
      DATA IMATHT(115)  /'ARRH'/
      DATA IMATHT(116)  /'VECT'/
      DATA IMATHT(117)  /'DEGR'/
C
C---------------------------------------------------------------------
C
C               ******************************************************
C               **  DEFINE THE NUMBER OF CHARACTERS FOR OPERATIONS  **
C               ******************************************************
C
      DATA IOPERN( 1)   /4/
      DATA IOPERN( 2)   /4/
      DATA IOPERN( 3)   /4/
      DATA IOPERN( 4)   /4/
      DATA IOPERN( 5)   /4/
      DATA IOPERN( 6)   /4/
      DATA IOPERN( 7)   /4/
      DATA IOPERN( 8)   /4/
C
      DATA IOPERN( 9)   /2/
      DATA IOPERN(10)   /3/
      DATA IOPERN(11)   /4/
      DATA IOPERN(12)   /2/
C
      DATA IOPERN(13)   /4/
      DATA IOPERN(14)   /4/
      DATA IOPERN(15)   /4/
C
      DATA IOPERN(16)   /3/
      DATA IOPERN(17)   /4/
C
      DATA IOPERN(18)   /3/
      DATA IOPERN(19)   /4/
      DATA IOPERN(20)   /3/
      DATA IOPERN(21)   /4/
C
      DATA IOPERN(22)   /4/
      DATA IOPERN(23)   /4/
      DATA IOPERN(24)   /4/
      DATA IOPERN(25)   /4/
      DATA IOPERN(26)   /4/
      DATA IOPERN(27)   /4/
C
      DATA IOPERN(28)   /4/
      DATA IOPERN(29)   /4/
      DATA IOPERN(30)   /4/
      DATA IOPERN(31)   /4/
C
      DATA IOPERN(32)   /4/
      DATA IOPERN(33)   /4/
      DATA IOPERN(34)   /2/
      DATA IOPERN(35)   /4/
      DATA IOPERN(36)   /3/
      DATA IOPERN(37)   /4/
C
C               ************************************************************
C               **  DEFINE THE NUMBER OF CHARACTERS FOR GREEK CHARACTERS  **
C               ************************************************************
C
      DATA IGREEN( 1)   /4/
      DATA IGREEN( 2)   /4/
      DATA IGREEN( 3)   /4/
      DATA IGREEN( 4)   /4/
      DATA IGREEN( 5)   /4/
      DATA IGREEN( 6)   /4/
      DATA IGREEN( 7)   /3/
      DATA IGREEN( 8)   /4/
      DATA IGREEN( 9)   /4/
      DATA IGREEN(10)   /4/
      DATA IGREEN(11)   /4/
      DATA IGREEN(12)   /2/
      DATA IGREEN(13)   /2/
      DATA IGREEN(14)   /2/
      DATA IGREEN(15)   /4/
      DATA IGREEN(16)   /2/
      DATA IGREEN(17)   /3/
      DATA IGREEN(18)   /4/
      DATA IGREEN(19)   /3/
      DATA IGREEN(20)   /4/
      DATA IGREEN(21)   /3/
      DATA IGREEN(22)   /3/
      DATA IGREEN(23)   /3/
      DATA IGREEN(24)   /4/
C
C               ********************************************************
C               **  DEFINE THE NUMBER OF CHARACTERS FOR MATH SYMBOLS  **
C               ********************************************************
C
      DATA IMATHN( 1)   /4/
      DATA IMATHN( 2)   /4/
      DATA IMATHN( 3)   /2/
      DATA IMATHN( 4)   /4/
      DATA IMATHN( 5)   /4/
      DATA IMATHN( 6)   /4/
      DATA IMATHN( 7)   /4/
      DATA IMATHN( 8)   /4/
      DATA IMATHN( 9)   /4/
      DATA IMATHN(10)   /4/
      DATA IMATHN(11)   /4/
      DATA IMATHN(12)   /2/
      DATA IMATHN(13)   /2/
      DATA IMATHN(14)   /4/
      DATA IMATHN(15)   /4/
      DATA IMATHN(16)   /4/
      DATA IMATHN(17)   /4/
      DATA IMATHN(18)   /4/
      DATA IMATHN(19)   /2/
      DATA IMATHN(20)   /2/
      DATA IMATHN(21)   /4/
      DATA IMATHN(22)   /4/
      DATA IMATHN(23)   /4/
      DATA IMATHN(24)   /4/
      DATA IMATHN(25)   /4/
      DATA IMATHN(26)   /4/
      DATA IMATHN(27)   /4/
      DATA IMATHN(28)   /4/
      DATA IMATHN(29)   /4/
      DATA IMATHN(30)   /4/
      DATA IMATHN(31)   /4/
      DATA IMATHN(32)   /4/
      DATA IMATHN(33)   /4/
      DATA IMATHN(34)   /4/
      DATA IMATHN(35)   /4/
      DATA IMATHN(36)   /4/
      DATA IMATHN(37)   /4/
      DATA IMATHN(38)   /4/
      DATA IMATHN(39)   /4/
      DATA IMATHN(40)   /4/
      DATA IMATHN(41)   /4/
      DATA IMATHN(42)   /4/
      DATA IMATHN(43)   /4/
      DATA IMATHN(44)   /4/
      DATA IMATHN(45)   /4/
      DATA IMATHN(46)   /4/
      DATA IMATHN(47)   /4/
      DATA IMATHN(48)   /4/
      DATA IMATHN(49)   /4/
      DATA IMATHN(50)   /4/
      DATA IMATHN(51)   /4/
      DATA IMATHN(52)   /4/
      DATA IMATHN(53)   /4/
      DATA IMATHN(54)   /4/
      DATA IMATHN(55)   /4/
      DATA IMATHN(56)   /4/
      DATA IMATHN(57)   /4/
      DATA IMATHN(58)   /4/
      DATA IMATHN(59)   /4/
      DATA IMATHN(60)   /4/
      DATA IMATHN(61)   /4/
      DATA IMATHN(62)   /4/
      DATA IMATHN(63)   /4/
      DATA IMATHN(64)   /3/
      DATA IMATHN(65)   /3/
C
      DATA IMATHN(66)   /4/
      DATA IMATHN(67)   /4/
      DATA IMATHN(68)   /4/
      DATA IMATHN(69)   /4/
      DATA IMATHN(70)   /4/
C
      DATA IMATHN(71)   /1/
      DATA IMATHN(72)   /4/
      DATA IMATHN(73)   /2/
      DATA IMATHN(74)   /2/
      DATA IMATHN(75)   /4/
      DATA IMATHN(76)   /2/
      DATA IMATHN(77)   /4/
      DATA IMATHN(78)   /2/
      DATA IMATHN(79)   /4/
      DATA IMATHN(80)   /2/
      DATA IMATHN(81)   /4/
      DATA IMATHN(82)   /2/
      DATA IMATHN(83)   /4/
      DATA IMATHN(84)   /2/
      DATA IMATHN(85)   /1/
      DATA IMATHN(86)   /4/
      DATA IMATHN(87)   /2/
      DATA IMATHN(88)   /4/
      DATA IMATHN(89)   /4/
      DATA IMATHN(90)   /4/
      DATA IMATHN(91)   /2/
      DATA IMATHN(92)   /4/
      DATA IMATHN(93)   /2/
      DATA IMATHN(94)   /4/
      DATA IMATHN(95)   /2/
      DATA IMATHN(96)   /4/
      DATA IMATHN(97)   /2/
      DATA IMATHN(98)   /4/
      DATA IMATHN(99)   /2/
      DATA IMATHN(100)   /4/
      DATA IMATHN(101)   /2/
      DATA IMATHN(102)   /4/
      DATA IMATHN(103)   /2/
      DATA IMATHN(104)   /1/
      DATA IMATHN(105)   /4/
      DATA IMATHN(106)   /4/
      DATA IMATHN(107)   /2/
      DATA IMATHN(108)   /1/
      DATA IMATHN(109)   /4/
      DATA IMATHN(110)   /4/
      DATA IMATHN(111)   /4/
C
C  AUGUST 1992.  ADDED FOLLOWING LINES FOR REVERSE TRIANGLE SYNONYMS
C  AND FOR ARROW.
C
      DATA IMATHN(112)   /4/
      DATA IMATHN(113)   /2/
      DATA IMATHN(114)   /4/
      DATA IMATHN(115)   /4/
      DATA IMATHN(116)   /4/
      DATA IMATHN(117)   /4/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSC'
      ISUBN2='AN  '
C
      IFOUNO='NO'
      IFOUNC='NO'
      IERROR='NO'
C
CLINX NOVEMBER 1996.  FOLLOWING TO ACCOMODATE LINUX G77 COMPILER.
      CALL DPCONA(92,IMATHT(104))
      J2=0
      NUMC=0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCAN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSCAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISTART,ISTRIN(ISTART),NUMCHS,ILOCR2
   52 FORMAT('ISTART,ISTRIN(ISTART),NUMCHS,ILOCR2 = ',I8,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)(ISTRIN(I),I=1,NUMCHS)
   53 FORMAT('(ISTRIN(I),I=1,NUMCHS) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************************
C               **  STEP 2--                               **
C               **  PACK THE PRESENT CHARACTER             **
C               **  AND THE NEXT 3 CHARACTERS INTO         **
C               **  THE SINGLE COMPUTER WORD IWORD1.       **
C               **  IF A LEFT PARENTHESIS IS ENCOUNTERED,  **
C               **  STOP THE PACK                          **
C               **  (AND EXCLUDE THE LEFT PARENTHESIS      **
C               **  FROM THE PACK).                        **
C               *********************************************
C
      ISTEPN='2'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWORD1=' '
C
      ISTAR1=0
      ILEN1=NUMBPC
      ILEN2=NUMBPC
C
      DO1100K=1,4
      L=ISTART+K-1
      IF(L.GT.NUMCHS)GOTO1190
      IF(ISTRIN(L).EQ.'(')GOTO1190
      ISTAR2=NUMBPC*(K-1)
      CALL DPCHEX(ISTAR1,ILEN1,ISTRIN(L),ISTAR2,ILEN2,IWORD1)
 1100 CONTINUE
 1190 CONTINUE
CCCCC CONVERT IWORD1 TO UPPER CASE.             FEBRUARY 1995.
      DO1191I=1,4
        CALL DPCOAN(IWORD1(I:I),IVALT)
        IF(IVALT.GE.97.AND.IVALT.LE.122)IVALT=IVALT-32
        CALL DPCONA(IVALT,IWORD1(I:I))
 1191 CONTINUE
C
C               *************************************************************
C               **  STEP 1--CHECK TO SEE                                   **
C               **          IF BEYOND THE RIGHTMOST RIGHT PARENTHESIS      **
C               **          (WHICH IMPLIES THAT ALL SUBSEQUENT CHARACTERS  **
C               **          ARE ONLY 1 CHARACTER LONG).                    **
C               *************************************************************
C
      IF(ISTART.GT.ILOCR2)GOTO6000
C
C               ***************************
C               **  STEP 3.1--           **
C               **  CHECK FOR FONT TYPE  **
C               ***************************
C
 2100 CONTINUE
      ISTEPN='3.1'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=8
      DO2110J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2150
 2110 CONTINUE
      GOTO2190
 2150 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2160
      GOTO2190
 2160 CONTINUE
      IFONT=IWORD1
      IEND=ILOCRP
      IOP=IFONT
      IFOUNO='YES'
      GOTO9000
 2190 CONTINUE
C
C               **********************************
C               **  STEP 3.2--                  **
C               **  CHECK FOR UPPER/LOWER CASE  **
C               **********************************
C
 2200 CONTINUE
      ISTEPN='3.2'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
      JMIN=9
      JMAX=12
      DO2210J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2250
 2210 CONTINUE
      GOTO2290
 2250 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2260
      GOTO2290
 2260 CONTINUE
      ICASE=IWORD1
      IF(ICASE.EQ.'LC')ICASE='LOWE'
      IF(ICASE.EQ.'LCAS')ICASE='LOWE'
      IF(ICASE.EQ.'UC')ICASE='UPPE'
      IF(ICASE.EQ.'UCAS')ICASE='UPPE'
      IF(ICASE.EQ.'CAPS')ICASE='UPPE'
      IF(ICASE.EQ.'CAP')ICASE='UPPE'
      IEND=ILOCRP
      IOP=ICASE
      IFOUNO='YES'
      GOTO9000
 2290 CONTINUE
C
C               *************************************************
C               **  STEP 3.3--                                 **
C               **  CHECK FOR LEFT/CENTER/RIGHT JUSTIFICATION  **
C               *************************************************
C
 2300 CONTINUE
      ISTEPN='3.3'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=13
      JMAX=15
      DO2310J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2350
 2310 CONTINUE
      GOTO2390
 2350 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2360
      GOTO2390
 2360 CONTINUE
      IJUST=IWORD1
      IEND=ILOCRP
      IOP=IJUST
      IFOUNO='YES'
      GOTO9000
 2390 CONTINUE
C
C               ******************************************
C               **  STEP 3.4--                          **
C               **  CHECK FOR SEQUENCE/UNSEQUENCE CASE  **
C               ******************************************
C
 2400 CONTINUE
      ISTEPN='3.4'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=16
      JMAX=17
      DO2410J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2450
 2410 CONTINUE
      GOTO2490
 2450 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2460
      GOTO2490
 2460 CONTINUE
      ISEQUE=IWORD1
      IEND=ILOCRP
      IOP=ISEQUE
      IFOUNO='YES'
      GOTO9000
 2490 CONTINUE
C
C               ********************************************
C               **  STEP 3.5--                            **
C               **  CHECK FOR SUBSCRIPT/SUPERSCRIPT CASE  **
C               ********************************************
C
 2500 CONTINUE
      ISTEPN='3.5'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=18
      JMAX=21
      DO2510J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2550
 2510 CONTINUE
      GOTO2590
 2550 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2560
      GOTO2590
 2560 CONTINUE
      ISUBSU=IWORD1
      IEND=ILOCRP
      IOP=ISUBSU
      IFOUNO='YES'
      GOTO9000
 2590 CONTINUE
C
C               ****************************************
C               **  STEP 3.6--                        **
C               **  CHECK FOR SCREEN MAX, ANGLE MAX,  **
C               **  HEIGHT, WIDTH, AND ANGLE.         **
C               ****************************************
C
 2600 CONTINUE
      ISTEPN='3.6'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=22
      JMAX=27
      DO2610J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2650
 2610 CONTINUE
      GOTO2690
 2650 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2660
      GOTO2690
 2660 CONTINUE
      IXXXXX=IWORD1
      IEND=ILOCRP
      IOP=IXXXXX
      IFOUNO='YES'
      GOTO9000
 2690 CONTINUE
C
C               *********************************************
C               **  STEP 3.7--                             **
C               **  CHECK FOR MOVE, DRAW, ETC. OPERATIONS  **
C               *********************************************
C
 2700 CONTINUE
      ISTEPN='3.7'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=28
      JMAX=37
      DO2710J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IOPERT(J))GOTO2750
 2710 CONTINUE
      GOTO2790
 2750 CONTINUE
      NUMC=IOPERN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO2760
      GOTO2790
 2760 CONTINUE
      IXXXXX=IWORD1
      IEND=ILOCRP
      IOP=IXXXXX
      IFOUNO='YES'
      GOTO9000
 2790 CONTINUE
C
C               **********************************
C               **  STEP 3.8--                  **
C               **  CHECK FOR GREEK CHARACTERS  **
C               **********************************
C
 3100 CONTINUE
      ISTEPN='3.8'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=24
      DO3110J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IGREET(J))GOTO3150
 3110 CONTINUE
      GOTO3190
 3150 CONTINUE
      NUMC=IGREEN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO3160
      GOTO3190
 3160 CONTINUE
      ICHAR2=IWORD1
      IEND=ILOCRP
      IFOUNC='YES'
      GOTO9000
 3190 CONTINUE
C
C               ******************************
C               **  STEP 3.9--              **
C               **  CHECK FOR MATH SYMBOLS  **
C               ******************************
C
 4100 CONTINUE
      ISTEPN='3.9'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
CCCCC JMAX=109
CCCCC JMAX=111
      JMAX=117
      DO4110J=JMIN,JMAX
      J2=J
      IF(IWORD1.EQ.IMATHT(J))GOTO4150
 4110 CONTINUE
      GOTO4190
 4150 CONTINUE
      NUMC=IMATHN(J2)
      ILOCLP=ISTART+NUMC
      ILOCRP=ISTART+NUMC+1
      CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
      IF(IFOULR.EQ.'YES')GOTO4160
      GOTO4190
 4160 CONTINUE
      ICHAR2=IWORD1
      IEND=ILOCRP
      IFOUNC='YES'
      GOTO9000
 4190 CONTINUE
C
C               *************************************************
C               **  STEP 4--                                   **
C               **  NO MATCH FOUND FOR ANY OF THE ABOVE;       **
C               **  THEREFORE OUTPUT ONLY THE LEAD CHARACTER.  **
C               *************************************************
C
C
 6000 CONTINUE
      ISTEPN='4'
      IF(IBUGD2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMCHS.LE.1)GOTO6005
      ILOCLP=ISTART
      ILOCRP=ISTART+1
      IF(ISTRIN(ILOCLP).EQ.'('.AND.ISTRIN(ILOCRP).EQ.')')GOTO6006
 6005 CONTINUE
      ICHAR2=ISTRIN(ISTART)
      IEND=ISTART
      IFOUNC='YES'
      GOTO9000
 6006 CONTINUE
      IEND=ILOCRP
      IFOUNO='YES'
      GOTO9000
C
C     PRE-1986--THE FOLLOWING COMMENTED-OUT CODE WAS FOR PUTTING OUT
C     UP TO 4 CHARACTERS AS A PLOT CHARACTER
C     AND THEREFORE COMMENTED OUT.
C
CCCCC DO6010I=1,4
CCCCC I2=I
CCCCC ICHAR3='    '
CCCCC ICHAR3(1:1)=IWORD1(I:I)
CCCCC IF(ICHAR3.EQ.'(')GOTO6020
CCCCC IF(ICHAR3.EQ.' ')GOTO6020
C6010 CONTINUE
CCCCC NUMC=I2
CCCCC GOTO6080
C6020 CONTINUE
CCCCC NUMC=I2-1
CCCCC GOTO6080
C6080 CONTINUE
CCCCC IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCAN')GOTO6089
CCCCC WRITE(ICOUT,6081)
C6081 FORMAT('***** FROM THE MIDDLE OF DPSCAN--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6082)IWORD1,ICHAR3
C6082 FORMAT('IWORD1,ICHAR3 = ',A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,6083)I2,NUMC
C6083 FORMAT('I2,NUMC = ',2I8)
CCCCC CALL DPWRST('XXX','BUG ')
C6089 CONTINUE
C6090 CONTINUE
CCCCC ILOCLP=ISTART+NUMC
CCCCC ILOCRP=ISTART+NUMC+1
CCCCC CALL DPCHLR(ISTRIN,NUMCHS,ILOCLP,ILOCRP,IFOULR,IBUGD2,IERROR)
CCCCC IF(IFOULR.EQ.'YES')GOTO6095
CCCCC GOTO6097
C6095 CONTINUE
CCCCC ICHAR2=IWORD1
CCCCC IEND=ILOCRP
CCCCC IFOUNC='YES'
CCCCC GOTO9000
C6097 CONTINUE
CCCCC ICHAR2=ISTRIN(ISTART)
CCCCC IEND=ISTART
CCCCC IFOUNC='YES'
CCCCC GOTO9000
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCAN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSCAN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUNC,IFOUNO,IBUGD2,IERROR
 9012 FORMAT('IFOUNC,IFOUNO,IBUGD2,IERROR = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHAR2,IOP,ISTART,IEND
 9013 FORMAT('ICHAR2,IOP,ISTART,IEND = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IFONT,ICASE,IJUST,ISEQUE,ISUBSU
 9014 FORMAT('IFONT,ICASE,IJUST,ISEQUE,ISUBSU = ',
     1A4,2X,A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)HMAX,VMAX,AMAX
 9015 FORMAT('HMAX,VMAX,AMAX = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)X0,Y0,ANGLE
 9016 FORMAT('X0,Y0,ANGLE = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)WIDTH,HEIGHT
 9017 FORMAT('WIDTH,HEIGHT = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)ISTAR2,IWORD1,NUMC,J2
 9018 FORMAT('ISTAR2,IWORD1,NUMC,J2 = ',I8,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4
 9019 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSCEB(Y1,Y2,Y3,NPTS,NLAB,
     1W,N,
     1AMEAN,ASD,S2BMPS,
     1XSE,XSES2,IDFH,SIGMAH,
     1SESUK1,SESUK2,
     1DLOWSE,DHIGSE,
     1IWRITE,
     1ICAPSW,ICAPTY,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--IMPLEMENT SCHILLER-EBERHARDT APPROACH TO
C              CONSENSUS MEANS
C     PRINTING--YES
C     SUBROUTINES NEEDED--NONE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2006/3
C     ORIGINAL VERSION--MARCH     2006. EXTRACTED FROM DPMAN2 ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES--------------
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*1 IBASLC
C
      CHARACTER*20 IMETH
C
      REAL APPF
      REAL XSE
      REAL XSES2
      REAL S2BMPS
      REAL SIGMAH
      REAL SESUK1
      REAL SESUK2
C
C----------------------------------------------------------------
C
      REAL Y1(*)
      REAL Y2(*)
      REAL Y3(*)
      REAL AMEAN(*)
      REAL ASD(*)
C
      INTEGER N(*)
C
      DOUBLE PRECISION W(*)
C
      INCLUDE 'DPCOST.INC'
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDI2(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDI2,ALIGN,VALIGN
      CHARACTER*45 IVALUE(MAXHED)
      INTEGER NCHAR(MAXHED)
      REAL AVALUE(MAXHED)
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
      LOGICAL IFLAG3
C
      CHARACTER*132 ITTEMP
      CHARACTER*132 IHEAD
C
      CHARACTER*4 IRTFMD
      COMMON/COMRTF/IRTFMD
C
      REAL CPUMIN
      REAL CPUMAX
      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
      IERROR='NO'
C
      ISUBN1='DPVR'
      ISUBN2='ML  '
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'SCEB')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPSCEB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)NPTS,NLAB
   52   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO55I=1,NPTS
          WRITE(ICOUT,56)I,Y1(I),Y2(I),Y3(I)
   56     FORMAT('I,Y1(I),Y2(I),Y3(I) = ',I8,3G15.7)
          CALL DPWRST('XXX','BUG ')
   55   CONTINUE
      ENDIF
C
      DSUM1=0.0D0
      DO810I=1,NLAB
        DVAR=DBLE(ASD(I))**2
        W(I)=1.0D0/(DVAR+DBLE(S2BMPS))
        DSUM1=DSUM1 + W(I)
  810 CONTINUE
      DWTSUM=DSUM1
      DSUM1=0.0D0
      DSUM2=0.0D0
      DSUM3=0.0D0
      DO815I=1,NLAB
        DVAR=DBLE(ASD(I))**2
        W(I)=W(I)/DWTSUM
        XI=DBLE(AMEAN(I))
        DSUM1=DSUM1 + W(I)*XI
        DSUM2=DSUM2 + W(I)*DVAR
        DSUM3=DSUM3 + (W(I)*DVAR)**2/DBLE(N(I)-1.0D0)
  815 CONTINUE
      XSE=REAL(DSUM1)
      ADFH=REAL(IDFH)
      DTERM1=(DSUM2 + SIGMAH**2)**2
      DTERM2=(DSUM3 + SIGMAH**4/ADFH)
      ADF=REAL(DTERM1/DTERM2)
      IDF=INT(ADF+0.5)
C
      DSUM1=0.0D0
      DO820I=1,NLAB
        DVAR=DBLE(ASD(I))**2
        W(I)=1.0D0/DVAR
        DSUM1=DSUM1 + W(I)
  820 CONTINUE
      DWTSUM=DSUM1
      DSUM1=0.0D0
      DO825I=1,NLAB
        DTERM1=(W(I)/DWTSUM)**2
        DSUM1=DSUM1 + DTERM1*DBLE(ASD(I)**2)
  825 CONTINUE
      XSES2=REAL(DSUM1)
C
      DBIAS=0.0D0
      DO830I=1,NLAB
        XI=DBLE(AMEAN(I))
        DTERM1=DABS(XI-DBLE(XSE))
        IF(DTERM1.GT.DBIAS)DBIAS=DTERM1
  830 CONTINUE
C
      CALL TPPF(0.975,IDF,APPF)
      DSESU1=SQRT(DBLE(XSES2) + DBLE(SIGMAH)**2) + DBIAS
      DSESU2=2.0D0*SQRT(DBLE(XSES2) + DBLE(SIGMAH)**2) + DBIAS
      DSEU=DBLE(APPF)*SQRT(DBLE(XSES2) + DBLE(SIGMAH)**2) + DBIAS
      DLOWSE=DBLE(XSE) - DSEU
      DHIGSE=DBLE(XSE) + DSEU
      ABIAS=REAL(DBIAS)
      ISEDF=IDF
      SESUK1=REAL(DSESU1)
      SESUK2=REAL(DSESU2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
 5121   FORMAT('   <TR>')
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=400>')
 5127   FORMAT('      </TD>')
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
 5128   FORMAT('   </TR>')
 5151   FORMAT('         ',I8)
 5152   FORMAT('         ',F15.7)
 5155   FORMAT('         &nbsp;')
 5191   FORMAT('</TABLE>')
 5193   FORMAT('</UL>')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('         <b>5. Method: Schiller-Eberhardt:</b>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5171)
 5171   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Consensus Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XSE
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5173)
 5173   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Estimate of Variance of Mean:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)XSES2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5174)
 5174   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Bias Allowance:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)ABIAS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5175)
 5175   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Sigmah (heterogeneity):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)SIGMAH
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5176)
 5176   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Degrees of Freedom for Sigmah:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)IDFH
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5177)
 5177   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Standard Uncertainty (<i>k</i> = 1):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)DSESU1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5178)
 5178   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (<i>k</i> = 2):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)DSESU2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5179)APPF
 5179   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Expanded Uncertainty (<i>k</i> = ',F10.7,'):')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)DSEU
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5181)
 5181   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Degrees of Freedom:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)IDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5182)
 5182   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         't Percent Point Value (alpha = 0.05:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)APPF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5183)
 5183   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Lower 95% Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DLOWSE)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5184)
 5184   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Upper 95% Confidence Limit:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)REAL(DHIGSE)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5185)
 5185   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         'Note: Schiller-Eberhardt Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5186)
 5186   FORMAT('         &nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ',
     1         '5 or Fewer Labs')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8002   FORMAT(A1,'begin{table}')
 8005   FORMAT(A1,'begin{center}')
 8006   FORMAT(5X,A1,'begin{tabular} {lr}')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8006)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8011   FORMAT(5X,'{',A1,'bf 5. Method: Schiller-Eberhardt:} & ',
     1         2X,A1,A1)
 8012   FORMAT(5X,'Estimate of Consensus Mean: & ',
     1         F15.7,2X,A1,A1)
 8013   FORMAT(5X,'Estimate of Variance of Mean: & ',
     1         F15.7,2X,A1,A1)
 8014   FORMAT(5X,'Bias Allowance: & ',
     1         F15.7,2X,A1,A1)
 8015   FORMAT(5X,'Sigmah (heterogeneity): & ',
     1         F15.7,2X,A1,A1)
 8016   FORMAT(5X,'Degrees of Freedom for Sigmah: & ',
     1         I8,2X,A1,A1)
C
        WRITE(ICOUT,8011)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8012)XSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)XSES2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)ABIAS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8015)SIGMAH,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8016)IDFH,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8020   FORMAT(5X,'Standard Uncertainty (k = 1): & ',
     1         F15.7,2X,A1,A1)
 8021   FORMAT(5X,'Expanded Uncertainty (k = 2): & ',
     1         F15.7,2X,A1,A1)
 8022   FORMAT(5X,'Expanded Uncertainty (k = ',F10.7,'): & ',
     1         F15.7,2X,A1,A1)
        WRITE(ICOUT,8020)DSESU1,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)DSESU2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)APPF,DSEU,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8024   FORMAT(5X,'Degrees of Freedom: & ',
     1         I8,2X,A1,A1)
 8025   FORMAT(5X,'t Percent Point Value of 0.975: & ',
     1         F15.7,2X,A1,A1)
 8026   FORMAT(5X,'Lower 95',A1,'% Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8027   FORMAT(5X,'Upper 95',A1,'% Confidence Interval: & ',
     1         F15.7,2X,A1,A1)
 8028   FORMAT(5X,'Note: Schiller-Eberhardt Best Usage: & ',
     1         2X,A1,A1)
 8029   FORMAT(5X,'      5 or Fewer Labs & ',
     1         2X,A1,A1)
        WRITE(ICOUT,8024)IDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8025)APPF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8026)IBASLC,DLOWSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC,DHIGSE,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8028)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8029)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8030   FORMAT(A1,'end{tabular}')
 8031   FORMAT(A1,'end{center}')
 8032   FORMAT(A1,'end{table}')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8032)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF ')THEN
C
        CALL DPCONA(92,IBASLC)
C
 6191   FORMAT(A1,'f',I1)
        IF(IRTFFF.EQ.'Courier New')THEN
          ITEMP=1
        ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
          ITEMP=8
        ELSE
          ITEMP=1
        ENDIF 
        WRITE(ICOUT,6191)IBASLC,ITEMP
        CALL DPWRST(ICOUT,'WRIT')
C
        NCOL=4
        IDEFPS=20
        IFRST=IRTFPS*5500/IDEFPS
        IINC1=IRTFPS*1540/IDEFPS
C
        DO6105ISET1=1,NCOL
          VALIGN(ISET1)='b'
          ALIGN(ISET1)='r'
          IF(NUMDI2(ISET1).LT.0.OR.NUMDI2(ISET1).GT.9)NUMDI2(ISET1)=7
 6105   CONTINUE
        ALIGN(1)='l'
        NUMDI2(1)=0
        NUMDI2(2)=7
C
        IWIDTH(1)=IFRST
        IWIDTH(2)=IWIDTH(1) + IINC1
C
        ITTEMP=' '
        NCTEMP=0
        NHEAD=0
C
        CALL DPRTF1(ITTEMP,NCTEMP,IHEAD,NHEAD)
C
        NHEAD=2
        IFLAG1=.FALSE.
        IFLAG2=.FALSE.
C
        IVALUE(1)=' b 5. Method: Schiller-Eberhardt'
        IVALUE(1)(1:1)=IBASLC
        NCHAR(1)=32
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IFLAG1=.FALSE.
        NHEAD=1
C
        NCHAR(1)=32
        IVALUE(1)='   Estimate of  Consensus Mean:'
        AVALUE(2)=XSE
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Estimate of Variance of Mean:'
        AVALUE(2)=XSES2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=18
        IVALUE(1)='   Bias Allowance:'
        AVALUE(2)=ABIAS
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=26
        IVALUE(1)='   Sigmah (heterogeneity):'
        AVALUE(2)=SIGMAH
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=33
        IVALUE(1)='   Degrees of Freedom for Sigmah:'
        AVALUE(2)=IDFH
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=32
        IVALUE(1)='   Standard Uncertainty (k = 1):'
        AVALUE(2)=DSESU1
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=32
        IVALUE(1)='   Expanded Uncertainty (k = 2):'
        AVALUE(2)=DSESU2
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=41
        IVALUE(1)(1:29)='   Expanded Uncertainty (k = '
        WRITE(IVALUE(1)(30:39),'(F10.7)')APPF
        IVALUE(1)(40:41)='):'
        AVALUE(2)=DSEU
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=34
        IVALUE(1)='   t Percent Point Value of 0.975:'
        AVALUE(2)=APPF
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=22
        IVALUE(1)='   Degrees of Freedom:'
        AVALUE(2)=IDF
        NJUNK=NUMDI2(2)
        NUMDI2(2)=0
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
        NUMDI2(2)=NJUNK
C
        NCHAR(1)=39
        IVALUE(1)='   Lower 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DLOWSE)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        NCHAR(1)=39
        IVALUE(1)='   Upper 95% (normal) Confidence Limit:'
        AVALUE(2)=REAL(DHIGSE)
        CALL DPRTF5(IVALUE(1),NCHAR(1),AVALUE,NHEAD,IFLAG1)
C
        IVALUE(1)='   Note: Schiller-Eberhardt Best Usage:'
        NCHAR(1)=39
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        IVALUE(1)='         5 or Fewer Labs:'
        NCHAR(1)=25
        IVALUE(2)=' '
        NCHAR(2)=0
        CALL DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
        CALL DPRTF6(NHEAD)
        IFLAG1=.TRUE.
        IFLAG2=.FALSE.
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'WOML')THEN
      ELSE
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4001)
 4001   FORMAT('5.  Method: Schiller-Eberhardt')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4002)XSE
 4002   FORMAT('    Estimate of Consensus Mean:             ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4003)XSES2
 4003   FORMAT('    Estimate of Variance of Mean:           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4004)ABIAS
 4004   FORMAT('    Bias Allowance:                         ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4005)SIGMAH
 4005   FORMAT('    Sigmah (heterogeneity):                 ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4006)IDFH
 4006   FORMAT('    Degrees of Freedom for Sigmah:          ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4012)DSESU1
 4012   FORMAT('    Standard Uncertainty (k = 1):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4013)DSESU2
 4013   FORMAT('    Expanded Uncertainty (k = 2):           ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4014)APPF,DSEU
 4014   FORMAT('    Expanded Uncertainty (k = ',F10.7,'):  ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4020)IDF
 4020   FORMAT('    Degrees of Freedom:                     ',
     1         I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4021)APPF
 4021   FORMAT('    t Percent Point Value (alpha = 0.05):   ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4022)REAL(DLOWSE)
 4022   FORMAT('    Lower 95% Confidence Limit:             ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4023)REAL(DHIGSE)
 4023   FORMAT('    Upper 95% Confidence Limit:             ',
     1         F15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4031)
 4031   FORMAT('    Note: Schiller-Eberhardt Best Usage:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4032)
 4032   FORMAT('          5 or Fewer Labs')
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'SCEB')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPSCEB--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IERROR
 9012   FORMAT('IERROR = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NPTS,NLAB
 9013   FORMAT('NPTS,NLAB = ',2I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)XSE,XSES2,DSEU
 9014   FORMAT('XSE,XSES2,DSEU = ',3G15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)DLOWSE,DHIGSE
 9015   FORMAT('DLOWSE,DHIGSE = ',2G15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPSCI2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A SEMI-CIRCLE
C              WITH ONE END OF THE DIAGONAL AT (X1,Y1)
C              AND THE OTHER END AT (X2,Y2).
C     NOTE--THE SEMI-CIRCLE WILL BE DRAWN CLOCKWISE.
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--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
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
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCI2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSCI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE SEMI-CIRCLE        **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      RADIUS=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      XCENT=(X1+X2)/2.0
      YCENT=(Y1+Y2)/2.0
C
      K=0
C
      X=0.0
      Y=0.0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO3010I=1,181,5
      IREV=181-I+1
      PHI2=IREV-1
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=RADIUS*COS(PHI2)+RADIUS
      Y=RADIUS*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 3010 CONTINUE
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  CLE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCI2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSCI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSCIR(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE SEMI-CIRCLES
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE SEMI-CIRCLE WILL BE DRAWN CLOCKWISE.
C     NOTE--THE INPUT COORDINATES DEFINE THE ENDS OF THE DIAMETER
C           OF THE SEMI-CIRCLE.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN SEMI-CIRCLE WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN SEMI-CIRCLE WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN SEMI-CIRCLE WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
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
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCIR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSCIR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='SCIR'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.3.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'ABSO'.AND.
     1IARGT(3).EQ.'NUMB'.AND.IARGT(4).EQ.'NUMB')
     1GOTO1113
      IF(NUMARG.GE.4.AND.IHARG(2).EQ.'RELA'.AND.
     1IARGT(3).EQ.'NUMB'.AND.IARGT(4).EQ.'NUMB')
     1GOTO1114
      GOTO1130
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=3
      GOTO1119
C
 1114 CONTINUE
      ITYPEO='RELA'
      ILOCFN=3
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPSCIR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR SEMI-CIRCLE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A SEMI-CIRCLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END OF A DIAGONAL AT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND THE OTHER END OF THE DIAGONAL AT 40 60,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      SEMI-CIRCLE 20 20 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      SEMI-CIRCLE ABSOLUTE 20 20 40 60')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
C
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
      CALL DPSCI2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCIR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSCIR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSCR7(ISTRIN,NUMCHA,X0,Y0,
     1IFONT,ICASE,IJUST,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANUMHP,ANUMVP,
     1IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,
     1ISYMBL,ISPAC,
     1IFILL,
     1IMPSW2,AMPSCH,AMPSCW,
     1XEND,YEND,IFOUND,IBUGD2,IERROR)
C
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--82/7
C     ORIGINAL VERSION--JANUARY   1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --OCTOBER   1993. HANDLE LOWER CASE CHARACTERS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISTRIN
C
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IFILL
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISEQUE
      CHARACTER*4 ISUBSU
      CHARACTER*4 IDRAW
      CHARACTER*4 IFOUNO
      CHARACTER*4 IFONSV
      CHARACTER*4 ICASSV
      CHARACTER*4 ICHAR2
      CHARACTER*4 IOP
      CHARACTER*4 IFOUNC
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      CHARACTER*4 ICASE2
C
C---------------------------------------------------------------------
C
      DIMENSION ISTRIN(*)
C
C-----COMMON----------------------------------------------------------
C
C
      CHARACTER*4 IMPSW2
C
      INCLUDE 'DPCOBE.INC'
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
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      ICASE2='UPPE'
      ISEQUE='ON'
      ISUBSU='OFF'
C
C
      X02=50.0
      Y02=50.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR7')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSCR7--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)X0,Y0,IFONT,ICASE,IJUST,ANGLE
   52 FORMAT('X0,Y0,IFONT,ICASE,IJUST,ANGLE = ',
     1E15.7,E15.7,2X,A4,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)HMAX,VMAX,AMAX,WIDTH,HEIGHT
   53 FORMAT('HMAX,VMAX,AMAX,WIDTH,HEIGHT = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)ANUMHP,ANUMVP
   54 FORMAT('ANUMHP,ANUMVP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)XEND,YEND,IBUGD2
   55 FORMAT('XEND,YEND,IBUGD2 = ',E15.7,E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMCHA
   56 FORMAT('NUMCHA = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO57I=1,NUMCHA
      WRITE(ICOUT,58)I,ISTRIN(I)
   58 FORMAT('I,ISTRIN(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   57 CONTINUE
      WRITE(ICOUT,59)IBUGG4,ISUBG4
   59 FORMAT('IBUGG4,ISUBG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)ICOL,JCOL,PTHICK,JTHICK,PTHIC2
   60 FORMAT('ICOL,JCOL,PTHICK,JTHICK,PTHIC2 = ',
     1A4,I8,E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IPATT,JPATT
   61 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)PHEIGH,PWIDTH,PVEGAP,PHOGAP
   62 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)PHEIG2,PWIDT2,PVEGA2,PHOGA2
   63 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ISYMBL,ISPAC
   65 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)IFILL
   66 FORMAT('IFILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)IFOUND,IBUGD2,IERROR
   68 FORMAT('IFOUND,IBUGD2,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************
C               **  STEP XX--          **
C               **  SAVE INPUT VALUES  **
C               *************************
C
      IFONSV=IFONT
      ICASSV=ICASE
      HEIGSV=HEIGHT
      WIDTSV=WIDTH
C
      PHEISV=PHEIGH
      PWIDSV=PWIDTH
      PVEGSV=PVEGAP
      PHOGSV=PHOGAP
C
      PHE2SV=PHEIG2
      PWI2SV=PWIDT2
      PVG2SV=PVEGA2
      PHG2SV=PHOGA2
C
      IF(IMPSW2.EQ.'ON')THEN
        PHEIGH=PHEIGH*AMPSCH
        PVEGAP=PVEGAP*AMPSCH
        PWIDTH=PWIDTH*AMPSCW
        PHOGAP=PHOGAP*AMPSCW
        PHEIG2=PHEIG2*AMPSCH
        PVEGA2=PVEGA2*AMPSCH
        PWIDT2=PWIDT2*AMPSCW
        PHOGA2=PHOGA2*AMPSCW
        HEIGHT=HEIGHT*AMPSCH
        WIDTH=WIDTH*AMPSCW
      ENDIF
C
C               *********************************************
C               **  STEP XX--                              **
C               **  DETERMINE THE LOCATION                 **
C               **  OF THE RIGHT-MOST NON-BLANK CHARACTER  **
C               *********************************************
C
      DO300I=1,NUMCHA
      IREV=NUMCHA-I+1
      IF(ISTRIN(IREV).NE.' ')GOTO305
  300 CONTINUE
      NUMCHS=0
      GOTO309
  305 CONTINUE
      NUMCHS=IREV
  309 CONTINUE
C
C               *************************************
C               **  STEP XX--                      **
C               **  DETERMINE THE LOCATION         **
C               **  OF THE RIGHT-MOST PARENTHESIS  **
C               *************************************
C
      ILOCR2=0
      DO600I=1,NUMCHS
      IREV=NUMCHS-I+1
      IF(ISTRIN(IREV).EQ.')')GOTO610
  600 CONTINUE
      GOTO690
  610 CONTINUE
      ILOCR2=IREV
      GOTO690
  690 CONTINUE
C
C               ***********************************************
C               **  STEP XX--                                **
C               **  PROCEED SEQUENTIALLY THROUGH THE STRING  **
C               ***********************************************
C
      IF(IJUST.EQ.'LEFT')GOTO1100
      IF(IJUST.EQ.'LEBO')GOTO1100
      IF(IJUST.EQ.'LECE')GOTO1100
      IF(IJUST.EQ.'LETO')GOTO1100
C
      IF(IJUST.EQ.'CENT')GOTO1200
      IF(IJUST.EQ.'CEBO')GOTO1200
      IF(IJUST.EQ.'CECE')GOTO1200
      IF(IJUST.EQ.'CETO')GOTO1200
C
      IF(IJUST.EQ.'RIGH')GOTO1200
      IF(IJUST.EQ.'RIBO')GOTO1200
      IF(IJUST.EQ.'RICE')GOTO1200
      IF(IJUST.EQ.'RITO')GOTO1200
C
      GOTO1100
C
C               *****************************************
C               **  STEP 11--                          **
C               **  TREAT THE LEFT-JUSTIFICATION CASE  **
C               *****************************************
C
 1100 CONTINUE
C
      IEND=0
C
      XEND=X0
      YEND=Y0
      IF(IJUST.EQ.'LECE')YEND=Y0-PHEIGH/2.0
      IF(IJUST.EQ.'LETO')YEND=Y0-PHEIGH
C
 1110 CONTINUE
      ISTART=IEND+1
      IF(ISTART.GT.NUMCHS)GOTO1190
C
C               ************************************
C               **  STEP 12--                     **
C               **  DECODE THE NEXT CHARACTER     **
C               **  (OR THE NEXT FEW CHARACTERS)  **
C               ************************************
C
      CALL DPSCAN(ISTART,ISTRIN,NUMCHS,ILOCR2,
     1ICHAR2,IOP,IFONT,ICASE,IJUST,ISEQUE,ISUBSU,
     1HMAX,VMAX,AMAX,X0,Y0,ANGLE,WIDTH,HEIGHT,
     1IEND,IFOUNC,IFOUNO,IBUGD2,IERROR)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR7')
     1WRITE(ICOUT,1112)ICHAR2,IOP,ISTART,IEND,IFOUNC,
     1IFOUNO
 1112 FORMAT('ICHAR2,IOP,ISTART,IEND,IFOUNC,IFOUNO = ',
     1A4,2X,A4,I8,I8,2X,A4,2X,A4)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR7')
     1CALL DPWRST('XXX','BUG ')
C
C               ******************************
C               **  STEP 13--               **
C               **  DRAW OUT THE CHARACTER  **
C               ******************************
C
      CALL DPSBSP(IFOUNO,IOP,XEND,YEND,HEIGHT,WIDTH,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANGLE,AMAX,
     1IBUGD2,IERROR)
      IF(IFOUNO.EQ.'YES')GOTO1180
C
      XSTART=XEND
      YSTART=YEND
C
      IDRAW='ON'
CCCCC OCTOBER 1993.  HANDLE CASE IF ICHAR2 IS LOWER CASE.
      ICASE2=ICASE
      CALL DPCOAN(ICHAR2(1:1),IVAL)
      IF(IVAL.GE.97.AND.IVAL.LE.122)THEN
        IVAL=IVAL-32
        CALL DPCONA(IVAL,ICHAR2(1:1))
        IF(ICASE.EQ.'LOWE'.OR.ICASE.EQ.'ASIS')ICASE2='LOWE'
      ELSE
        IF(ICASE.EQ.'ASIS')ICASE2='UPPE'
      END IF
CCCCC END CHANGE
C
      CALL DPSCR8(ICHAR2,XSTART,YSTART,IDRAW,
CCCCC1IFONT,ICASE,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1IFONT,ICASE2,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANUMHP,ANUMVP,
     1IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,
     1XEND,YEND,
     1ISPAC,
     1IFILL,
     1IFOUND,IBUGD2,IERROR)
C
 1180 CONTINUE
      GOTO1110
C
 1190 CONTINUE
      IF(IJUST.EQ.'LECE')YEND=YEND+PHEIGH/2.0
      IF(IJUST.EQ.'LETO')YEND=YEND+PHEIGH
      GOTO8000
C
C               *****************************************
C               **  STEP 21--                          **
C               **  TREAT THE CENTER-JUSTIFICATION     **
C               **  AND THE RIGHT-JUSTIFICATION CASES  **
C               *****************************************
C
 1200 CONTINUE
C
      XLEN=0.0
      YLEN=0.0
C
      IEND=0
C
      IDRAW='OFF'
C
      XEND99=X0
      YEND99=Y0
C
 1210 CONTINUE
      ISTART=IEND+1
      IF(ISTART.GT.NUMCHS)GOTO1250
C
C               ************************************
C               **  STEP 22--                     **
C               **  DECODE THE NEXT CHARACTER     **
C               **  (OR THE NEXT FEW CHARACTERS)  **
C               ************************************
C
      CALL DPSCAN(ISTART,ISTRIN,NUMCHS,ILOCR2,
     1ICHAR2,IOP,IFONT,ICASE,IJUST,ISEQUE,ISUBSU,
     1HMAX,VMAX,AMAX,X0,Y0,ANGLE,WIDTH,HEIGHT,
     1IEND,IFOUNC,IFOUNO,IBUGD2,IERROR)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR7')
     1WRITE(ICOUT,1212)ICHAR2,IOP,ISTART,IEND,IFOUNC,
     1IFOUNO
 1212 FORMAT('ICHAR2,IOP,ISTART,IEND,IFOUNC,IFOUNO = ',
     1A4,2X,A4,I8,I8,2X,A4,2X,A4)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR7')
     1CALL DPWRST('XXX','BUG ')
C
C               *********************************************
C               **  STEP 23--                              **
C               **  DETERMINE THE LENGTH OF THE CHARACTER  **
C               *********************************************
C
      CALL DPSBSP(IFOUNO,IOP,XEND99,YEND99,HEIGHT,WIDTH,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANGLE,AMAX,
     1IBUGD2,IERROR)
      IF(IFOUNO.EQ.'YES')GOTO1240
C
      XSTA99=XEND99
      YSTA99=YEND99
CCCCC OCTOBER 1993.  HANDLE CASE IF ICHAR2 IS LOWER CASE.
      ICASE2=ICASE
      CALL DPCOAN(ICHAR2(1:1),IVAL)
      IF(IVAL.GE.97.AND.IVAL.LE.122)THEN
        IVAL=IVAL-32
        CALL DPCONA(IVAL,ICHAR2(1:1))
        IF(ICASE.EQ.'LOWE'.OR.ICASE.EQ.'ASIS')ICASE2='LOWE'
      ELSE
        IF(ICASE.EQ.'ASIS')ICASE2='UPPE'
      END IF
CCCCC END CHANGE
C
      CALL DPSCR8(ICHAR2,XSTA99,YSTA99,IDRAW,
CCCCC1IFONT,ICASE,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1IFONT,ICASE2,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANUMHP,ANUMVP,
     1IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,
     1XEND99,YEND99,
     1ISPAC,
     1IFILL,
     1IFOUND,IBUGD2,IERROR)
C
 1240 CONTINUE
      GOTO1210
C
 1250 CONTINUE
      XLEN=XEND99-X0
      YLEN=YEND99-Y0
C
C               ***************************************
C               **  STEP 24--                        **
C               **  RESTORE VALUES TO THOSE AT TIME  **
C               **  OF INPUT TO THIS SUBROUTINE      **
C               ***************************************
C
      IFONT=IFONSV
      ICASE=ICASSV
      HEIGHT=HEIGSV
      WIDTH=WIDTSV
C
      PHEIGH=PHEISV
      PWIDTH=PWIDSV
      PVEGAP=PVEGSV
      PHOGAP=PHOGSV
C
      PHEIG2=PHE2SV
      PWIDT2=PWI2SV
      PVEGA2=PVG2SV
      PHOGA2=PHG2SV
C
      IF(IMPSW2.EQ.'ON')THEN
        PHEIGH=PHEIGH*AMPSCH
        PVEGAP=PVEGAP*AMPSCH
        PWIDTH=PWIDTH*AMPSCW
        PHOGAP=PHOGAP*AMPSCW
        PHEIG2=PHEIG2*AMPSCH
        PVEGA2=PVEGA2*AMPSCH
        PWIDT2=PWIDT2*AMPSCW
        PHOGA2=PHOGA2*AMPSCW
        HEIGHT=HEIGHT*AMPSCH
        WIDTH=WIDTH*AMPSCW
      ENDIF
C               ************************************************
C               **  STEP 25--                                 **
C               **  COMPUTE STARTING POINT                    **
C               **  FOR THE CENTER- OR RIGHT-JUSTIFIED STRING **
C               ************************************************
C
CCCCC IF(IJUST.EQ.'CENT')X02=X0-(XLEN/2.0)
      IF(IJUST.EQ.'CENT')X02=X0-(XLEN/2.0)+(PHOGAP/2.0)
      IF(IJUST.EQ.'CENT')Y02=Y0-(YLEN/2.0)
C
CCCCC IF(IJUST.EQ.'CEBO')X02=X0-(XLEN/2.0)
      IF(IJUST.EQ.'CEBO')X02=X0-(XLEN/2.0)+(PHOGAP/2.0)
      IF(IJUST.EQ.'CEBO')Y02=Y0-(YLEN/2.0)
C
CCCCC IF(IJUST.EQ.'CECE')X02=X0-(XLEN/2.0)
      IF(IJUST.EQ.'CECE')X02=X0-(XLEN/2.0)+(PHOGAP/2.0)
      IF(IJUST.EQ.'CECE')Y02=Y0-(YLEN/2.0)-PHEIGH/2.0
C
CCCCC IF(IJUST.EQ.'CETO')X02=X0-(XLEN/2.0)
      IF(IJUST.EQ.'CETO')X02=X0-(XLEN/2.0)+(PHOGAP/2.0)
      IF(IJUST.EQ.'CETO')Y02=Y0-(YLEN/2.0)-PHEIGH
C
      IF(IJUST.EQ.'RIGH')X02=X0-XLEN
      IF(IJUST.EQ.'RIGH')Y02=Y0-YLEN
C
      IF(IJUST.EQ.'RIBO')X02=X0-XLEN
      IF(IJUST.EQ.'RIBO')Y02=Y0-YLEN
C
      IF(IJUST.EQ.'RICE')X02=X0-XLEN
      IF(IJUST.EQ.'RICE')Y02=Y0-YLEN-PHEIGH/2.0
C
      IF(IJUST.EQ.'RITO')X02=X0-XLEN
      IF(IJUST.EQ.'RITO')Y02=Y0-YLEN-PHEIGH
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR7')GOTO1259
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1251)
 1251 FORMAT('***** FROM THE MIDDLE    OF DPSCR7--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1252)IJUST,XLEN,YLEN,PWIDT2,PHEIG2
 1252 FORMAT('IJUST,XLEN,YLEN,PWIDT2,PHEIG2 = ',A4,4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1253)X0,Y0,X02,Y02
 1253 FORMAT('X0,Y0,X02,Y02 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 1259 CONTINUE
C
      IEND=0
C
      XEND=X02
      YEND=Y02
C
      IDRAW='ON'
C
 1260 CONTINUE
      ISTART=IEND+1
      IF(ISTART.GT.NUMCHS)GOTO1290
C
C               ************************************
C               **  STEP 26--                     **
C               **  DECODE THE NEXT CHARACTER     **
C               **  (OR THE NEXT FEW CHARACTERS)  **
C               ************************************
C
      CALL DPSCAN(ISTART,ISTRIN,NUMCHS,ILOCR2,
     1ICHAR2,IOP,IFONT,ICASE,IJUST,ISEQUE,ISUBSU,
     1HMAX,VMAX,AMAX,X0,Y0,ANGLE,WIDTH,HEIGHT,
     1IEND,IFOUNC,IFOUNO,IBUGD2,IERROR)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR7')
     1WRITE(ICOUT,1262)ICHAR2,IOP,ISTART,IEND,IFOUNC,
     1IFOUNO
 1262 FORMAT('ICHAR2,IOP,ISTART,IEND,IFOUNC,IFOUNO = ',
     1A4,2X,A4,I8,I8,2X,A4,2X,A4)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR7')
     1CALL DPWRST('XXX','BUG ')
C
C               ******************************
C               **  STEP 27--               **
C               **  DRAW OUT THE CHARACTER  **
C               ******************************
C
      CALL DPSBSP(IFOUNO,IOP,XEND,YEND,HEIGHT,WIDTH,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANGLE,AMAX,
     1IBUGD2,IERROR)
      IF(IFOUNO.EQ.'YES')GOTO1280
C
      XSTART=XEND
      YSTART=YEND
CCCCC OCTOBER 1993.  HANDLE CASE IF ICHAR2 IS LOWER CASE.
      ICASE2=ICASE
      CALL DPCOAN(ICHAR2(1:1),IVAL)
      IF(IVAL.GE.97.AND.IVAL.LE.122)THEN
        IVAL=IVAL-32
        CALL DPCONA(IVAL,ICHAR2(1:1))
        IF(ICASE.EQ.'LOWE'.OR.ICASE.EQ.'ASIS')ICASE2='LOWE'
      ELSE
        IF(ICASE.EQ.'ASIS')ICASE2='UPPE'
      END IF
CCCCC END CHANGE
C
      CALL DPSCR8(ICHAR2,XSTART,YSTART,IDRAW,
CCCCC1IFONT,ICASE,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1IFONT,ICASE2,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANUMHP,ANUMVP,
     1IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,
     1XEND,YEND,
     1ISPAC,
     1IFILL,
     1IFOUND,IBUGD2,IERROR)
C
 1280 CONTINUE
      GOTO1260
C
 1290 CONTINUE
      IF(IJUST.EQ.'CECE')YEND=YEND+PHEIGH/2.0
      IF(IJUST.EQ.'CETO')YEND=YEND+PHEIGH
      IF(IJUST.EQ.'RICE')YEND=YEND+PHEIGH/2.0
      IF(IJUST.EQ.'RITO')YEND=YEND+PHEIGH
      GOTO8000
C
C               ***************************************
C               **  STEP 28--                        **
C               **  RESTORE VALUES TO THOSE AT TIME  **
C               **  OF INPUT TO THIS SUBROUTINE      **
C               ***************************************
C
 8000 CONTINUE
      IFONT=IFONSV
      ICASE=ICASSV
      WIDTH=WIDTSV
      HEIGHT=HEIGSV
C
      PHEIGH=PHEISV
      PWIDTH=PWIDSV
      PVEGAP=PVEGSV
      PHOGAP=PHOGSV
C
      PHEIG2=PHE2SV
      PWIDT2=PWI2SV
      PVEGA2=PVG2SV
      PHOGA2=PHG2SV
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR7')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSCR7--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)XEND,YEND
 9012 FORMAT('XEND,YEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IPATT,JPATT
 9013 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)ICOL,JCOL,PTHICK,JTHICK,PTHIC2
 9020 FORMAT('ICOL,JCOL,PTHICK,JTHICK,PTHIC2 = ',
     1A4,I8,E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9022 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9023 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)ISYMBL,ISPAC
 9025 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)IFILL
 9026 FORMAT('IFILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IFOUND,IBUGD2,IERROR
 9028 FORMAT('IFOUND,IBUGD2,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSCR8(ICHAR2,XSTART,YSTART,IDRAW,
     1IFONT,ICASE,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANUMHP,ANUMVP,
     1IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,
     1XEND,YEND,
     1ISPAC,
     1IFILL,
     1IFOUND,IBUG,IERROR)
C
C     PURPOSE--SCRIBE OUT THE SINGLE CHARACTER
C              IN THE HOLLERITH VARIABLE ICHAR2.
C     NOTE--ICHAR2 SHOULD CONTAIN A SINGLE CHARACTER
C           OR SHOULD CONTAIN AN ABBREVIATED
C           STRING (4 CHARACTERS AT MOST) INDICATING A DESIRED
C           MATH OPERATION, GREEK LETTER, ETC.
C           THE ABBREVIATED STRING HAS HAD () REMOVED.
C           THE PRE-CHECKING AND FORMATION OF A VALID ICHAR2
C           WAS DONE IN DPSCAN.
C     INPUT  ARGUMENTS--ICHAR2  = THE HOLLERITH VARIABLE
C                                CONTAINING THE CHARACTER OF INTEREST.
C                       XSTART = THE STARTING HORIZONTAL COORDINATE;
C                                THE HORIZONTAL COORDINATE OF THE
C                                BOTTOM LEFT POINT OF THE FIRST CHARACTER.
C                                XSTART MAY BE IN ANY UNITS, BUT IS USUALLY
C                                GIVEN IN % UNITS, INCHES, CENTIMETERS, OR
C                                TEKTRONIX PICTURE POINTS.
C                       YSTART = THE STARTING VERTICAL COORDINATE;
C                                THE VERTICAL COORDINATE OF THE
C                                BOTTOM LEFT POINT OF THE FIRST CHARACTER.
C                                YSTART MAY BE IN ANY UNITS, BUT IS USUALLY
C                                GIVEN IN % UNITS, INCHES, CENTIMETERS, OR
C                                TEKTRONIX PICTURE POINTS.
C                       HEIGHT = THE HEIGHT OF THE CHARACTERS (INCLUDING GAP);
C                                THE HEIGHT OF A CHARACTER
C                                MAY BE IN ANY UNITS, BUT IS USUALLY
C                                GIVEN IN % UNITS, INCHES, CENTIMETERS, OR
C                                TEKTRONIX PICTURE POINTS.
C
C                       WIDTH  = THE WIDTH OF THE CHARACTERS (INCLUDING GAP);
C                                THE WIDTH OF A CHARACTER
C                                MAY BE IN ANY UNITS, BUT IS USUALLY
C                                GIVEN IN % UNITS, INCHES, CENTIMETERS, OR
C                                TEKTRONIX PICTURE POINTS.
C
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--82/7
C     ORIGINAL VERSION--
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --OCTOBER   1991.  ADDED SOME ABBREVIATIONS FOR CHARACTER
C                                        FILL.  ALAN
C     UPDATED         --AUGUST    1992.  ADD SOME CHAR FILL (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHAR2
      CHARACTER*4 IDRAW
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 ICOL
      CHARACTER*4 ISPAC
      CHARACTER*4 IFILL
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUG
      CHARACTER*4 IERROR
C
      CHARACTER*4 IOP
      CHARACTER*4 IFIG
      CHARACTER*4 IMATH
      CHARACTER*4 ICHAR3
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 IFLAG
C
      CHARACTER*4 IPATT2
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(100)
      DIMENSION X(100)
      DIMENSION Y(100)
C
      DIMENSION PX(100)
      DIMENSION PY(100)
C
CCCCC DIMENSION PX3(100)
CCCCC DIMENSION PY3(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
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
      IPATT2='SOLI'
C
      IMATH='NO'
C
      XFACHP=1.0
      YFACHP=1.0
C
      XMINC=0.0
      XMAXC=0.0
      XMINC2=0.0
      XMAXC2=0.0
      YMINC2=0.0
      YMAXC2=0.0
C
      X2=0.0
      X3=0.0
      X4=0.0
C
      XEND2=(-999.0)
      YEND2=(-999.0)
C
      I2=(-999)
C
      PPENTH=(-999.0)
      NLOOP=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR8')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('****** AT THE BEGINNING OF DPSCR8--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2,XSTART,YSTART,IDRAW,WIDTH,HEIGHT
   52 FORMAT('ICHAR2,XSTART,YSTART,IDRAW,WIDTH,HEIGHT = ',
     1A4,2E15.7,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IFONT,ICASE,ANGLE
   53 FORMAT('IFONT,ICASE,ANGLE = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)HMAX,VMAX,AMAX
   54 FORMAT('HMAX,VMAX,AMAX = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ANUMHP,ANUMVP
   55 FORMAT('ANUMHP,ANUMVP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ISPAC
   56 FORMAT('ISPAC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFILL
   57 FORMAT('IFILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)XEND,YEND
   58 FORMAT('XEND,YEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT,JPATT
   59 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)ICOL,JCOL,PTHICK,JTHICK,PTHIC2
   60 FORMAT('ICOL,JCOL,PTHICK,JTHICK,PTHIC2 = ',
     1A4,I8,E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)PHEIGH,PWIDTH,PVEGAP,PHOGAP
   62 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)PHEIG2,PWIDT2,PVEGA2,PHOGA2
   63 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IFOUND,IBUGG4,ISUBG4,IERROR
   69 FORMAT('IFOUND,IBUGG4,ISUBG4,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
CCCCC           ******************************************************
CCCCC           **  STEP 3.0--                                      **
CCCCC           **  COPY OVER VALUES FOR THE USUAL CASE (= 1 PASS)  **
CCCCC           ******************************************************
CCCCC
CCCCC ISTART = LOCATION (1 TO 4) OF FIRST CHARACTER IN ICHAR2
CCCCC   (IF FIRST CHARACTER IS BLANK, THEN ISTART STILL = 1)
CCCCC  ISTOP = LOCATION (1 TO 4) OF LAST NON-BLANK CHARACTER IN ICHAR2
CCCCC   OR OF LAST CHARACTER BEFORE (
CCCCC  (UNLESS ( IS IN LOCATION 1)
CCCCC  IPOINT = LOCATION (1 TO 4) OF CURRENTLOCATION OF ITNTEREST.
CCCCC ICHAR3 EITHER HAS ELEMENTS IPOINT TO ISTOP OF ICHAR2
CCCCC OR (IF NO MATCH WAS FOUND),
CCCCC ELEMENTS IPOINT OT IPOINT OF ICHAR2.
CCCCC ISTART AND ISTOP DO NOT CHANGE.
CCCCC IPOINT MAY CHANGE (INCREASE) IF NO MATCH
CCCCC
CCCCC ISTART=1
CCCCC ISTOP=4
CCCCC ICTEMP=ICHAR2(4:4)
CCCCC IF(ICTEMP.EQ.' ')ISTOP=3
CCCCC IF(ICTEMP.EQ.'(')ISTOP=3
CCCCC ICTEMP=ICHAR2(3:3)
CCCCC IF(ICTEMP.EQ.' ')ISTOP=2
CCCCC IF(ICTEMP.EQ.'(')ISTOP=2
CCCCC ICTEMP=ICHAR2(2:2)
CCCCC IF(ICTEMP.EQ.' ')ISTOP=1
CCCCC IF(ICTEMP.EQ.'(')ISTOP=1
CCCCC
CCCCC IPOINT=ISTART
C
      ICHAR3=ICHAR2
      XSTAR2=XSTART
      YSTAR2=YSTART
C
C               **********************************************
C               **  STEP 3.1--                              **
C               **  TREAT THE ROMAN ALPHABET, NUMERIC, AND  **
C               **  STANDARD SYMBOLS CASE                   **
C               **********************************************
C
 1200 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR8')GOTO1209
      WRITE(ICOUT,1201)
 1201 FORMAT('***** FROM NEAR BEGINNING OF DPSCR8--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1202)ICHAR2,ICHAR3
 1202 FORMAT('ICHAR2,ICHAR3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1203)I2,ISTART,ISTOP
C1203 FORMAT('I2,ISTART,ISTOP = ',3I8)
CCCCC CALL DPWRST('XXX','BUG ')
 1209 CONTINUE
C
      IF(IFONT.EQ.'SIMP')GOTO1210
      IF(IFONT.EQ.'DUPL')GOTO1220
      IF(IFONT.EQ.'TRIP')GOTO1230
      IF(IFONT.EQ.'COMP')GOTO1240
      IF(IFONT.EQ.'TRII')GOTO1250
      IF(IFONT.EQ.'COMI')GOTO1260
      IF(IFONT.EQ.'SIMS')GOTO1270
      IF(IFONT.EQ.'COMS')GOTO1280
      GOTO1240
C
 1210 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRSU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRSL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRSN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRSS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1220 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRDU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRDL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRDN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRDS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1230 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRTU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRTL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRTN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRTS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1240 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRCU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRCL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRCN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRCS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1250 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRTIU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRTIL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRTIN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'NO')
CCCCC1CALL DPRTIS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
CCCCC1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRTS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1260 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRCIU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRCIL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRCIN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'NO')
CCCCC1CALL DPRCIS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
CCCCC1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRCS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1270 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRSSU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRSSL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'NO')
CCCCC1CALL DPRSSN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
CCCCC1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRSN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'NO')
CCCCC1CALL DPRSSS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
CCCCC1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRSS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1280 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPRCSU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPRCSL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRCSN(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
CCCCC IF(IFOUND.EQ.'NO')
CCCCC1CALL DPRCSS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
CCCCC1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')
     1CALL DPRCS(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1290
      GOTO1900
C
 1290 CONTINUE
C
C               *************************************
C               **  STEP 3.2--                     **
C               **  TREAT THE GREEK ALPHABET CASE  **
C               *************************************
C
 1300 CONTINUE
      IF(IFONT.EQ.'SIMP')GOTO1310
      GOTO1340
C
 1310 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPGSU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPGSL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1390
      GOTO1900
C
 1340 CONTINUE
      IFOUND='NO'
      IF(ICASE.EQ.'UPPE')
     1CALL DPGCU(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(ICASE.EQ.'LOWE')
     1CALL DPGCL(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'NO')GOTO1390
      GOTO1900
C
 1390 CONTINUE
C
C               ***********************************
C               **  STEP 3.3--                   **
C               **  TREAT THE MATH SYMBOLS CASE  **
C               ***********************************
C
 1400 CONTINUE
C
 1410 CONTINUE
      IFOUND='NO'
      CALL DPMATH(ICHAR3,IOP,X,Y,NUMCO,IXMINC,IXMAXC,IXDELC,
     1IBUG,IFOUND,IERROR)
      IF(IFOUND.EQ.'YES')IMATH='YES'
      IF(IFOUND.EQ.'NO')GOTO1490
      GOTO1900
C
 1490 CONTINUE
C
CCCCC           ****************************************
CCCCC           **  STEP 3.4--                        **
CCCCC           **  IF NO MATCH FOUND,                **
CCCCC           **  THEN WRITE OUT AN ERROR MESSAGE.  **
CCCCC           ****************************************
C
C1500 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1511)
C1511 FORMAT('***** ERROR IN DPSCR8--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1512)
C1512 FORMAT('      NO MATCH FOUND IN AVAILABLE HERSHEY ')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1513)
C1513 FORMAT('      SYMBOL SETS FOR THE GIVEN INPUT CHARACTER.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1514)ICHAR2
C1514 FORMAT('      INPUT CHARACTER = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1515)IFONT
C1515 FORMAT('      INPUT FONT      = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1516)ICASE
C1516 FORMAT('      INPUT CASE      = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
C
CCCCC STEP 3.4--
CCCCC IF NO MATCH FOUND,
CCCCC THEN DECOMPOSE ICHAR2--
CCCCC STRIP OFF CURRENT LEAD CHARACTER AND PROCESS IT.
CCCCC
C1500 CONTINUE
CCCCC IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR8')GOTO1589
CCCCC WRITE(ICOUT,1581)
C1581 FORMAT('***** FROM THE MIDDLE OF DPSCR--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1582)
C1582 FORMAT('      NO MATCH FOUND IN EXAMINING ICHAR3 = ',A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1583)ICHAR2,ICHAR3
C1583 FORMAT('ICHAR2,ICHAR3 = ',A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1584)I2,ISTART,ISTOP,IPOINT,ISTOP
C1584 FORMAT('I2,ISTART,ISTOP,IPOINT,ISTOP = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
C1589 CONTINUE
CC
CCCCC IF(IPOINT.GE.ISTOP)GOTO1570
CCCCC GOTO1580
CC
C1570 CONTINUE
CCCCC IERROR='YES'
CCCCC GOTO9000
C1580 CONTINUE
CCCCC ICHAR3='    '
CCCCC ICHAR3(1:1)=ICHAR2(IPOINT:IPOINT)
CCCCC IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR8')GOTO1599
CCCCC WRITE(ICOUT,1591)
C1591 FORMAT('***** FROM THE MIDDLE+ OF DPSCR--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1592)ICHAR2,ICHAR3
C1592 FORMAT('ICHAR2,ICHAR3 = ',A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,1593)I2,ISTART,ISTOP
C1593 FORMAT('I2,ISTART,ISTOP = ',3I8)
CCCCC CALL DPWRST('XXX','BUG ')
C1599 CONTINUE
CCCCC GOTO1200
C1590 CONTINUE
C
C               ****************************************************
C               **  STEP XX--                                     **
C               **  BRANCH POINT FOR A SUCCESSFUL FIND            **
C               **  (IN THE VARIOUS FONTS) OF ICHAR2 FROM ABOVE.  **
C               ****************************************************
C
 1900 CONTINUE
C
C               ****************************************************************
C               **  STEP XX--
C               **  DRAW OUT THE CHARACTER (IF IDRAW IS ON).
C               **  INVISIBLY DRAW OUT THE CHARACTER (TO DETERMINE LENGTH) (IF I
C               **  INDEX I IS THE POSITION IN THE COORDINATE VECTOR
C               **  INDEX J IS THE VERTEX NUMBER WITHIN A SUB-TRACE
C               **
C               **  NOTE--(XMAXC2-XMINC2) (= 20) HERSHEY UNITS = PWIDTH (= %) DA
C               **  FOR BOTH FIXED SPACING AND PROPORTIONAL SPACING.
C               **  THEREFORE TO TRANSLATE A HERSHEY DIFFERENCE
C               **  INTO A DATAPLOT (0 TO 100% UNITS) DIFFERENCE,
C               **  MULTIPLY THE HERSHEY DIFFERENCE BY PWIDTH/(XMAXC2-XMINC2)
C               **  = PWIDTH/20
C               ****************************************************************
C
 2000 CONTINUE
C
C     NOTE--THE VALUES -8 TO 8 ARE THE ACTUAL HERSHEY
C           WIDTH OF THE ROMAN SIMPLEX UPPER CASE A
C           AND -9 TO 12 ARE THE ACTUAL HERESHEY HEIGHT
C           OF THE ROMAN SIMPLEX UPPER CASE A.
C
      XMINC=IXMINC
      XMAXC=IXMAXC
C
CCCCC XMINC2=(-10.0)
CCCCC XMAXC2=10.0
      XMINC2=(-8.0)
      XMAXC2=8.0
      IF(IMATH.EQ.'YES')XMINC2=XMINC
      IF(IMATH.EQ.'YES')XMAXC2=XMAXC
      YMINC2=(-9.0)
      YMAXC2=12.0
CCCCC IF(IMATH.EQ.'YES')YMINC2=(-10.0)
CCCCC IF(IMATH.EQ.'YES')YMAXC2=10.0
      IF(IMATH.EQ.'YES')YMINC2=XMINC
      IF(IMATH.EQ.'YES')YMAXC2=XMAXC
C
      XFACHP=PWIDTH/(XMAXC2-XMINC2)
      YFACHP=PHEIGH/(YMAXC2-YMINC2)
C
      I=0
      J=0
 2500 CONTINUE
      I=I+1
      IF(I.GT.NUMCO)GOTO2580
      IF(IOP(I).EQ.'MOVE')GOTO2510
      GOTO2530
C
 2510 CONTINUE
      NPTEMP=J
      IFIG='LINE'
      IF(J.GE.1.AND.IDRAW.EQ.'ON')GOTO2520
      GOTO2529
 2520 CONTINUE
      IFLAG='ON'
CCCCC CALL GRDRPL(PX,PY,NPTEMP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NPTEMP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
CCCCC NP=NPTEMP
CCCCC PPENTH=0.1
CCCCC NLOOP=((PTHICK/(2.0*PPENTH))-1.0)+0.1
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR8')
CCCCC1WRITE(ICOUT,3521)PPENTH,NLOOP
C3521 FORMAT('PPENTH,NLOOP = ',E15.7,I8)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR8')
CCCCC1CALL DPWRST('XXX','BUG ')
CCCCC IF(NLOOP.LE.0)GOTO3529
CCCCC DO3522K=1,NLOOP
CCCCC AK=K
CCCCC DEL=PPENTH*AK
CCCCC CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
CCCCC CALL GRDRPL(PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
CCCCC DEL=(-PPENTH*AK)
CCCCC CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
CCCCC CALL GRDRPL(PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
 3522 CONTINUE
 3529 CONTINUE
C
C               *********************************
C               **  FILL (CERTAIN) CHARACTERS  **
C               *********************************
C
      IF(IFILL.EQ.'OFF')GOTO2528
      NPTEM2=NPTEMP
C  OCTOBER 1991.  FOLLOWING CODE MODIFIED TO RECOGNIZE CHARACTER ABREVIATIONS.
C  SPECIFICALLY, ADDED TR, SQ, DI
      IF(ICHAR2.EQ.'TRIA')GOTO2521
      IF(ICHAR2.EQ.'TR')GOTO2521
      IF(ICHAR2.EQ.'SQUA')GOTO2521
      IF(ICHAR2.EQ.'SQ')GOTO2521
      IF(ICHAR2.EQ.'DIAM')GOTO2521
      IF(ICHAR2.EQ.'DI')GOTO2521
      IF(ICHAR2.EQ.'HEXA')GOTO2521
      IF(ICHAR2.EQ.'CIRC')GOTO2521
      IF(ICHAR2.EQ.'CI')GOTO2521
      IF(ICHAR2.EQ.'CUBE')NPTEM2=5
      IF(ICHAR2.EQ.'CUBE')GOTO2521
      IF(ICHAR2.EQ.'PYRA')NPTEM2=4
      IF(ICHAR2.EQ.'PYRA')GOTO2521
C
C  FOLLOWING 6 LINES ADDED AUGUST 1992.
      IF(ICHAR2.EQ.'REVT')GOTO2521
      IF(ICHAR2.EQ.'TRIR')GOTO2521
      IF(ICHAR2.EQ.'TRII')GOTO2521
      IF(ICHAR2.EQ.'RT  ')GOTO2521
      IF(ICHAR2.EQ.'ARRO')GOTO2521
      IF(ICHAR2.EQ.'ARRH')GOTO2521
      GOTO2528
C
 2521 CONTINUE
CCCCC NP=NPTEMP   ????   APRIL 28, 1987
      NP=NPTEM2
      IFLAG='LOOP'
CCCCC PPENTH=0.1
CCCCC NLOOP=((PHEIGH/(2.0*PPENTH))-1.0)+0.1
      CALL DPDRPL(PX,PY,NPTEM2,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR8')
CCCCC1WRITE(ICOUT,2522)PWIDTH,PPENTH,NLOOP
C2522 FORMAT('PWIDTH,PPENTH,NLOOP = ',2E15.7,I8)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR8')
CCCCC1CALL DPWRST('XXX','BUG ')
C
CCCCC IF(NLOOP.LE.0)GOTO2528
CCCCC DO2523I=1,NLOOP
CCCCC AI=I
CCCCC DEL=PPENTH*AI
CCCCC CALL GRDEPL(PX,PY,NPTEMP,DEL,PX3,PY3,NP3)   ???? APRIL 28, 1987
C     CALL GRDEPL(PX,PY,NPTEM2,DEL,PX3,PY3,NP3)   (THIS IS THE GOOD ONE)
CCCCC CALL GRDRPL(PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
C2523 CONTINUE
 2528 CONTINUE
C
 2529 CONTINUE
      J=0
      GOTO2530
C
 2530 CONTINUE
      J=J+1
CCCCC X2=X(I)-XMINC2
CCCCC IF(ISPAC.EQ.'PROP')X2=X(I)-XMINC
      X2=X(I)-XMINC
      Y2=Y(I)-YMINC2
      X3=X2*XFACHP
      Y3=Y2*YFACHP
      X5=XSTAR2+X3
      Y5=YSTAR2+Y3
      CALL DPROTA(X5,Y5,XSTAR2,YSTAR2,ANGLE,AMAX,X6,Y6)
      PX(J)=X6
      PY(J)=Y6
      GOTO2500
C
 2580 CONTINUE
      NPTEMP=J
      IF(J.GE.1.AND.IDRAW.EQ.'ON')GOTO2590
      GOTO2599
 2590 CONTINUE
      IFLAG='ON'
CCCCC CALL GRDRPL(PX,PY,NPTEMP,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
      CALL DPDRPL(PX,PY,NPTEMP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
CCCCC NP=NPTEMP
CCCCC PPENTH=0.1
CCCCC NLOOP=((PTHICK/(2.0*PPENTH))-1.0)+0.1
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR8')
CCCCC1WRITE(ICOUT,4521)PPENTH,NLOOP
C4521 FORMAT('PPENTH,NLOOP = ',E15.7,I8)
CCCCC IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'SCR8')
CCCCC1CALL DPWRST('XXX','BUG ')
CCCCC IF(NLOOP.LE.0)GOTO4529
CCCCC DO4522K=1,NLOOP
CCCCC AK=K
CCCCC DEL=PPENTH*AK
CCCCC CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
CCCCC CALL GRDRPL(PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCC 1JPATT,JTHICK,PTHIC2,JCOL)
CCCCC DEL=(-PPENTH*AK)
CCCCC CALL GRDEPL(PX,PY,NP,DEL,PX3,PY3,NP3)
CCCCC CALL GRDRPL(PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL,
CCCCC1JPATT,JTHICK,PTHIC2,JCOL)
 4522 CONTINUE
 4529 CONTINUE
C
C               *********************************
C               **  FILL (CERTAIN) CHARACTERS  **
C               *********************************
C
C  OCTOBER 1991.  FOLLOWING CODE MODIFIED TO RECOGNIZE CHARACTER ABREVIATIONS.
C  SPECIFICALLY, ADDED TR, SQ, DI
      IF(IFILL.EQ.'OFF')GOTO2598
      NPTEM2=NPTEMP
      IF(ICHAR2.EQ.'TRIA')GOTO2591
      IF(ICHAR2.EQ.'TR')GOTO2591
      IF(ICHAR2.EQ.'SQUA')GOTO2591
      IF(ICHAR2.EQ.'SQ')GOTO2591
      IF(ICHAR2.EQ.'DIAM')GOTO2591
      IF(ICHAR2.EQ.'DI')GOTO2591
      IF(ICHAR2.EQ.'HEXA')GOTO2591
      IF(ICHAR2.EQ.'CIRC')GOTO2591
      IF(ICHAR2.EQ.'CI')GOTO2591
      IF(ICHAR2.EQ.'CUBE')NPTEM2=5
      IF(ICHAR2.EQ.'CUBE')GOTO2591
      IF(ICHAR2.EQ.'PYRA')NPTEM2=4
      IF(ICHAR2.EQ.'PYRA')GOTO2591
C
C  FOLLOWING 6 LINES ADDED AUGUST 1992.
      IF(ICHAR2.EQ.'REVT')GOTO2591
      IF(ICHAR2.EQ.'TRIR')GOTO2591
      IF(ICHAR2.EQ.'TRII')GOTO2591
      IF(ICHAR2.EQ.'RT  ')GOTO2591
      IF(ICHAR2.EQ.'ARRO')GOTO2591
      IF(ICHAR2.EQ.'ARRH')GOTO2591
      GOTO2598
C
 2591 CONTINUE
      IHORPA='OFF'
      IVERPA='ON'
      IDUPPA='OFF'
      IDDOPA='OFF'
      PXSPA2=0.1
      PYSPA2=0.1
      ICOLF=ICOL
      JCOLF=JCOL
      ICOLP=ICOL
      JCOLP=JCOL
CCCCC CALL GRFIRE(PX,PY,NPTEMP,IFIG,
CCCCC1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2,
CCCCC1PTHICK,JTHICK,PTHIC2,
CCCCC1ICOLF,JCOLF,ICOLP,JCOLP)
      CALL GRFIRE(PX,PY,NPTEM2,IFIG,
     1IPATT,JPATT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2,
     1PTHICK,JTHICK,PTHIC2,
     1ICOLF,JCOLF,ICOLP,JCOLP,
     1IPATT2)
 2598 CONTINUE
C
 2599 CONTINUE
C
C     X2 IS THE WIDTH OF THE CHARACTER (NO SPACING) IN HERSHEY UNITS
C     X3 IS THE WIDTH OF THE CHARACTER (NO SPACING) IN DATAPLOT UNITS
C     X4 IS THE WIDHT OF THE CHARACTER + SPACING IN DATAPLOT UNITS
C
      X2=XMAXC2-XMINC2
      IF(ISPAC.EQ.'PROP')X2=XMAXC-XMINC
      X3=X2*XFACHP
      X4=X3+PHOGAP
      X5=XSTAR2+X4
      Y5=YSTAR2
      CALL DPROTA(X5,Y5,XSTAR2,YSTAR2,ANGLE,AMAX,X6,Y6)
      XEND2=X6
      YEND2=Y6
C
C               ****************************************************************
C               **  STEP 3.6--
C               **  ARE WE DECOMPOSING ICHAR2 CHARACTER BY CHARACTER? (USUALLY N
C               **  IF NOT, THEN EXIT.
C               **  IF SO, ARE WE DONE?
C               ****************************************************************
C
CCCCC IF(ISTART.GE.ISTOP)GOTO2690
CCCCC ISTART=ISTART+1
CCCCC ICHAR3(1:1)=ICHAR2(ISTART:ISTART)
CCCCC XSTAR2=XEND2
CCCCC YSTAR2=YEND2
CCCCC GOTO1200
C2690 CONTINUE
      XEND=XEND2
      YEND=YEND2
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
C
 9000 CONTINUE
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SCR8')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('****** AT THE END       OF DPSCR8--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)XSTART,YSTART,XEND,YEND
 9012 FORMAT('XSTART,YSTART,XEND,YEND = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)ANUMHP,ANUMVP
 9019 FORMAT('ANUMHP,ANUMVP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)ICOL,JCOL,PTHICK,JTHICK,PTHIC2
 9020 FORMAT('ICOL,JCOL,PTHICK,JTHICK,PTHIC2 = ',
     1A4,I8,E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ICHAR2,IDRAW,IFONT,ICASE
 9024 FORMAT('ICHAR2,IDRAW,IFONT,ICASE = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)ANGLE,AMAX
 9025 FORMAT('ANGLE,AMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)IPATT,JPATT
 9035 FORMAT('IPATT,JPATT = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9036)ISPAC
 9036 FORMAT('ISPAC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9037)IFILL
 9037 FORMAT('IFILL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9038)PHEIGH,PWIDTH,PVEGAP,PHOGAP
 9038 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)PHEIG2,PWIDT2,PVEGA2,PHOGA2
 9039 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9040)IMATH
 9040 FORMAT('IMATH = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)XMINC,XMAXC
 9041 FORMAT('XMINC,XMAXC = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)XMINC2,XMAXC2,YMINC2,YMAXC2
 9042 FORMAT('XMINC2,XMAXC2,YMINC2,YMAXC2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)XFACHP,YFACHP
 9043 FORMAT('XFACHP,YFACHP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9044)X2,X3,X4,X5,X6
 9044 FORMAT('X2,X3,X4,X5,X6 = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9045)Y5,Y6
 9045 FORMAT('Y5,Y6 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9046)XSTART,XEND
 9046 FORMAT('XSTART,XEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9047)YSTART,YEND
 9047 FORMAT('YSTART,YEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)XSTAR2,XEND2
 9051 FORMAT('XSTAR2,XEND2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)YSTAR2,YEND2
 9052 FORMAT('YSTAR2,YEND2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9053)ICHAR2,ICHAR3
 9053 FORMAT('ICHAR2,ICHAR3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9054)IENTRY
C9054 FORMAT('IENTRY = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9056)PWIDTH,PPENTH,NLOOP
 9056 FORMAT('PWIDTH,PPENTH,NLOOP = ',2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9059)IFOUND,IBUGG4,ISUBG4,IERROR
 9059 FORMAT('IFOUND,IBUGG4,ISUBG4,IERROR = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSDCL(IHARG,NUMARG,IDSDCO,ISDFCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D SIDEFACE.
C              THE COLOR FOR THE SIDEFACE WILL BE PLACED
C              IN THE CHARACTER VARIABLE ISDFCO.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDSDCO
C     OUTPUT ARGUMENTS--ISDFCO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS SIDEFACE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDSDCO
      CHARACTER*4 ISDFCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      ISDFCO=IDSDCO
      GOTO1180
C
 1160 CONTINUE
      ISDFCO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ISDFCO
 1181 FORMAT('THE (3-D) SIDEFACE COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSDF(IHARG,NUMARG,ISDFSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D SIDEFACE SWITCH ISDFSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--ISDFSW   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS SIDEFACE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 ISDFSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IF(NUMARG.EQ.0)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      ISDFSW='ON'
      GOTO1180
C
 1160 CONTINUE
      ISDFSW='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ISDFSW
 1181 FORMAT('THE (3-D) SIDEFACE SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSDGC(IHARG,NUMARG,IDSDGC,ISDFGC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D SIDEFACE GRID.
C              THE COLOR FOR THE SIDEFACE GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE ISDFGC.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDSDGC
C     OUTPUT ARGUMENTS--ISDFGC
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS SIDEFACE COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, 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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDSDGC
      CHARACTER*4 ISDFGC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      ISDFGC=IDSDGC
      GOTO1180
C
 1160 CONTINUE
      ISDFGC=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ISDFGC
 1181 FORMAT('THE (3-D) SIDEFACE GRID COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSDGP(IHARG,NUMARG,IDSDGP,ISDFGP,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR THE 3-D SIDEFACE GRID.
C              THE PATTERN FOR THE SIDEFACE GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE ISDFGP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDSDGP
C     OUTPUT ARGUMENTS--ISDFGP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS SIDEFACE COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, 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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDSDGP
      CHARACTER*4 ISDFGP
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1160
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1150 CONTINUE
      ISDFGP='SOLI'
      GOTO1180
C
 1160 CONTINUE
      ISDFGP='BLAN'
      GOTO1180
C
 1170 CONTINUE
      ISDFGP=IDSDGP
      GOTO1180
C
 1175 CONTINUE
      ISDFGP=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ISDFGP
 1181 FORMAT('THE (3-D) SIDEFACE GRID PATTERN ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSDGR(IHARG,NUMARG,IDSDGR,ISDFGR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D SIDEFACE GRID SWITCH ISDFGR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDSDGR
C     OUTPUT ARGUMENTS--ISDFGR   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS SIDEFACE COMMANDS.
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--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDSDGR
      CHARACTER*4 ISDFGR
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
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
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1199
C
 1150 CONTINUE
      ISDFGR='ON'
      GOTO1180
C
 1160 CONTINUE
      ISDFGR='OFF'
      GOTO1180
C
 1170 CONTINUE
      ISDFGR=IDSDGR
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ISDFGR
 1181 FORMAT('THE (3-D) SIDEFACE GRID SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSEAR(IANSLC,IWIDTH,IHARG,IHARG2,NUMARG,ISEART,
     1ICOM3,ICOM4,ICOM5,NUMCOM,NCOM5,
CCCCC FEBRUARY 2003: ADD FOLLOWING LINE TO CALL LIST
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--SEARCH A USER-DEFINED FILE
C              FOR A USER-DEFINED STRING
C              AND PRINT ALL LINES WHERE THAT
C              STRING OCCURS.
C     ALSO--IF CALLED FOR, SEARCH THE MASTER REFERENCE FILE
C           (WHICH IS A FILE CONTAINING LISTS OF FILE NAMES)
C           FOR DATA FILE NAMES, FOR REFERENCE FILE NAMES,
C           AND FOR MACRO FILE NAMES.
C     ALSO--IF CALLED FOR, SEARCH THE DICTIONARY FILE
C           (WHICH IS A FILE CONTAINING THE LIST OF COMMANDS,
C           FUNCTIONS, LET SUBCOMMANDS, AND OTHER KEYWORDS.)
C     NOTE--THIS SUBROUTINE USES THE SAME FILE AS LIST.
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--88/1
C     ORIGINAL VERSION--JANUARY   1988.
C     UPDATED         --AUGUST    1988. (CHANGE DPMASF TO DPDIRF)
C     UPDATED         --AUGUST    1988. (DICTIONARY FILE)
C     UPDATED         --JANUARY   1994. SEARCH1  (1LIN)
C     UPDATED         --FEBRUARY  2003. STORE LINE NUMBER OF FIRST MATCH
C                                       IN INTERNAL PARAMETER "LINENUMB".
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANSLC
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
C
      CHARACTER*4 ISEART
      CHARACTER*4 ICOM3
      CHARACTER*4 ICOM4
      CHARACTER*40 ICOM5
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
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*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IANSI
      CHARACTER*80 ICANS
      CHARACTER*80 ISTRIN
      CHARACTER*80 ISTRIU
CCCCC CHARACTER*40 ICJUNK
C
      CHARACTER*80 ITAST
      CHARACTER*80 ITASTU
      CHARACTER*4 IHIT
      CHARACTER*4 IGO
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      DIMENSION IANSLC(*)
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION VALUE(*)
      DIMENSION IVALUE(*)
C
      DIMENSION ICOM3(*)
      DIMENSION ICOM4(*)
      DIMENSION ICOM5(*)
      DIMENSION NCOM5(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOF2.INC'
      INCLUDE 'DPCOHO.INC'
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='DPSE'
      ISUBN2='AR  '
C
      IFOUND='YES'
      IERROR='NO'
C
      MINN2=1
      NCSTRI=(-999)
C
      IHIT='NO'
      IGO='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SEAR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2,ISUBRO,IERROR
   53 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IWIDTH
   54 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,55)(IANSLC(I),I=1,IWIDTH)
   55 FORMAT('(IANSLC(I),I=1,IWIDTH) = ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ISEART
   56 FORMAT('ISEART = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILISNU
   61 FORMAT('ILISNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)ILISNA
   62 FORMAT('ILISNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)ILISST
   63 FORMAT('ILISST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ILISFO
   64 FORMAT('ILISFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)ILISAC
   65 FORMAT('ILISAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ILISFO
   66 FORMAT('ILISFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)ILISCS
   67 FORMAT('ILISCS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IDIRNU
   71 FORMAT('IDIRNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)IDIRNA
   72 FORMAT('IDIRNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)IDIRST
   73 FORMAT('IDIRST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)IDIRFO
   74 FORMAT('IDIRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)IDIRAC
   75 FORMAT('IDIRAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IDIRFO
   76 FORMAT('IDIRFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)IDIRCS
   77 FORMAT('IDIRCS = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)IDICNU
   81 FORMAT('IDICNU = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)IDICNA
   82 FORMAT('IDICNA = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDICST
   83 FORMAT('IDICST = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDICFO
   84 FORMAT('IDICFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,85)IDICAC
   85 FORMAT('IDICAC = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,86)IDICFO
   86 FORMAT('IDICFO = ',A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,87)IDICCS
   87 FORMAT('IDICCS = ',A12)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************
C               **  STEP 11--           **
C               **  COPY OVER VARIABLES **
C               **************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNIT=ILISNU
      IFILE=ILISNA
      ISTAT=ILISST
      IFORM=ILISFO
      IACCES=ILISAC
      IPROT=ILISPR
      ICURST=ILISCS
C
      ISUBN0='SEAR'
      IERRFI='NO'
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SEAR')GOTO1199
      WRITE(ICOUT,1193)IOUNIT
 1193 FORMAT('IOUNIT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)IFILE
 1194 FORMAT('IFILE = ',A80)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)ISTAT,IFORM,IACCES,IPROT,ICURST
 1195 FORMAT('ISTAT,IFORM,IACCES,IPROT,ICURST = ',
     1A12,2X,A12,2X,A12,2X,A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)ISUBN0,IERRFI
 1196 FORMAT('ISUBN0,IERRFI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1199 CONTINUE
C
C               ***********************************************
C               **  STEP 12--                                **
C               **  CHECK TO SEE IF THE LIST FILE MAY EXIST  **
C               ***********************************************
C
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ISTAT.EQ.'NONE')GOTO1200
      GOTO1290
 1200 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** IMPLEMENTATION ERROR IN DPSEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE DESIRED SEARCHING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      CANNOT BE CARRIED OUT BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      THE INTERNAL VARIABLE    ILISST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      WHICH ALLOWS SUCH SEARCHING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      HAS BEEN SET TO    NONE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)ISTAT,ILISST
 1217 FORMAT('ISTAT,ILISST = ',A12,2X,A12)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1290 CONTINUE
C
C               ********************************
C               **  STEP 13--                 **
C               **  EXTRACT THE FILE NAME.    **
C               **  DO THE GENERAL CASE OF    **
C               **  SEARCHING GENERAL FILES.  **
C               **  DO ALSO THE SPECIAL CASE  **
C               **  OF SEARCHING THE          **
C               **  MASTER DIRECTORY FILE.    **
C               **  DO ALSO THE SPECIAL CASE  **
C               **  OF SEARCHING THE          **
C               **  DICTIONARY      FILE.     **
C               ********************************
C
      ISTEPN='13'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1310I=1,80
      IANSI=IANSLC(I)
      ICANS(I:I)=IANSI(1:1)
 1310 CONTINUE
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=2
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOL1,ICOL2,IFILE,NCFILE,
     1IBUGS2,ISUBRO,IERROR)
C
      IF(NCFILE.EQ.9.AND.IFILE.EQ.'DIRECTORY')GOTO1320
      IF(NCFILE.EQ.9.AND.IFILE.EQ.'directory')GOTO1320
C
      IF(NCFILE.EQ.6.AND.IFILE.EQ.'MASTER')GOTO1320
      IF(NCFILE.EQ.6.AND.IFILE.EQ.'master')GOTO1320
C
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'DICTIONARY')GOTO1330
      IF(NCFILE.EQ.10.AND.IFILE.EQ.'dictionary')GOTO1330
C
      GOTO1370
C
 1320 CONTINUE
      IFILE=IDIRNA
      GOTO1370
C
 1330 CONTINUE
      IFILE=IDICNA
      GOTO1370
C
 1370 CONTINUE
      IF(NCFILE.GE.1)GOTO1379
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1371)
 1371 FORMAT('***** ERROR IN DPSEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1372)
 1372 FORMAT('      A USER FILE NAME IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1373)
 1373 FORMAT('      IN THE LIST COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1374)
 1374 FORMAT('      (FOR EXAMPLE,    LIST PROG7.DP)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1375)
 1375 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1376)
 1376 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1377)(IANSLC(I),I=1,IWIDTH)
 1377 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1379 CONTINUE
C
 1390 CONTINUE
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************
C               **  STEP 14--                 **
C               **  EXTRACT THE STRING TO BE SEARCHED FOR.    **
C               ********************************
C
      ISTEPN='14'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISTART=1
      ISTOP=IWIDTH
      IWORD=3
      CALL DPEXWO(ICANS,ISTART,ISTOP,IWORD,
     1ICOLS1,ICOLS2,ITAST,NCTAST,
     1IBUGS2,ISUBRO,IERROR)
C
      CALL DPUP80(ITAST,ITASTU,IBUGS2,IERROR)
C
 1440 CONTINUE
      IF(NCTAST.GE.1)GOTO1449
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1441)
 1441 FORMAT('***** ERROR IN DPSEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1442)
 1442 FORMAT('      A TARGET STRING IS REQUIRED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1443)
 1443 FORMAT('      IN THE SEARCH COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1444)
 1444 FORMAT('      (FOR EXAMPLE,    SEARCH PHONE.TEX JONES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1445)
 1445 FORMAT('      BUT NONE WAS GIVEN HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1446)
 1446 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1447)(IANSLC(I),I=1,IWIDTH)
 1447 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.LE.0)WRITE(ICOUT,999)
      IF(IWIDTH.LE.0)CALL DPWRST('XXX','BUG ')
      GOTO9000
 1449 CONTINUE
C
C               *****************************************
C               **  STEP 21--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2190
      DO2100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2120
 2100 CONTINUE
      GOTO2190
 2110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2190
 2120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2190
 2190 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SEAR')GOTO2195
      WRITE(ICOUT,2191)NUMARG,ILOCQ
 2191 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 2195 CONTINUE
C
C               *********************************************
C               **  STEP 22--                              **
C               **  BRANCH    TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2210
      IF(ICASEQ.EQ.'SUBS')GOTO2220
      IF(ICASEQ.EQ.'FOR')GOTO2230
C
 2210 CONTINUE
      DO2215I=1,MAXN
      ISUB(I)=1
 2215 CONTINUE
      NQ=MAXN
      GOTO2270
C
 2220 CONTINUE
      NIOLD=MAXN
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2270
C
 2230 CONTINUE
      NIOLD=MAXN
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      NMXFOR=IROWN
      GOTO2270
C
 2270 CONTINUE
      IF(NQ.GE.MINN2)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2271)
 2271 FORMAT('***** ERROR IN DPSEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2272)
 2272 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2273)
 2273 FORMAT('      THE NUMBER OF SPECIFIED FILE LINES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2274)
 2274 FORMAT('      TO BE LISTED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2276)MINN2
 2276 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2277)
 2277 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2278)
 2278 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2279)(IANSLC(I),I=1,IWIDTH)
 2279 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2290 CONTINUE
      NS=NQ
C
C               **************************
C               **  STEP 51--           **
C               **  OPEN  THE FILE      **
C               **************************
C
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1WRITE(ICOUT,3111)IFILE
 3111 FORMAT('IFILE = ',A80)
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL DPWRST('XXX','BUG ')
C
      IREWIN='ON'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')GOTO9000
C
 3190 CONTINUE
C
C               *************************************
C               **  STEP 41--                      **
C               **  READ A GENERAL FILE.           **
C               **  SEARCH FOR THE STRING.         **
C               **  IF FOUND, PRINT THE LINE OUT.  **
C               **  PRINT ALL LINES ON WHICH THE   **
C               **  STRING OCCURS.                 **
C               *************************************
C
      ISTEPN='41'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMAX=1000000
      IF(ICASEQ.EQ.'SUBS')IMAX=MAXN
      IF(ICASEQ.EQ.'FOR')IMAX=IROWN
C
      ILISAV=-1
C
      DO4110I=1,IMAX
C
      ILICUR=I
C
      READ(IOUNIT,4111,END=4190)(ISTRIN(J:J),J=1,80)
 4111 FORMAT(80A1)
      CALL DPDB80(ISTRIN,JMAX,IBUGS2,ISUBRO,IERROR)
      NCSTRI=JMAX
C
      CALL DPUP80(ISTRIN,ISTRIU,IBUGS2,IERROR)
C
      IF(NCSTRI.EQ.3.AND.ISTRIN(1:3).EQ.'EOF')GOTO4190
      GOTO4115
C
 4115 CONTINUE
      IF(ICASEQ.EQ.'FULL')
     1GOTO4116
      IF(ICASEQ.EQ.'SUBS'.OR.ICASEQ.EQ.'FOR'.AND.ISUB(I).EQ.1)
     1GOTO4116
      GOTO4110
C
 4116 CONTINUE
C
CCCCC THE FOLLOWING SECTIONS WERE REWRITTEN    JANUARY 1994
      IHIT='NO'
      IF(ISEART.EQ.'1LIN')IGO='NO'
CCCCC THE FOLLOWING LINE WAS ADDED    JANUARY 1994
      IF(ISEART.EQ.'FIRS')IGO='NO'
      IF(ISEART.EQ.'BLAN'.AND.NCSTRI.LE.0)IGO='NO'
      IF(ISEART.EQ.'----'.AND.ISTRIN(1:4).EQ.'----')IGO='NO'
      IF(IGO.EQ.'YES')GOTO4129
C
      IF(NCSTRI.LE.0)GOTO4129
      DO4120I1=1,NCSTRI
         I2=I1+NCTAST-1
         IF(I2.GT.NCSTRI)GOTO4129
         IF(ISTRIN(I1:I2).EQ.ITAST(1:NCTAST))IHIT='YES'
         IF(ISTRIU(I1:I2).EQ.ITASTU(1:NCTAST))IHIT='YES'
         IF(IHIT.EQ.'YES')IGO='YES'
         IF(IHIT.EQ.'YES'.AND.ILISAV.LT.0)ILISAV=ILICUR
         IF(IHIT.EQ.'YES')GOTO4129
 4120 CONTINUE
 4129 CONTINUE
C
      IF(IHIT.EQ.'YES'.OR.IGO.EQ.'YES')THEN
         WRITE(ICOUT,4117)(ISTRIN(J:J),J=1,NCSTRI)
 4117    FORMAT(80A1)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      IF(IHIT.EQ.'YES'.AND.ISEART.EQ.'FIRS')GOTO4190
C
 4110 CONTINUE
C
 4190 CONTINUE
C
      IH='LINE'
      IH2='NUMB'
      VALUE0=REAL(ILISAV)
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANSLC,IWIDTH,IBUGS2,IERROR)
C
C               **************************
C               **  STEP 51--           **
C               **  CLOSE THE FILE      **
C               **************************
C
      ISTEPN='51'
      IF(IBUGS2.EQ.'ON'.OR.ISUBRO.EQ.'SEAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1IENDFI,IREWIN,ISUBN0,IERRFI,IBUGS2,ISUBRO,IERROR)
C
 5190 CONTINUE
C
C               ****************
C               **  STEP 90-- **
C               **  EXIT.     **
C               ****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'SEAR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSEAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 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)ISEART
 9033 FORMAT('ISEART = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ICASEQ,NQ,NS
 9041 FORMAT('ICASEQ,NQ,NS = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)JMAX,NCSTRI
 9042 FORMAT('JMAX,NCSTRI = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSECL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXSEG,ISEGCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR A SEGMENT.
C              THE COLOR FOR SEGMENT I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR ISEGCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C                     --MAXSEG
C     OUTPUT ARGUMENTS--ISEGCO (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              COLOR FOR SEGMENT I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFCO
      CHARACTER*4 ISEGCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION ISEGCO(*)
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
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLO')GOTO1140
      GOTO1199
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFCO
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXSEG
      ISEGCO(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)ISEGCO(I)
 1136 FORMAT('ALL SEGMENT COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO1199
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPSECL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE SEGMENT ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE SEGMENT IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      SEGMENT 3 COLOR GREEN')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXSEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPSECL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE SEGMENT ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF SEGMENTS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXSEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'SEGMENT.')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ISEGCO(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,ISEGCO(I)
 1186 FORMAT('THE COLOR FOR SEGMENT ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPSECO(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXSEG,PSEGXC,PSEGYC,NUMSEG,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 PAIRS OF (X,Y) COORDINATES
C              FOR A LINE SEGMENT.
C              THE FIRST PAIR WILL BE FOR THE TAIL OF THE SEGMENT;
C              THE SECOND PAIR WILL BE FOR THE HEAD OF THE SEGMENT.
C              THE (X1,Y1), (X2,Y2) COORDINATES WILL BE PLACED IN THE
C              FIRST AND SECOND ELEMENTS (RESPECTIVELY) OF
C              THE 2 SEGAYS PSEGXC(.,.) AND PSEGYC(.,.)
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXSEG
C     OUTPUT ARGUMENTS--PSEGXC (A FLOATING POINT VECTOR
C                              WHOSE (I,1)-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR THE TAIL OF SEGMENT I;
C                              WHOSE (I,2)-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR THE HEAD OF SEGMENT I;
C                     --PSEGYC (A FLOATING POINT VECTOR
C                              WHOSE (I,1)-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR THE TAIL OF SEGMENT I;
C                              WHOSE (I,2)-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR THE HEAD OF SEGMENT I;
C                     --NUMSEG = THE NUMBER OF SEGMENTS DEFINED SO FAR
C                              (ACTUALLY, THE HIGHEST REFERENCED SEGMENT SO FAR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
C
      DIMENSION PSEGXC(100,2)
      DIMENSION PSEGYC(100,2)
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
      ISUBN1='DPAR'
      ISUBN2='CO  '
C
      IFOUND='NO'
      IERROR='NO'
C
      HOLD1=0.0
      HOLD2=0.0
      HOLD3=0.0
      HOLD4=0.0
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.5)GOTO1125
C
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPSECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN THE SEGMENT ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      THE COORDINATES ARE SPECIFIED BY 4 NUMBERS, ',
     1'AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      SEGMENT 3 COORDINATES 30 80 31 79')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1120 CONTINUE
      HOLD1=CPUMIN
      HOLD2=CPUMIN
      HOLD3=CPUMIN
      HOLD4=CPUMIN
      NUMSEG=0
      GOTO1130
C
 1125 CONTINUE
      DO1126J=2,5
      IF(IARGT(J).EQ.'NUMB')GOTO1127
      GOTO1128
 1127 CONTINUE
      IF(J.EQ.2)HOLD1=ARG(J)
      IF(J.EQ.3)HOLD2=ARG(J)
      IF(J.EQ.4)HOLD3=ARG(J)
      IF(J.EQ.5)HOLD4=ARG(J)
      GOTO1126
 1128 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.2)HOLD1=VALUE(ILOC)
      IF(J.EQ.3)HOLD2=VALUE(ILOC)
      IF(J.EQ.4)HOLD3=VALUE(ILOC)
      IF(J.EQ.5)HOLD4=VALUE(ILOC)
 1126 CONTINUE
      NUMSEG=MAXSEG
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXSEG
      PSEGXC(I,1)=HOLD1
      PSEGYC(I,1)=HOLD2
      PSEGXC(I,2)=HOLD3
      PSEGYC(I,2)=HOLD4
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)
 1136 FORMAT('ALL SEGMENT COORDINATES HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)PSEGXC(I,1),PSEGYC(I,1)
 1137 FORMAT('    (X,Y) FOR TAIL OF SEGMENT = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)PSEGXC(I,2),PSEGYC(I,2)
 1138 FORMAT('    (X,Y) FOR HEAD OF SEGMENT = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPSECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE SEGMENT ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE SEGMENT IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      SEGMENT 3 COORDINATES 30 80 31 79')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXSEG)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPSECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE SEGMENT ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF SEGMENTS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXSEG
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'SEGMENT.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      IF(NUMARG.GE.6)GOTO1175
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1170 CONTINUE
      HOLD1=CPUMIN
      HOLD2=CPUMIN
      HOLD3=CPUMIN
      HOLD4=CPUMIN
      IF(I.EQ.NUMSEG)NUMSEG=I-1
      GOTO1180
C
 1175 CONTINUE
      DO1176J=3,6
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.3)HOLD1=ARG(J)
      IF(J.EQ.4)HOLD2=ARG(J)
      IF(J.EQ.5)HOLD3=ARG(J)
      IF(J.EQ.6)HOLD4=ARG(J)
      GOTO1176
 1178 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.3)HOLD1=VALUE(ILOC)
      IF(J.EQ.4)HOLD2=VALUE(ILOC)
      IF(J.EQ.5)HOLD3=VALUE(ILOC)
      IF(J.EQ.6)HOLD4=VALUE(ILOC)
 1176 CONTINUE
      IF(I.GT.NUMSEG)NUMSEG=I
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PSEGXC(I,1)=HOLD1
      PSEGYC(I,1)=HOLD2
      PSEGXC(I,2)=HOLD3
      PSEGYC(I,2)=HOLD4
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I
 1186 FORMAT('THE COORDINATES FOR SEGMENT ',I8,
     1' HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)PSEGXC(I,1),PSEGYC(I,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)PSEGXC(I,2),PSEGYC(I,2)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSECO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSEED(IHARG,IARGT,IARG,NUMARG,IDEFSE,
     1ISEED,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SEED (AN INTEGER)
C              WHICH IS USED AS INPUT IN UNIFORM RANDOM NUMBER GENERATION AND
C              WHICH IN TURN SERVES AS THE BASIS FOR ALL RANDOM NUMBER GENERATIO
C              THE SPECIFIED SEED VALUE WILL BE PLACED
C              IN THE INTEGER VARIABLE ISEED.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFSE (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--ISEED  (AN INTEGER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
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--82/7
C     ORIGINAL VERSION--APRIL     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
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
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPSEED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR SEED ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE ANALYST DESIRES THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      SEED VALUE FOR RANDOM NUMBER GENERATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      TO BE 735679238,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      SEED 735679238 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      IHOLD=IDEFSE
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ISEED=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ISEED
 1181 FORMAT('THE RANDOM NUMBER SEED HAS JUST BEEN SET TO ',
     1I11)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
