      SUBROUTINE DPROAC(IHARG,IARGT,ARG,NUMARG,DEFRAC,
     1ROOTAC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ROOT ACCURACY.
C              THE DIFFERENCE IN FUNCTION VALUES AFTER EACH
C              ITERATION OF A ROOT EXTRACTION WILL BE COMPARED
C              TO THE SPECIFIED ROOT ACCURACY.
C              THE SPECIFIED ROOT ACCURACY VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE ROOTAC.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFRAC (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--ROOTAC  (A  FLOATING POINT 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-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
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 ARG(*)
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.2.AND.IHARG(2).EQ.'=')GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'ACCU')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ACCU')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,1121)
 1121 FORMAT('***** ERROR IN DPROAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ROOT ACCURACY ',
     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 THE ANALYST WILL BE CARRYING OUT  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      A ROOT-EXTRACTION, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES TO TERMINATE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      THE ROOT-FINDING PROCESS WHENEVER SUCCESSIVE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      X DIFFERENCES ARE .00001 OR SMALLER; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      ROOT ACCURACY .00001 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFRAC
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ROOTAC=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ROOTAC
 1181 FORMAT('THE ROOT ACCURACY HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPROEY(IHARG,IARGT,ARG,NUMARG,
     1X3DEYE,Y3DEYE,Z3DEYE,
     1X3DMID,Y3DMID,Z3DMID,
     1AEYEXC,AEYEYC,AEYEZC,
     1IFOUND,IERROR)
C
C     PURPOSE--ROTATE THE CURRENT EYE COORDINATES
C              LEFT, RIGHT, UP, DOWN, XY, XZ, OR YZ
C              DEFAULT DIRECTION = LEFT
C              DEFAULT ANGLE     = 10 DEGREES
C     COMMAND EXAMPLE = ROTATE EYE LEFT 45
C
C     0 ARGUMENT CASE
C        ROTATE ==> ROTATE EYE LEFT 10
C     1 ARGUMENT CASE
C        ROTATE 17    ==> ROTATE EYE LEFT 17
C        ROTATE EYE   ==> ROTATE EYE LEFT 10
C        ROTATE LEFT  ==> ROTATE EYE LEFT 10
C        ROTATE RIGHT ==> ROTATE EYE RIGHT 10
C        ROTATE UP    ==> ROTATE EYE UP 10
C        ROTATE DOWN  ==> ROTATE EYE DOWN 10
C        ROTATE XY    ==> ROTATE EYE XY   10
C        ROTATE XZ    ==> ROTATE EYE XZ   10
C        ROTATE YZ    ==> ROTATE EYE YZ   10
C     2 ARGUMENT CASE
C        ROTATE EYE 17   ==> ROTATE EYE LEFT 17
C        ROTATE LEFT  17 ==> ROTATE EYE LEFT 17
C        ROTATE RIGHT 17 ==> ROTATE EYE RIGHT 17
C        ROTATE UP    17 ==> ROTATE EYE UP 17
C        ROTATE DOWN  17 ==> ROTATE EYE DOWN 17
C        ROTATE XY    17 ==> ROTATE EYE XY 17
C        ROTATE XZ    17 ==> ROTATE EYE XZ 17
C        ROTATE YZ    17 ==> ROTATE EYE YZ 17
C        ROTATE EYE LEFT  ==> ROTATE EYE LEFT 10
C        ROTATE EYE RIGHT ==> ROTATE EYE LEFT 10
C        ROTATE EYE UP    ==> ROTATE EYE UP    10
C        ROTATE EYE DOWN  ==> ROTATE EYE DOWN  10
C        ROTATE EYE XY    ==> ROTATE EYE XY    10
C        ROTATE EYE XZ    ==> ROTATE EYE XZ    10
C        ROTATE EYE YZ    ==> ROTATE EYE YZ    10
C     3 ARGUMENT CASE
C        ROTATE EYE LEFT  17
C        ROTATE EYE RIGHT 17
C        ROTATE EYE UP    17
C        ROTATE EYE DOWN  17
C        ROTATE EYE XY    17
C        ROTATE EYE XZ    17
C        ROTATE EYE YZ    17
C
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG
C                     --X3DEYE  = X-COORDINATE OF EYE
C                     --Y3DEYE  = Y-COORDINATE OF EYE
C                     --Z3DEYE  = Z-COORDINATE OF EYE
C                     --X3DMID  = X-COORDINATE OF MID-FIGURE
C                     --Y3DMID  = Y-COORDINATE OF MID-FIGURE
C                     --Z3DMID  = Z-COORDINATE OF MID-FIGURE
C     OUTPUT ARGUMENTS--AEYEXC  = X-COORDINATE OF EYE (POST-ROTAT.)
C                     --AEYEYC  = Y-COORDINATE OF EYE (POST-ROTAT.)
C                     --AEYEZC  = Z-COORDINATE OF EYE (POST-ROTAT.)
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--93/10
C     ORIGINAL VERSION--SEPTEMBER  1993.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
CCCCC OCTOBER 1993.  ADD FOLLOWING LINE
      CHARACTER*4 IDIR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
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'
      ANGDEF=10.0
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE CASE          **
C               ********************************************
C
      IF(NUMARG.EQ.0)THEN
         ANGLE=ANGDEF
         IDIR='LEFT'
         GOTO1000
      ENDIF
C
      IF(NUMARG.GE.1)THEN
         IF(IHARG(NUMARG).EQ.'?')GOTO2000
      ENDIF
C
      IF(NUMARG.EQ.1)THEN
         IF(IARGT(1).EQ.'NUMB')THEN
            ANGLE=ARG(1)
            IDIR='LEFT'
            GOTO1000
         ELSE
            ANGLE=ANGDEF
            IDIR='LEFT'
            IF(IHARG(1).EQ.'EYE ')IDIR='LEFT'
            IF(IHARG(1).EQ.'LEFT')IDIR='LEFT'
            IF(IHARG(1).EQ.'RIGH')IDIR='RIGH'
            IF(IHARG(1).EQ.'UP  ')IDIR='UP  '
            IF(IHARG(1).EQ.'DOWN')IDIR='DOWN'
            IF(IHARG(1).EQ.'XY  ')IDIR='XY  '
            IF(IHARG(1).EQ.'YX  ')IDIR='XY  '
            IF(IHARG(1).EQ.'XZ  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'ZX  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'YZ  ')IDIR='YZ  '
            IF(IHARG(1).EQ.'ZY  ')IDIR='YZ  '
            GOTO1000
         ENDIF
      ENDIF
C
      IF(NUMARG.EQ.2)THEN
         IF(IARGT(2).EQ.'NUMB')THEN
            ANGLE=ARG(2)
            IDIR='LEFT'
            IF(IHARG(1).EQ.'EYE ')IDIR='LEFT'
            IF(IHARG(1).EQ.'LEFT')IDIR='LEFT'
            IF(IHARG(1).EQ.'RIGH')IDIR='RIGH'
            IF(IHARG(1).EQ.'UP  ')IDIR='UP  '
            IF(IHARG(1).EQ.'DOWN')IDIR='DOWN'
            IF(IHARG(1).EQ.'XY  ')IDIR='XY  '
            IF(IHARG(1).EQ.'YX  ')IDIR='XY  '
            IF(IHARG(1).EQ.'XZ  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'ZX  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'YZ  ')IDIR='YZ  '
            IF(IHARG(1).EQ.'ZY  ')IDIR='YZ  '
            GOTO1000
         ELSE
            ANGLE=ANGDEF
            IDIR='LEFT'
            IF(IHARG(2).EQ.'EYE ')IDIR='LEFT'
            IF(IHARG(2).EQ.'LEFT')IDIR='LEFT'
            IF(IHARG(2).EQ.'RIGH')IDIR='RIGH'
            IF(IHARG(2).EQ.'UP  ')IDIR='UP  '
            IF(IHARG(2).EQ.'DOWN')IDIR='DOWN'
            IF(IHARG(1).EQ.'XY  ')IDIR='XY  '
            IF(IHARG(1).EQ.'YX  ')IDIR='XY  '
            IF(IHARG(1).EQ.'XZ  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'ZX  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'YZ  ')IDIR='YZ  '
            IF(IHARG(1).EQ.'ZY  ')IDIR='YZ  '
            GOTO1000
         ENDIF
      ENDIF
C
      IF(NUMARG.EQ.3)THEN
         IF(IARGT(3).EQ.'NUMB')THEN
            ANGLE=ARG(3)
            IDIR='LEFT'
            IF(IHARG(2).EQ.'EYE ')IDIR='LEFT'
            IF(IHARG(2).EQ.'LEFT')IDIR='LEFT'
            IF(IHARG(2).EQ.'RIGH')IDIR='RIGH'
            IF(IHARG(2).EQ.'UP  ')IDIR='UP  '
            IF(IHARG(2).EQ.'DOWN')IDIR='DOWN'
            IF(IHARG(1).EQ.'XY  ')IDIR='XY  '
            IF(IHARG(1).EQ.'YX  ')IDIR='XY  '
            IF(IHARG(1).EQ.'XZ  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'ZX  ')IDIR='XZ  '
            IF(IHARG(1).EQ.'YZ  ')IDIR='YZ  '
            IF(IHARG(1).EQ.'ZY  ')IDIR='YZ  '
            GOTO1000
         ELSE
            ANGLE=ANGDEF
            IDIR='LEFT'
            GOTO1000
         ENDIF
      ENDIF
C
      GOTO8000
C
C               ********************************************
C               **  STEP 11--                             **
C               **  DO THE ROTATION                       **
C               ********************************************
C
 1000 CONTINUE
      IFOUND='YES'
      THETA=(ANGLE/360.0)*2*3.14159
      X1=X3DEYE
      Y1=Y3DEYE
      Z1=Z3DEYE
      X2=X3DEYE-X3DMID
      Y2=Y3DEYE-Y3DMID
      Z2=Z3DEYE-Z3DMID
C
      IF(IDIR.EQ.'LEFT'.OR.IDIR.EQ.'RIGH')THEN
         IF(IDIR.EQ.'RIGH')THETA=(-THETA)
         X3=X2*COS(THETA)-Y2*SIN(THETA)
         Y3=X2*SIN(THETA)+Y2*COS(THETA)
         Z3=Z2
         GOTO1100
      ENDIF
C
      IF(IDIR.EQ.'UP'.OR.IDIR.EQ.'DOWN')THEN
         IF(IDIR.EQ.'DOWN')THETA=(-THETA)
CTODO    X3=X2*COS(A1)+Y2*COS(A2)+Z2*COS(A3) DPTR32, MATH DICT. 337
CTODO    Y3=X2*COS(B1)+Y2*COS(B2)+Z2*COS(B3)
CTODO    Z3=X2*COS(C1)+Y2*COS(C2)+Z2*COS(C3)
         GOTO1100
      ENDIF
C
      IF(IDIR.EQ.'XY  ')THEN
         THETA=(-THETA)
         X3=X2*COS(THETA)-Y2*SIN(THETA)
         Y3=X2*SIN(THETA)+Y2*COS(THETA)
         Z3=Z2
         GOTO1100
      ENDIF
C
      IF(IDIR.EQ.'XZ  ')THEN
         THETA=(-THETA)
         X3=X2*COS(THETA)-Z2*SIN(THETA)
         Y3=Y2
         Z3=X2*SIN(THETA)+Z2*COS(THETA)
         GOTO1100
      ENDIF
C
      IF(IDIR.EQ.'YZ  ')THEN
         THETA=(-THETA)
         X3=X2
         Y3=Z2*SIN(THETA)+Y2*COS(THETA)
         Z3=Z2*COS(THETA)-Y2*SIN(THETA)
         GOTO1100
      ENDIF
C
 1100 CONTINUE
      X4=X3+X3DMID
      Y4=Y3+Y3DMID
      Z4=Z3+Z3DMID
      AEYEXC=X4
      AEYEYC=Y4
      AEYEZC=Z4
      IF(IFEEDB.EQ.'ON')THEN
         WRITE(ICOUT,999)
  999    FORMAT(1X)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1111)
 1111    FORMAT('OLD & NEW (X,Y,Z) EYE COORDINATES--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1121)X1,X4
 1121    FORMAT('    X = ',2F10.3)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1122)Y1,Y4
 1122    FORMAT('    Y = ',2F10.3)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1123)Z1,Z4
 1123    FORMAT('    Z = ',2F10.3)
         CALL DPWRST('XXX','BUG ')
      ENDIF
      GOTO9000
C
C               ********************************************
C               **  STEP 12--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 2000 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2011)
 2011 FORMAT('THE CURRENT (X,Y,Z) EYE COORDINATES ARE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2021)X3DEYE
 2021 FORMAT('    X = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2022)Y3DEYE
 2022 FORMAT('    Y = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2023)Z3DEYE
 2023 FORMAT('    Z = ',E15.7)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2031)
 2031 FORMAT('THE DEFAULT ROTATION DIRECTION IS LEFT (= XY)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2032)
 2032 FORMAT('THE DEFAULT ROTATION ANGLE IS 10 DEGREES')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2033)
 2033 FORMAT(' THEREFORE, ROTATE == ROTATE EYE LEFT 10')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2041)
 2041 FORMAT('SYNTAX: ROTATE EYE <DIRECTION> <ANGLE>')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2042)
 2042 FORMAT('<DIRECTION> = LEFT, RIGHT, UP, DOWN, XY, XZ, YZ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2043)
 2043 FORMAT('<ANGLE> = -360 TO +360 DEGREES')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2044)
 2044 FORMAT('EXAMPLE--ROTATE EYE LEFT 60')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2045)
 2045 FORMAT('EXAMPLE--ROTATE EYE YZ 45')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2046)
 2046 FORMAT('EXAMPLE--ROTATE      (== ROTATE EYE LEFT 10)')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
C
C               ********************************************
C               **  STEP 80--                             **
C               **  TREAT THE    ERROR    CASE            **
C               ********************************************
C
 8000 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,8011)
 8011 FORMAT('***** ERROR IN DPROEY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8012)
 8012 FORMAT('      ILLEGAL SYNTAX FOR    ROTATE EYE    COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8013)
 8013 FORMAT('    SYNTAX: ROTATE EYE <DIRECTION> <ANGLE>')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8014)
 8014 FORMAT('    <DIRECTION> = LEFT, RIGHT, UP, DOWN, XY, XZ, YZ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8015)
 8015 FORMAT('    <ANGLE> = -360 TO +360 DEGREES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8016)
 8016 FORMAT('    EXAMPLE--ROTATE EYE LEFT 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8017)
 8017 FORMAT('    EXAMPLE--ROTATE EYE YZ 45')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPROG2(Y,X,N,ICASPL,IRELAT,IDATSW,CLWID,XSTART,XSTOP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C                   1) A ROOTOGRAM,
C                   2) A RELATIVE ROOTOGRAM
C                      (THAT IS, WITH AREA = 1).
C                   3) A CUMULATIVE ROOTOGRAM
C                   4) A RELATIVE CUMULATIVE ROOTOGRAM
C                      (THAT IS, WITH MAX BAR HEIGHT = 1).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --APRIL     1982.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IRELAT
      CHARACTER*4 IDATSW
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
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='DPRO'
      ISUBN2='G2  '
C
      IERROR='NO'
C
      K=(-999)
      KP3=0
C
      AN3=0.0
      DENOM=0.0
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPROG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,32)
   32 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,33)
   33 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,34)N
   34 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   39 CONTINUE
C
      IF(N.GE.2)GOTO49
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,46)
   46 FORMAT('***** ERROR IN DPROG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,47)
   47 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,48)
   48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   49 CONTINUE
C
      HOLD=X(1)
      DO60I=1,N
      IF(X(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPROG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT HORIZONTAL AXIS ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)
   70 FORMAT('***** AT THE BEGINNING OF DPROG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IDATSW
   71 FORMAT('IDATSW = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N,CLWID,XSTART,XSTOP
   72 FORMAT('N,CLWID,XSTART,XSTOP = ',I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y(I),X(I)
   74 FORMAT('I, Y(I), X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   80 CONTINUE
C
C               **********************************************
C               **  STEP 2--                                **
C               **  IF NECESSARY,                           **
C               **  DETERMINE CLASS WIDTH,                  **
C               **  START VALUE, STOP VALUE,                **
C               **  AND NUMBER OF CLASSES.                  **
C               **********************************************
C
      IF(IDATSW.EQ.'RAW')GOTO110
      IF(IDATSW.EQ.'FREQ')GOTO150
C
  110 CONTINUE
      IF(CLWID.NE.CPUMIN.AND.XSTART.NE.CPUMIN.AND.
     1XSTOP.NE.CPUMAX)GOTO119
      IWRIT2='OFF'
      CALL MEAN(X,N,IWRIT2,XMEAN,IBUGG3,IERROR)
      CALL SD(X,N,IWRIT2,XSD,IBUGG3,IERROR)
      IF(CLWID.EQ.CPUMIN)CLWID=0.3*XSD
      IF(XSTART.EQ.CPUMIN)XSTART=XMEAN-6.0*XSD
      IF(XSTOP.EQ.CPUMAX)XSTOP=XMEAN+6.0*XSD
  119 CONTINUE
      GOTO180
C
  150 CONTINUE
      CALL SORT(X,N,D2)
      NM1=N-1
      CLWID=D2(2)-D2(1)
      DO160I=1,NM1
      IP1=I+1
      DELI=D2(IP1)-D2(I)
      IF(DELI.LT.CLWID)CLWID=DELI
  160 CONTINUE
      XSTART=D2(1)-(CLWID/2.0)
      XSTOP=D2(N)+(CLWID/2.0)
      GOTO180
C
  180 CONTINUE
      TOTWID=XSTOP-XSTART
      ANUMCL=TOTWID/CLWID
      NUMCLA=ANUMCL+1.0
C
      J=NUMCLA-1
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      ABSDEL=ABS(CLMAXJ-XSTOP)
      IF(ABSDEL.LE.0.0001)NUMCLA=NUMCLA-1
C
C               *******************************************************
C               **  STEP 3--                                         **
C               **  DETERMINE THE FREQUENCY (COUNTS) FOR EACH CLASS  **
C               *******************************************************
C
      DO300J=1,NUMCLA
      D2(J)=0.0
  300 CONTINUE
C
      IF(IDATSW.EQ.'RAW')GOTO410
      IF(IDATSW.EQ.'FREQ')GOTO510
C
  410 CONTINUE
      DO420I=1,N
      DO430J=1,NUMCLA
      J2=J
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(CLMINJ.LE.X(I).AND.X(I).LT.CLMAXJ)GOTO440
  430 CONTINUE
      GOTO420
  440 CONTINUE
      D2(J2)=D2(J2)+1.0
  420 CONTINUE
C
C     FOR THIS RAW DATA CASE,
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C
      J=NUMCLA
      DO450I=1,N
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(X(I).EQ.CLMAXJ)D2(J)=D2(J)+1.0
  450 CONTINUE
      GOTO590
C
  510 CONTINUE
      DO520I=1,N
      DO530J=1,NUMCLA
      J2=J
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(CLMINJ.LE.X(I).AND.X(I).LT.CLMAXJ)GOTO540
  530 CONTINUE
      GOTO520
  540 CONTINUE
      D2(J2)=D2(J2)+Y(I)
  520 CONTINUE
C
C     FOR THIS FREQUENCY DATA CASE,
C     TREAT THE SPECIAL CASE OF EQUALITY
C     WITH THE UPPER LIMIT OF THE LAST (RIGHT-MOST) CLASS
C     (ALTHOUGH THIS SHOULD NOT HAPPEN WITH THE IDATSW = 'FREQ' CASE.)
C
      J=NUMCLA
      DO550I=1,N
      AJ=J
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      IF(X(I).EQ.CLMAXJ)D2(J)=D2(J)+Y(I)
  550 CONTINUE
      GOTO590
C
  590 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO595
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,591)
  591 FORMAT('***** IN THE MIDDLE    OF DPROG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,592)CLWID,XSTART,XSTOP,TOTWID,ANUMCL,NUMCLA
  592 FORMAT('CLWID,XSTART,XSTOP,TOTWID,ANUMCL,NUMCLA= ',5E11.4,I8)
      CALL DPWRST('XXX','BUG ')
      DO593J=1,NUMCLA
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      FJ=D2(J)
      WRITE(ICOUT,594)J,CLMINJ,CLMAXJ,FJ
  594 FORMAT('J,CLMINJ,CLMAXJ,FJ = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
  593 CONTINUE
  595 CONTINUE
C
C               **********************************
C               **  STEP 4--                    **
C               **  DETERMINE PLOT COORDINATES  **
C               **********************************
C
CCCCC IF(BAWID.EQ.CPUMIN)BAWID=CLWID
C
      IF(ICASPL.EQ.'ROOT')GOTO1100
      IF(ICASPL.EQ.'CUMR')GOTO1200
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** INTERNAL ERROR IN DPROG2 ',
     1'AT BRANCH POINT 1011--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1012)
 1012 FORMAT('      ICASPL SHOULD BE EITHER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1013)
 1013 FORMAT('      ROOT   OR    CUMR, BUT IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1014)ICASPL
 1014 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1100 CONTINUE
      SUM=0.0
      DO1110J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1110 CONTINUE
      AN3=SUM
C
      DENOM=1.0
      IF(IRELAT.EQ.'ON')DENOM=AN3
C
      DO1120J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC AJ=J
CCCCC CLMIDJ=XSTART+(AJ-0.5)*CLWID
CCCCC BAMINJ=CLMIDJ-BAWID/2.0
CCCCC BAMAXJ=CLMIDJ+BAWID/2.0
      AJ=J
      CLMIDJ=XSTART+(AJ-0.5)*CLWID
C
      FJ=D2(J)
C
CCCCC X2(K)=BAMINJ
CCCCC X2(KP1)=BAMINJ
CCCCC X2(KP2)=BAMAXJ
CCCCC X2(KP3)=BAMAXJ
      X2(J)=CLMIDJ
C
CCCCC Y2(K)=0.0
CCCCC Y2(KP1)=FJ/DENOMCCCCC
CCCCC Y3=0.0
CCCCC IF(FJ.GT.0.0)Y3=SQRT(FJ)/DENOM
CCCCC Y2(KP1)=Y3
CCCCC Y2(KP2)=FJ/DENOM
CCCCC Y2(KP2)=Y3
CCCCC Y2(KP3)=0.0
      Y3=0.0
      IF(FJ.GT.0.0)Y3=SQRT(FJ)/DENOM
      Y2(K)=Y3
C
 1120 CONTINUE
CCCCC N2=KP3
      N2=K
      NPLOTV=2
C
      DO1130J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC D2(K)=1.0
CCCCC D2(KP1)=1.0
CCCCC D2(KP2)=1.0
CCCCC D2(KP3)=1.0
      D2(K)=1.0
C
 1130 CONTINUE
      GOTO9000
C
 1200 CONTINUE
      SUM=0.0
      DO1210J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1210 CONTINUE
      AN3=SUM
C
      DENOM=1.0
      IF(IRELAT.EQ.'ON')DENOM=AN3
C
      SUM=0.0
      DO1220J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC AJ=J
CCCCC CLMIDJ=XSTART+(AJ-0.5)*CLWID
CCCCC BAMINJ=CLMIDJ-BAWID/2.0
CCCCC BAMAXJ=CLMIDJ+BAWID/2.0
      AJ=J
      CLMIDJ=XSTART+(AJ-0.5)*CLWID
C
      FJ=D2(J)
      SUM=SUM+FJ
      CUMFJ=SUM
C
CCCCC X2(K)=BAMINJ
CCCCC X2(KP1)=BAMINJ
CCCCC X2(KP2)=BAMAXJ
CCCCC X2(KP3)=BAMAXJ
      X2(K)=CLMIDJ
C
CCCCC Y2(K)=0.0
CCCCC Y3=0.0
CCCCC IF(CUMFJ.GT.0.0)Y3=SQRT(CUMFJ)/DENOM
CCCCC Y2(KP1)=Y3
CCCCC Y2(KP2)=Y3
CCCCC Y2(KP3)=0.0
      Y3=0.0
      IF(CUMFJ.GT.0.0)Y3=SQRT(CUMFJ)/DENOM
      Y2(K)=Y3
C
 1220 CONTINUE
CCCCC N2=KP3
      N2=K
      NPLOTV=2
C
      DO1230J=1,NUMCLA
C
CCCCC K=4*(J-1)+1
CCCCC KP1=K+1
CCCCC KP2=K+2
CCCCC KP3=K+3
      K=J
C
CCCCC D2(K)=1.0
CCCCC D2(KP1)=1.0
CCCCC D2(KP2)=1.0
CCCCC D2(KP3)=1.0
      D2(K)=1.0
C
 1230 CONTINUE
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPROG2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IRELAT,IERROR,N2
 9012 FORMAT('ICASPL,IRELAT,IERROR,N2 = ',A4,2X,A4,2X,A4,2X,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDATSW,AN3,DENOM
 9013 FORMAT('IDATSW,AN3,DENOM = ',A4,2X,E15.8,E15.8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)N,CLWID,XSTART,XSTOP
 9017 FORMAT('N,CLWID,XSTART,XSTOP = ',I6,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPROGR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING 4 PLOTS--
C              1) ROOTOGRAM;
C              2) RELATIVE ROOTOGRAM;
C              3) CUMULATIVE ROOTOGRAM;
C              4) RELATIVE CUMULATIVE ROOTOGRAM;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
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 IRELAT
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION CLLIMI(*)
      DIMENSION CLWIDT(*)
CCCCC DIMENSION BAWIDT(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      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='DPRO'
      ISUBN2='GR  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=2
C
      ICOLR=0
C
C               *******************************************
C               **  TREAT THE ROOTOGRAM AND RELATED      **
C               **  STATISTICAL DISTRIBUTION PLOTS CASE  **
C               *******************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPROGR--')
      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
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'ROOT')GOTO110
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'ROOT')GOTO120
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'ROOT')GOTO130
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'CUMU'.AND.IHARG(2).EQ.'ROOT')
     1GOTO140
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CUMU'.AND.IHARG(1).EQ.'RELA'.AND.IHARG(2).EQ.'ROOT')
     1GOTO140
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ICASPL='ROOT'
      IRELAT='OFF'
      GOTO180
C
  120 CONTINUE
      ICASPL='ROOT'
      IRELAT='ON'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  130 CONTINUE
      ICASPL='CUMR'
      IRELAT='OFF'
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  140 CONTINUE
      ICASPL='CUMR'
      IRELAT='ON'
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
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,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 2--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGG2.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)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
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)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPROGR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A ROOTOGRAM ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,322)
  322 FORMAT('      (FOR WHICH A RELATIVE ROOTOGRAM ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,323)
  323 FORMAT('      (FOR WHICH A CUMULATIVE ROOTOGRAM ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,324)
  324 FORMAT('      (FOR WHICH A RELATIVE CUMULATIVE ROOTOGRAM ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'ON')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 SUBCASE      **
C               **  (BASED ON THE QUALIFIER)--         **
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)GOTO480
      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
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DPROGR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************************
C               **  STEP 5--                                        **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS          **
C               **  INDICATES THAT THE VALUES IN THE                **
C               **  FIRST  VARIABLE ARE NOT DATA POINTS             **
C               **  BUT ALREADY-COMPUTED FREQUENCIES,               **
C               **  AND THE VALUES IN THE SECOND VARIABLE           **
C               **  ARE THE CORRESPONDING X VALUES FOR EACH         **
C               **  FREQUENCY.  IF WE HAVE THE 2-VARIABLE CASE,     **
C               **  CHECK THE VALIDITY OF THE SECOND (X) VARIABLE.  **
C               ******************************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATSW='RAW'
      IF(NUMV2.EQ.1)IDATSW='RAW'
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)IDATSW='FREQ'
      IF(NUMV2.EQ.2)GOTO509
      GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NRIGHT.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPROGR--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,552)
  552 FORMAT('      FOR A ROOTOGRAM, ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,553)
  553 FORMAT('      FOR A RELATIVE ROOTOGRAM, ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,554)
  554 FORMAT('      FOR A CUMULATIVE ROOTOGRAM, ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,555)
  555 FORMAT('      FOR A RELATIVE CUMULATIVE ROOTOGRAM, ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,559)
  559 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,564)(IANS(I),I=1,IWIDTH)
  564 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPROGR--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,572)
  572 FORMAT('      FOR A ROOTOGRAM, ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,573)
  573 FORMAT('      FOR A RELATIVE ROOTOGRAM, ')
      IF(ICASPL.EQ.'ROOT'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'OFF')WRITE(ICOUT,574)
  574 FORMAT('      FOR A CUMULATIVE ROOTOGRAM, ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'OFF')CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'ON')WRITE(ICOUT,575)
  575 FORMAT('      FOR A RELATIVE CUMULATIVE ROOTOGRAM, ')
      IF(ICASPL.EQ.'CUMR'.AND.IRELAT.EQ.'ON')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARIABLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,580)
  580 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,581)
  581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,583)
  583 FORMAT('      THE FIRST  VARIABLE  (FREQUENCIES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT
  584 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,585)
  585 FORMAT('      THE SECOND VARIABLE  (HORIZ. AXIS VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  586 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,587)
  587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,588)(IANS(I),I=1,IWIDTH)
  588 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IF(NUMV2.LE.1)GOTO651
      GOTO652
C
  651 CONTINUE
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)X1(J)=TAGPLO(I)
      GOTO660
C
  652 CONTINUE
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)X1(J)=TAGPLO(I)
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
      GOTO660
C
  660 CONTINUE
      NLOCAL=J
C
C               ****************************************************************
C               **  STEP 7--
C               **  DETERMINE IF THE ANALYST
C               **  HAS SPECIFIED    1)  THE CLASS WIDTH,
C               **                   2)  THE MIN POINT OF THE FIRST CELL,
C               **                   3)  THE MAX POINT OF THE LAST  CELL,
C               **  FOR THE DISTRIBUTIONAL ANALYSIS.
C               **  IF NON-DEFAULT, USE THE SPECIFIED VALUES.
C               **  IF DEFAULT, USE THE DEFAULT VALUES--
C               **     1)  CLASS WIDTH = .3 OF A SAMPLE STANDARD DEVIATION;
C               **     2)  START = SAMPLE MEAN - 6*(SAMPLE STANDARD DEVIATION);
C               **     3)  STOP  = SAMPLE MEAN + 6*(SAMPLE STANDARD DEVIATION);
C               **  NOTE THAT THE DEFAULT SETTINGS ARE IN FACT
C               ****************************************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CLWID=CLWIDT(1)
CCCCC BAWID=BAWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
C
C               *****************************************************
C               **  STEP 8--                                       **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS          **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.             **
C               **  RESET THE VECTOR D(.) TO ALL ONES.             **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).  **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).  **
C               *****************************************************
C
      CALL DPROG2(Y1,X1,NLOCAL,ICASPL,IRELAT,IDATSW,CLWID,XSTART,XSTOP,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
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 DPROGR--')
      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 ')
      WRITE(ICOUT,9014)IRELAT,CLWID,XSTART,XSTOP
 9014 FORMAT('IRELAT,CLWID,XSTART,XSTOP = ',A4,2X,3E15.7)
      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 DPROO2(MODEL,NUMCHA,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IVARN,IVARN2,NUMVAR,XMIN,XMAX,ROOTS2,NROOTS,
CCCCC AD FOLLOWING LINE.  FEBRUARY 1994.
     1ROOTAC,
     1IBUGA3,IBUGCO,IBUGEV,IERROR)
C
C     PURPOSE--COMPUTE THE ROOTS OF A FUNCTION
C              THAT ARE KNOWN TO BE BETWEEN THE LIMITS
C              XMIN AND XMAX.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY  1994. ACTIVATE ROOT ACCURACY
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 MODEL
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IVARN
      CHARACTER*4 IVARN2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IERROR
C
      CHARACTER*4 ILAB
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION MODEL(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
      DIMENSION IVARN(*)
      DIMENSION IVARN2(*)
      DIMENSION ROOTS2(*)
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION ILOCV(10)
      DIMENSION ILAB(10)
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='DPRO'
      ISUBN2='O2  '
C
      IERROR='NO'
C
C     THE FOLLOWING ACCURACY SETTING WAS SWITCHED DUE TO FAILURE
C     TO CONVERGE FOR SOME FUNCTIONS ON 32-BIT VAX
C     (BUT DID CONVERGE ON 36-BIT UNIVAC)
CCCCC ROOTAC=0.0000001
CCCCC PASS ROOTAC AS ARGUMENT.  FEBRUARY 1994.
CCCCC ROOTAC=0.000001
      CUTOFF=0.001
      DIFF=(-999.)
      RATIO=(-999.)
      IPASS=2
      NROOTS=0
C
      J2=0
C
      X2=0.0
      X3MIN=0.0
      X3MAX=0.0
      CALC1=0.0
      RATIO=0.0
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 DPROO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGCO,IBUGEV
   52 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMCHA,NUMPV,NUMVAR
   53 FORMAT('NUMCHA,NUMPV,NUMVAR = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)(MODEL(J),J=1,NUMCHA)
   54 FORMAT('MODEL(I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMPV
      WRITE(ICOUT,56)I,PARAM(I),IPARN(I),IPARN2(I)
   56 FORMAT('I,PARAM(I),IPARN(I),IPARN2(I) = ',I8,E15.7,A4,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)IANGLU
   57 FORMAT('IANGLU = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO60I=1,NUMVAR
      WRITE(ICOUT,61)I,IVARN(I),IVARN2(I)
   61 FORMAT('I, IVARN(I),IVARN2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
      WRITE(ICOUT,62)XMIN,XMAX
   62 FORMAT('XMIN, XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************************************
C               **  STEP 1--                                     **
C               **  DETERMINE THE LOCATIONS (IN THE LIST IPARN)  **
C               **  OF THE VARIABLES OF THE FUNCTION.            **
C               ***************************************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO100I=1,NUMVAR
      IH=IVARN(I)
      IH2=IVARN2(I)
      DO200J=1,NUMPV
      J2=J
      IF(IPARN(J).EQ.IH.AND.IPARN2(J).EQ.IH2)GOTO210
  200 CONTINUE
  210 CONTINUE
      ILOCV(I)=J2
  100 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  WRITE OUT PRELIMINARY SUMMARY INFORMATION  **
C               *************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO409
      IF(IFEEDB.EQ.'OFF')GOTO409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,401)
  401 FORMAT('ROOTS OF AN EQUATION')
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='    '
      ILAB(2)='  FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON--'
      NUMWDL=4
      CALL DPPRIF(ILAB,NUMWDL,MODEL,NUMCHA,IBUGA3)
C
      WRITE(ICOUT,402)IVARN(1),IVARN2(1)
  402 FORMAT('      ROOT VARIABLE                     = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,403)XMIN
  403 FORMAT('      SPECIFIED LOWER LIMIT OF INTERVAL = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,404)XMAX
  404 FORMAT('      SPECIFIED UPPER LIMIT OF INTERVAL = ',F20.10)
      CALL DPWRST('XXX','BUG ')
  409 CONTINUE
C
      NUMSEG=100
      NUMPT=NUMSEG+1
      ANUMPT=NUMPT
C
C               ************************************************************
C               **  STEP 3--                                              **
C               **  PARTITION THE INTERVAL FROM XMIN TO XMAX              **
C               **  INTO      NUMSEG      EQUALLY-SPACED SEGMENTS.        **
C               **  STEP THROUGH EACH OF THE      NUMSEG + 1      POINTS  **
C               **  WHICH DEFINE THE SEGMENTS--                           **
C               **  ALL THE WHILE LOOKING FOR FUNCTION CROSS-OVERS.       **
C               ************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1000I=1,NUMPT
      AI=I
      P=(AI-1.0)/(ANUMPT-1.0)
      X2=(1.0-P)*XMIN+P*XMAX
      X3MAX=X2
C
      DO1100K=1,NUMVAR
      JLOC=ILOCV(K)
      PARAM(JLOC)=X2
 1100 CONTINUE
C
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,CALC2,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,1302)X2,CALC2
 1302 FORMAT('X2,CALC2 = ',2E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(CALC2.EQ.0)NROOTS=NROOTS+1
      IF(CALC2.EQ.0)ROOTS2(NROOTS)=X2
C
      IF(I.EQ.1)GOTO1390
C
      IF(CALC1.LT.0.0.AND.CALC2.GT.0.0)GOTO1350
      IF(CALC1.GT.0.0.AND.CALC2.LT.0.0)GOTO1350
      GOTO1390
C
 1350 CONTINUE
C
C     THE FOLLOWING LINE WAS MOVED 25 LINES UP
C     (MODIFICATION SUGGESTED BY TED PRINCE, NBS)
CCCCC X3MAX=X2
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  PERFORM THE FOLLOWING SUB-SECTION OF CODE ONLY       **
C               **  WHEN A CROSS-OVER HAS BEEN FOUND WHILE STEPPING      **
C               **  THROUGH THE   NUMSEG + 1    POINTS IN THE INTERVAL.  **
C               **  THE PURPOSE OF THE FOLLOWING SUB-SECTION OF CODE     **
C               **  IS TO DETERMINE MORE PRECISELY THE ROOT              **
C               **  WHEN A CROSS-OVER HAS BEEN DETECTED.                 **
C               ***********************************************************
C
      ICOUMX=1000
      ICOUNT=0
 1360 CONTINUE
      ICOUNT=ICOUNT+1
      IF(ICOUNT.LE.ICOUMX)GOTO1329
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('***** CAUTION FROM DPROO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1322)
 1322 FORMAT('      THE NUMBER OF INTERATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1323)
 1323 FORMAT('      IN THE ROOT-FINDING PROCESS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1324)ICOUMX
 1324 FORMAT('      HAS JUST EXCEEDED ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)X3
 1325 FORMAT('            ROOT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)ROOTAC
 1326 FORMAT('            DESIRED ACCURACY   = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)DIFF
 1327 FORMAT('            ACTUAL DELTA X     = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1328)RATIO
 1328 FORMAT('            ACTUAL DELTA X / X = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO1370
 1329 CONTINUE
C
      X3=(X3MIN+X3MAX)/2.0
C
      DO3100K=1,NUMVAR
      JLOC=ILOCV(K)
      PARAM(JLOC)=X3
 3100 CONTINUE
C
      CALL COMPIM(MODEL,NUMCHA,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,CALC3,
     1IBUGCO,IBUGEV,IERROR)
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,1303)X3,CALC3
 1303 FORMAT('X3,CALC3 = ',2E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      PROD1=CALC1*CALC3
      PROD2=CALC2*CALC3
      IF(PROD1.GT.0.0)X3MIN=X3
      IF(PROD2.GT.0.0)X3MAX=X3
C
      ABSX3=ABS(X3)
      DIFF=ABS(X3MAX-X3MIN)
      IF(ABSX3.LE.CUTOFF.AND.DIFF.LE.ROOTAC)GOTO1370
      IF(ABSX3.LE.CUTOFF.AND.DIFF.GT.ROOTAC)GOTO1340
      RATIO=ABS(DIFF/X3)
      IF(ABSX3.GT.CUTOFF.AND.RATIO.LE.ROOTAC)GOTO1370
      IF(ABSX3.GT.CUTOFF.AND.RATIO.GT.ROOTAC)GOTO1340
 1340 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,3145)CUTOFF,ROOTAC,DIFF,RATIO,ABSX3
 3145 FORMAT('CUTOFF,ROOTAC,DIFF,RATIO,ABSX3 = ',5E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(PROD2.EQ.0.0)GOTO1370
      IF(PROD1.GT.0.0.OR.PROD2.GT.0.0)GOTO1360
C
 1365 CONTINUE
      WRITE(ICOUT,1361)
 1361 FORMAT('***** ERROR IN DPROO2--IMPOSSIBLE CONDITION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1362)
 1362 FORMAT('      ARISING--PROD1 OR PROD2 NOT = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1363)PROD1,PROD2,X3MIN,X3,X3MAX,CALC1,CALC3,CALC2
 1363 FORMAT('PROD1,PROD2,X3MIN,X3,X3MAX,CALC1,CALC3,CALC2 = ',
     18E10.3)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1370 CONTINUE
      NROOTS=NROOTS+1
      ROOTS2(NROOTS)=X3
      GOTO1390
C
 1390 CONTINUE
      X3MIN=X3MAX
      CALC1=CALC2
C
 1000 CONTINUE
C
C               ***************************
C               **  STEP 5--             **
C               **  WRITE OUT THE ROOTS  **
C               ***************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO1490
      IF(IFEEDB.EQ.'OFF')GOTO1490
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1405)NROOTS
 1405 FORMAT('      NUMBER OF ROOTS FOUND IN INTERVAL = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(NROOTS.LE.0)GOTO1490
      DO1410I=1,NROOTS
      WRITE(ICOUT,1411)I,ROOTS2(I)
 1411 FORMAT('ROOT ',I5,' = ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END      OF DPROO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)NROOTS
 9012 FORMAT('NROOTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NROOTS
      WRITE(ICOUT,9016)I,ROOTS2(I)
 9016 FORMAT('I,ROOTS2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)IERROR
 9021 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)NUMVAR,NUMSEG
 9022 FORMAT('NUMVAR,NUMSEG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)CALC1,CALC2,CALC3
 9023 FORMAT('CALC1,CALC2,CALC3 = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)X2,X3MIN,X3,X3MAX
 9024 FORMAT('X2,X3MIN,X3,X3MAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPROOT(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
CCCCC ADD FOLLOWING LINE.  FEBRUARY 1994.
     1ROOTAC,
     1IANGLU,IBUGA3,IBUGCO,IBUGEV,IBUGQ,IERROR)
C
C     PURPOSE--TREAT THE LET CASE FOR
C              FINDING THE ROOTS OF AN EQUATION.
C     EXAMPLE--LET X = ROOTS X**3+2*X**2-4*X+5 FOR X = -100 200
C            --LET X = F1 FOR X = 0 B
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1979.
C     UPDATED--       --FEBRUARY  1979.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --FEBRUARY  1994. ACTIVATE ROOT ACCURACY
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 IWD1
      CHARACTER*4 IWD12
      CHARACTER*4 IWD2
      CHARACTER*4 IWD22
      CHARACTER*4 ILAB
      CHARACTER*4 IKEY
      CHARACTER*4 IKEY2
      CHARACTER*4 INCLUN
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASUP
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IFOUN1
      CHARACTER*4 IFOUN2
      CHARACTER*4 IOLD
      CHARACTER*4 IOLD2
      CHARACTER*4 INEW
      CHARACTER*4 INEW2
      CHARACTER*4 IHPARN
      CHARACTER*4 IHPAR2
      CHARACTER*4 IHL
      CHARACTER*4 IHL2
      CHARACTER*4 IDUMV
      CHARACTER*4 IDUMV2
      CHARACTER*4 IHOUT
      CHARACTER*4 IHOUT2
      CHARACTER*4 IUOUT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IFOUND
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
      DIMENSION IDUMV(100)
      DIMENSION IDUMV2(100)
      DIMENSION ROOTS2(100)
C
      DIMENSION ILAB(10)
      DIMENSION IOLD(10)
      DIMENSION IOLD2(10)
      DIMENSION INEW(10)
      DIMENSION INEW2(10)
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
      ISUBN1='DPRO'
      ISUBN2='OT  '
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
      ILOCMX=0
      NUMLIM=0
      ILOC3=0
C
C               *******************************
C               **  TREAT THE ROOTS SUBCASE  **
C               **  OF THE LET COMMAND       **
C               *******************************
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 DPROOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGCO,IBUGEV
   53 FORMAT('IBUGCO,IBUGEV = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGQ
   54 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************
C               **  STEP 1--                    **
C               **  INITIALIZE SOME VARIABLES.  **
C               **********************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NEWNAM='NO'
C
      MAXN2=MAXCHF
      MAXN3=MAXCHF
CCCCC MAXN4=MAXCHF
C
C               ****************************************************************
C               **  STEP 2--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE VARIABLE NAME TO LEFT OF = SIGN                     *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               ****************************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      DO2000I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I).AND.IHLEF2.EQ.IHNAM2(I))GOTO2100
 2000 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO2200
      GOTO2900
 2200 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2201)
 2201 FORMAT('***** ERROR IN DPROOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2202)
 2202 FORMAT('      THE NUMBER OF VARIABLE, PARAMETER, & FUNCTION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2203)MAXNAM
 2203 FORMAT('      NAMES HAS JUST EXCEEDED THE ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2204)
 2204 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2205)
 2205 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2206)
 2206 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2207)
 2207 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2100 CONTINUE
      ILISTL=I2
 2900 CONTINUE
C
C               ***************************************************************
C               **  STEP 3.1--                                               **
C               **  EXTRACT THE RIGHT-SIDE FUNCTIONAL
C               **  EXPRESSION FROM THE INPUT COMMAND LINE                   **
C               **  (STARTING WITH THE FIRST NON-BLANK LOCATION AFTER THE    **
C               **  EQUAL SIGN AND ENDING WITH THE END OF THE LINE           **
C               **  OR WITH THE LAST NON-BLANK CHARACTER BEFORE     WRT  .   **
C               **  PLACE THE FUNCTION IN IFUNC2(.)  .                       **
C               ***************************************************************
C
      ISTEPN='3.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWD1=IHARG(3)
      IWD12=IHARG2(3)
      IWD2='WRT '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3500
C
      IWD1=IHARG(3)
      IWD12=IHARG2(3)
      IWD2='FOR '
      IWD22='    '
      CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
     1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(IFOUND.EQ.'YES')GOTO3500
C
CCCCC IWD1=IHARG(3)
CCCCC IWD12=IHARG2(3)
CCCCC IWD2='SUBS'
CCCCC IWD22='ET  '
CCCCC CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
CCCCC1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
CCCCC IF(IERROR.EQ.'YES')GOTO9000
CCCCC IF(IFOUND.EQ.'YES')GOTO3500
C
CCCCC IWD1=IHARG(3)
CCCCC IWD12=IHARG2(3)
CCCCC IWD2='EXCE'
CCCCC IWD22='PT  '
CCCCC CALL DPEXST(IANS,IWIDTH,IWD1,IWD12,IWD2,IWD22,MAXN2,
CCCCC1IFUNC2,N2,IBUGA3,IFOUND,IERROR)
CCCCC IF(IERROR.EQ.'YES')GOTO9000
CCCCC IF(IFOUND.EQ.'YES')GOTO3500
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3101)
 3101 FORMAT('***** ERROR IN DPROOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3102)
 3102 FORMAT('      INVALID COMMAND FORM FOR ROOT-FINDING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3103)
 3103 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3104)
 3104 FORMAT('      LET ... = ROOTS ... WRT  ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3105)
 3105 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3106)(IANS(I),I=1,IWIDTH)
 3106 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3500 CONTINUE
C
C               *****************************************************
C               **  STEP 3.2--                                     **
C               **  DETERMINE IF THE RIGHT-HAND SIDE IS            **
C               **  IN FUNCTION FORM OR IS IN EQUATION FORM.       **
C               **  IF IN EQUATION FORM, CONVERT TO FUNCTION FORM  **
C               **  BY REPLACING THE EQUAL SIGN BY A MINUS SIGN    **
C               **  AND ENCLOSING THE REST OF THE EXPRESSION IN    **
C               **  PARENTHESES.                                   **
C               **  PLACE THE OUTPUT FUNCTION BACK IN IFUNC2(.)    **
C               *****************************************************
C
      ISTEPN='3.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO3600I=1,N2
      I2=I
      IF(IFUNC2(I).EQ.'=')GOTO3610
 3600 CONTINUE
      GOTO3900
 3610 CONTINUE
      ILOCE2=I2
C
      IMIN=ILOCE2+1
      IF(IMIN.GT.N2)GOTO3690
      DO3650I=IMIN,N2
      IREV=N2-I+IMIN
      IREVP1=IREV+1
      IFUNC2(IREVP1)=IFUNC2(IREV)
 3650 CONTINUE
      I=ILOCE2
      IFUNC2(I)='-'
      I=ILOCE2+1
      IFUNC2(I)='('
      I=N2+2
      IFUNC2(I)=')'
      N2=I
 3690 CONTINUE
C
 3900 CONTINUE
C
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  DETERMINE IF THE EXPRESSION HAS ANY FUNCTION NAMES   **
C               **  INBEDDED.  IF SO, REPLACE THE FUNCTION NAMES         **
C               **  BY EACH FUNCTION'S DEFINITION.  DO SO REPEATEDLY     **
C               **  UNTIL ALL FUNCTION REFERENCES HAVE BEEN ANNIHILATED  **
C               **  AND THE EXPRESSION IS LEFT ONLY WITH                 **
C               **  CONSTANTS, PARAMETERS, AND VARIABLES--NO FUNCTIONS.  **
C               **  PLACE THE RESULTING FUNCTIONAL EXPRESSION INTO IFUNC3(.) **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPEXFU(IFUNC2,N2,IHNAME,IHNAM2,IUSE,IVSTAR,IVSTOP,
     1NUMNAM,IANS,IWIDTH,IFUNC,NUMCHF,MAXCHF,IFUNC3,N3,MAXN3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      IF(IBUGA3.EQ.'OFF')GOTO5090
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='INPU'
      ILAB(2)='T FU'
      ILAB(3)='NCTI'
      ILAB(4)='ON  '
      ILAB(5)='    '
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      WRITE(ICOUT,5081)IDUMV(1),IDUMV2(1)
 5081 FORMAT('ROOT VARIABLE         = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
C
 5090 CONTINUE
C
C               *************************************
C               **  STEP 5--                       **
C               **  EXTRACT QUALIFIER INFORMATION. **
C               *************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               **************************************************
C               **  STEP 5.1--                                  **
C               **  DETERMINE THE DUMMY VARIABLE FOR THE ROOT.  **
C               **************************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IKEY='WRT '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5119
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      NUMDV=1
      GOTO5190
 5119 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5129
      IDUMV(1)=IHOUT
      IDUMV2(1)=IHOUT2
      NUMDV=1
      GOTO5190
 5129 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5181)
 5181 FORMAT('***** ERROR IN DPROOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5182)
 5182 FORMAT('      INVALID COMMAND FORM FOR ROOT-FINDING.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5183)
 5183 FORMAT('      NO VARIABLE FOR ROOT-FINDING DEFINED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5185)
 5185 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5186)
 5186 FORMAT('      LET ... = ROOTS ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5187)
 5187 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5189)(IANS(I),I=1,IWIDTH)
 5189 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5190 CONTINUE
C
C               **************************************************
C               **  STEP 5.2--                                  **
C               **  DETERMINE THE LIMITS FOR   THE ROOTS.       **
C               **************************************************
C
      ISTEPN='5.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLIM=0
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=3
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5219
      XMIN=VOUT
      NUMLIM=NUMLIM+1
 5219 CONTINUE
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=4
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5239
      IF(IHOUT.EQ.'TO  '.AND.IHOUT2.EQ.'    ')GOTO5229
      XMAX=VOUT
      ILOCMX=ILOC2
      NUMLIM=NUMLIM+1
 5229 CONTINUE
C
      IF(NUMLIM.EQ.2)GOTO5239
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=5
      ILOCA=1
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO5239
      XMAX=VOUT
      ILOCMX=ILOC2
      NUMLIM=NUMLIM+1
 5239 CONTINUE
C
      IF(NUMLIM.EQ.2)GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5281)
 5281 FORMAT('***** ERROR IN DPROOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5282)
 5282 FORMAT('      INVALID COMMAND FORM FOR ROOT-FINDING.')
      CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.EQ.0)WRITE(ICOUT,5283)
 5283 FORMAT('      NO LIMITS FOR ROOT-FINDING DEFINED.')
      IF(NUMLIM.EQ.0)CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.EQ.1)WRITE(ICOUT,5284)
 5284 FORMAT('      ONLY ONE LIMIT FOR ROOT-FINDING DEFINED.')
      IF(NUMLIM.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(NUMLIM.NE.0.AND.NUMLIM.NE.1)WRITE(ICOUT,5285)NUMLIM
 5285 FORMAT('      NUMBER OF LIMITS DEFINED = ',I8)
      IF(NUMLIM.NE.0.AND.NUMLIM.NE.1)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5286)
 5286 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5287)
 5287 FORMAT('      LET ... = ROOTS ... WRT ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5288)
 5288 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5289)(IANS(I),I=1,IWIDTH)
 5289 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 5290 CONTINUE
C
C               **********************************************
C               **  STEP 6.3--                              **
C               **  SCAN THE QUALIFIERS FOR VARIABLE,       **
C               **  PARAMETER, FUNCTION, AND VALUE CHANGES  **
C               **  IN THE FUNCTION.                        **
C               **********************************************
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NCHANG=0
      DO6300IFORI=1,10
C
      IKEY='FOR '
      IKEY2='    '
      ISHIFT=1
      IF(IFORI.EQ.1)ILOCA=ILOCMX
      IF(IFORI.NE.1)ILOCA=ILOC3
      ILOCB=NUMARG
      INCLUN='NO'
      CALL DPEXQU(IKEY,IKEY2,ISHIFT,ILOCA,ILOCB,
     1IHARG,IHARG2,NUMARG,
     1INCLUN,IANS,IWIDTH,IHNAME,IHNAM2,IVALUE,VALUE,IUSE,IN,NUMNAM,
     1IFOUN1,IFOUN2,ILOC1,ILOC2,IHOUT,IHOUT2,ILOUT,IVOUT,VOUT,IUOUT,
     1INOUT,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO6380
      IF(IFOUN1.EQ.'NO'.OR.IFOUN2.EQ.'NO')GOTO6350
C
      ILOC3=ILOC2+2
      IF(ILOC3.GT.NUMARG)GOTO6380
      NCHANG=NCHANG+1
      IOLD(NCHANG)=IHARG(ILOC2)
      IOLD2(NCHANG)=IHARG2(ILOC2)
      INEW(NCHANG)=IHARG(ILOC3)
      INEW2(NCHANG)=IHARG2(ILOC3)
C
 6300 CONTINUE
 6350 CONTINUE
      GOTO6390
C
 6380 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6301)
 6301 FORMAT('***** ERROR IN DPROOT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6302)
 6302 FORMAT('      INVALID COMMAND FORM FOR ROOT.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6303)
 6303 FORMAT('      GENERAL FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6304)
 6304 FORMAT('      LET FUNCTION ... = ROOT ... WRT ... FOR ... ',
     1'FOR ... = ... TO ...')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6305)
 6305 FORMAT('      THE ENTIRE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,6306)(IANS(I),I=1,IWIDTH)
 6306 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 6390 CONTINUE
C
C               **********************************************
C               **  STEP 6.4--                              **
C               **  CARRY OUT THE VARIABLE,                 **
C               **  PARAMETER, AND FUNCTION CHANGES         **
C               **  AND THEN PRINT OUT A BRIEF MESSAGE      **
C               **  INDICATING THAT THE CHANGES             **
C               **  HAVE BEEN MADE.                         **
C               **********************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO6490
      IF(IFEEDB.EQ.'OFF')GOTO6490
      IF(NCHANG.LE.0)GOTO6490
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      ILAB(1)='PRE '
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
      CALL COMPIC(IFUNC3,N3,IOLD,IOLD2,INEW,INEW2,NCHANG,IFUNC3,N3,
     1IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      ILAB(1)='POST'
      ILAB(2)='-CHA'
      ILAB(3)='NGE '
      ILAB(4)='FUNC'
      ILAB(5)='TION'
      ILAB(6)='  = '
      NUMWDL=6
      CALL DPPRIF(ILAB,NUMWDL,IFUNC3,N3,IBUGA3)
C
 6490 CONTINUE
C
C               **********************************************************
C               **  STEP 6.7--                                          **
C               **  MAKE A NON-CALCULATING PASS AT THE FUNCTION         **
C               **  SO AS TO EXTRACT ALL PARAMETER AND VARIABLE NAMES.  **
C               **********************************************************
C
      ISTEPN='6.8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IPASS=1
      CALL COMPIM(IFUNC3,N3,IPASS,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,AJUNK,
     1IBUGCO,IBUGEV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***********************************************
C               **  STEP 7--                                 **
C               **  CHECK THAT ALL PARAMETERS                **
C               **  IN THE FUNCTION ARE ALREADY PRESENT      **
C               **  IN THE AVAILABLE NAME LIST IHNAME(.).    **
C               **  ALSO CHECK THAT THE VARIABLE NAME        **
C               **  THAT FOLLOWS FOR (THAT IS, THE DUMMY     **
C               **  VARIABLE IS IN THE FUNCTION.             **
C               **  NOTE--ALL PARAMETERS AND VARIABLES       **
C               **  THAT ARE NOT FOUND IN IHNAME(.)          **
C               **  WILL BE AUTOMATICALLY SET TO 0.0         **
C               **  (BUT ONLY TEMPORARILY);                  **
C               **  THIS CONVENTION ALLOWS AN AUTOMATIC      **
C               **  SOLUTION TO THE PROBLEM OF SOLVING       **
C               **  FOR ROOTS OF EQUATIONS                   **
C               **  (AS OPPOSED TO FUNCTIONS)                **
C               **  SINCE 'Y' WILL TYPICALLY BE SET TO ZERO  **
C               **  AS ONE WOULD WANT FOR SOLVING            **
C               **  FOR A ROOT (= A FUNCTION ZERO).          **
C               ***********************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IP=0
      IV=0
      IF(NUMPV.LE.0)GOTO7650
      DO7600J=1,NUMPV
      IHPARN=IPARN(J)
      IHPAR2=IPARN2(J)
      IF(IHPARN.EQ.IDUMV(1).AND.IHPAR2.EQ.IDUMV2(1))GOTO7620
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHPARN,IHPAR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IF(IERRO2.EQ.'YES')GOTO7605
      GOTO7610
C
 7605 CONTINUE
      IP=IP+1
      PARAM(J)=0.0
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7606)IHPARN,IHPAR2
 7606 FORMAT('NOTE--',A4,A4,' HAS BEEN TEMPORARILY SET TO ZERO')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7607)
 7607 FORMAT('             FOR THE ROOT-FINDING PROCESS.')
      CALL DPWRST('XXX','BUG ')
      GOTO7600
C
 7610 CONTINUE
      IP=IP+1
      PARAM(J)=VALUE(ILOCP)
      GOTO7600
C
 7620 CONTINUE
      IV=IV+1
      LOCDUM=J
 7600 CONTINUE
 7650 CONTINUE
C
C               ******************************
C               **  STEP 8--                **
C               **  DETERMINE THE ROOTS  .  **
C               ******************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO7719
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7711)
 7711 FORMAT('***** FROM DPROOT, IMMEDIATELY BEFORE CALLING ',
     1'ROOTS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7712)N3,NUMPV
 7712 FORMAT('N3,NUMPV = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7713)NUMDV,XMIN,XMAX
 7713 FORMAT('NUMDV,XMIN,XMAX = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      DO7714I=1,NUMDV
      WRITE(ICOUT,7715)I,IDUMV(I),IDUMV2(I)
 7715 FORMAT('I,IDUMV(I),IDUMV2(I) = ',I8,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
 7714 CONTINUE
      WRITE(ICOUT,7716)IBUGA3,IBUGCO,IBUGEV
 7716 FORMAT('IBUGA3,IBUGCO,IBUGEV = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 7719 CONTINUE
C
      CALL DPROO2(IFUNC3,N3,PARAM,IPARN,IPARN2,NUMPV,
     1IANGLU,ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IDUMV,IDUMV2,NUMDV,XMIN,XMAX,ROOTS2,NROOTS,
CCCCC ADD FOLLOWING LINE FEBRAUARY 1994.
     1ROOTAC,
     1IBUGA3,IBUGCO,IBUGEV,IERROR)
      AROOTS=NROOTS
C
C               *****************************************
C               **  STEP 9--                           **
C               **  ENTER THE ROOTS INTO THE DATAPLOT  **
C               **  ARRAY V(.).                        **
C               **  ENTER THE FOUND NUMBER OF ROOTS    **
C               **  INTO THE DATAPLOT PARAMETER        **
C               **  NROOTS   .                         **
C               *****************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHL=IHLEFT
      IHL2=IHLEF2
      ICASUP='V'
      CALL DPINVP(IHL,IHL2,ICASUP,ROOTS2,NROOTS,AROOTS,NROOTS,
     1ISUBN1,ISUBN2,IBUGA3,IERROR)
C
      IHL='NROO'
      IHL2='TS  '
      ICASUP='P'
      CALL DPINVP(IHL,IHL2,ICASUP,ROOTS2,NROOTS,AROOTS,NROOTS,
     1ISUBN1,ISUBN2,IBUGA3,IERROR)
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 DPROOT--')
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NUMNAM
      WRITE(ICOUT,9016)I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)
 9016 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVSTAR(I),IVSTOP(I)=',
     1I8,2X,A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9017)NUMCHF,MAXCHF,IWIDTH,N2
 9017 FORMAT('NUMCHF,MAXCHF,IWIDTH,N2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)(IFUNC(I),I=1,IWIDTH)
 9018 FORMAT('IFUNC(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)(IFUNC2(I),I=1,N2)
 9019 FORMAT('IFUNC2(.) = ',115A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)N3
 9020 FORMAT('N3 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)(IFUNC3(I),I=1,N3)
 9021 FORMAT('IFUNC3(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)NUMPV
 9022 FORMAT('NUMPV = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IHLEFT,IHLEF2,IDUMV,IDUMV2
 9023 FORMAT('IHLEFT,IHLEF2,IDUMV,IDUMV2 = ',A4,A4,2X,A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ICASUP,IFOUND,IERROR
 9024 FORMAT('ICASUP,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)XMIN,XMAX
 9025 FORMAT('XMIN,XMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)NROOTS
 9026 FORMAT('NROOTS = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9027I=1,NROOTS
      WRITE(ICOUT,9028)I,ROOTS2(I)
 9028 FORMAT('I,ROOTS2(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9027 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPROTA(X,Y,XREF,YREF,ANGLE,AMAX,XP,YP)
C
C     ROTATE THE POINT (X,Y) ABOUT THE
C     REFERENCE POINT (XREF,YREF).
C     THE ANGLE OF ROTATION IS ANGLE.
C     AMAX (STANDING FOR MAXIMUM ANGLE) IS
C     THE ANGLE FOR 1 FULL ROTATION
C     (360.0 FOR DEGREES, 2*PI FOR RADIANS,
C     400 FOR GRADS)--THIS IMPLICITELY DEFINES
C     THE UNITS FOR THE ANGLE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--OCTOBER   1980.
C     UPDATED         --APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
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
      THETA=(ANGLE/AMAX)*2.0*3.1415926
C
      XROT=(X-XREF)*COS(THETA)-(Y-YREF)*SIN(THETA)
      YROT=(X-XREF)*SIN(THETA)+(Y-YREF)*COS(THETA)
C
      XP=XREF+XROT
      YP=YREF+YROT
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPROWL(IHARG,IARGT,IARG,NUMARG,IDEFR1,IDEFR2,
     1IFROW1,IFROW2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE ROW LIMITS
C              WHICH WILL DEFINE THE EXTREME
C              ROWS (WITHIN A FILE) TO BE SCANNED IN CARRYING
C              OUT THE READ AND SERIAL READ COMMANDS.
C              THE 2 LIMITS ARE CONTAINED IN THE
C              2 ARGUMENTS IFROW1 AND IFROW2, RESPECTIVELY.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --IARG   (AN INTEGER VECTOR)
C                     --NUMARG
C                     --IDEFR1
C                     --IDEFR2
C     OUTPUT ARGUMENTS--IFROW1 (AN INTEGER VARIABLE
C                       CONTAINING THE MINIMUM ROW
C                       IN THE DATA FILE TO BE SCANNED
C                       DURING A    READ    OR A    SERIAL READ.
C                     --IFROW2 (AN INTEGER VARIABLE
C                       CONTAINING THE MAXIMUM ROW
C                       IN THE DATA FILE TO BE SCANNED
C                       DURING A    READ    OR A    SERIAL READ.
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--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
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
      IHOLD1=0
      IHOLD2=0
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE ROW    LIMITS ARE TO BE CHANGED           **
C               ****************************************************
C
 1100 CONTINUE
      IF(NUMARG.LE.0)GOTO1900
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LIMI')GOTO1110
      GOTO1190
C
 1110 CONTINUE
      IF(NUMARG.EQ.1)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.3.AND.IARGT(2).EQ.'NUMB'.AND.
     1IARGT(3).EQ.'NUMB')GOTO1130
      GOTO1190
C
 1120 CONTINUE
      I1=IDEFR1
      I2=IDEFR2
      IF(I1.LE.I2)IHOLD1=I1
      IF(I1.LE.I2)IHOLD2=I2
      IF(I1.GT.I2)IHOLD1=I2
      IF(I1.GT.I2)IHOLD2=I1
      GOTO1180
C
 1130 CONTINUE
      I1=IARG(2)
      I2=IARG(3)
      IF(I1.LE.I2)IHOLD1=I1
      IF(I1.LE.I2)IHOLD2=I2
      IF(I1.GT.I2)IHOLD1=I2
      IF(I1.GT.I2)IHOLD2=I1
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IFROW1=IHOLD1
      IFROW2=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('THE ROW LIMITS (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      IF(IFROW2.NE.IDEFR2)WRITE(ICOUT,1186)IFROW1,IFROW2
 1186 FORMAT('HAVE JUST BEEN SET TO ',I8,2X,I8)
      IF(IFROW2.NE.IDEFR2)CALL DPWRST('XXX','BUG ')
      IF(IFROW2.EQ.IDEFR2)WRITE(ICOUT,1187)IFROW1
 1187 FORMAT('HAVE JUST BEEN SET TO ',I8,2X,'INFINITY')
      IF(IFROW2.EQ.IDEFR2)CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1900
C
 1190 CONTINUE
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE ROW    MINIMUM IS TO BE CHANGED           **
C               ****************************************************
C
 1200 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MINI')GOTO1210
      GOTO1290
C
 1210 CONTINUE
      IF(NUMARG.EQ.1)GOTO1220
      IF(IHARG(NUMARG).EQ.'ON')GOTO1220
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1220
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1220
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1220
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')GOTO1230
      GOTO1290
C
 1220 CONTINUE
      IHOLD1=IDEFR1
      GOTO1280
C
 1230 CONTINUE
      IHOLD1=IARG(2)
      GOTO1280
C
 1280 CONTINUE
      IFOUND='YES'
      IFROW1=IHOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1289
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1285)
 1285 FORMAT('THE ROW MINIMUM (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1286)IFROW1
 1286 FORMAT('HAS JUST BEEN SET TO ',I8)
      CALL DPWRST('XXX','BUG ')
 1289 CONTINUE
      GOTO1900
C
 1290 CONTINUE
C
C               ****************************************************
C               **  TREAT THE CASE WHEN                           **
C               **  THE ROW    MAXIMUM IS TO BE CHANGED           **
C               ****************************************************
C
 1300 CONTINUE
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MAXI')GOTO1310
      GOTO1390
C
 1310 CONTINUE
      IF(NUMARG.EQ.1)GOTO1320
      IF(IHARG(NUMARG).EQ.'ON')GOTO1320
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1320
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1320
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1320
      IF(NUMARG.GE.2.AND.IARGT(2).EQ.'NUMB')GOTO1330
      GOTO1390
C
 1320 CONTINUE
      IHOLD2=IDEFR2
      GOTO1380
C
 1330 CONTINUE
      IHOLD2=IARG(2)
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IFROW2=IHOLD2
C
      IF(IFEEDB.EQ.'OFF')GOTO1389
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1385)
 1385 FORMAT('THE ROW MAXIMUM (FOR READ AND SERIAL READ)')
      CALL DPWRST('XXX','BUG ')
      IF(IFROW2.NE.IDEFR2)WRITE(ICOUT,1386)IFROW2
 1386 FORMAT('HAS JUST BEEN SET TO ',I8)
      IF(IFROW2.NE.IDEFR2)CALL DPWRST('XXX','BUG ')
      IF(IFROW2.EQ.IDEFR2)WRITE(ICOUT,1387)
 1387 FORMAT('HAS JUST BEEN SET TO ','INFINITY')
      IF(IFROW2.EQ.IDEFR2)CALL DPWRST('XXX','BUG ')
 1389 CONTINUE
      GOTO1900
C
 1390 CONTINUE
C
 1900 CONTINUE
      RETURN
      END
      SUBROUTINE DPRPCO(IHARG,NUMARG,IDERPC,MAXREG,IREPCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION PATTERN COLORS = THE COLORS
C              OF THE LINES MAKING UP A PATTERN WITHIN A REGION.
C              THESE ARE LOCATED IN THE VECTOR IREPCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERPC
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREPCO (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--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDERPC
      CHARACTER*4 IREPCO
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 IREPCO(*)
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='DPRP'
      ISUBN2='CO  '
C
      NUMREG=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 DPRPCO--')
      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)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',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)IDERPC
   55 FORMAT('IDERPC = ',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)IREPCO(1)
   70 FORMAT('IREPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREPCO(I)
   76 FORMAT('I,IREPCO(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.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE      SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREPCO(1)=IDERPC
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDERPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDERPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERPC
      IREPCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREPCO(I)
 1276 FORMAT('THE COLOR OF REGION PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDERPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDERPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERPC
      DO1315I=1,NUMREG
      IREPCO(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)IREPCO(I)
 1316 FORMAT('THE COLOR OF ALL REGION PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      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 DPRPCO--')
      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)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',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)IDERPC
 9015 FORMAT('IDERPC = ',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)IREPCO(1)
 9030 FORMAT('IREPCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREPCO(I)
 9036 FORMAT('I,IREPCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRPLI(IHARG,IHARG2,NUMARG,IDERPL,MAXREG,IREPLI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPRPLI(IHARG,NUMARG,IDERPL,MAXREG,IREPLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN LINES = THE LINES TYPES
C              OF THE PATTERN WITHIN THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR IREPLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERPL
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREPLI (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--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDERPL
      CHARACTER*4 IREPLI
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(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IREPLI(*)
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='DPRP'
      ISUBN2='LI  '
C
      NUMREG=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 DPRPLI--')
      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)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',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)IDERPL
   55 FORMAT('IDERPL = ',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)IREPLI(1)
   70 FORMAT('IREPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREPLI(I)
   76 FORMAT('I,IREPLI(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.2)GOTO9000
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      IF(NUMARG.EQ.5)GOTO1150
      GOTO1160
C
 1130 CONTINUE
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(5).EQ.'ALL')IHOLD1='    '
      IF(IHARG(5).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(5).EQ.'ALL')THEN
        IHOLD1=IHARG(6)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(6).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(6).EQ.'ALL')THEN
        IHOLD1=IHARG(5)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(5).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      GOTO1200
C
 1160 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREPLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-3
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+3
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERPL
      IREPLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREPLI(I)
 1276 FORMAT('THE LINE TYPE FOR REGION PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERPL
      DO1315I=1,NUMREG
      IREPLI(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)IREPLI(I)
 1316 FORMAT('THE LINE TYPE FOR ALL REGION PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      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 DPRPLI--')
      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)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',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)IDERPL
 9015 FORMAT('IDERPL = ',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)IREPLI(1)
 9030 FORMAT('IREPLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREPLI(I)
 9036 FORMAT('I,IREPLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRPSP(IHARG,IARGT,ARG,NUMARG,PDERPS,MAXREG,PREPSP,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION PATTERN SPACINGS = THE SPACINGS
C              BETWEEN THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR PREPSP(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDERPS
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PREPSP (A FLOATING POINT 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--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PREPSP(*)
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='DPRP'
      ISUBN2='SP  '
C
      NUMREG=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
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 DPRPSP--')
      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)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDERPS
   55 FORMAT('PDERPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PREPSP(1)
   70 FORMAT('PREPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PREPSP(I)
   76 FORMAT('I,PREPSP(I) = ',I8,2X,E15.7)
      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.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDERPS
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      PREPSP(1)=PDERPS
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDERPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDERPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDERPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDERPS
      PREPSP(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,PREPSP(I)
 1276 FORMAT('THE SPACING BETWEEN (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDERPS
      IF(IHOLD1.EQ.'OFF')HOLD2=PDERPS
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDERPS
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDERPS
      DO1315I=1,NUMREG
      PREPSP(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PREPSP(I)
 1316 FORMAT('THE SPACING BETWEEN (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      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 DPRPSP--')
      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)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDERPS
 9015 FORMAT('PDERPS = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PREPSP(1)
 9030 FORMAT('PREPSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PREPSP(I)
 9036 FORMAT('I,PREPSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRPTH(IHARG,IARGT,ARG,NUMARG,PDERPT,MAXREG,PREPTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE REGION PATTERN THICKNESSES = THE THICKNESSES
C              OF THE LINES WHICH MAKE UP THE PATTERNS WITHIN THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR PREPTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDERPT
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PREPTH (A FLOATING POINT 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--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION PREPTH(*)
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='DPRP'
      ISUBN2='TH  '
C
      NUMREG=0
      IHOLD1='-999'
      HOLD1=-999.0
      HOLD2=-999.0
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 DPRPTH--')
      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)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOLD1,HOLD1,HOLD2
   54 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PDERPT
   55 FORMAT('PDERPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)NUMARG
   60 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO65I=1,NUMARG
      WRITE(ICOUT,66)IHARG(I),IARGT(I),ARG(I)
   66 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
      WRITE(ICOUT,70)PREPTH(1)
   70 FORMAT('PREPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PREPTH(I)
   76 FORMAT('I,PREPTH(I) = ',I8,2X,E15.7)
      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.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')HOLD1=PDERPT
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      PREPTH(1)=PDERPT
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDERPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDERPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDERPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDERPT
      PREPTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,PREPTH(I)
 1276 FORMAT('THE THICKNESS OF (LINES WITHIN) PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDERPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDERPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDERPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDERPT
      DO1315I=1,NUMREG
      PREPTH(I)=HOLD2
 1315 CONTINUE
      GOTO1370
C
 1370 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1319
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1316)PREPTH(I)
 1316 FORMAT('THE THICKNESS OF (LINES WITHIN) ALL PATTERNS',
     1' HAS JUST BEEN SET TO ',E15.7)
      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 DPRPTH--')
      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)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOLD1,HOLD1,HOLD2
 9014 FORMAT('IHOLD1,HOLD1,HOLD2 = ',A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PDERPT
 9015 FORMAT('PDERPT = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)NUMARG
 9020 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,NUMARG
      WRITE(ICOUT,9026)IHARG(I),IARGT(I),ARG(I)
 9026 FORMAT('IHARG(I),IARGT(I),ARG(I) = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
      WRITE(ICOUT,9030)PREPTH(1)
 9030 FORMAT('PREPTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PREPTH(I)
 9036 FORMAT('I,PREPTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPRPTY(IHARG,NUMARG,IDERPT,MAXREG,IREPTY,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN TYPES = THE TYPES
C              OF THE PATTERN WITHIN THE REGIONS.
C              THESE ARE LOCATED IN THE VECTOR IREPTY(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDERPT
C                     --MAXREG
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IREPTY (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--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDERPT
      CHARACTER*4 IREPTY
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 IREPTY(*)
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='DPRP'
      ISUBN2='TY  '
C
      NUMREG=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 DPRPTY--')
      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)MAXREG,NUMREG
   53 FORMAT('MAXREG,NUMREG = ',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)IDERPT
   55 FORMAT('IDERPT = ',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)IREPTY(1)
   70 FORMAT('IREPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IREPTY(I)
   76 FORMAT('I,IREPTY(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.1)GOTO9000
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      IF(NUMARG.EQ.4)GOTO1140
      GOTO1150
C
 1120 CONTINUE
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1='    '
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(4)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      IF(IHARG(4).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(4).EQ.'ALL')GOTO1300
      GOTO1200
C
 1150 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE SINGLE     SPECIFICATION  CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMREG=1
      IREPTY(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMREG=NUMARG-2
      IF(NUMREG.GT.MAXREG)NUMREG=MAXREG
      DO1225I=1,NUMREG
      J=I+2
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERPT
      IREPTY(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMREG
      WRITE(ICOUT,1276)I,IREPTY(I)
 1276 FORMAT('THE TYPE FOR REGION PATTERN ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMREG=MAXREG
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDERPT
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDERPT
      DO1315I=1,NUMREG
      IREPTY(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)IREPTY(I)
 1316 FORMAT('THE TYPE FOR ALL REGION PATTERNS',
     1' HAS JUST BEEN SET TO ',A4)
      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 DPRPTY--')
      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)MAXREG,NUMREG
 9013 FORMAT('MAXREG,NUMREG = ',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)IDERPT
 9015 FORMAT('IDERPT = ',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)IREPTY(1)
 9030 FORMAT('IREPTY(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IREPTY(I)
 9036 FORMAT('I,IREPTY(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPROLA(ITYPEH,IW21HO,IW22HO,W2HOLD,NWHOLD,
     1IA,PARAM,IPARN,IPARN2,
     1IWRITE,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--THIS SUBROUTINE READS THE CHARCTER DATA STORED IN
C              FILE "DPZCHF.DAT" AND STORES IT IN THE ROW LABEL.
C              EXAMPLE:
C                 LET ROWLABEL = IX
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THE MAXIMUM NUMBER OF ROWS FOR A GROUP LABEL IS
C                   MAXOBV/100.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--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 TECHNOOGY.
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--2004/1
C     ORIGINAL VERSION--JANUARY   2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ICASEL
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
C
      CHARACTER*4 ITYPEH
      CHARACTER*4 IW21HO
      CHARACTER*4 IW22HO
      CHARACTER*4 IA
      CHARACTER*4 IPARN
      CHARACTER*4 IPARN2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
C
      DIMENSION ITYPEH(*)
      DIMENSION IW21HO(*)
      DIMENSION IW22HO(*)
      DIMENSION W2HOLD(*)
C
      DIMENSION IA(*)
      DIMENSION PARAM(*)
      DIMENSION IPARN(*)
      DIMENSION IPARN2(*)
C
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOF2.INC'
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*500 IATEMP
      CHARACTER*6 IFRMT
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='DPRO'
      ISUBN2='LA  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ROLA')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DPROLA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C
C               ********************************************
C               **  STEP 2--                              **
C               **  OPEN THE DPZCHF.DAT FILE.             **
C               ********************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ROLA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHRIGH=IHARG(3)
      IHRIG2=IHARG2(3)
C
      IOUNIT=IZCHNU
      IFILE=IZCHNA
      ISTAT=IZCHST
      IFORM=IZCHFO
      IACCES=IZCHAC
      IPROT=IZCHPR
      ICURST=IZCHCS
C
      ISUBN0='READ'
      IERRFI='NO'
      CALL DPOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,
     1            ICURST,
     1            IREWIN,ISUBN0,IERRFI,IBUGA3,ISUBRO,IERROR)
      IF(IERRFI.EQ.'YES')THEN
        IERROR='YES'
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,111)
  111   FORMAT('***** ERROR IN DPROLA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,118)
  118   FORMAT('      UNABLE TO OPEN THE FILE CHARACTER DATA FILE:')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,119)IFILE
  119   FORMAT('      ',A80)
        CALL DPWRST('XXX','BUG ')
        GOTO8000
      ENDIF
C
      READ(IOUNIT,'(I8)',END=171,ERR=171)NUMVAR
C
      DO130I=1,NUMVAR
        READ(IOUNIT,'(A4,A4)',END=181,ERR=181)IH,IH2
        IF(IHRIGH.EQ.IH .AND. IHRIG2.EQ.IH2)THEN
          IVAR=I
          GOTO199
        ENDIF
  130 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)IHRIGH,IHRIG2
  131 FORMAT('***** VARIABLE ',A4,A4,' NOT FOUND IN THE CHARACTER ',
     1       'DATA FILE:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,119)IFILE
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8000
C
  171 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,173)
  173 FORMAT('      ERROR READING THE NUMBER OF CHARACTER VARIABLES ',
     1       'IN THE CHARACTER DATA FILE:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,119)IFILE
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8000
C
  181 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,183)
  183 FORMAT('      ERROR READING THE VARIABLE NAMES ',
     1       'IN THE CHARACTER DATA FILE:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,119)IFILE
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8000
C
  199 CONTINUE
C
C               *************************************************
C               **  STEP 3--                                   **
C               **  DEFINE THE ROW    LABELS.                  **
C               **  STORE UNIQUE VALUES IN IROWLB.             **
C               *************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ROLA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO205I=1,MAXOBV
        IROWLB(I)=' '
  205 CONTINUE
C
      IFRMT='(A   )'
      WRITE(IFRMT(3:5),'(I3)')25*IVAR
      IFRST=(IVAR-1)*25 + 1
      ILAST=IVAR*25 - 1
C
      DO210I=1,MAXOBV
        IROW=I
        IATEMP=' '
        READ(IOUNIT,IFRMT,END=499,ERR=491)IATEMP
        IROWLB(I)=IATEMP(IFRST:ILAST)
  210 CONTINUE
      GOTO499
C
  491 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,493)IROW
  493 FORMAT('      ERROR READING ROW ',I8,' OF THE CHARACTER ',
     1       'VARIABLES IN THE CHARACTER DATA FILE:')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,119)IFILE
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO8000
C
C
C               ******************************
C               **  STEP 3--                **
C               **  WRITE OUT A FEW LINES   **
C               **  OF SUMMARY INFORMATION  **
C               **  ABOUT THE CODING.       **
C               ******************************
C
  499 CONTINUE
C
      IF(IFEEDB.EQ.'ON' .AND. IWRITE.EQ.'ON')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,811)IROW
  811   FORMAT('NUMBER OF ROW LABELS READ = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,813)IROWLB(1)(1:24)
  813   FORMAT('FIRST ROW LABEL                      = ',A24)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,815)IROW,IROWLB(1)(1:24)
  815   FORMAT('LAST ROW LABEL (',I8,')   = ',A24)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************************
C               **  STEP 88--                        **
C               **  CLOSE THE DPZCHF.DAT FILE.       **
C               ***************************************
C
 8000 CONTINUE
C
      IENDFI='OFF'
      IREWIN='ON'
      CALL DPCLFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IPROT,ICURST,
     1            IENDFI,IREWIN,ISUBN0,IERRFI,IBUGA3,ISUBRO,IERROR)
      IZCHCS='CLOSED'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ROLA')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END OF DPROLA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IBUGA3,IERROR
 9012   FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)IROW
 9013   FORMAT('IROW = ',I8)
        CALL DPWRST('XXX','BUG ')
        IF(IROW.GT.0)THEN
          DO9015I=1,MIN(IROW,20)
            WRITE(ICOUT,9016)I,IROWLB(I)
 9016       FORMAT('I,IROWLB(I) = ',I8,A24)
            CALL DPWRST('XXX','BUG ')
 9015     CONTINUE
        ENDIF
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPRSL(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 SIMPLEX 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-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--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
      CHARACTER*4 IOPERA
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IOPERA(300)
      DIMENSION IX(300)
      DIMENSION IY(300)
C
      DIMENSION IXMIND(30)
      DIMENSION IXMAXD(30)
      DIMENSION IXDELD(30)
      DIMENSION ISTARD(30)
      DIMENSION NUMCOO(30)
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
C     DEFINE CHARACTER    601--LOWER CASE A
C
      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   6,   5/
      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',   6,  -9/
      DATA IOPERA(   3),IX(   3),IY(   3)/'MOVE',   6,   2/
      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   4,   4/
      DATA IOPERA(   5),IX(   5),IY(   5)/'DRAW',   2,   5/
      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',  -1,   5/
      DATA IOPERA(   7),IX(   7),IY(   7)/'DRAW',  -3,   4/
      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',  -5,   2/
      DATA IOPERA(   9),IX(   9),IY(   9)/'DRAW',  -6,  -1/
      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',  -6,  -3/
      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',  -5,  -6/
      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',  -3,  -8/
      DATA IOPERA(  13),IX(  13),IY(  13)/'DRAW',  -1,  -9/
      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',   2,  -9/
      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',   4,  -8/
      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',   6,  -6/
C
      DATA IXMIND(   1)/  -9/
      DATA IXMAXD(   1)/  10/
      DATA IXDELD(   1)/  19/
      DATA ISTARD(   1)/   1/
      DATA NUMCOO(   1)/  16/
C
C     DEFINE CHARACTER    602--LOWER CASE B
C
      DATA IOPERA(  17),IX(  17),IY(  17)/'MOVE',  -6,  12/
      DATA IOPERA(  18),IX(  18),IY(  18)/'DRAW',  -6,  -9/
      DATA IOPERA(  19),IX(  19),IY(  19)/'MOVE',  -6,   2/
      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',  -4,   4/
      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',  -2,   5/
      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   1,   5/
      DATA IOPERA(  23),IX(  23),IY(  23)/'DRAW',   3,   4/
      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',   5,   2/
      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',   6,  -1/
      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',   6,  -3/
      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',   5,  -6/
      DATA IOPERA(  28),IX(  28),IY(  28)/'DRAW',   3,  -8/
      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',   1,  -9/
      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',  -2,  -9/
      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',  -4,  -8/
      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',  -6,  -6/
C
      DATA IXMIND(   2)/ -10/
      DATA IXMAXD(   2)/   9/
      DATA IXDELD(   2)/  19/
      DATA ISTARD(   2)/  17/
      DATA NUMCOO(   2)/  16/
C
C     DEFINE CHARACTER    603--LOWER CASE C
C
      DATA IOPERA(  33),IX(  33),IY(  33)/'MOVE',   6,   2/
      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',   4,   4/
      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',   2,   5/
      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',  -1,   5/
      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',  -3,   4/
      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',  -5,   2/
      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',  -6,  -1/
      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',  -6,  -3/
      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',  -5,  -6/
      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',  -3,  -8/
      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',  -1,  -9/
      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   2,  -9/
      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   4,  -8/
      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   6,  -6/
C
      DATA IXMIND(   3)/  -9/
      DATA IXMAXD(   3)/   9/
      DATA IXDELD(   3)/  18/
      DATA ISTARD(   3)/  33/
      DATA NUMCOO(   3)/  14/
C
C     DEFINE CHARACTER    604--LOWER CASE D
C
      DATA IOPERA(  47),IX(  47),IY(  47)/'MOVE',   6,  12/
      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',   6,  -9/
      DATA IOPERA(  49),IX(  49),IY(  49)/'MOVE',   6,   2/
      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',   4,   4/
      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',   2,   5/
      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',  -1,   5/
      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',  -3,   4/
      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',  -5,   2/
      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',  -6,  -1/
      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',  -6,  -3/
      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',  -5,  -6/
      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',  -3,  -8/
      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',  -1,  -9/
      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',   2,  -9/
      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',   4,  -8/
      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',   6,  -6/
C
      DATA IXMIND(   4)/  -9/
      DATA IXMAXD(   4)/  10/
      DATA IXDELD(   4)/  19/
      DATA ISTARD(   4)/  47/
      DATA NUMCOO(   4)/  16/
C
C     DEFINE CHARACTER    605--LOWER CASE E
C
      DATA IOPERA(  63),IX(  63),IY(  63)/'MOVE',  -6,  -1/
      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',   6,  -1/
      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',   6,   1/
      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',   5,   3/
      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',   4,   4/
      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   2,   5/
      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',  -1,   5/
      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',  -3,   4/
      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',  -5,   2/
      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',  -6,  -1/
      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',  -6,  -3/
      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',  -5,  -6/
      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',  -3,  -8/
      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW',  -1,  -9/
      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',   2,  -9/
      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',   4,  -8/
      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',   6,  -6/
C
      DATA IXMIND(   5)/  -9/
      DATA IXMAXD(   5)/   9/
      DATA IXDELD(   5)/  18/
      DATA ISTARD(   5)/  63/
      DATA NUMCOO(   5)/  17/
C
C     DEFINE CHARACTER    606--LOWER CASE F
C
      DATA IOPERA(  80),IX(  80),IY(  80)/'MOVE',   5,  12/
      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',   3,  12/
      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',   1,  11/
      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',   0,   8/
      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',   0,  -9/
      DATA IOPERA(  85),IX(  85),IY(  85)/'MOVE',  -3,   5/
      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',   4,   5/
C
      DATA IXMIND(   6)/  -5/
      DATA IXMAXD(   6)/   7/
      DATA IXDELD(   6)/  12/
      DATA ISTARD(   6)/  80/
      DATA NUMCOO(   6)/   7/
C
C     DEFINE CHARACTER    607--LOWER CASE G
C
      DATA IOPERA(  87),IX(  87),IY(  87)/'MOVE',   6,   5/
      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   6, -11/
      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',   5, -14/
      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',   4, -15/
      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',   2, -16/
      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',  -1, -16/
      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',  -3, -15/
      DATA IOPERA(  94),IX(  94),IY(  94)/'MOVE',   6,   2/
      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',   4,   4/
      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',   2,   5/
      DATA IOPERA(  97),IX(  97),IY(  97)/'DRAW',  -1,   5/
      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',  -3,   4/
      DATA IOPERA(  99),IX(  99),IY(  99)/'DRAW',  -5,   2/
      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',  -6,  -1/
      DATA IOPERA( 101),IX( 101),IY( 101)/'DRAW',  -6,  -3/
      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',  -5,  -6/
      DATA IOPERA( 103),IX( 103),IY( 103)/'DRAW',  -3,  -8/
      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',  -1,  -9/
      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',   2,  -9/
      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',   4,  -8/
      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',   6,  -6/
C
      DATA IXMIND(   7)/  -9/
      DATA IXMAXD(   7)/  10/
      DATA IXDELD(   7)/  19/
      DATA ISTARD(   7)/  87/
      DATA NUMCOO(   7)/  21/
C
C     DEFINE CHARACTER    608--LOWER CASE H
C
      DATA IOPERA( 108),IX( 108),IY( 108)/'MOVE',  -5,  12/
      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',  -5,  -9/
      DATA IOPERA( 110),IX( 110),IY( 110)/'MOVE',  -5,   1/
      DATA IOPERA( 111),IX( 111),IY( 111)/'DRAW',  -2,   4/
      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',   0,   5/
      DATA IOPERA( 113),IX( 113),IY( 113)/'DRAW',   3,   5/
      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',   5,   4/
      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',   6,   1/
      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',   6,  -9/
C
      DATA IXMIND(   8)/  -9/
      DATA IXMAXD(   8)/  10/
      DATA IXDELD(   8)/  19/
      DATA ISTARD(   8)/ 108/
      DATA NUMCOO(   8)/   9/
C
C     DEFINE CHARACTER    609--LOWER CASE I
C
      DATA IOPERA( 117),IX( 117),IY( 117)/'MOVE',  -1,  12/
      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',   0,  11/
      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',   1,  12/
      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',   0,  13/
      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',  -1,  12/
      DATA IOPERA( 122),IX( 122),IY( 122)/'MOVE',   0,   5/
      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',   0,  -9/
C
      DATA IXMIND(   9)/  -4/
      DATA IXMAXD(   9)/   4/
      DATA IXDELD(   9)/   8/
      DATA ISTARD(   9)/ 117/
      DATA NUMCOO(   9)/   7/
C
C     DEFINE CHARACTER    610--LOWER CASE J
C
      DATA IOPERA( 124),IX( 124),IY( 124)/'MOVE',   0,  12/
      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',   1,  11/
      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',   2,  12/
      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',   1,  13/
      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',   0,  12/
      DATA IOPERA( 129),IX( 129),IY( 129)/'MOVE',   1,   5/
      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   1, -12/
      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   0, -15/
      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',  -2, -16/
      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',  -4, -16/
C
      DATA IXMIND(  10)/  -5/
      DATA IXMAXD(  10)/   5/
      DATA IXDELD(  10)/  10/
      DATA ISTARD(  10)/ 124/
      DATA NUMCOO(  10)/  10/
C
C     DEFINE CHARACTER    611--LOWER CASE K
C
      DATA IOPERA( 134),IX( 134),IY( 134)/'MOVE',  -5,  12/
      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',  -5,  -9/
      DATA IOPERA( 136),IX( 136),IY( 136)/'MOVE',   5,   5/
      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',  -5,  -5/
      DATA IOPERA( 138),IX( 138),IY( 138)/'MOVE',  -1,  -1/
      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   6,  -9/
C
      DATA IXMIND(  11)/  -9/
      DATA IXMAXD(  11)/   8/
      DATA IXDELD(  11)/  17/
      DATA ISTARD(  11)/ 134/
      DATA NUMCOO(  11)/   6/
C
C     DEFINE CHARACTER    612--LOWER CASE L
C
      DATA IOPERA( 140),IX( 140),IY( 140)/'MOVE',   0,  12/
      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',   0,  -9/
C
      DATA IXMIND(  12)/  -4/
      DATA IXMAXD(  12)/   4/
      DATA IXDELD(  12)/   8/
      DATA ISTARD(  12)/ 140/
      DATA NUMCOO(  12)/   2/
C
C     DEFINE CHARACTER    613--LOWER CASE M
C
      DATA IOPERA( 142),IX( 142),IY( 142)/'MOVE', -11,   5/
      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW', -11,  -9/
      DATA IOPERA( 144),IX( 144),IY( 144)/'MOVE', -11,   1/
      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',  -8,   4/
      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',  -6,   5/
      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',  -3,   5/
      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',  -1,   4/
      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   0,   1/
      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   0,  -9/
      DATA IOPERA( 151),IX( 151),IY( 151)/'MOVE',   0,   1/
      DATA IOPERA( 152),IX( 152),IY( 152)/'DRAW',   3,   4/
      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',   5,   5/
      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',   8,   5/
      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',  10,   4/
      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',  11,   1/
      DATA IOPERA( 157),IX( 157),IY( 157)/'DRAW',  11,  -9/
C
      DATA IXMIND(  13)/ -15/
      DATA IXMAXD(  13)/  15/
      DATA IXDELD(  13)/  30/
      DATA ISTARD(  13)/ 142/
      DATA NUMCOO(  13)/  16/
C
C     DEFINE CHARACTER    614--LOWER CASE N
C
      DATA IOPERA( 158),IX( 158),IY( 158)/'MOVE',  -5,   5/
      DATA IOPERA( 159),IX( 159),IY( 159)/'DRAW',  -5,  -9/
      DATA IOPERA( 160),IX( 160),IY( 160)/'MOVE',  -5,   1/
      DATA IOPERA( 161),IX( 161),IY( 161)/'DRAW',  -2,   4/
      DATA IOPERA( 162),IX( 162),IY( 162)/'DRAW',   0,   5/
      DATA IOPERA( 163),IX( 163),IY( 163)/'DRAW',   3,   5/
      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',   5,   4/
      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',   6,   1/
      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',   6,  -9/
C
      DATA IXMIND(  14)/  -9/
      DATA IXMAXD(  14)/  10/
      DATA IXDELD(  14)/  19/
      DATA ISTARD(  14)/ 158/
      DATA NUMCOO(  14)/   9/
C
C     DEFINE CHARACTER    615--LOWER CASE O
C
      DATA IOPERA( 167),IX( 167),IY( 167)/'MOVE',  -1,   5/
      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',  -3,   4/
      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',  -5,   2/
      DATA IOPERA( 170),IX( 170),IY( 170)/'DRAW',  -6,  -1/
      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',  -6,  -3/
      DATA IOPERA( 172),IX( 172),IY( 172)/'DRAW',  -5,  -6/
      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',  -3,  -8/
      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',  -1,  -9/
      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',   2,  -9/
      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',   4,  -8/
      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',   6,  -6/
      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',   7,  -3/
      DATA IOPERA( 179),IX( 179),IY( 179)/'DRAW',   7,  -1/
      DATA IOPERA( 180),IX( 180),IY( 180)/'DRAW',   6,   2/
      DATA IOPERA( 181),IX( 181),IY( 181)/'DRAW',   4,   4/
      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',   2,   5/
      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',  -1,   5/
C
      DATA IXMIND(  15)/  -9/
      DATA IXMAXD(  15)/  10/
      DATA IXDELD(  15)/  19/
      DATA ISTARD(  15)/ 167/
      DATA NUMCOO(  15)/  17/
C
C     DEFINE CHARACTER    616--LOWER CASE P
C
      DATA IOPERA( 184),IX( 184),IY( 184)/'MOVE',  -6,   5/
      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',  -6, -16/
      DATA IOPERA( 186),IX( 186),IY( 186)/'MOVE',  -6,   2/
      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',  -4,   4/
      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',  -2,   5/
      DATA IOPERA( 189),IX( 189),IY( 189)/'DRAW',   1,   5/
      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',   3,   4/
      DATA IOPERA( 191),IX( 191),IY( 191)/'DRAW',   5,   2/
      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',   6,  -1/
      DATA IOPERA( 193),IX( 193),IY( 193)/'DRAW',   6,  -3/
      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',   5,  -6/
      DATA IOPERA( 195),IX( 195),IY( 195)/'DRAW',   3,  -8/
      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',   1,  -9/
      DATA IOPERA( 197),IX( 197),IY( 197)/'DRAW',  -2,  -9/
      DATA IOPERA( 198),IX( 198),IY( 198)/'DRAW',  -4,  -8/
      DATA IOPERA( 199),IX( 199),IY( 199)/'DRAW',  -6,  -6/
C
      DATA IXMIND(  16)/ -10/
      DATA IXMAXD(  16)/   9/
      DATA IXDELD(  16)/  19/
      DATA ISTARD(  16)/ 184/
      DATA NUMCOO(  16)/  16/
C
C     DEFINE CHARACTER    617--LOWER CASE Q
C
      DATA IOPERA( 200),IX( 200),IY( 200)/'MOVE',   6,   5/
      DATA IOPERA( 201),IX( 201),IY( 201)/'DRAW',   6, -16/
      DATA IOPERA( 202),IX( 202),IY( 202)/'MOVE',   6,   2/
      DATA IOPERA( 203),IX( 203),IY( 203)/'DRAW',   4,   4/
      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',   2,   5/
      DATA IOPERA( 205),IX( 205),IY( 205)/'DRAW',  -1,   5/
      DATA IOPERA( 206),IX( 206),IY( 206)/'DRAW',  -3,   4/
      DATA IOPERA( 207),IX( 207),IY( 207)/'DRAW',  -5,   2/
      DATA IOPERA( 208),IX( 208),IY( 208)/'DRAW',  -6,  -1/
      DATA IOPERA( 209),IX( 209),IY( 209)/'DRAW',  -6,  -3/
      DATA IOPERA( 210),IX( 210),IY( 210)/'DRAW',  -5,  -6/
      DATA IOPERA( 211),IX( 211),IY( 211)/'DRAW',  -3,  -8/
      DATA IOPERA( 212),IX( 212),IY( 212)/'DRAW',  -1,  -9/
      DATA IOPERA( 213),IX( 213),IY( 213)/'DRAW',   2,  -9/
      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',   4,  -8/
      DATA IOPERA( 215),IX( 215),IY( 215)/'DRAW',   6,  -6/
C
      DATA IXMIND(  17)/  -9/
      DATA IXMAXD(  17)/  10/
      DATA IXDELD(  17)/  19/
      DATA ISTARD(  17)/ 200/
      DATA NUMCOO(  17)/  16/
C
C     DEFINE CHARACTER    618--LOWER CASE R
C
      DATA IOPERA( 216),IX( 216),IY( 216)/'MOVE',  -3,   5/
      DATA IOPERA( 217),IX( 217),IY( 217)/'DRAW',  -3,  -9/
      DATA IOPERA( 218),IX( 218),IY( 218)/'MOVE',  -3,  -1/
      DATA IOPERA( 219),IX( 219),IY( 219)/'DRAW',  -2,   2/
      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',   0,   4/
      DATA IOPERA( 221),IX( 221),IY( 221)/'DRAW',   2,   5/
      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',   5,   5/
C
      DATA IXMIND(  18)/  -7/
      DATA IXMAXD(  18)/   6/
      DATA IXDELD(  18)/  13/
      DATA ISTARD(  18)/ 216/
      DATA NUMCOO(  18)/   7/
C
C     DEFINE CHARACTER    619--LOWER CASE S
C
      DATA IOPERA( 223),IX( 223),IY( 223)/'MOVE',   6,   2/
      DATA IOPERA( 224),IX( 224),IY( 224)/'DRAW',   5,   4/
      DATA IOPERA( 225),IX( 225),IY( 225)/'DRAW',   2,   5/
      DATA IOPERA( 226),IX( 226),IY( 226)/'DRAW',  -1,   5/
      DATA IOPERA( 227),IX( 227),IY( 227)/'DRAW',  -4,   4/
      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',  -5,   2/
      DATA IOPERA( 229),IX( 229),IY( 229)/'DRAW',  -4,   0/
      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',  -2,  -1/
      DATA IOPERA( 231),IX( 231),IY( 231)/'DRAW',   3,  -2/
      DATA IOPERA( 232),IX( 232),IY( 232)/'DRAW',   5,  -3/
      DATA IOPERA( 233),IX( 233),IY( 233)/'DRAW',   6,  -5/
      DATA IOPERA( 234),IX( 234),IY( 234)/'DRAW',   6,  -6/
      DATA IOPERA( 235),IX( 235),IY( 235)/'DRAW',   5,  -8/
      DATA IOPERA( 236),IX( 236),IY( 236)/'DRAW',   2,  -9/
      DATA IOPERA( 237),IX( 237),IY( 237)/'DRAW',  -1,  -9/
      DATA IOPERA( 238),IX( 238),IY( 238)/'DRAW',  -4,  -8/
      DATA IOPERA( 239),IX( 239),IY( 239)/'DRAW',  -5,  -6/
C
      DATA IXMIND(  19)/  -8/
      DATA IXMAXD(  19)/   9/
      DATA IXDELD(  19)/  17/
      DATA ISTARD(  19)/ 223/
      DATA NUMCOO(  19)/  17/
C
C     DEFINE CHARACTER    620--LOWER CASE T
C
      DATA IOPERA( 240),IX( 240),IY( 240)/'MOVE',   0,  12/
      DATA IOPERA( 241),IX( 241),IY( 241)/'DRAW',   0,  -5/
      DATA IOPERA( 242),IX( 242),IY( 242)/'DRAW',   1,  -8/
      DATA IOPERA( 243),IX( 243),IY( 243)/'DRAW',   3,  -9/
      DATA IOPERA( 244),IX( 244),IY( 244)/'DRAW',   5,  -9/
      DATA IOPERA( 245),IX( 245),IY( 245)/'MOVE',  -3,   5/
      DATA IOPERA( 246),IX( 246),IY( 246)/'DRAW',   4,   5/
C
      DATA IXMIND(  20)/  -5/
      DATA IXMAXD(  20)/   7/
      DATA IXDELD(  20)/  12/
      DATA ISTARD(  20)/ 240/
      DATA NUMCOO(  20)/   7/
C
C     DEFINE CHARACTER    621--LOWER CASE U
C
      DATA IOPERA( 247),IX( 247),IY( 247)/'MOVE',  -5,   5/
      DATA IOPERA( 248),IX( 248),IY( 248)/'DRAW',  -5,  -5/
      DATA IOPERA( 249),IX( 249),IY( 249)/'DRAW',  -4,  -8/
      DATA IOPERA( 250),IX( 250),IY( 250)/'DRAW',  -2,  -9/
      DATA IOPERA( 251),IX( 251),IY( 251)/'DRAW',   1,  -9/
      DATA IOPERA( 252),IX( 252),IY( 252)/'DRAW',   3,  -8/
      DATA IOPERA( 253),IX( 253),IY( 253)/'DRAW',   6,  -5/
      DATA IOPERA( 254),IX( 254),IY( 254)/'MOVE',   6,   5/
      DATA IOPERA( 255),IX( 255),IY( 255)/'DRAW',   6,  -9/
C
      DATA IXMIND(  21)/  -9/
      DATA IXMAXD(  21)/  10/
      DATA IXDELD(  21)/  19/
      DATA ISTARD(  21)/ 247/
      DATA NUMCOO(  21)/   9/
C
C     DEFINE CHARACTER    622--LOWER CASE V
C
      DATA IOPERA( 256),IX( 256),IY( 256)/'MOVE',  -6,   5/
      DATA IOPERA( 257),IX( 257),IY( 257)/'DRAW',   0,  -9/
      DATA IOPERA( 258),IX( 258),IY( 258)/'MOVE',   6,   5/
      DATA IOPERA( 259),IX( 259),IY( 259)/'DRAW',   0,  -9/
C
      DATA IXMIND(  22)/  -8/
      DATA IXMAXD(  22)/   8/
      DATA IXDELD(  22)/  16/
      DATA ISTARD(  22)/ 256/
      DATA NUMCOO(  22)/   4/
C
C     DEFINE CHARACTER    623--LOWER CASE W
C
      DATA IOPERA( 260),IX( 260),IY( 260)/'MOVE',  -8,   5/
      DATA IOPERA( 261),IX( 261),IY( 261)/'DRAW',  -4,  -9/
      DATA IOPERA( 262),IX( 262),IY( 262)/'MOVE',   0,   5/
      DATA IOPERA( 263),IX( 263),IY( 263)/'DRAW',  -4,  -9/
      DATA IOPERA( 264),IX( 264),IY( 264)/'MOVE',   0,   5/
      DATA IOPERA( 265),IX( 265),IY( 265)/'DRAW',   4,  -9/
      DATA IOPERA( 266),IX( 266),IY( 266)/'MOVE',   8,   5/
      DATA IOPERA( 267),IX( 267),IY( 267)/'DRAW',   4,  -9/
C
      DATA IXMIND(  23)/ -11/
      DATA IXMAXD(  23)/  11/
      DATA IXDELD(  23)/  22/
      DATA ISTARD(  23)/ 260/
      DATA NUMCOO(  23)/   8/
C
C     DEFINE CHARACTER    624--LOWER CASE X
C
      DATA IOPERA( 268),IX( 268),IY( 268)/'MOVE',  -5,   5/
      DATA IOPERA( 269),IX( 269),IY( 269)/'DRAW',   6,  -9/
      DATA IOPERA( 270),IX( 270),IY( 270)/'MOVE',   6,   5/
      DATA IOPERA( 271),IX( 271),IY( 271)/'DRAW',  -5,  -9/
C
      DATA IXMIND(  24)/  -8/
      DATA IXMAXD(  24)/   9/
      DATA IXDELD(  24)/  17/
      DATA ISTARD(  24)/ 268/
      DATA NUMCOO(  24)/   4/
C
C     DEFINE CHARACTER    625--LOWER CASE Y
C
      DATA IOPERA( 272),IX( 272),IY( 272)/'MOVE',  -6,   5/
      DATA IOPERA( 273),IX( 273),IY( 273)/'DRAW',   0,  -9/
      DATA IOPERA( 274),IX( 274),IY( 274)/'MOVE',   6,   5/
      DATA IOPERA( 275),IX( 275),IY( 275)/'DRAW',   0,  -9/
      DATA IOPERA( 276),IX( 276),IY( 276)/'DRAW',  -2, -13/
      DATA IOPERA( 277),IX( 277),IY( 277)/'DRAW',  -4, -15/
      DATA IOPERA( 278),IX( 278),IY( 278)/'DRAW',  -6, -16/
      DATA IOPERA( 279),IX( 279),IY( 279)/'DRAW',  -7, -16/
C
      DATA IXMIND(  25)/  -8/
      DATA IXMAXD(  25)/   8/
      DATA IXDELD(  25)/  16/
      DATA ISTARD(  25)/ 272/
      DATA NUMCOO(  25)/   8/
C
C     DEFINE CHARACTER    626--LOWER CASE Z
C
      DATA IOPERA( 280),IX( 280),IY( 280)/'MOVE',   6,   5/
      DATA IOPERA( 281),IX( 281),IY( 281)/'DRAW',  -5,  -9/
      DATA IOPERA( 282),IX( 282),IY( 282)/'MOVE',  -5,   5/
      DATA IOPERA( 283),IX( 283),IY( 283)/'DRAW',   6,   5/
      DATA IOPERA( 284),IX( 284),IY( 284)/'MOVE',  -5,  -9/
      DATA IOPERA( 285),IX( 285),IY( 285)/'DRAW',   6,  -9/
C
      DATA IXMIND(  26)/  -8/
      DATA IXMAXD(  26)/   9/
      DATA IXDELD(  26)/  17/
      DATA ISTARD(  26)/ 280/
      DATA NUMCOO(  26)/   6/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
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 DPRSL--')
      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               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
      GOTO1000
C
C               **************************************
C               **************************************
C               **  STEP 2--                        **
C               **  EXTRACT THE COORDINATES         **
C               **  FOR THIS PARTICULAR CHARACTER.  **
C               **************************************
C               **************************************
C
 1000 CONTINUE
      ISTART=ISTARD(ICHARN)
      NC=NUMCOO(ICHARN)
      ISTOP=ISTART+NC-1
      J=0
      DO1100I=ISTART,ISTOP
      J=J+1
      IOP(J)=IOPERA(I)
      X(J)=IX(I)
      Y(J)=IY(I)
 1100 CONTINUE
      NUMCO=J
      IXMINS=IXMIND(ICHARN)
      IXMAXS=IXMAXD(ICHARN)
      IXDELS=IXDELD(ICHARN)
C
      GOTO9000
C
C               *****************
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
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 DPRSL--')
      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 DPRSN(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 SIMPLEX 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-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--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
      CHARACTER*4 IOPERA
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IOPERA(300)
      DIMENSION IX(300)
      DIMENSION IY(300)
C
      DIMENSION IXMIND(30)
      DIMENSION IXMAXD(30)
      DIMENSION IXDELD(30)
      DIMENSION ISTARD(30)
      DIMENSION NUMCOO(30)
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
C     DEFINE CHARACTER    700--0
C
      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',  -1,  12/
      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -4,  11/
      DATA IOPERA(   3),IX(   3),IY(   3)/'DRAW',  -6,   8/
      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',  -7,   3/
      DATA IOPERA(   5),IX(   5),IY(   5)/'DRAW',  -7,   0/
      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',  -6,  -5/
      DATA IOPERA(   7),IX(   7),IY(   7)/'DRAW',  -4,  -8/
      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',  -1,  -9/
      DATA IOPERA(   9),IX(   9),IY(   9)/'DRAW',   1,  -9/
      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   4,  -8/
      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',   6,  -5/
      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',   7,   0/
      DATA IOPERA(  13),IX(  13),IY(  13)/'DRAW',   7,   3/
      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',   6,   8/
      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',   4,  11/
      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',   1,  12/
      DATA IOPERA(  17),IX(  17),IY(  17)/'DRAW',  -1,  12/
C
      DATA IXMIND(   1)/ -10/
      DATA IXMAXD(   1)/  10/
      DATA IXDELD(   1)/  20/
      DATA ISTARD(   1)/   1/
      DATA NUMCOO(   1)/  17/
C
C     DEFINE CHARACTER    701--1
C
      DATA IOPERA(  18),IX(  18),IY(  18)/'MOVE',  -4,   8/
      DATA IOPERA(  19),IX(  19),IY(  19)/'DRAW',  -2,   9/
      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   1,  12/
      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',   1,  -9/
C
      DATA IXMIND(   2)/ -10/
      DATA IXMAXD(   2)/  10/
      DATA IXDELD(   2)/  20/
      DATA ISTARD(   2)/  18/
      DATA NUMCOO(   2)/   4/
C
C     DEFINE CHARACTER    702--2
C
      DATA IOPERA(  22),IX(  22),IY(  22)/'MOVE',  -6,   7/
      DATA IOPERA(  23),IX(  23),IY(  23)/'DRAW',  -6,   8/
      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',  -5,  10/
      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',  -4,  11/
      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',  -2,  12/
      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',   2,  12/
      DATA IOPERA(  28),IX(  28),IY(  28)/'DRAW',   4,  11/
      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',   5,  10/
      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',   6,   8/
      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',   6,   6/
      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',   5,   4/
      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',   3,   1/
      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',  -7,  -9/
      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',   7,  -9/
C
      DATA IXMIND(   3)/ -10/
      DATA IXMAXD(   3)/  10/
      DATA IXDELD(   3)/  20/
      DATA ISTARD(   3)/  22/
      DATA NUMCOO(   3)/  14/
C
C     DEFINE CHARACTER    703--3
C
      DATA IOPERA(  36),IX(  36),IY(  36)/'MOVE',  -5,  12/
      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',   6,  12/
      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',   0,   4/
      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',   3,   4/
      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',   5,   3/
      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',   6,   2/
      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',   7,  -1/
      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',   7,  -3/
      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   6,  -6/
      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   4,  -8/
      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',   1,  -9/
      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',  -2,  -9/
      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',  -5,  -8/
      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',  -6,  -7/
      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',  -7,  -5/
C
      DATA IXMIND(   4)/ -10/
      DATA IXMAXD(   4)/  10/
      DATA IXDELD(   4)/  20/
      DATA ISTARD(   4)/  36/
      DATA NUMCOO(   4)/  15/
C
C     DEFINE CHARACTER    704--4
C
      DATA IOPERA(  51),IX(  51),IY(  51)/'MOVE',   3,  12/
      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',  -7,  -2/
      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',   8,  -2/
      DATA IOPERA(  54),IX(  54),IY(  54)/'MOVE',   3,  12/
      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   3,  -9/
C
      DATA IXMIND(   5)/ -10/
      DATA IXMAXD(   5)/  10/
      DATA IXDELD(   5)/  20/
      DATA ISTARD(   5)/  51/
      DATA NUMCOO(   5)/   5/
C
C     DEFINE CHARACTER    705--5
C
      DATA IOPERA(  56),IX(  56),IY(  56)/'MOVE',   5,  12/
      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',  -5,  12/
      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',  -6,   3/
      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',  -5,   4/
      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',  -2,   5/
      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',   1,   5/
      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',   4,   4/
      DATA IOPERA(  63),IX(  63),IY(  63)/'DRAW',   6,   2/
      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',   7,  -1/
      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',   7,  -3/
      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',   6,  -6/
      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',   4,  -8/
      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   1,  -9/
      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',  -2,  -9/
      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',  -5,  -8/
      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',  -6,  -7/
      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',  -7,  -5/
C
      DATA IXMIND(   6)/ -10/
      DATA IXMAXD(   6)/  10/
      DATA IXDELD(   6)/  20/
      DATA ISTARD(   6)/  56/
      DATA NUMCOO(   6)/  17/
C
C     DEFINE CHARACTER    706--6
C
      DATA IOPERA(  73),IX(  73),IY(  73)/'MOVE',   6,   9/
      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',   5,  11/
      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',   2,  12/
      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW',   0,  12/
      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',  -3,  11/
      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',  -5,   8/
      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',  -6,   3/
      DATA IOPERA(  80),IX(  80),IY(  80)/'DRAW',  -6,  -2/
      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',  -5,  -6/
      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',  -3,  -8/
      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',   0,  -9/
      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',   1,  -9/
      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',   4,  -8/
      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',   6,  -6/
      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',   7,  -3/
      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   7,  -2/
      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',   6,   1/
      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',   4,   3/
      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',   1,   4/
      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',   0,   4/
      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',  -3,   3/
      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',  -5,   1/
      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',  -6,  -2/
C
      DATA IXMIND(   7)/ -10/
      DATA IXMAXD(   7)/  10/
      DATA IXDELD(   7)/  20/
      DATA ISTARD(   7)/  73/
      DATA NUMCOO(   7)/  23/
C
C     DEFINE CHARACTER    707--7
C
      DATA IOPERA(  96),IX(  96),IY(  96)/'MOVE',   7,  12/
      DATA IOPERA(  97),IX(  97),IY(  97)/'DRAW',  -3,  -9/
      DATA IOPERA(  98),IX(  98),IY(  98)/'MOVE',  -7,  12/
      DATA IOPERA(  99),IX(  99),IY(  99)/'DRAW',   7,  12/
C
      DATA IXMIND(   8)/ -10/
      DATA IXMAXD(   8)/  10/
      DATA IXDELD(   8)/  20/
      DATA ISTARD(   8)/  96/
      DATA NUMCOO(   8)/   4/
C
C     DEFINE CHARACTER    708--8
C
      DATA IOPERA( 100),IX( 100),IY( 100)/'MOVE',  -2,  12/
      DATA IOPERA( 101),IX( 101),IY( 101)/'DRAW',  -5,  11/
      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',  -6,   9/
      DATA IOPERA( 103),IX( 103),IY( 103)/'DRAW',  -6,   7/
      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',  -5,   5/
      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',  -3,   4/
      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',   1,   3/
      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',   4,   2/
      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',   6,   0/
      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',   7,  -2/
      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',   7,  -5/
      DATA IOPERA( 111),IX( 111),IY( 111)/'DRAW',   6,  -7/
      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',   5,  -8/
      DATA IOPERA( 113),IX( 113),IY( 113)/'DRAW',   2,  -9/
      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',  -2,  -9/
      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',  -5,  -8/
      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',  -6,  -7/
      DATA IOPERA( 117),IX( 117),IY( 117)/'DRAW',  -7,  -5/
      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',  -7,  -2/
      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',  -6,   0/
      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',  -4,   2/
      DATA IOPERA( 121),IX( 121),IY( 121)/'DRAW',  -1,   3/
      DATA IOPERA( 122),IX( 122),IY( 122)/'DRAW',   3,   4/
      DATA IOPERA( 123),IX( 123),IY( 123)/'DRAW',   5,   5/
      DATA IOPERA( 124),IX( 124),IY( 124)/'DRAW',   6,   7/
      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',   6,   9/
      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',   5,  11/
      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',   2,  12/
      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',  -2,  12/
C
      DATA IXMIND(   9)/ -10/
      DATA IXMAXD(   9)/  10/
      DATA IXDELD(   9)/  20/
      DATA ISTARD(   9)/ 100/
      DATA NUMCOO(   9)/  29/
C
C     DEFINE CHARACTER    709--9
C
      DATA IOPERA( 129),IX( 129),IY( 129)/'MOVE',   6,   5/
      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   5,   2/
      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   3,   0/
      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   0,  -1/
      DATA IOPERA( 133),IX( 133),IY( 133)/'DRAW',  -1,  -1/
      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',  -4,   0/
      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',  -6,   2/
      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',  -7,   5/
      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',  -7,   6/
      DATA IOPERA( 138),IX( 138),IY( 138)/'DRAW',  -6,   9/
      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',  -4,  11/
      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',  -1,  12/
      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',   0,  12/
      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',   3,  11/
      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',   5,   9/
      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',   6,   5/
      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',   6,   0/
      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',   5,  -5/
      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',   3,  -8/
      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',   0,  -9/
      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',  -2,  -9/
      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',  -5,  -8/
      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',  -6,  -6/
C
      DATA IXMIND(  10)/ -10/
      DATA IXMAXD(  10)/  10/
      DATA IXDELD(  10)/  20/
      DATA ISTARD(  10)/ 129/
      DATA NUMCOO(  10)/  23/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
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 DPRSN--')
      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               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C               **************************************************
C
      CALL DPCHNU(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
      GOTO1000
C
C               **************************************
C               **************************************
C               **  STEP 2--                        **
C               **  EXTRACT THE COORDINATES         **
C               **  FOR THIS PARTICULAR CHARACTER.  **
C               **************************************
C               **************************************
C
 1000 CONTINUE
      ISTART=ISTARD(ICHARN)
      NC=NUMCOO(ICHARN)
      ISTOP=ISTART+NC-1
      J=0
      DO1100I=ISTART,ISTOP
      J=J+1
      IOP(J)=IOPERA(I)
      X(J)=IX(I)
      Y(J)=IY(I)
 1100 CONTINUE
      NUMCO=J
      IXMINS=IXMIND(ICHARN)
      IXMAXS=IXMAXD(ICHARN)
      IXDELS=IXDELD(ICHARN)
C
      GOTO9000
C
C               *****************
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
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 DPRSN--')
      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 DPRSS(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 SIMPLEX 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-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--87/4
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1987.
C     UPDATED         --MAY       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
      CHARACTER*4 IOPERA
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IOPERA(300)
      DIMENSION IX(300)
      DIMENSION IY(300)
C
      DIMENSION IXMIND(30)
      DIMENSION IXMAXD(30)
      DIMENSION IXDELD(30)
      DIMENSION ISTARD(30)
      DIMENSION NUMCOO(30)
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
C     DEFINE CHARACTER    710--. (PERIOD)
C
      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   0,  -7/
      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -1,  -8/
      DATA IOPERA(   3),IX(   3),IY(   3)/'DRAW',   0,  -9/
      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   1,  -8/
      DATA IOPERA(   5),IX(   5),IY(   5)/'DRAW',   0,  -7/
C
      DATA IXMIND(   1)/  -5/
      DATA IXMAXD(   1)/   5/
      DATA IXDELD(   1)/  10/
      DATA ISTARD(   1)/   1/
      DATA NUMCOO(   1)/   5/
C
C     DEFINE CHARACTER    711--, (COMMA)
C
      DATA IOPERA(   6),IX(   6),IY(   6)/'MOVE',   1,  -8/
      DATA IOPERA(   7),IX(   7),IY(   7)/'DRAW',   0,  -9/
      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',  -1,  -8/
      DATA IOPERA(   9),IX(   9),IY(   9)/'DRAW',   0,  -7/
      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   1,  -8/
      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',   1, -10/
      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',   0, -12/
      DATA IOPERA(  13),IX(  13),IY(  13)/'DRAW',  -1, -13/
C
      DATA IXMIND(   2)/  -5/
      DATA IXMAXD(   2)/   5/
      DATA IXDELD(   2)/  10/
      DATA ISTARD(   2)/   6/
      DATA NUMCOO(   2)/   8/
C
C     DEFINE CHARACTER    712--: (COLON)
C
      DATA IOPERA(  14),IX(  14),IY(  14)/'MOVE',   0,   5/
      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',  -1,   4/
      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',   0,   3/
      DATA IOPERA(  17),IX(  17),IY(  17)/'DRAW',   1,   4/
      DATA IOPERA(  18),IX(  18),IY(  18)/'DRAW',   0,   5/
      DATA IOPERA(  19),IX(  19),IY(  19)/'MOVE',   0,  -7/
      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',  -1,  -8/
      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',   0,  -9/
      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   1,  -8/
      DATA IOPERA(  23),IX(  23),IY(  23)/'DRAW',   0,  -7/
C
      DATA IXMIND(   3)/  -5/
      DATA IXMAXD(   3)/   5/
      DATA IXDELD(   3)/  10/
      DATA ISTARD(   3)/  14/
      DATA NUMCOO(   3)/  10/
C
C     DEFINE CHARACTER    713--; (SEMICOLON)
C
      DATA IOPERA(  24),IX(  24),IY(  24)/'MOVE',   0,   5/
      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',  -1,   4/
      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',   0,   3/
      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',   1,   4/
      DATA IOPERA(  28),IX(  28),IY(  28)/'DRAW',   0,   5/
      DATA IOPERA(  29),IX(  29),IY(  29)/'MOVE',   1,  -8/
      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',   0,  -9/
      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',  -1,  -8/
      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',   0,  -7/
      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',   1,  -8/
      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',   1, -10/
      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',   0, -12/
      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',  -1, -13/
C
      DATA IXMIND(   4)/  -5/
      DATA IXMAXD(   4)/   5/
      DATA IXDELD(   4)/  10/
      DATA ISTARD(   4)/  24/
      DATA NUMCOO(   4)/  13/
C
C     DEFINE CHARACTER    714--! (EXCLAMATION POINT)
C
      DATA IOPERA(  37),IX(  37),IY(  37)/'MOVE',   0,  12/
      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',   0,  -2/
      DATA IOPERA(  39),IX(  39),IY(  39)/'MOVE',   0,  -7/
      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',  -1,  -8/
      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',   0,  -9/
      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',   1,  -8/
      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',   0,  -7/
C
      DATA IXMIND(   5)/  -5/
      DATA IXMAXD(   5)/   5/
      DATA IXDELD(   5)/  10/
      DATA ISTARD(   5)/  37/
      DATA NUMCOO(   5)/   7/
C
C     DEFINE CHARACTER    715--? (QUESTION MARK)
C
      DATA IOPERA(  44),IX(  44),IY(  44)/'MOVE',  -6,   7/
      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',  -6,   8/
      DATA IOPERA(  46),IX(  46),IY(  46)/'DRAW',  -5,  10/
      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',  -4,  11/
      DATA IOPERA(  48),IX(  48),IY(  48)/'DRAW',  -2,  12/
      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',   2,  12/
      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',   4,  11/
      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',   5,  10/
      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',   6,   8/
      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',   6,   6/
      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',   5,   4/
      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   4,   3/
      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',   0,   1/
      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',   0,  -2/
      DATA IOPERA(  58),IX(  58),IY(  58)/'MOVE',   0,  -7/
      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',  -1,  -8/
      DATA IOPERA(  60),IX(  60),IY(  60)/'DRAW',   0,  -9/
      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',   1,  -8/
      DATA IOPERA(  62),IX(  62),IY(  62)/'DRAW',   0,  -7/
C
      DATA IXMIND(   6)/  -9/
      DATA IXMAXD(   6)/   9/
      DATA IXDELD(   6)/  18/
      DATA ISTARD(   6)/  44/
      DATA NUMCOO(   6)/  19/
C
C     DEFINE CHARACTER    734--& (AMPERSAND)
C
      DATA IOPERA(  63),IX(  63),IY(  63)/'MOVE',  10,   3/
      DATA IOPERA(  64),IX(  64),IY(  64)/'DRAW',  10,   4/
      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',   9,   5/
      DATA IOPERA(  66),IX(  66),IY(  66)/'DRAW',   8,   5/
      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',   7,   4/
      DATA IOPERA(  68),IX(  68),IY(  68)/'DRAW',   6,   2/
      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',   4,  -3/
      DATA IOPERA(  70),IX(  70),IY(  70)/'DRAW',   2,  -6/
      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',   0,  -8/
      DATA IOPERA(  72),IX(  72),IY(  72)/'DRAW',  -2,  -9/
      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',  -6,  -9/
      DATA IOPERA(  74),IX(  74),IY(  74)/'DRAW',  -8,  -8/
      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',  -9,  -7/
      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW', -10,  -5/
      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW', -10,  -3/
      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',  -9,  -1/
      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',  -8,   0/
      DATA IOPERA(  80),IX(  80),IY(  80)/'DRAW',  -1,   4/
      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',   0,   5/
      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',   1,   7/
      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',   1,   9/
      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',   0,  11/
      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',  -2,  12/
      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',  -4,  11/
      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',  -5,   9/
      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',  -5,   7/
      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',  -4,   4/
      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',  -2,   1/
      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',   3,  -6/
      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',   5,  -8/
      DATA IOPERA(  93),IX(  93),IY(  93)/'DRAW',   7,  -9/
      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',   9,  -9/
      DATA IOPERA(  95),IX(  95),IY(  95)/'DRAW',  10,  -8/
      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',  10,  -7/
C
      DATA IXMIND(   7)/ -13/
      DATA IXMAXD(   7)/  13/
      DATA IXDELD(   7)/  26/
      DATA ISTARD(   7)/  63/
      DATA NUMCOO(   7)/  34/
C
C     DEFINE CHARACTER    719--$ (DOLLAR SIGN)
C
      DATA IOPERA(  97),IX(  97),IY(  97)/'MOVE',  -2,  16/
      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',  -2, -13/
      DATA IOPERA(  99),IX(  99),IY(  99)/'MOVE',   2,  16/
      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',   2, -13/
      DATA IOPERA( 101),IX( 101),IY( 101)/'MOVE',   7,   9/
      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',   5,  11/
      DATA IOPERA( 103),IX( 103),IY( 103)/'DRAW',   2,  12/
      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',  -2,  12/
      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',  -5,  11/
      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',  -7,   9/
      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',  -7,   7/
      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',  -6,   5/
      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',  -5,   4/
      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',  -3,   3/
      DATA IOPERA( 111),IX( 111),IY( 111)/'DRAW',   3,   1/
      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',   5,   0/
      DATA IOPERA( 113),IX( 113),IY( 113)/'DRAW',   6,  -1/
      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',   7,  -3/
      DATA IOPERA( 115),IX( 115),IY( 115)/'DRAW',   7,  -6/
      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',   5,  -8/
      DATA IOPERA( 117),IX( 117),IY( 117)/'DRAW',   2,  -9/
      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',  -2,  -9/
      DATA IOPERA( 119),IX( 119),IY( 119)/'DRAW',  -5,  -8/
      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',  -7,  -6/
C
      DATA IXMIND(   8)/ -10/
      DATA IXMAXD(   8)/  10/
      DATA IXDELD(   8)/  20/
      DATA ISTARD(   8)/  97/
      DATA NUMCOO(   8)/  24/
C
C     DEFINE CHARACTER    720--/ (SLASH)
C
      DATA IOPERA( 121),IX( 121),IY( 121)/'MOVE',   9,  16/
      DATA IOPERA( 122),IX( 122),IY( 122)/'DRAW',  -9, -16/
C
      DATA IXMIND(   9)/ -11/
      DATA IXMAXD(   9)/  11/
      DATA IXDELD(   9)/  22/
      DATA ISTARD(   9)/ 121/
      DATA NUMCOO(   9)/   2/
C
C     DEFINE CHARACTER    721--( (LEFT PARENTHESES)
C
      DATA IOPERA( 123),IX( 123),IY( 123)/'MOVE',   4,  16/
      DATA IOPERA( 124),IX( 124),IY( 124)/'DRAW',   2,  14/
      DATA IOPERA( 125),IX( 125),IY( 125)/'DRAW',   0,  11/
      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',  -2,   7/
      DATA IOPERA( 127),IX( 127),IY( 127)/'DRAW',  -3,   2/
      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',  -3,  -2/
      DATA IOPERA( 129),IX( 129),IY( 129)/'DRAW',  -2,  -7/
      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   0, -11/
      DATA IOPERA( 131),IX( 131),IY( 131)/'DRAW',   2, -14/
      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',   4, -16/
C
      DATA IXMIND(  10)/  -7/
      DATA IXMAXD(  10)/   7/
      DATA IXDELD(  10)/  14/
      DATA ISTARD(  10)/ 123/
      DATA NUMCOO(  10)/  10/
C
C     DEFINE CHARACTER    722--) (RIGHT PARENTHESES)
C
      DATA IOPERA( 133),IX( 133),IY( 133)/'MOVE',  -4,  16/
      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',  -2,  14/
      DATA IOPERA( 135),IX( 135),IY( 135)/'DRAW',   0,  11/
      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',   2,   7/
      DATA IOPERA( 137),IX( 137),IY( 137)/'DRAW',   3,   2/
      DATA IOPERA( 138),IX( 138),IY( 138)/'DRAW',   3,  -2/
      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',   2,  -7/
      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',   0, -11/
      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',  -2, -14/
      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',  -4, -16/
C
      DATA IXMIND(  11)/  -7/
      DATA IXMAXD(  11)/   7/
      DATA IXDELD(  11)/  14/
      DATA ISTARD(  11)/ 133/
      DATA NUMCOO(  11)/  10/
C
C     DEFINE CHARACTER    728--* (ASTERISK)
C
      DATA IOPERA( 143),IX( 143),IY( 143)/'MOVE',   0,   6/
      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',   0,  -6/
      DATA IOPERA( 145),IX( 145),IY( 145)/'MOVE',  -5,   3/
      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',   5,  -3/
      DATA IOPERA( 147),IX( 147),IY( 147)/'MOVE',   5,   3/
      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',  -5,  -3/
C
      DATA IXMIND(  12)/  -8/
      DATA IXMAXD(  12)/   8/
      DATA IXDELD(  12)/  16/
      DATA ISTARD(  12)/ 143/
      DATA NUMCOO(  12)/   6/
C
C     DEFINE CHARACTER    724--- (HYPHEN OR MINUS SIGN)
C
      DATA IOPERA( 149),IX( 149),IY( 149)/'MOVE',  -9,   0/
      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   9,   0/
C
      DATA IXMIND(  13)/ -13/
      DATA IXMAXD(  13)/  13/
      DATA IXDELD(  13)/  26/
      DATA ISTARD(  13)/ 149/
      DATA NUMCOO(  13)/   2/
C
C     DEFINE CHARACTER    725--+ (PLUS SIGN)
C
      DATA IOPERA( 151),IX( 151),IY( 151)/'MOVE',   0,   9/
      DATA IOPERA( 152),IX( 152),IY( 152)/'DRAW',   0,  -9/
      DATA IOPERA( 153),IX( 153),IY( 153)/'MOVE',  -9,   0/
      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',   9,   0/
C
      DATA IXMIND(  14)/ -13/
      DATA IXMAXD(  14)/  13/
      DATA IXDELD(  14)/  26/
      DATA ISTARD(  14)/ 151/
      DATA NUMCOO(  14)/   4/
C
C     DEFINE CHARACTER    726--= (EQUAL SIGN)
C
      DATA IOPERA( 155),IX( 155),IY( 155)/'MOVE',  -9,   3/
      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',   9,   3/
      DATA IOPERA( 157),IX( 157),IY( 157)/'MOVE',  -9,  -3/
      DATA IOPERA( 158),IX( 158),IY( 158)/'DRAW',   9,  -3/
C
      DATA IXMIND(  15)/ -13/
      DATA IXMAXD(  15)/  13/
      DATA IXDELD(  15)/  26/
      DATA ISTARD(  15)/ 155/
      DATA NUMCOO(  15)/   4/
C
C     DEFINE CHARACTER    716--' (SINGLE QUOTE)
C
      DATA IOPERA( 159),IX( 159),IY( 159)/'MOVE',   0,  12/
      DATA IOPERA( 160),IX( 160),IY( 160)/'DRAW',   0,   5/
C
      DATA IXMIND(  16)/  -4/
      DATA IXMAXD(  16)/   4/
      DATA IXDELD(  16)/   8/
      DATA ISTARD(  16)/ 159/
      DATA NUMCOO(  16)/   2/
C
C     DEFINE CHARACTER    717--  (DOUBLE QUOTE)
C
      DATA IOPERA( 161),IX( 161),IY( 161)/'MOVE',  -4,  12/
      DATA IOPERA( 162),IX( 162),IY( 162)/'DRAW',  -4,   5/
      DATA IOPERA( 163),IX( 163),IY( 163)/'MOVE',   4,  12/
      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',   4,   5/
C
      DATA IXMIND(  17)/  -8/
      DATA IXMAXD(  17)/   8/
      DATA IXDELD(  17)/  16/
      DATA ISTARD(  17)/ 161/
      DATA NUMCOO(  17)/   4/
C
C     DEFINE CHARACTER    718--  (DEGREES)
C
      DATA IOPERA( 165),IX( 165),IY( 165)/'MOVE',  -1,  12/
      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',  -3,  11/
      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',  -4,   9/
      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',  -4,   7/
      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',  -3,   5/
      DATA IOPERA( 170),IX( 170),IY( 170)/'DRAW',  -1,   4/
      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',   1,   4/
      DATA IOPERA( 172),IX( 172),IY( 172)/'DRAW',   3,   5/
      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',   4,   7/
      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',   4,   9/
      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',   3,  11/
      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',   1,  12/
      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',  -1,  12/
C
      DATA IXMIND(  18)/  -7/
      DATA IXMAXD(  18)/   7/
      DATA IXDELD(  18)/  14/
      DATA ISTARD(  18)/ 165/
      DATA NUMCOO(  18)/  13/
C
C     DEFINE CHARACTER   2747--  (NO   SPACE BLANK)
C
      DATA IOPERA( 178),IX( 178),IY( 178)/'MOVE', -32, -32/
C
      DATA IXMIND(  19)/   0/
      DATA IXMAXD(  19)/   0/
      DATA IXDELD(  19)/   0/
      DATA ISTARD(  19)/ 178/
      DATA NUMCOO(  19)/   1/
C
C     DEFINE CHARACTER   2748--  (HALF SPACE BLANK)
C
      DATA IOPERA( 179),IX( 179),IY( 179)/'MOVE', -32, -32/
C
      DATA IXMIND(  20)/  -4/
      DATA IXMAXD(  20)/   4/
      DATA IXDELD(  20)/   8/
      DATA ISTARD(  20)/ 179/
      DATA NUMCOO(  20)/   1/
C
C     DEFINE CHARACTER   2749--  (FULL SPACE BLANK)
C
      DATA IOPERA( 180),IX( 180),IY( 180)/'MOVE', -32, -32/
C
      DATA IXMIND(  21)/  -8/
      DATA IXMAXD(  21)/   8/
      DATA IXDELD(  21)/  16/
      DATA ISTARD(  21)/ 180/
      DATA NUMCOO(  21)/   1/
C
C     DEFINE CHARACTER    730--  (LEFT  APOSTRAPHE)
C
      DATA IOPERA( 181),IX( 181),IY( 181)/'MOVE',   1,  12/
      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',   0,  11/
      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',  -1,   9/
      DATA IOPERA( 184),IX( 184),IY( 184)/'DRAW',  -1,   7/
      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',   0,   6/
      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',   1,   7/
      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',   0,   8/
C
      DATA IXMIND(  22)/  -5/
      DATA IXMAXD(  22)/   5/
      DATA IXDELD(  22)/  10/
      DATA ISTARD(  22)/ 181/
      DATA NUMCOO(  22)/   7/
C
C     DEFINE CHARACTER    731--  (RIGHT APOSTRAPHE)
C
      DATA IOPERA( 188),IX( 188),IY( 188)/'MOVE',   0,  10/
      DATA IOPERA( 189),IX( 189),IY( 189)/'DRAW',  -1,  11/
      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',   0,  12/
      DATA IOPERA( 191),IX( 191),IY( 191)/'DRAW',   1,  11/
      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',   1,   9/
      DATA IOPERA( 193),IX( 193),IY( 193)/'DRAW',   0,   7/
      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',  -1,   6/
C
      DATA IXMIND(  23)/  -5/
      DATA IXMAXD(  23)/   5/
      DATA IXDELD(  23)/  10/
      DATA ISTARD(  23)/ 188/
      DATA NUMCOO(  23)/   7/
C
C     DEFINE CHARACTER    XXX--| (KEYBOARD VERTICAL BAR)
C
      DATA IOPERA( 195),IX( 195),IY( 195)/'MOVE',   0,  12/
      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',   0,  -9/
C
      DATA IXMIND(  24)/  -4/
      DATA IXMAXD(  24)/   4/
      DATA IXDELD(  24)/   8/
      DATA ISTARD(  24)/ 195/
      DATA NUMCOO(  24)/   2/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
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 DPRSS--')
      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               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C               **************************************************
C
      CALL DPCHSY(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
      GOTO1000
C
C               **************************************
C               **************************************
C               **  STEP 2--                        **
C               **  EXTRACT THE COORDINATES         **
C               **  FOR THIS PARTICULAR CHARACTER.  **
C               **************************************
C               **************************************
C
 1000 CONTINUE
      ISTART=ISTARD(ICHARN)
      NC=NUMCOO(ICHARN)
      ISTOP=ISTART+NC-1
      J=0
      DO1100I=ISTART,ISTOP
      J=J+1
      IOP(J)=IOPERA(I)
      X(J)=IX(I)
      Y(J)=IY(I)
 1100 CONTINUE
      NUMCO=J
      IXMINS=IXMIND(ICHARN)
      IXMAXS=IXMAXD(ICHARN)
      IXDELS=IXDELD(ICHARN)
C
      GOTO9000
C
C               *****************
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
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 DPRSS--')
      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 DPRSSL(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 SIMPLEX SCRIPT 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-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--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 DPRSSL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICHAR2
   52 FORMAT('ICHAR2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGD2,IFOUND,IERROR
   59 FORMAT('IBUGD2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
C
      IF(ICHARN.LE.14)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRSSL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.15)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRSSL2(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 DPRSSL--')
      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 DPRSSU(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 SIMPLEX SCRIPT UPPER CASE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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--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 DPRSSU--')
      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.10)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRSSU1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(11.LE.ICHARN.AND.ICHARN.LE.19)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRSSU2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(ICHARN.GE.20)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRSSU3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPRSSU--')
      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 DPRSU(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 SIMPLEX 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-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--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
      CHARACTER*4 IOPERA
C
C---------------------------------------------------------------------
C
      DIMENSION IOP(*)
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IOPERA(300)
      DIMENSION IX(300)
      DIMENSION IY(300)
C
      DIMENSION IXMIND(30)
      DIMENSION IXMAXD(30)
      DIMENSION IXDELD(30)
      DIMENSION ISTARD(30)
      DIMENSION NUMCOO(30)
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
C     DEFINE CHARACTER    501--UPPER CASE A
C
      DATA IOPERA(   1),IX(   1),IY(   1)/'MOVE',   0,  12/
      DATA IOPERA(   2),IX(   2),IY(   2)/'DRAW',  -8,  -9/
      DATA IOPERA(   3),IX(   3),IY(   3)/'MOVE',   0,  12/
      DATA IOPERA(   4),IX(   4),IY(   4)/'DRAW',   8,  -9/
      DATA IOPERA(   5),IX(   5),IY(   5)/'MOVE',  -5,  -2/
      DATA IOPERA(   6),IX(   6),IY(   6)/'DRAW',   5,  -2/
C
      DATA IXMIND(   1)/  -9/
      DATA IXMAXD(   1)/   9/
      DATA IXDELD(   1)/  18/
      DATA ISTARD(   1)/   1/
      DATA NUMCOO(   1)/   6/
C
C     DEFINE CHARACTER    502--UPPER CASE B
C
      DATA IOPERA(   7),IX(   7),IY(   7)/'MOVE',  -7,  12/
      DATA IOPERA(   8),IX(   8),IY(   8)/'DRAW',  -7,  -9/
      DATA IOPERA(   9),IX(   9),IY(   9)/'MOVE',  -7,  12/
      DATA IOPERA(  10),IX(  10),IY(  10)/'DRAW',   2,  12/
      DATA IOPERA(  11),IX(  11),IY(  11)/'DRAW',   5,  11/
      DATA IOPERA(  12),IX(  12),IY(  12)/'DRAW',   6,  10/
      DATA IOPERA(  13),IX(  13),IY(  13)/'DRAW',   7,   8/
      DATA IOPERA(  14),IX(  14),IY(  14)/'DRAW',   7,   6/
      DATA IOPERA(  15),IX(  15),IY(  15)/'DRAW',   6,   4/
      DATA IOPERA(  16),IX(  16),IY(  16)/'DRAW',   5,   3/
      DATA IOPERA(  17),IX(  17),IY(  17)/'DRAW',   2,   2/
      DATA IOPERA(  18),IX(  18),IY(  18)/'MOVE',  -7,   2/
      DATA IOPERA(  19),IX(  19),IY(  19)/'DRAW',   2,   2/
      DATA IOPERA(  20),IX(  20),IY(  20)/'DRAW',   5,   1/
      DATA IOPERA(  21),IX(  21),IY(  21)/'DRAW',   6,   0/
      DATA IOPERA(  22),IX(  22),IY(  22)/'DRAW',   7,  -2/
      DATA IOPERA(  23),IX(  23),IY(  23)/'DRAW',   7,  -5/
      DATA IOPERA(  24),IX(  24),IY(  24)/'DRAW',   6,  -7/
      DATA IOPERA(  25),IX(  25),IY(  25)/'DRAW',   5,  -8/
      DATA IOPERA(  26),IX(  26),IY(  26)/'DRAW',   2,  -9/
      DATA IOPERA(  27),IX(  27),IY(  27)/'DRAW',  -7,  -9/
C
      DATA IXMIND(   2)/ -11/
      DATA IXMAXD(   2)/  10/
      DATA IXDELD(   2)/  21/
      DATA ISTARD(   2)/   7/
      DATA NUMCOO(   2)/  21/
C
C     DEFINE CHARACTER    503--UPPER CASE C
C
      DATA IOPERA(  28),IX(  28),IY(  28)/'MOVE',   8,   7/
      DATA IOPERA(  29),IX(  29),IY(  29)/'DRAW',   7,   9/
      DATA IOPERA(  30),IX(  30),IY(  30)/'DRAW',   5,  11/
      DATA IOPERA(  31),IX(  31),IY(  31)/'DRAW',   3,  12/
      DATA IOPERA(  32),IX(  32),IY(  32)/'DRAW',  -1,  12/
      DATA IOPERA(  33),IX(  33),IY(  33)/'DRAW',  -3,  11/
      DATA IOPERA(  34),IX(  34),IY(  34)/'DRAW',  -5,   9/
      DATA IOPERA(  35),IX(  35),IY(  35)/'DRAW',  -6,   7/
      DATA IOPERA(  36),IX(  36),IY(  36)/'DRAW',  -7,   4/
      DATA IOPERA(  37),IX(  37),IY(  37)/'DRAW',  -7,  -1/
      DATA IOPERA(  38),IX(  38),IY(  38)/'DRAW',  -6,  -4/
      DATA IOPERA(  39),IX(  39),IY(  39)/'DRAW',  -5,  -6/
      DATA IOPERA(  40),IX(  40),IY(  40)/'DRAW',  -3,  -8/
      DATA IOPERA(  41),IX(  41),IY(  41)/'DRAW',  -1,  -9/
      DATA IOPERA(  42),IX(  42),IY(  42)/'DRAW',   3,  -9/
      DATA IOPERA(  43),IX(  43),IY(  43)/'DRAW',   5,  -8/
      DATA IOPERA(  44),IX(  44),IY(  44)/'DRAW',   7,  -6/
      DATA IOPERA(  45),IX(  45),IY(  45)/'DRAW',   8,  -4/
C
      DATA IXMIND(   3)/ -10/
      DATA IXMAXD(   3)/  11/
      DATA IXDELD(   3)/  21/
      DATA ISTARD(   3)/  28/
      DATA NUMCOO(   3)/  18/
C
C     DEFINE CHARACTER    504--UPPER CASE D
C
      DATA IOPERA(  46),IX(  46),IY(  46)/'MOVE',  -7,  12/
      DATA IOPERA(  47),IX(  47),IY(  47)/'DRAW',  -7,  -9/
      DATA IOPERA(  48),IX(  48),IY(  48)/'MOVE',  -7,  12/
      DATA IOPERA(  49),IX(  49),IY(  49)/'DRAW',   0,  12/
      DATA IOPERA(  50),IX(  50),IY(  50)/'DRAW',   3,  11/
      DATA IOPERA(  51),IX(  51),IY(  51)/'DRAW',   5,   9/
      DATA IOPERA(  52),IX(  52),IY(  52)/'DRAW',   6,   7/
      DATA IOPERA(  53),IX(  53),IY(  53)/'DRAW',   7,   4/
      DATA IOPERA(  54),IX(  54),IY(  54)/'DRAW',   7,  -1/
      DATA IOPERA(  55),IX(  55),IY(  55)/'DRAW',   6,  -4/
      DATA IOPERA(  56),IX(  56),IY(  56)/'DRAW',   5,  -6/
      DATA IOPERA(  57),IX(  57),IY(  57)/'DRAW',   3,  -8/
      DATA IOPERA(  58),IX(  58),IY(  58)/'DRAW',   0,  -9/
      DATA IOPERA(  59),IX(  59),IY(  59)/'DRAW',  -7,  -9/
C
      DATA IXMIND(   4)/ -11/
      DATA IXMAXD(   4)/  10/
      DATA IXDELD(   4)/  21/
      DATA ISTARD(   4)/  46/
      DATA NUMCOO(   4)/  14/
C
C     DEFINE CHARACTER    505--UPPER CASE E
C
      DATA IOPERA(  60),IX(  60),IY(  60)/'MOVE',  -6,  12/
      DATA IOPERA(  61),IX(  61),IY(  61)/'DRAW',  -6,  -9/
      DATA IOPERA(  62),IX(  62),IY(  62)/'MOVE',  -6,  12/
      DATA IOPERA(  63),IX(  63),IY(  63)/'DRAW',   7,  12/
      DATA IOPERA(  64),IX(  64),IY(  64)/'MOVE',  -6,   2/
      DATA IOPERA(  65),IX(  65),IY(  65)/'DRAW',   2,   2/
      DATA IOPERA(  66),IX(  66),IY(  66)/'MOVE',  -6,  -9/
      DATA IOPERA(  67),IX(  67),IY(  67)/'DRAW',   7,  -9/
C
      DATA IXMIND(   5)/ -10/
      DATA IXMAXD(   5)/   9/
      DATA IXDELD(   5)/  19/
      DATA ISTARD(   5)/  60/
      DATA NUMCOO(   5)/   8/
C
C     DEFINE CHARACTER    506--UPPER CASE F
C
      DATA IOPERA(  68),IX(  68),IY(  68)/'MOVE',  -6,  12/
      DATA IOPERA(  69),IX(  69),IY(  69)/'DRAW',  -6,  -9/
      DATA IOPERA(  70),IX(  70),IY(  70)/'MOVE',  -6,  12/
      DATA IOPERA(  71),IX(  71),IY(  71)/'DRAW',   7,  12/
      DATA IOPERA(  72),IX(  72),IY(  72)/'MOVE',  -6,   2/
      DATA IOPERA(  73),IX(  73),IY(  73)/'DRAW',   2,   2/
C
      DATA IXMIND(   6)/ -10/
      DATA IXMAXD(   6)/   8/
      DATA IXDELD(   6)/  18/
      DATA ISTARD(   6)/  68/
      DATA NUMCOO(   6)/   6/
C
C     DEFINE CHARACTER    507--UPPER CASE G
C
      DATA IOPERA(  74),IX(  74),IY(  74)/'MOVE',   8,   7/
      DATA IOPERA(  75),IX(  75),IY(  75)/'DRAW',   7,   9/
      DATA IOPERA(  76),IX(  76),IY(  76)/'DRAW',   5,  11/
      DATA IOPERA(  77),IX(  77),IY(  77)/'DRAW',   3,  12/
      DATA IOPERA(  78),IX(  78),IY(  78)/'DRAW',  -1,  12/
      DATA IOPERA(  79),IX(  79),IY(  79)/'DRAW',  -3,  11/
      DATA IOPERA(  80),IX(  80),IY(  80)/'DRAW',  -5,   9/
      DATA IOPERA(  81),IX(  81),IY(  81)/'DRAW',  -6,   7/
      DATA IOPERA(  82),IX(  82),IY(  82)/'DRAW',  -7,   4/
      DATA IOPERA(  83),IX(  83),IY(  83)/'DRAW',  -7,  -1/
      DATA IOPERA(  84),IX(  84),IY(  84)/'DRAW',  -6,  -4/
      DATA IOPERA(  85),IX(  85),IY(  85)/'DRAW',  -5,  -6/
      DATA IOPERA(  86),IX(  86),IY(  86)/'DRAW',  -3,  -8/
      DATA IOPERA(  87),IX(  87),IY(  87)/'DRAW',  -1,  -9/
      DATA IOPERA(  88),IX(  88),IY(  88)/'DRAW',   3,  -9/
      DATA IOPERA(  89),IX(  89),IY(  89)/'DRAW',   5,  -8/
      DATA IOPERA(  90),IX(  90),IY(  90)/'DRAW',   7,  -6/
      DATA IOPERA(  91),IX(  91),IY(  91)/'DRAW',   8,  -4/
      DATA IOPERA(  92),IX(  92),IY(  92)/'DRAW',   8,  -1/
      DATA IOPERA(  93),IX(  93),IY(  93)/'MOVE',   3,  -1/
      DATA IOPERA(  94),IX(  94),IY(  94)/'DRAW',   8,  -1/
C
      DATA IXMIND(   7)/ -10/
      DATA IXMAXD(   7)/  11/
      DATA IXDELD(   7)/  21/
      DATA ISTARD(   7)/  74/
      DATA NUMCOO(   7)/  21/
C
C     DEFINE CHARACTER    508--UPPER CASE H
C
      DATA IOPERA(  95),IX(  95),IY(  95)/'MOVE',  -7,  12/
      DATA IOPERA(  96),IX(  96),IY(  96)/'DRAW',  -7,  -9/
      DATA IOPERA(  97),IX(  97),IY(  97)/'MOVE',   7,  12/
      DATA IOPERA(  98),IX(  98),IY(  98)/'DRAW',   7,  -9/
      DATA IOPERA(  99),IX(  99),IY(  99)/'MOVE',  -7,   2/
      DATA IOPERA( 100),IX( 100),IY( 100)/'DRAW',   7,   2/
C
      DATA IXMIND(   8)/ -11/
      DATA IXMAXD(   8)/  11/
      DATA IXDELD(   8)/  22/
      DATA ISTARD(   8)/  95/
      DATA NUMCOO(   8)/   6/
C
C     DEFINE CHARACTER    509--UPPER CASE I
C
      DATA IOPERA( 101),IX( 101),IY( 101)/'MOVE',   0,  12/
      DATA IOPERA( 102),IX( 102),IY( 102)/'DRAW',   0,  -9/
C
      DATA IXMIND(   9)/  -4/
      DATA IXMAXD(   9)/   4/
      DATA IXDELD(   9)/   8/
      DATA ISTARD(   9)/ 101/
      DATA NUMCOO(   9)/   2/
C
C     DEFINE CHARACTER    510--UPPER CASE J
C
      DATA IOPERA( 103),IX( 103),IY( 103)/'MOVE',   4,  12/
      DATA IOPERA( 104),IX( 104),IY( 104)/'DRAW',   4,  -4/
      DATA IOPERA( 105),IX( 105),IY( 105)/'DRAW',   3,  -7/
      DATA IOPERA( 106),IX( 106),IY( 106)/'DRAW',   2,  -8/
      DATA IOPERA( 107),IX( 107),IY( 107)/'DRAW',   0,  -9/
      DATA IOPERA( 108),IX( 108),IY( 108)/'DRAW',  -2,  -9/
      DATA IOPERA( 109),IX( 109),IY( 109)/'DRAW',  -4,  -8/
      DATA IOPERA( 110),IX( 110),IY( 110)/'DRAW',  -5,  -7/
      DATA IOPERA( 111),IX( 111),IY( 111)/'DRAW',  -6,  -4/
      DATA IOPERA( 112),IX( 112),IY( 112)/'DRAW',  -6,  -2/
C
      DATA IXMIND(  10)/  -8/
      DATA IXMAXD(  10)/   8/
      DATA IXDELD(  10)/  16/
      DATA ISTARD(  10)/ 103/
      DATA NUMCOO(  10)/  10/
C
C     DEFINE CHARACTER    511--UPPER CASE K
C
      DATA IOPERA( 113),IX( 113),IY( 113)/'MOVE',  -7,  12/
      DATA IOPERA( 114),IX( 114),IY( 114)/'DRAW',  -7,  -9/
      DATA IOPERA( 115),IX( 115),IY( 115)/'MOVE',   7,  12/
      DATA IOPERA( 116),IX( 116),IY( 116)/'DRAW',  -7,  -2/
      DATA IOPERA( 117),IX( 117),IY( 117)/'MOVE',  -2,   3/
      DATA IOPERA( 118),IX( 118),IY( 118)/'DRAW',   7,  -9/
C
      DATA IXMIND(  11)/ -11/
      DATA IXMAXD(  11)/  10/
      DATA IXDELD(  11)/  21/
      DATA ISTARD(  11)/ 113/
      DATA NUMCOO(  11)/   6/
C
C     DEFINE CHARACTER    512--UPPER CASE L
C
      DATA IOPERA( 119),IX( 119),IY( 119)/'MOVE',  -6,  12/
      DATA IOPERA( 120),IX( 120),IY( 120)/'DRAW',  -6,  -9/
      DATA IOPERA( 121),IX( 121),IY( 121)/'MOVE',  -6,  -9/
      DATA IOPERA( 122),IX( 122),IY( 122)/'DRAW',   6,  -9/
C
      DATA IXMIND(  12)/ -10/
      DATA IXMAXD(  12)/   7/
      DATA IXDELD(  12)/  17/
      DATA ISTARD(  12)/ 119/
      DATA NUMCOO(  12)/   4/
C
C     DEFINE CHARACTER    513--UPPER CASE M
C
      DATA IOPERA( 123),IX( 123),IY( 123)/'MOVE',  -8,  12/
      DATA IOPERA( 124),IX( 124),IY( 124)/'DRAW',  -8,  -9/
      DATA IOPERA( 125),IX( 125),IY( 125)/'MOVE',  -8,  12/
      DATA IOPERA( 126),IX( 126),IY( 126)/'DRAW',   0,  -9/
      DATA IOPERA( 127),IX( 127),IY( 127)/'MOVE',   8,  12/
      DATA IOPERA( 128),IX( 128),IY( 128)/'DRAW',   0,  -9/
      DATA IOPERA( 129),IX( 129),IY( 129)/'MOVE',   8,  12/
      DATA IOPERA( 130),IX( 130),IY( 130)/'DRAW',   8,  -9/
C
      DATA IXMIND(  13)/ -12/
      DATA IXMAXD(  13)/  12/
      DATA IXDELD(  13)/  24/
      DATA ISTARD(  13)/ 123/
      DATA NUMCOO(  13)/   8/
C
C     DEFINE CHARACTER    514--UPPER CASE N
C
      DATA IOPERA( 131),IX( 131),IY( 131)/'MOVE',  -7,  12/
      DATA IOPERA( 132),IX( 132),IY( 132)/'DRAW',  -7,  -9/
      DATA IOPERA( 133),IX( 133),IY( 133)/'MOVE',  -7,  12/
      DATA IOPERA( 134),IX( 134),IY( 134)/'DRAW',   7,  -9/
      DATA IOPERA( 135),IX( 135),IY( 135)/'MOVE',   7,  12/
      DATA IOPERA( 136),IX( 136),IY( 136)/'DRAW',   7,  -9/
C
      DATA IXMIND(  14)/ -11/
      DATA IXMAXD(  14)/  11/
      DATA IXDELD(  14)/  22/
      DATA ISTARD(  14)/ 131/
      DATA NUMCOO(  14)/   6/
C
C     DEFINE CHARACTER    515--UPPER CASE O
C
      DATA IOPERA( 137),IX( 137),IY( 137)/'MOVE',  -2,  12/
      DATA IOPERA( 138),IX( 138),IY( 138)/'DRAW',  -4,  11/
      DATA IOPERA( 139),IX( 139),IY( 139)/'DRAW',  -6,   9/
      DATA IOPERA( 140),IX( 140),IY( 140)/'DRAW',  -7,   7/
      DATA IOPERA( 141),IX( 141),IY( 141)/'DRAW',  -8,   4/
      DATA IOPERA( 142),IX( 142),IY( 142)/'DRAW',  -8,  -1/
      DATA IOPERA( 143),IX( 143),IY( 143)/'DRAW',  -7,  -4/
      DATA IOPERA( 144),IX( 144),IY( 144)/'DRAW',  -6,  -6/
      DATA IOPERA( 145),IX( 145),IY( 145)/'DRAW',  -4,  -8/
      DATA IOPERA( 146),IX( 146),IY( 146)/'DRAW',  -2,  -9/
      DATA IOPERA( 147),IX( 147),IY( 147)/'DRAW',   2,  -9/
      DATA IOPERA( 148),IX( 148),IY( 148)/'DRAW',   4,  -8/
      DATA IOPERA( 149),IX( 149),IY( 149)/'DRAW',   6,  -6/
      DATA IOPERA( 150),IX( 150),IY( 150)/'DRAW',   7,  -4/
      DATA IOPERA( 151),IX( 151),IY( 151)/'DRAW',   8,  -1/
      DATA IOPERA( 152),IX( 152),IY( 152)/'DRAW',   8,   4/
      DATA IOPERA( 153),IX( 153),IY( 153)/'DRAW',   7,   7/
      DATA IOPERA( 154),IX( 154),IY( 154)/'DRAW',   6,   9/
      DATA IOPERA( 155),IX( 155),IY( 155)/'DRAW',   4,  11/
      DATA IOPERA( 156),IX( 156),IY( 156)/'DRAW',   2,  12/
      DATA IOPERA( 157),IX( 157),IY( 157)/'DRAW',  -2,  12/
C
      DATA IXMIND(  15)/ -11/
      DATA IXMAXD(  15)/  11/
      DATA IXDELD(  15)/  22/
      DATA ISTARD(  15)/ 137/
      DATA NUMCOO(  15)/  21/
C
C     DEFINE CHARACTER    516--UPPER CASE P
C
      DATA IOPERA( 158),IX( 158),IY( 158)/'MOVE',  -7,  12/
      DATA IOPERA( 159),IX( 159),IY( 159)/'DRAW',  -7,  -9/
      DATA IOPERA( 160),IX( 160),IY( 160)/'MOVE',  -7,  12/
      DATA IOPERA( 161),IX( 161),IY( 161)/'DRAW',   2,  12/
      DATA IOPERA( 162),IX( 162),IY( 162)/'DRAW',   5,  11/
      DATA IOPERA( 163),IX( 163),IY( 163)/'DRAW',   6,  10/
      DATA IOPERA( 164),IX( 164),IY( 164)/'DRAW',   7,   8/
      DATA IOPERA( 165),IX( 165),IY( 165)/'DRAW',   7,   5/
      DATA IOPERA( 166),IX( 166),IY( 166)/'DRAW',   6,   3/
      DATA IOPERA( 167),IX( 167),IY( 167)/'DRAW',   5,   2/
      DATA IOPERA( 168),IX( 168),IY( 168)/'DRAW',   2,   1/
      DATA IOPERA( 169),IX( 169),IY( 169)/'DRAW',  -7,   1/
C
      DATA IXMIND(  16)/ -11/
      DATA IXMAXD(  16)/  10/
      DATA IXDELD(  16)/  21/
      DATA ISTARD(  16)/ 158/
      DATA NUMCOO(  16)/  12/
C
C     DEFINE CHARACTER    517--UPPER CASE Q
C
      DATA IOPERA( 170),IX( 170),IY( 170)/'MOVE',  -2,  12/
      DATA IOPERA( 171),IX( 171),IY( 171)/'DRAW',  -4,  11/
      DATA IOPERA( 172),IX( 172),IY( 172)/'DRAW',  -6,   9/
      DATA IOPERA( 173),IX( 173),IY( 173)/'DRAW',  -7,   7/
      DATA IOPERA( 174),IX( 174),IY( 174)/'DRAW',  -8,   4/
      DATA IOPERA( 175),IX( 175),IY( 175)/'DRAW',  -8,  -1/
      DATA IOPERA( 176),IX( 176),IY( 176)/'DRAW',  -7,  -4/
      DATA IOPERA( 177),IX( 177),IY( 177)/'DRAW',  -6,  -6/
      DATA IOPERA( 178),IX( 178),IY( 178)/'DRAW',  -4,  -8/
      DATA IOPERA( 179),IX( 179),IY( 179)/'DRAW',  -2,  -9/
      DATA IOPERA( 180),IX( 180),IY( 180)/'DRAW',   2,  -9/
      DATA IOPERA( 181),IX( 181),IY( 181)/'DRAW',   4,  -8/
      DATA IOPERA( 182),IX( 182),IY( 182)/'DRAW',   6,  -6/
      DATA IOPERA( 183),IX( 183),IY( 183)/'DRAW',   7,  -4/
      DATA IOPERA( 184),IX( 184),IY( 184)/'DRAW',   8,  -1/
      DATA IOPERA( 185),IX( 185),IY( 185)/'DRAW',   8,   4/
      DATA IOPERA( 186),IX( 186),IY( 186)/'DRAW',   7,   7/
      DATA IOPERA( 187),IX( 187),IY( 187)/'DRAW',   6,   9/
      DATA IOPERA( 188),IX( 188),IY( 188)/'DRAW',   4,  11/
      DATA IOPERA( 189),IX( 189),IY( 189)/'DRAW',   2,  12/
      DATA IOPERA( 190),IX( 190),IY( 190)/'DRAW',  -2,  12/
      DATA IOPERA( 191),IX( 191),IY( 191)/'MOVE',   1,  -5/
      DATA IOPERA( 192),IX( 192),IY( 192)/'DRAW',   7, -11/
C
      DATA IXMIND(  17)/ -11/
      DATA IXMAXD(  17)/  11/
      DATA IXDELD(  17)/  22/
      DATA ISTARD(  17)/ 170/
      DATA NUMCOO(  17)/  23/
C
C     DEFINE CHARACTER    518--UPPER CASE R
C
      DATA IOPERA( 193),IX( 193),IY( 193)/'MOVE',  -7,  12/
      DATA IOPERA( 194),IX( 194),IY( 194)/'DRAW',  -7,  -9/
      DATA IOPERA( 195),IX( 195),IY( 195)/'MOVE',  -7,  12/
      DATA IOPERA( 196),IX( 196),IY( 196)/'DRAW',   2,  12/
      DATA IOPERA( 197),IX( 197),IY( 197)/'DRAW',   5,  11/
      DATA IOPERA( 198),IX( 198),IY( 198)/'DRAW',   6,  10/
      DATA IOPERA( 199),IX( 199),IY( 199)/'DRAW',   7,   8/
      DATA IOPERA( 200),IX( 200),IY( 200)/'DRAW',   7,   6/
      DATA IOPERA( 201),IX( 201),IY( 201)/'DRAW',   6,   4/
      DATA IOPERA( 202),IX( 202),IY( 202)/'DRAW',   5,   3/
      DATA IOPERA( 203),IX( 203),IY( 203)/'DRAW',   2,   2/
      DATA IOPERA( 204),IX( 204),IY( 204)/'DRAW',  -7,   2/
      DATA IOPERA( 205),IX( 205),IY( 205)/'MOVE',   0,   2/
      DATA IOPERA( 206),IX( 206),IY( 206)/'DRAW',   7,  -9/
C
      DATA IXMIND(  18)/ -11/
      DATA IXMAXD(  18)/  10/
      DATA IXDELD(  18)/  21/
      DATA ISTARD(  18)/ 193/
      DATA NUMCOO(  18)/  14/
C
C     DEFINE CHARACTER    519--UPPER CASE S
C
      DATA IOPERA( 207),IX( 207),IY( 207)/'MOVE',   7,   9/
      DATA IOPERA( 208),IX( 208),IY( 208)/'DRAW',   5,  11/
      DATA IOPERA( 209),IX( 209),IY( 209)/'DRAW',   2,  12/
      DATA IOPERA( 210),IX( 210),IY( 210)/'DRAW',  -2,  12/
      DATA IOPERA( 211),IX( 211),IY( 211)/'DRAW',  -5,  11/
      DATA IOPERA( 212),IX( 212),IY( 212)/'DRAW',  -7,   9/
      DATA IOPERA( 213),IX( 213),IY( 213)/'DRAW',  -7,   7/
      DATA IOPERA( 214),IX( 214),IY( 214)/'DRAW',  -6,   5/
      DATA IOPERA( 215),IX( 215),IY( 215)/'DRAW',  -5,   4/
      DATA IOPERA( 216),IX( 216),IY( 216)/'DRAW',  -3,   3/
      DATA IOPERA( 217),IX( 217),IY( 217)/'DRAW',   3,   1/
      DATA IOPERA( 218),IX( 218),IY( 218)/'DRAW',   5,   0/
      DATA IOPERA( 219),IX( 219),IY( 219)/'DRAW',   6,  -1/
      DATA IOPERA( 220),IX( 220),IY( 220)/'DRAW',   7,  -3/
      DATA IOPERA( 221),IX( 221),IY( 221)/'DRAW',   7,  -6/
      DATA IOPERA( 222),IX( 222),IY( 222)/'DRAW',   5,  -8/
      DATA IOPERA( 223),IX( 223),IY( 223)/'DRAW',   2,  -9/
      DATA IOPERA( 224),IX( 224),IY( 224)/'DRAW',  -2,  -9/
      DATA IOPERA( 225),IX( 225),IY( 225)/'DRAW',  -5,  -8/
      DATA IOPERA( 226),IX( 226),IY( 226)/'DRAW',  -7,  -6/
C
      DATA IXMIND(  19)/ -10/
      DATA IXMAXD(  19)/  10/
      DATA IXDELD(  19)/  20/
      DATA ISTARD(  19)/ 207/
      DATA NUMCOO(  19)/  20/
C
C     DEFINE CHARACTER    520--UPPER CASE T
C
      DATA IOPERA( 227),IX( 227),IY( 227)/'MOVE',   0,  12/
      DATA IOPERA( 228),IX( 228),IY( 228)/'DRAW',   0,  -9/
      DATA IOPERA( 229),IX( 229),IY( 229)/'MOVE',  -7,  12/
      DATA IOPERA( 230),IX( 230),IY( 230)/'DRAW',   7,  12/
C
      DATA IXMIND(  20)/  -8/
      DATA IXMAXD(  20)/   8/
      DATA IXDELD(  20)/  16/
      DATA ISTARD(  20)/ 227/
      DATA NUMCOO(  20)/   4/
C
C     DEFINE CHARACTER    521--UPPER CASE U
C
      DATA IOPERA( 231),IX( 231),IY( 231)/'MOVE',  -7,  12/
      DATA IOPERA( 232),IX( 232),IY( 232)/'DRAW',  -7,  -3/
      DATA IOPERA( 233),IX( 233),IY( 233)/'DRAW',  -6,  -6/
      DATA IOPERA( 234),IX( 234),IY( 234)/'DRAW',  -4,  -8/
      DATA IOPERA( 235),IX( 235),IY( 235)/'DRAW',  -1,  -9/
      DATA IOPERA( 236),IX( 236),IY( 236)/'DRAW',   1,  -9/
      DATA IOPERA( 237),IX( 237),IY( 237)/'DRAW',   4,  -8/
      DATA IOPERA( 238),IX( 238),IY( 238)/'DRAW',   6,  -6/
      DATA IOPERA( 239),IX( 239),IY( 239)/'DRAW',   7,  -3/
      DATA IOPERA( 240),IX( 240),IY( 240)/'DRAW',   7,  12/
C
      DATA IXMIND(  21)/ -11/
      DATA IXMAXD(  21)/  11/
      DATA IXDELD(  21)/  22/
      DATA ISTARD(  21)/ 231/
      DATA NUMCOO(  21)/  10/
C
C     DEFINE CHARACTER    522--UPPER CASE V
C
      DATA IOPERA( 241),IX( 241),IY( 241)/'MOVE',  -8,  12/
      DATA IOPERA( 242),IX( 242),IY( 242)/'DRAW',   0,  -9/
      DATA IOPERA( 243),IX( 243),IY( 243)/'MOVE',   8,  12/
      DATA IOPERA( 244),IX( 244),IY( 244)/'DRAW',   0,  -9/
C
      DATA IXMIND(  22)/  -9/
      DATA IXMAXD(  22)/   9/
      DATA IXDELD(  22)/  18/
      DATA ISTARD(  22)/ 241/
      DATA NUMCOO(  22)/   4/
C
C     DEFINE CHARACTER    523--UPPER CASE W
C
      DATA IOPERA( 245),IX( 245),IY( 245)/'MOVE', -10,  12/
      DATA IOPERA( 246),IX( 246),IY( 246)/'DRAW',  -5,  -9/
      DATA IOPERA( 247),IX( 247),IY( 247)/'MOVE',   0,  12/
      DATA IOPERA( 248),IX( 248),IY( 248)/'DRAW',  -5,  -9/
      DATA IOPERA( 249),IX( 249),IY( 249)/'MOVE',   0,  12/
      DATA IOPERA( 250),IX( 250),IY( 250)/'DRAW',   5,  -9/
      DATA IOPERA( 251),IX( 251),IY( 251)/'MOVE',  10,  12/
      DATA IOPERA( 252),IX( 252),IY( 252)/'DRAW',   5,  -9/
C
      DATA IXMIND(  23)/ -12/
      DATA IXMAXD(  23)/  12/
      DATA IXDELD(  23)/  24/
      DATA ISTARD(  23)/ 245/
      DATA NUMCOO(  23)/   8/
C
C     DEFINE CHARACTER    524--UPPER CASE X
C
      DATA IOPERA( 253),IX( 253),IY( 253)/'MOVE',  -7,  12/
      DATA IOPERA( 254),IX( 254),IY( 254)/'DRAW',   7,  -9/
      DATA IOPERA( 255),IX( 255),IY( 255)/'MOVE',   7,  12/
      DATA IOPERA( 256),IX( 256),IY( 256)/'DRAW',  -7,  -9/
C
      DATA IXMIND(  24)/ -10/
      DATA IXMAXD(  24)/  10/
      DATA IXDELD(  24)/  20/
      DATA ISTARD(  24)/ 253/
      DATA NUMCOO(  24)/   4/
C
C     DEFINE CHARACTER    525--UPPER CASE Y
C
      DATA IOPERA( 257),IX( 257),IY( 257)/'MOVE',  -8,  12/
      DATA IOPERA( 258),IX( 258),IY( 258)/'DRAW',   0,   2/
      DATA IOPERA( 259),IX( 259),IY( 259)/'DRAW',   0,  -9/
      DATA IOPERA( 260),IX( 260),IY( 260)/'MOVE',   8,  12/
      DATA IOPERA( 261),IX( 261),IY( 261)/'DRAW',   0,   2/
C
      DATA IXMIND(  25)/  -9/
      DATA IXMAXD(  25)/   9/
      DATA IXDELD(  25)/  18/
      DATA ISTARD(  25)/ 257/
      DATA NUMCOO(  25)/   5/
C
C     DEFINE CHARACTER    526--UPPER CASE Z
C
      DATA IOPERA( 262),IX( 262),IY( 262)/'MOVE',   7,  12/
      DATA IOPERA( 263),IX( 263),IY( 263)/'DRAW',  -7,  -9/
      DATA IOPERA( 264),IX( 264),IY( 264)/'MOVE',  -7,  12/
      DATA IOPERA( 265),IX( 265),IY( 265)/'DRAW',   7,  12/
      DATA IOPERA( 266),IX( 266),IY( 266)/'MOVE',  -7,  -9/
      DATA IOPERA( 267),IX( 267),IY( 267)/'DRAW',   7,  -9/
C
      DATA IXMIND(  26)/ -10/
      DATA IXMAXD(  26)/  10/
      DATA IXDELD(  26)/  20/
      DATA ISTARD(  26)/ 262/
      DATA NUMCOO(  26)/   6/
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMCO=1
      ISTART=1
      ISTOP=1
      NC=1
C
C               ******************************************
C               ******************************************
C               **  TREAT THE ROMAN SIMPLEX UPPER CASE  **
C               **  HERSHEY CHARACTER SET CASE          **
C               ******************************************
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 DPRSU--')
      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               **************************************************
C               **  STEP 1--                                    **
C               **  SEARCH FOR THE INPUT CHARACTER(S).          **
C               **  MAP THE CHARACTER(S) INTO A NUMERIC VALUE.  **
C               **************************************************
C               **************************************************
C
      CALL DPCHAL(ICHAR2,ICHARN,IBUGD2,IFOUND)
      IF(IFOUND.EQ.'NO')GOTO9000
      GOTO1000
C
C               **************************************
C               **************************************
C               **  STEP 2--                        **
C               **  EXTRACT THE COORDINATES         **
C               **  FOR THIS PARTICULAR CHARACTER.  **
C               **************************************
C               **************************************
C
 1000 CONTINUE
      ISTART=ISTARD(ICHARN)
      NC=NUMCOO(ICHARN)
      ISTOP=ISTART+NC-1
      J=0
      DO1100I=ISTART,ISTOP
      J=J+1
      IOP(J)=IOPERA(I)
      X(J)=IX(I)
      Y(J)=IY(I)
 1100 CONTINUE
      NUMCO=J
      IXMINS=IXMIND(ICHARN)
      IXMAXS=IXMAXD(ICHARN)
      IXDELS=IXDELD(ICHARN)
C
      GOTO9000
C
C               *****************
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
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 DPRSU--')
      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 DPRTF1(IHEAD,NHEAD,CAPTN,NCAP)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              RTF OUTPUT.  THIS ROUTINE IS USED TO INITIATE
C              THE RTF OUTPUT AND STARTS THE FIRST TABLE.
C              THE ONLY OPTIONAL ELEMENT IS THE CAPTION.
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE HEADER
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                HEADER.
C                     --CAPTN  = THE CHARACTER STRING CONTAINING
C                                THE CAPTION.
C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                CAPTION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) CAPTN
      CHARACTER*(*) IHEAD
C
      CHARACTER*1  IBASLC
      CHARACTER*10 IFORMT
C
      INCLUDE 'DPCOST.INC'
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
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
C
      CALL DPCONA(92,IBASLC)
 8001 FORMAT('{',A1,'pard')
 8002 FORMAT(A1,'par}')
C8003 FORMAT('{',A1,'qc',A1,'fs',I2,A1,'b')
 8003 FORMAT('{',A1,'qc',A1,'b')
 8007 FORMAT('}')
 8008 FORMAT(A1,'line')
 8009 FORMAT(A1,'line ',A1,'line')
      WRITE(ICOUT,8001)IBASLC
      CALL DPWRST('XXX','WRIT')
      IF(NHEAD.GE.1)THEN
        ATEMP=1.5*REAL(IRTFPS)
        ITEMP=INT(ATEMP)
        WRITE(ICOUT,8003)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:5)='(A  )'
        WRITE(IFORMT(3:4),'(I2)')NHEAD
        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 8013 FORMAT('{',A1,'qc',A1,'b')
      IF(NCAP.GT.0)THEN
        WRITE(ICOUT,8013)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IFORMT=' '
        IFORMT(1:5)='(A  )'
        WRITE(IFORMT(3:4),'(I2)')NCAP
        WRITE(ICOUT,IFORMT)CAPTN(1:NCAP)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,8002)IBASLC
      CALL DPWRST('XXX','WRIT')
C
      RETURN
      END
      SUBROUTINE DPRTF4(IVALUE,NCHAR,NHEAD,IFLAG1,IFLAG2)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              RTF OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              A HEADER ROW FOR A TABLE.  YOU CAN ALSO OPTIONALLY
C              ADD A RULE LINE BEFORE OR AFTER THE HEADER.
C
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING ARRAY
C                                 CONTAINING THE TEXT FOR THE
C                                 HEADER VALUES.
C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 HEADER VALUES.
C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
C                                 THE NUMBER OF HEADER VALUES.
C                     --IFLAG1  = A LOGICAL VALUE THAT SPECIFIES
C                                 WHETHER A RULE LINE IS DRAWN BEFORE
C                                 THE HEADER.
C                     --IFLAG2  = A LOGICAL VALUE THAT SPECIFIES
C                                 WHETHER A RULE LINE IS DRAWN AFTER
C                                 THE HHEADER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE(NHEAD)
      INTEGER NCHAR(NHEAD)
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDIG(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
C
      CHARACTER*1  IBASLC
      CHARACTER*20 IFORMT
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
      CALL DPCONA(92,IBASLC)
C
C  STEP 1: GENERATE A HEADER LINE
C
 8001 FORMAT('{',A1,'trowd',A1,'trgraph90')
      WRITE(ICOUT,8001)IBASLC,IBASLC
      CALL DPWRST('XXX','WRIT')
C
 8011 FORMAT(A1,'clvertalt',A1,'cellx',I3)
 8012 FORMAT(A1,'clvertalc',A1,'cellx',I3)
 8013 FORMAT(A1,'clvertalb',A1,'cellx',I3)
 8111 FORMAT(A1,'clvertalt',A1,'cellx',I4)
 8112 FORMAT(A1,'clvertalc',A1,'cellx',I4)
 8113 FORMAT(A1,'clvertalb',A1,'cellx',I4)
 8211 FORMAT(A1,'clvertalt',A1,'cellx',I5)
 8212 FORMAT(A1,'clvertalc',A1,'cellx',I5)
 8213 FORMAT(A1,'clvertalb',A1,'cellx',I5)
 8014 FORMAT(A1,'clbrdrt',A1,'brdrw15',A1,'brdrs')
 8015 FORMAT(A1,'clbrdrb',A1,'brdrw15',A1,'brdrs')
      DO8010I=1,NHEAD
        IF(IFLAG1)THEN
          WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(IFLAG2)THEN
          WRITE(ICOUT,8015)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(VALIGN(I).EQ.'b')THEN
          IF(IWIDTH(I).LE.999)THEN
            WRITE(ICOUT,8013)IBASLC,IBASLC,IWIDTH(I)
          ELSEIF(IWIDTH(I).LE.9999)THEN
            WRITE(ICOUT,8113)IBASLC,IBASLC,IWIDTH(I)
          ELSE
            WRITE(ICOUT,8213)IBASLC,IBASLC,IWIDTH(I)
          ENDIF
        ELSEIF(VALIGN(I).EQ.'c')THEN
          IF(IWIDTH(I).LE.999)THEN
            WRITE(ICOUT,8012)IBASLC,IBASLC,IWIDTH(I)
          ELSEIF(IWIDTH(I).LE.9999)THEN
            WRITE(ICOUT,8112)IBASLC,IBASLC,IWIDTH(I)
          ELSE
            WRITE(ICOUT,8212)IBASLC,IBASLC,IWIDTH(I)
          ENDIF
        ELSE
          IF(IWIDTH(I).LE.999)THEN
            WRITE(ICOUT,8011)IBASLC,IBASLC,IWIDTH(I)
          ELSEIF(IWIDTH(I).LE.9999)THEN
            WRITE(ICOUT,8111)IBASLC,IBASLC,IWIDTH(I)
          ELSE
            WRITE(ICOUT,8211)IBASLC,IBASLC,IWIDTH(I)
          ENDIF
        ENDIF
        CALL DPWRST('XXX','WRIT')
 8010 CONTINUE
C
 8021 FORMAT(A1,'pard',A1,'intbl',A1,'ql {')
 8022 FORMAT(A1,'pard',A1,'intbl',A1,'qc {')
 8023 FORMAT(A1,'pard',A1,'intbl',A1,'qr {')
      IFORMT=' '
      IFORMT(1:5)='(A  )'
 8027 FORMAT('}',A1,'cell')
      DO8020I=1,NHEAD
        IF(ALIGN(I).EQ.'l')THEN
          WRITE(ICOUT,8021)IBASLC,IBASLC,IBASLC
        ELSEIF(ALIGN(I).EQ.'c')THEN
          WRITE(ICOUT,8022)IBASLC,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8023)IBASLC,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        IF(NCHAR(I).GT.0)THEN
          WRITE(IFORMT(3:4),'(I2)')NCHAR(I)
          WRITE(ICOUT,IFORMT)IVALUE(I)(1:NCHAR(I))
          CALL DPWRST('XXX','WRIT')
        ELSE
          ITEMP=1
          WRITE(IFORMT(3:4),'(I2)')ITEMP
          WRITE(ICOUT,IFORMT) ' '
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8027)IBASLC
        CALL DPWRST('XXX','WRIT')
 8020 CONTINUE
C
 8039 FORMAT(A1,'row}')
      WRITE(ICOUT,8039)IBASLC
      CALL DPWRST('XXX','WRIT')
C
      RETURN
      END
      SUBROUTINE DPRTF5(IVALUE,NCHAR,AVALUE,NHEAD,IFLAG1)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              RTF OUTPUT.  THIS ROUTINE IS USED TO GENERATE
C              A DATA ROW FOR A TABLE.  THE FIRST FIELD CAN BE
C              A TEXT VALUE (FOR A ROW LABEL).
C
C     INPUT  ARGUMENTS--IVALUE  = THE CHARACTER STRING CONTAINING
C                                 THE TEXT FOR THE FIRST COLUMN.
C                     --NCHAR   = THE INTEGER ARRAY THAT SPECIFIES
C                                 THE NUMBER OF CHARACTERS IN THE
C                                 FIRST TEXT FIELD.
C                     --AVALUE  = A REAL ARRAY CONTAINING THE DATA
C                                 TO BE GENERATED.
C                     --NHEAD   = THE INTEGER VALUE THAT SPECIFIES
C                                 THE NUMBER OF NUMERIC VALUES.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IVALUE
      REAL AVALUE(NHEAD)
      INTEGER NCHAR
C
      PARAMETER (MAXHED=50)
      INTEGER IWIDTH(MAXHED)
      INTEGER NUMDIG(MAXHED)
      CHARACTER*8 ALIGN(MAXHED)
      CHARACTER*8 VALIGN(MAXHED)
      COMMON/HTML4/IWIDTH,NUMDIG,ALIGN,VALIGN
C
      LOGICAL IFLAG1
C
      CHARACTER*1  IBASLC
      CHARACTER*20 IFORMT
C
      INCLUDE 'DPCOST.INC'
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
      CALL DPCONA(92,IBASLC)
C
C  STEP 1: GENERATE A HEADER LINE
C
 8001 FORMAT('{',A1,'trowd',A1,'trgraph90')
      WRITE(ICOUT,8001)IBASLC,IBASLC
      CALL DPWRST('XXX','WRIT')
C
 8011 FORMAT(A1,'clvertalt',A1,'cellx',I3)
 8012 FORMAT(A1,'clvertalc',A1,'cellx',I3)
 8013 FORMAT(A1,'clvertalb',A1,'cellx',I3)
 8111 FORMAT(A1,'clvertalt',A1,'cellx',I4)
 8112 FORMAT(A1,'clvertalc',A1,'cellx',I4)
 8113 FORMAT(A1,'clvertalb',A1,'cellx',I4)
 8211 FORMAT(A1,'clvertalt',A1,'cellx',I5)
 8212 FORMAT(A1,'clvertalc',A1,'cellx',I5)
 8213 FORMAT(A1,'clvertalb',A1,'cellx',I5)
 8014 FORMAT(A1,'clbrdrt',A1,'brdrw15',A1,'brdrs')
 8015 FORMAT(A1,'clbrdrb',A1,'brdrw15',A1,'brdrs')
      NCOLS=NHEAD
      IF(NCHAR.GT.0)NCOLS=NCOLS+1
      DO8010I=1,NCOLS
        IF(IFLAG1)THEN
          WRITE(ICOUT,8015)IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(VALIGN(I).EQ.'b')THEN
          IF(IWIDTH(I).LE.999)THEN
            WRITE(ICOUT,8013)IBASLC,IBASLC,IWIDTH(I)
          ELSEIF(IWIDTH(I).LE.9999)THEN
            WRITE(ICOUT,8113)IBASLC,IBASLC,IWIDTH(I)
          ELSE
            WRITE(ICOUT,8213)IBASLC,IBASLC,IWIDTH(I)
          ENDIF
        ELSEIF(VALIGN(I).EQ.'c')THEN
          IF(IWIDTH(I).LE.999)THEN
            WRITE(ICOUT,8012)IBASLC,IBASLC,IWIDTH(I)
          ELSEIF(IWIDTH(I).LE.9999)THEN
            WRITE(ICOUT,8112)IBASLC,IBASLC,IWIDTH(I)
          ELSE
            WRITE(ICOUT,8212)IBASLC,IBASLC,IWIDTH(I)
          ENDIF
        ELSE
          IF(IWIDTH(I).LE.999)THEN
            WRITE(ICOUT,8011)IBASLC,IBASLC,IWIDTH(I)
          ELSEIF(IWIDTH(I).LE.9999)THEN
            WRITE(ICOUT,8111)IBASLC,IBASLC,IWIDTH(I)
          ELSE
            WRITE(ICOUT,8211)IBASLC,IBASLC,IWIDTH(I)
          ENDIF
        ENDIF
        CALL DPWRST('XXX','WRIT')
 8010 CONTINUE
C
 8021 FORMAT(A1,'pard',A1,'intbl',A1,'ql {')
 8022 FORMAT(A1,'pard',A1,'intbl',A1,'qc {')
 8023 FORMAT(A1,'pard',A1,'intbl',A1,'qr {')
      IFORMT=' '
      IFORMT(1:5)='(A  )'
 8027 FORMAT('}',A1,'cell')
C
C  PRINT ROW LABEL
C
      IF(NCHAR.GT.0)THEN
        IF(ALIGN(1).EQ.'l')THEN
          WRITE(ICOUT,8021)IBASLC,IBASLC,IBASLC
        ELSEIF(ALIGN(1).EQ.'c')THEN
          WRITE(ICOUT,8022)IBASLC,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8023)IBASLC,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(IFORMT(3:4),'(I2)')NCHAR
        WRITE(ICOUT,IFORMT)IVALUE(1:NCHAR)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8027)IBASLC
        CALL DPWRST('XXX','WRIT')
        IADD=1
      ELSE
        IADD=0
      ENDIF
C
C  PRINT NUMERIC VALUES
C
 8091 FORMAT(a1,'f',I1)
      IF(IRTFFF.EQ.'Courier New')THEN
        ITEMP=1
      ELSEIF(IRTFFF.EQ.'Lucida Console')THEN
        ITEMP=8
      ENDIF 
      WRITE(ICOUT,8091)IBASLC,ITEMP
      CALL DPWRST(ICOUT,'WRIT')
 8035 FORMAT(1X)
 8031 FORMAT(G15.7)
 8033 FORMAT(I12)
      DO8020I=1,NHEAD
        IF(ALIGN(I+IADD).EQ.'l')THEN
          WRITE(ICOUT,8021)IBASLC,IBASLC,IBASLC
        ELSEIF(ALIGN(I+IADD).EQ.'c')THEN
          WRITE(ICOUT,8022)IBASLC,IBASLC,IBASLC
        ELSE
          WRITE(ICOUT,8023)IBASLC,IBASLC,IBASLC
        ENDIF
        CALL DPWRST('XXX','WRIT')
C
        IFORMT=' '
        NRIGHT=MIN(NUMDIG(I+IADD),9)
        IF(ABS(AVALUE(I+IADD)).LT.10.0)THEN
          NLEFT=1
        ELSEIF(ABS(AVALUE(I+IADD)).LT.100.0)THEN
          NLEFT=2
        ELSEIF(ABS(AVALUE(I+IADD)).LT.1000.0)THEN
          NLEFT=3
        ELSEIF(ABS(AVALUE(I+IADD)).LT.10000.0)THEN
          NLEFT=4
        ELSEIF(ABS(AVALUE(I+IADD)).LT.100000.0)THEN
          NLEFT=5
        ELSEIF(ABS(AVALUE(I+IADD)).LT.1000000.0)THEN
          NLEFT=6
        ELSE
          NLEFT=7
        ENDIF
        NTOT=NRIGHT+NLEFT+2
        IF(NUMDIG(I+IADD).GT.0)THEN
          IFORMT(1:7)='(F  . )'
          WRITE(IFORMT(3:4),'(I2)')NTOT
          WRITE(IFORMT(6:6),'(I1)')NRIGHT
          WRITE(ICOUT,IFORMT)AVALUE(I+IADD)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(NUMDIG(I+IADD).EQ.0)THEN
          IFORMT(1:5)='(I  )'
          WRITE(IFORMT(3:4),'(I2)')NLEFT
          WRITE(ICOUT,IFORMT)INT(AVALUE(I+IADD)+0.5)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(NUMDIG(I+IADD).EQ.-1)THEN
          WRITE(ICOUT,8035)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(NUMDIG(I+IADD).EQ.-2)THEN
          IFORMT(1:7)='(G  .7)'
          NTOT=12+NLEFT
          WRITE(IFORMT(3:4),'(I2)')NTOT
          WRITE(ICOUT,IFORMT)AVALUE(I+IADD)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,'(A1)') ' '
        ENDIF
C
        WRITE(ICOUT,8027)IBASLC
        CALL DPWRST('XXX','WRIT')
 8020 CONTINUE
C
 8039 FORMAT(A1,'row}')
      WRITE(ICOUT,8039)IBASLC
      CALL DPWRST('XXX','WRIT')
C
      IF(IRTFFF.EQ.'Times New Roman')THEN
        ITEMP=0
      ELSEIF(IRTFFF.EQ.'Lucida Sans')THEN
        ITEMP=6
      ELSEIF(IRTFFF.EQ.'Arial')THEN
        ITEMP=2
      ELSEIF(IRTFFF.EQ.'Bookman')THEN
        ITEMP=3
      ELSEIF(IRTFFF.EQ.'Georgia')THEN
        ITEMP=4
      ELSEIF(IRTFFF.EQ.'Tahoma')THEN
        ITEMP=5
      ELSEIF(IRTFFF.EQ.'Verdana')THEN
        ITEMP=7
      ENDIF 
      WRITE(ICOUT,8091)IBASLC,ITEMP
      CALL DPWRST(ICOUT,'WRIT')
C
      RETURN
      END
      SUBROUTINE DPRTF6(NHEAD)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              RTF OUTPUT.  THIS ROUTINE IS USED TO CLOSE A
C              TABLE (PRINT 2 BLANK LINES).
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE HEADER
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                HEADER.
C                     --CAPTN  = THE CHARACTER STRING CONTAINING
C                                THE CAPTION.
C                     --NCAP   = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                CAPTION.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*1  IBASLC
C
      INCLUDE 'DPCOST.INC'
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
C  STEP 1: WRITE SOME LINE BREAKS
C
C
      CALL DPCONA(92,IBASLC)
 8009 FORMAT(A1,'line ',A1,'line')
      WRITE(ICOUT,8009)IBASLC,IBASLC
      CALL DPWRST('XXX','WRIT')
C
      RETURN
      END
      SUBROUTINE DPRTF7(IHEAD,NHEAD,AVAL)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              RTF OUTPUT.  THIS ROUTINE IS USED TO WRITE A
C              A SINGLE LINE OF OUTPUT.
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE LINE
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                LINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*(*) IHEAD
C
      CHARACTER*1  IBASLC
      CHARACTER*1  IQUOTE
      CHARACTER*25 IFORMT
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
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
      CALL DPCONA(92,IBASLC)
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
 8005 FORMAT('{',A1,'ql ')
 8007 FORMAT(A1,'line')
C
      IF(NHEAD.GE.1)THEN
        IFORMT=' '
        IFORMT(1:23)='(A  ,2X,F12.5,2X,A1)'
        WRITE(IFORMT(3:4),'(I2)')NHEAD
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,IFORMT)IHEAD(1:NHEAD),AVAL,'}'
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPRTF8(IHEAD,NHEAD,ITEMP,IFLAG1)
C
C     PURPOSE--THIS ROUTINE IS A UTILUTY ROUTINE FOR CREATING
C              RTF OUTPUT.  THIS ROUTINE IS USED TO INITIATE
C              THE RTF OUTPUT AND GENERATE AN OVERALL TITLE.
C     INPUT  ARGUMENTS--IHEAD  = THE CHARACTER STRING CONTAINING
C                                THE TEXT FOR THE HEADER
C                     --NHEAD  = THE INTEGER NUMBER THAT SPECIFIES
C                                THE NUMBER OF CHARACTERS IN THE
C                                HEADER.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABOARATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
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--2005/2
C     ORIGINAL VERSION--FEBRUARY  2005.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL IFLAG1
      LOGICAL IFLAG2
C
      CHARACTER*(*) IHEAD
C
      CHARACTER*1  IBASLC
      CHARACTER*1  IQUOTE
      CHARACTER*40 IFORMT
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
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
      CALL DPCONA(92,IBASLC)
      CALL DPCONA(39,IQUOTE)
C
 8001 FORMAT(A1,'par}')
 8003 FORMAT(A1,'pagebb')
 8004 FORMAT(A1,'f',I1)
 8014 FORMAT(A1,'f',I2)
 8005 FORMAT('{',A1,'pard')
      IF(IFLAG1)THEN
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ITEMP.LE.9)THEN
          WRITE(ICOUT,8004)IBASLC,ITEMP
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8014)IBASLC,ITEMP
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8005)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      IF(NHEAD.GE.1)THEN
        IFORMT=' '
        IFORMT='( { ,A1, qc  ,A  , }  ,A1, line )'
        IFORMT(2:2)=IQUOTE
        IFORMT(4:4)=IQUOTE
        IFORMT(9:9)=IQUOTE
        IFORMT(13:13)=IQUOTE
        IFORMT(19:19)=IQUOTE
        IFORMT(22:22)=IQUOTE
        IFORMT(27:27)=IQUOTE
        IFORMT(32:32)=IQUOTE
        WRITE(IFORMT(16:17),'(I2)')NHEAD
        WRITE(ICOUT,IFORMT)IBASLC,IHEAD(1:NHEAD),IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPRTIL(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 ITALIC 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-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--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 DPRTIL--')
      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.7)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRTIL1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(8.LE.ICHARN.AND.ICHARN.LE.15)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRTIL2(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1029 CONTINUE
C
      IF(16.LE.ICHARN.AND.ICHARN.LE.23)GOTO1030
      GOTO1039
 1030 CONTINUE
      CALL DRTIL3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IF(ICHARN.GE.24)GOTO1040
      GOTO1049
 1040 CONTINUE
      CALL DRTIL4(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 DPRTIL--')
      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 DPRTIN(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 ITALIC 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-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--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 DPRTIN--')
      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.7)GOTO1010
      GOTO1019
 1010 CONTINUE
      CALL DRTIN1(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1019 CONTINUE
C
      IF(ICHARN.GE.8)GOTO1020
      GOTO1029
 1020 CONTINUE
      CALL DRTIN2(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 DPRTIN--')
      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 DPRTIU(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 ITALIC 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-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--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 DPRTIU--')
      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 DRTIU1(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 DRTIU2(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 DRTIU3(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1039 CONTINUE
C
      IF(ICHARN.GE.20)GOTO1040
      GOTO1049
 1040 CONTINUE
      CALL DRTIU4(ICHARN,IOP,X,Y,NUMCO,IXMINS,IXMAXS,IXDELS,
     1IBUGD2,IFOUND,IERROR)
      GOTO9000
 1049 CONTINUE
C
      IFOUND='NO'
      GOTO9000
C
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 DPRTIU--')
      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
