      SUBROUTINE DPPACO(IHARG,NUMARG,IDEFPC,MAXPAT,IPATCO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN COLORS.
C              THESE ARE LOCATED IN THE VECTOR IPATCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFPC
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IPATCO (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPC
      CHARACTER*4 IPATCO
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 IPATCO(*)
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='DPPA'
      ISUBN2='CO  '
C
      NUMPAT=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 DPPACO--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPC
   55 FORMAT('IDEFPC = ',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)IPATCO(1)
   70 FORMAT('IPATCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IPATCO(I)
   76 FORMAT('I,IPATCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IDEFPC
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      IPATCO(1)=IDEFPC
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG-1
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEFPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEFPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPC
      IPATCO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,IPATCO(I)
 1276 FORMAT('PATTERN COLOR ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEFPC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEFPC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPC
      DO1315I=1,NUMPAT
      IPATCO(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)IPATCO(I)
 1316 FORMAT('ALL PATTERN COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPACO--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPC
 9015 FORMAT('IDEFPC = ',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)IPATCO(1)
 9030 FORMAT('IPATCO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IPATCO(I)
 9036 FORMAT('I,IPATCO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPAHE(IHARG,IARGT,ARG,NUMARG,PDEFPH,MAXPAT,PPATHE,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN HEIGHTS.
C              THESE ARE LOCATED IN THE VECTOR PPATHE(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFPH
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PPATHE (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  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 PPATHE(*)
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='DPPA'
      ISUBN2='HE  '
C
      NUMPAT=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 DPPAHE--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPH
   55 FORMAT('PDEFPH = ',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)PPATHE(1)
   70 FORMAT('PPATHE(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PPATHE(I)
   76 FORMAT('I,PPATHE(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.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=PDEFPH
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      PPATHE(1)=PDEFPH
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG-1
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPH
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPH
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPH
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPH
      PPATHE(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,PPATHE(I)
 1276 FORMAT('PATTERN HEIGHT ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPH
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPH
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPH
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPH
      DO1315I=1,NUMPAT
      PPATHE(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)PPATHE(I)
 1316 FORMAT('ALL PATTERN HEIGHTS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPAHE--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPH
 9015 FORMAT('PDEFPH = ',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)PPATHE(1)
 9030 FORMAT('PPATHE(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PPATHE(I)
 9036 FORMAT('I,PPATHE(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPALI(IHARG,NUMARG,IDEFPL,MAXPAT,IPATLI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN LINE TYPES.
C              THESE ARE LOCATED IN THE VECTOR IPATLI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFPL
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IPATLI (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPL
      CHARACTER*4 IPATLI
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 IPATLI(*)
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='DPPA'
      ISUBN2='LI  '
C
      NUMPAT=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 DPPALI--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPL
   55 FORMAT('IDEFPL = ',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)IPATLI(1)
   70 FORMAT('IPATLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IPATLI(I)
   76 FORMAT('I,IPATLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      IPATLI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG-1
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPL
      IPATLI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,IPATLI(I)
 1276 FORMAT('PATTERN LINE ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPL
      DO1315I=1,NUMPAT
      IPATLI(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)IPATLI(I)
 1316 FORMAT('ALL PATTERN LINES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPALI--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPL
 9015 FORMAT('IDEFPL = ',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)IPATLI(1)
 9030 FORMAT('IPATLI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IPATLI(I)
 9036 FORMAT('I,IPATLI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPAPA(IHARG,NUMARG,IDEFPP,MAXPAT,IPATPA,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN (PATTERNS).
C              THESE ARE LOCATED IN THE VECTOR IPATPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFPP
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IPATPA (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPP
      CHARACTER*4 IPATPA
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 IPATPA(*)
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='DPPA'
      ISUBN2='PA  '
C
      NUMPAT=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 DPPAPA--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPP
   55 FORMAT('IDEFPP = ',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)IPATPA(1)
   70 FORMAT('IPATPA(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IPATPA(I)
   76 FORMAT('I,IPATPA(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1100
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      GOTO1130
C
 1100 CONTINUE
      GOTO1200
C
 1110 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1='    '
      IF(IHARG(1).EQ.'ALL')GOTO1300
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(1).EQ.'ALL')GOTO1300
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(1)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      IPATPA(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPP
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPP
      IPATPA(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,IPATPA(I)
 1276 FORMAT('PATTERN ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPP
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPP
      DO1315I=1,NUMPAT
      IPATPA(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)IPATPA(I)
 1316 FORMAT('ALL PATTERNS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPAPA--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPP
 9015 FORMAT('IDEFPP = ',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)IPATPA(1)
 9030 FORMAT('IPATPA(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IPATPA(I)
 9036 FORMAT('I,IPATPA(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPARE(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
CCCCC1ICONT,IDIREC,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
     1ICONT,IDIREC,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PARETO PLOT
C              (AN ORDERED--HIGH TO LOW) PLOT)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/8
C     ORIGINAL VERSION--AUGUST    1988.
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 ICONT
      CHARACTER*4 IDIREC
CCCCC THE FOLLOWING LINE WAS ADDED     DECEMBER 1994
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
C
      DIMENSION XIDTEM(MAXOBV)
      DIMENSION TEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),XIDTEM(1))
      EQUIVALENCE (GARBAG(IGARB4),TEMP(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
      IERROR='NO'
C
      ISUBN1='DPPA'
      ISUBN2='RE  '
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
      ICOLH=0
C
C               **********************************
C               **  TREAT THE PARETO PLOT CASE  **
C               **********************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PARE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPARE--')
      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)ICONT,IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('ICONT,IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IDIREC
   54 FORMAT('IDIREC = ',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
      ICASPL='PAPL'
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'PARE'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
      GOTO190
C
  190 CONTINUE
C
C               ***********************************************************
C               **  STEP 1--                                             **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,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,ICOLL,NLEFT
  211 FORMAT('IHLEFT,ICOLL,NLEFT = ',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 2 OR LARGER.                **
C               ***************************************************************
C
      ISTEPN='3'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPPARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A PARETO PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE 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 DPPARE')
      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               **  IS BOTH THE HORIZONTAL AXIS VARIABLE VALUE, AND       **
C               **  THE CHARACTER TAG.                                    **
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  NEED NOT HAVE BEEN PREVIOUSLY                         **
C               **  SORTED OR HAVE COMMON VALUES ADJACENT.                **
C               **  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
      IF(NUMV2.EQ.1)GOTO590
      IF(NUMV2.EQ.2)GOTO530
      GOTO510
C
  510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPPARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR A PARETO PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,519)
  519 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,520)
  520 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,521)
  521 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)NUMV2
  522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,524)(IANS(I),I=1,IWIDTH)
  524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  530 CONTINUE
      IHHOR=IHARG(2)
      IHHOR2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHHOR,IHHOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLH=IVALUE(ILOCV)
      NHOR=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,531)IHHOR,ICOLH,NHOR
  531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NHOR.NE.NLEFT)GOTO570
      GOTO590
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPPARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A PARETO PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)
  578 FORMAT('      WHEN HAVE 2 VARAIBLES 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  (RESPONSE VALUES)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,NLEFT
  584 FORMAT('                  ',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)IHHOR,NHOR
  586 FORMAT('                  ',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 SECOND VARIABLE (IF EXISTENT)      **
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,IERROR)
      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
      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)
      IF(NUMV2.LE.1)GOTO660
C
      IJ=MAXN*(ICOLH-1)+I
      IF(ICOLH.LE.MAXCOL)X1(J)=V(IJ)
      IF(ICOLH.EQ.MAXCP1)X1(J)=PRED(I)
      IF(ICOLH.EQ.MAXCP2)X1(J)=RES(I)
      IF(ICOLH.EQ.MAXCP3)X1(J)=YPLOT(I)
      IF(ICOLH.EQ.MAXCP4)X1(J)=XPLOT(I)
      IF(ICOLH.EQ.MAXCP5)X1(J)=X2PLOT(I)
      IF(ICOLH.EQ.MAXCP6)X1(J)=TAGPLO(I)
C
  660 CONTINUE
      NLOCAL=J
C
C               *************************************************************
C               **  STEP 8--                                               **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                  **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.                     **
C               **  DEFINE THE VECTOR D(.) TO 1'S, 2'S, AND 3'S            **
C               **  FOR THE PLOTTED VALUE, THE LOWER CONFIDENCE LINE,      **
C               **  AND THE UPPER CONFIDENCE LINE.                         **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).          **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).          **
C               *************************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C
  809 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS ADDED DECEMBER 1994
      MAXTAG=NLOCAL
      IF(NUMV2.GE.2)THEN
         MAXTAG=X1(1)
         DO820I=1,NLOCAL
            IF(X1(I).GT.MAXTAG)MAXTAG=X1(I)
  820    CONTINUE
      ENDIF
C
CCCCC MAXTAG WAS ADDED AS AN ARGUMENT BELOW     DECEMBER 1994
CCCCC ISUBRO WAS ADDED AS AN ARGUMENT BELOW     DECEMBER 1994
      CALL DPPAR2(Y1,X1,NLOCAL,NUMV2,MAXTAG,ICASPL,ICONT,IDIREC,
CCCCC1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
     1Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PARE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPARE--')
      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)IDIREC
 9014 FORMAT('IDIREC = ',A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPAR2(Y,X,N,NUMV2,MAXTAG,ICASPL,ICONT,IDIREC,
CCCCC1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
     1Y2,X2,D2,N2,NPLOTV,ISUBRO,IBUGG3,IERROR)
CCCCC MAXTAG WAS ADDED TO THE ABOVE LIST DECEMBER 1994
CCCCC ISUBRO WAS ADDED TO THE ABOVE LIST DECEMBER 1994
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A PARETO PLOT.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/8
C     ORIGINAL VERSION--AUGUST    1988.
C     UPDATED         --APRIL     1992. NUMSET TO NUMV2
C     UPDATED         --DECEMBER  1994. ADD MAXTAG FOR 2-ARG
C     UPDATED         --DECEMBER  1994. REWRITE MOST OF CODE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 IDIREC
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
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='DPPA'
      ISUBN2='R2  '
C
CCCCC THE FOLLOWING SECTION WAS ADDED     DECEMBER 1994
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PAR2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPAR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,N,NUMV2,MAXTAG,IERROR
   52 FORMAT('ICASPL,N,NUMV2,MAXTAG,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDIREC
   53 FORMAT('IDIREC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)N,N2,NPLOTV
   54 FORMAT('N,N2,NPLOTV = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      DO81I=1,N
      WRITE(ICOUT,82)I,Y(I),X(I)
   82 FORMAT('I,Y(I),X(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      DO85I=1,N2
      WRITE(ICOUT,999)
      WRITE(ICOUT,86)I,Y2(I),X2(I),D2(I)
   86 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   90 CONTINUE
C
      IF(NUMV2.EQ.1)THEN
         DO1112I=1,N
            X(I)=I
 1112    CONTINUE
      ENDIF
C
      IF(IDIREC.EQ.'DECR')THEN
         DO1120I=1,N
            Y(I)=(-Y(I))
 1120    CONTINUE
      ENDIF
C
      CALL SORTC(Y,X,N,Y2,D2)
C
      IF(IDIREC.EQ.'DECR')THEN
         DO1130I=1,N
            Y2(I)=(-Y2(I))
 1130    CONTINUE
      ENDIF
C
CCCCC IF(NUMV2.EQ.1)THEN
         DO1140I=1,N
            X2(I)=I
 1140    CONTINUE
CCCCC ENDIF
C
      K=N
      DO1150I=1,N
         K=K+1
         Y2(K)=Y2(I)
         X2(K)=X2(I)
CCCCC THE FOLLOWING LINE WAS FIXED   DECEMBER 1994
CCCCC    D2(K)=N+1
         D2(K)=MAXTAG+1
 1150 CONTINUE
C
      N2=K
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PAR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPAR2--')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9012)ICASPL,N,NUMSET,IERROR
C9012 FORMAT('ICASPL,N,NUMSET,IERROR = ',A4,2I8,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE AUGMENTED   DECEMBER 1994
CCCCC WRITE(ICOUT,9012)ICASPL,N,NUMV2,IERROR
C9012 FORMAT('ICASPL,N,NUMV2,IERROR = ',A4,2I8,2X,A4)
      WRITE(ICOUT,9012)ICASPL,N,NUMV2,MAXTAG,IERROR
 9012 FORMAT('ICASPL,N,NUMV2,MAXTAG,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDIREC
 9013 FORMAT('IDIREC = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N2,NPLOTV
 9014 FORMAT('N2,NPLOTV = ',I8,2X,I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N2
      WRITE(ICOUT,9036)I,Y2(I),X2(I),D2(I)
 9036 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPASP(IHARG,IARGT,ARG,NUMARG,PDEFPG,MAXPAT,PPATSP,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN SPACINGS.
C              THESE ARE LOCATED IN THE VECTOR PPATSP(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFPG
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PPATSP (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  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 PPATSP(*)
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='DPPA'
      ISUBN2='SP  '
C
      NUMPAT=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 DPPASP--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPG
   55 FORMAT('PDEFPG = ',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)PPATSP(1)
   70 FORMAT('PPATSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PPATSP(I)
   76 FORMAT('I,PPATSP(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.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=PDEFPG
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      PPATSP(1)=PDEFPG
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG-1
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPG
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPG
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPG
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPG
      PPATSP(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,PPATSP(I)
 1276 FORMAT('PATTERN SPACING ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPG
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPG
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPG
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPG
      DO1315I=1,NUMPAT
      PPATSP(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)PPATSP(I)
 1316 FORMAT('ALL PATTERN SPACINGS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPASP--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPG
 9015 FORMAT('PDEFPG = ',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)PPATSP(1)
 9030 FORMAT('PPATSP(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PPATSP(I)
 9036 FORMAT('I,PPATSP(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPASW(IHARG,NUMARG,IDEFPS,MAXPAT,IPATSW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN SWITCHES.
C              THESE ARE LOCATED IN THE VECTOR IPATSW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFPS
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--IPATSW (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPS
      CHARACTER*4 IPATSW
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 IPATSW(*)
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='DPPA'
      ISUBN2='SW  '
C
      NUMPAT=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 DPPASW--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPS
   55 FORMAT('IDEFPS = ',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)IPATSW(1)
   70 FORMAT('IPATSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,IPATSW(I)
   76 FORMAT('I,IPATSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1100
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      GOTO1130
C
 1100 CONTINUE
      GOTO1200
C
 1110 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1='ON'
      IF(IHARG(1).EQ.'ALL')GOTO1300
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(1).EQ.'ALL')GOTO1300
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(1)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      IPATSW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPS
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPS
      IPATSW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,IPATSW(I)
 1276 FORMAT('PATTERN ',I6,' HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFPS
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFPS
      DO1315I=1,NUMPAT
      IPATSW(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)IPATSW(I)
 1316 FORMAT('ALL PATTERNS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPASW--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)IDEFPS
 9015 FORMAT('IDEFPS = ',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)IPATSW(1)
 9030 FORMAT('IPATSW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,IPATSW(I)
 9036 FORMAT('I,IPATSW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPAT(IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PATTERN.
C              GENERATE ELEMENTS OF A PATTERN
C              BY THE FORM (FOR EXAMPLE) LET Y = PATTERN 1 1 2 2 3 3
C              (FOR A FULL VARIABLE OR PART OF A VARIABLE).
C     OUTPUT--NECESSARILY A VARIABLE.
C              EXAMPLE--LET Y    = 1 1 2 2 3 3                  (A FULL VARIABLE
C                     --LET Y    = 1 1 2 2 3 3  SUBSET 2 3 5    (A PARTIAL VAR.)
C                     --LET Y    = 1 1 2 2 3 3  FOR I = 1 2 10  (A PARTIAL VAR.)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JULY      1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
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='DPPA'
      ISUBN2='TT  '
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
      NLEFT=0
      ICOLL=0
      NRAWPA=0
      NNUM=0
      NS2=0
      NS2MOD=0
C
      ILEFT='UNKN'
      ILEFT2='UNKN'
C
C
C               ********************************************************
C               **  TREAT THE SUBCASE OF GENERATING A PATTERN         **
C               **       1) FOR A FULL VARIABLE, OR                   **
C               **       2) FOR PART OF A VARIABLE.                   **
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 DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGQ
   52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,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'
      NEWCOL='NO'
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=4
      MAXNA=1000
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE LEFT-HAND SIDE--                               *
C               **  IS THE PARAMETER OR VARIABLE NAME TO LEFT OF = SIGN        *
C               **  ALREADY IN THE NAME LIST?                                  *
C               **  NOTE THAT     ILEFT      IS THE NAME OF THE VARIABLE       *
C               **  ON THE LEFT.                                               *
C               **  NOTE THAT     ILISTL    IS THE LINE IN THE TABLE           *
C               **  OF THE NAME ON THE LEFT.                                   *
C               **  NOTE THAT     ICOLL    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE NAME OF THE LEFT.                                  *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC ILEFT=IHOL(2)
CCCCC ILEFT2=IHOL2(2)
      ILEFT=IHARG(1)
      ILEFT2=IHARG2(1)
      DO310I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO329
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
  310 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO320
      GOTO330
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)MAXNAM
  323 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,327)
  327 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,328)
  328 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  329 CONTINUE
      ILISTL=I2
      GOTO330
C
  330 CONTINUE
      NLEFT=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO340
      GOTO390
C
  340 CONTINUE
      WRITE(ICOUT,341)
  341 FORMAT('***** ERROR IN DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,342)
  342 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,343)MAXCOL
  343 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,344)
  344 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,345)
  345 FORMAT('      ENTER      STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,346)
  346 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,347)
  347 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,348)
  348 FORMAT('      IF       LET X = 1 2 9         FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,349)
  349 FORMAT('      THEN ONE MIGHT ENTER     NAME X 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,350)
  350 FORMAT('      (THEREBY EQUATING THE NAME X WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,351)
  351 FORMAT('      FOLLOWED BY              LET X = 1 2 9')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,352)
  352 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,353)
  353 FORMAT('      WITH THE NUMERIC CONSTANTS 3.14)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NLEFT=IN(ILISTL)
C
  390 CONTINUE
C
C               *************************************************
C               **  STEP 4--                                   **
C               **  EXAMINE THE RIGHT-HAND SIDE--              **
C               **  DO WE HAVE A SERIES OF CONSTANTS,          **
C               **  OR A SERIES OF PARAMETERS,                 **
C               **  OR A MIXTURE OF CONSTANTS AND PARAMETERS?  **
C               **  (ALL OF THE ABOVE ARE ALLOWED.)            **
C               *************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.4)GOTO1290
 1210 CONTINUE
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      ILLEGAL SYNTAX FOR LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      THERE SHOULD BE AT LEAST 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      NUMBER OR WORD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      TO THE RIGHT OF THE WORD    PATTERN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      FOR THIS TYPE OF LET COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      NUMAM3=NUMARG-3
      WRITE(ICOUT,1218)NUMAM3
 1218 FORMAT('      NUMBER OF SUCH NUMBERS/WORDS FOUND = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *************************************************
C               **  STEP 5--                                   **
C               **  GENERATE    NRAWPA         NUMBERS         **
C               **  IN   THE RAW PATTERN.                      **
C               **  STORE THEM TEMPORARILY IN                  **
C               **  THE VECTOR Y(.).                           **
C               *************************************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      NRAWPA=0
      DO1310J=4,NUMARG
      J2=J
      K=K+1
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1370
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1370
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1370
      IF(IARGT(J).EQ.'NUMB')GOTO1311
      IF(IARGT(J).EQ.'WORD')GOTO1312
      GOTO1360
 1311 CONTINUE
      Y(K)=ARG(J)
      GOTO1310
 1312 CONTINUE
      IH=IHARG(J)
      IH2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      Y(K)=VALUE(ILOC)
      GOTO1310
 1310 CONTINUE
      NRAWPA=K
      GOTO1380
C
 1360 CONTINUE
      WRITE(ICOUT,1361)
 1361 FORMAT('***** INTERNAL ERROR IN DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1362)
 1362 FORMAT('      AN ARGUMENT TYPE WHICH SHOULD BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1363)
 1363 FORMAT('      EITHER A NUMBER OR A WORD, IS NEITHER.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1364)IHARG(J2),IHARG2(J2)
 1364 FORMAT('      ARGUMENT                  = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1365)J2
 1365 FORMAT('      LOCATION IN ARGUMENT LIST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1366)IARGT(J2)
 1366 FORMAT('      ARGUMENT TYPE             = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1367)
 1367 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1368)(IANS(I),I=1,IWIDTH)
 1368 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1370 CONTINUE
      NRAWPA=K-1
      GOTO1380
C
 1380 CONTINUE
      IFOUND='YES'
      IF(NRAWPA.GE.1)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1381)
 1381 FORMAT('***** ERROR IN DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1382)
 1382 FORMAT('      ILLEGAL FORM FOR THE LET COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1383)
 1383 FORMAT('      THERE ARE NO ELEMENTS IN THE PATTERN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1384)
 1384 FORMAT('      THIS IS CAUSED BY EITHER THE WORD   PATTERN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1385)
 1385 FORMAT('      BEING THE LAST WORD ON THE COMMAND LINE, OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1386)
 1386 FORMAT('      BY THE WORDS    SUBSET  OR  FOR   IMMEDIATELY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1387)
 1387 FORMAT('      FOLLOWING THE WORD   PATTERN   ON THE COMMAND ',
     1'LINE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1388)
 1388 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1389)(IANS(I),I=1,IWIDTH)
 1389 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1390 CONTINUE
C
C               ***********************************************************
C               **  STEP 7--                                             **
C               **  IF CALLED FOR (THAT IS, IF IBUGA3 IS ON),      **
C               **  PRINT OUT THE INTERMEDIATE VARIABLE Y(.).            **
C               **  THIS IS USEFUL FOR DIAGNOSTIC PURPOSES               **
C               **  IN REVIEWING THE OUTPUT FROM THIS SUBROUTINE.        **
C               ***********************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO1590
      WRITE(ICOUT,1551)
 1551 FORMAT('OUTPUT FROM MIDDLE OF DPPAT AFTER THE RAW PATTERN ',
     1'HAS BEEN GENERATED--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1552)NRAWPA
 1552 FORMAT('NRAWPA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NRAWPA.LE.0)GOTO1590
      DO1554I=1,NRAWPA
      WRITE(ICOUT,1555)I,Y(I)
 1555 FORMAT('I,Y(I) = ',I8,F12.5)
      CALL DPWRST('XXX','BUG ')
 1554 CONTINUE
C
 1590 CONTINUE
C
C               *****************************************
C               **  STEP 8--                           **
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='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1670
      DO1610J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1620
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1620
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1630
 1610 CONTINUE
      GOTO1680
C
 1620 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1680
C
 1630 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1680
C
 1670 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1671)
 1671 FORMAT('***** INTERNAL ERROR IN DPPAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1672)
 1672 FORMAT('      AT BRANCH POINT 1671--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1673)
 1673 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1674)
 1674 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1675)NUMARG
 1675 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1676)
 1676 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1677)(IANS(I),I=1,IWIDTH)
 1677 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1680 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO1690
      WRITE(ICOUT,1681)NUMARG,ILOCQ,ICASEQ
 1681 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
C
 1690 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  BRANCH TO THE APPROPRIATE SUBCASE               **
C               **  (BASED ON THE QUALIFIER);                       **
C               **  DETERMINE THE NUMBER (= NNUM)                   **
C               **  OF        NUMBERS TO BE GENERATED.              **
C               **  NOTE THAT THE VARIABLE NIISUB                   **
C               **  IS THE LENGTH OF THE RESULTING                  **
C               **  VARIABLE ISUB(.).                               **
C               **  NOTE THAT DPFOR AUTOMATICALLY EXTENDS           **
C               **  THE INPUT LENGTH OF ISUB(.) IF NECESSARY.       **
C               **  (HENCE THE REDEFINITION OF NIISUB TO NINEW      **
C               **  AFTER THE CALL TO DPFOR.                        **
C               ******************************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO1710
      IF(ICASEQ.EQ.'SUBS')GOTO1720
      IF(ICASEQ.EQ.'FOR')GOTO1730
C
 1710 CONTINUE
CCCCC IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
CCCCC IF(NEWNAM.EQ.'YES')NIISUB=NRAWPA
      NIISUB=NRAWPA
      DO1715I=1,NIISUB
      ISUB(I)=1
 1715 CONTINUE
      NS=NIISUB
      NNUM=NIISUB
      GOTO1750
C
 1720 CONTINUE
      NIISUB=MAXN
      CALL DPSUBS(NIISUB,ILOCS,NS,IBUGQ,IERROR)
      NNUM=NS
      GOTO1750
C
 1730 CONTINUE
      IF(NEWNAM.EQ.'NO')NIISUB=NLEFT
      IF(NEWNAM.EQ.'YES')NIISUB=MAXN
      CALL DPFOR(NIISUB,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIISUB=NINEW
      NNUM=NS
      GOTO1750
C
 1750 CONTINUE
C
C               ******************************************************
C               **  STEP 10--                                       **
C               **  COPY THE        PATTERN                        **
C               **  FROM THE INTERMEDIATE VECTOR Y(.)               **
C               **  TO THE APPROPRIATE COLUMN                       **
C               **  (BASED ON THE QUALIFIER--FULL, SUBSET, OR FOR)  **
C               **  IN THE INTERNAL DATAPLOT DATA TABLE.            **
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      NS2MOD=0
      DO2100I=1,NIISUB
      IJ=MAXN*(ICOLL-1)+I
      IF(ISUB(I).EQ.0)GOTO2100
      NS2=NS2+1
      NS2MOD=NS2MOD+1
      IF(NS2.EQ.1)IROW1=I
      IF(NS2MOD.GT.NRAWPA)NS2MOD=NS2MOD-NRAWPA
      IF(ICOLL.LE.MAXCOL)V(IJ)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP1)PRED(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP2)RES(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP3)YPLOT(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP4)XPLOT(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP5)X2PLOT(I)=Y(NS2MOD)
      IF(ICOLL.EQ.MAXCP6)TAGPLO(I)=Y(NS2MOD)
      IROWN=I
 2100 CONTINUE
      NNUM=NS2
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.NRAWPA)NINEW=NLEFT
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.NRAWPA)NINEW=NRAWPA
      IF(ICASEQ.EQ.'FULL'.AND.NEWNAM.EQ.'YES')NINEW=NIISUB
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'SUBS'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.GE.IROWN)NINEW=NLEFT
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'NO'.AND.
     1NLEFT.LT.IROWN)NINEW=IROWN
      IF(ICASEQ.EQ.'FOR'.AND.NEWNAM.EQ.'YES')NINEW=IROWN
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='V'
      IVALUE(ILISTL)=ICOLL
      VALUE(ILISTL)=ICOLL
      IN(ILISTL)=NINEW
C
CCCCC IUSE(ICOLL)='V'
CCCCC IVALUE(ICOLL)=ICOLL
CCCCC VALUE(ICOLL)=ICOLL
CCCCC IN(ICOLL)=NINEW
C
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
      IF(NEWNAM.EQ.'YES')NUMCOL=NUMCOL+1
C
      DO2400J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO2405
      GOTO2400
 2405 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
 2400 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO2459
      IF(IFEEDB.EQ.'OFF')GOTO2459
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)ILEFT,ILEFT2,NNUM
 2411 FORMAT('THE NUMBER OF VALUES GENERATED FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOLL-1)+IROW1
      IF(ICOLL.LE.MAXCOL)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,V(IJ),IROW1
 2421    FORMAT('THE FIRST           COMPUTED VALUE OF ',
     1   A4,A4,' = ',E15.7,'   (ROW ',I6,')')
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP1)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,PRED(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP2)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,RES(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP3)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,YPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP4)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,XPLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP5)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,X2PLOT(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ELSE IF(ICOLL.EQ.MAXCP6)THEN
         WRITE(ICOUT,2421)ILEFT,ILEFT2,TAGPLO(IROW1),IROW1
         CALL DPWRST('XXX','BUG ')
      ENDIF
C
      IJ=MAXN*(ICOLL-1)+IROWN
      IF(ICOLL.LE.MAXCOL.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,V(IJ),IROWN
 2431 FORMAT('THE LAST (',I5,'-TH) COMPUTED VALUE OF ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOLL.LE.MAXCOL.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP1.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,PRED(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP1.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP2.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,RES(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP2.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP3.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,YPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP3.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP4.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,XPLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP4.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP5.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,X2PLOT(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP5.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOLL.EQ.MAXCP6.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,ILEFT,ILEFT2,TAGPLO(IROWN),IROWN
      IF(ICOLL.EQ.MAXCP6.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(NNUM.NE.1)GOTO2449
      WRITE(ICOUT,2441)
 2441 FORMAT('SINCE THE GENERATED SAMPLE SIZE WAS ONLY 1,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2442)
 2442 FORMAT('THE ABOVE VALUE WAS THE SOLE VALUE COMPUTED.')
      CALL DPWRST('XXX','BUG ')
 2449 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2451)ILEFT,ILEFT2,ICOLL
 2451 FORMAT('THE CURRENT COLUMN FOR ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2453)ILEFT,ILEFT2,NINEW
 2453 FORMAT('THE CURRENT LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 2459 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGA3,IBUGQ
 9013 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)MAXN,NRAWPA,NS2,NS2MOD,NNUM
 9015 FORMAT('MAXN,NRAWPA,NS2,NS2MOD,NNUM = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NS,NIISUB,NNUM
 9016 FORMAT('NS,NIISUB,NNUM = ',I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)NLEFT,NRAWPA,NIISUB,IROW1,IROWN,NINEW
 9018 FORMAT('NLEFT,NRAWPA,NIISUB,IROW1,IROWN,NINEW = ',6I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)ILEFT,ILEFT2,NEWNAM,ICOLL,NINEW
 9019 FORMAT('ILEFT,ILEFT2,NEWNAM,ICOLL,NINEW = ',A4,A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPATH(IHARG,IARGT,ARG,NUMARG,PDEFPT,MAXPAT,PPATTH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN THICKNESSES.
C              THESE ARE LOCATED IN THE VECTOR PPATTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFPT
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PPATTH (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  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 PPATTH(*)
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='DPPA'
      ISUBN2='TH  '
C
      IFOUND='NO'
      IERROR='NO'
C
      NUMPAT=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 DPPATH--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPT
   55 FORMAT('PDEFPT = ',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)PPATTH(1)
   70 FORMAT('PPATTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PPATTH(I)
   76 FORMAT('I,PPATTH(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.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=PDEFPT
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      PPATTH(1)=PDEFPT
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG-1
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPT
      PPATTH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,PPATTH(I)
 1276 FORMAT('PATTERN THICKNESS ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPT
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPT
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPT
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPT
      DO1315I=1,NUMPAT
      PPATTH(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)PPATTH(I)
 1316 FORMAT('ALL PATTERN THICKNESSES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPATH--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPT
 9015 FORMAT('PDEFPT = ',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)PPATTH(1)
 9030 FORMAT('PPATTH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PPATTH(I)
 9036 FORMAT('I,PPATTH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPATT(IHARG,NUMARG,
     1IDEFPA,
     1ITEXPA,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR THE LINES
C              IN TEXT AND FIGURES.
C              THE PATTERN WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXPA.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFPA
C     OUTPUT ARGUMENTS--ITEXPA
C                     --IBUGD2
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPA
      CHARACTER*4 ITEXPA
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPATT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFPA
   53 FORMAT('IDEFPA = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IF(NUMARG.EQ.0)GOTO1140
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1140
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1160
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1170
C
 1140 CONTINUE
      ITEXPA='    '
      GOTO1180
C
 1150 CONTINUE
      ITEXPA='SOLI'
      GOTO1180
C
 1160 CONTINUE
      ITEXPA=IDEFPA
      GOTO1180
C
 1170 CONTINUE
      ITEXPA=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('THE PATTERN (FOR LINES IN TEXT AND FIGURES)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)ITEXPA
 1182 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPATT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGD2,ISUBRO,IFOUND,IERROR
 9012 FORMAT('IBUGD2,ISUBRO,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFPA,ITEXPA
 9013 FORMAT('IDEFPA,ITEXPA = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPAUS(IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--READ A LINE FROM THE TERMINAL
C              (THIS HAS THE NET EFFECT OF CAUSING
C              A PROGRAM TO PAUSE UNTIL THIS JUNK LINE IS READ).
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C-----NON-COMMON VARIABLES------------------------------------------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
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='YES'
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE END       OF DPPAUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,IFOUND,IERROR
   52 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **********************************************
C               **  STEP 1--                                **
C               **   READ IN A JUNK LINE FROM THE TERMINAL  **
C               **********************************************
C
      READ(IRD,1105)IJUNK
 1105 FORMAT(A4)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPAUS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPAWI(IHARG,IARGT,ARG,NUMARG,PDEFPW,MAXPAT,PPATWI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN WIDTHS.
C              THESE ARE LOCATED IN THE VECTOR PPATWI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFPW
C                     --MAXPAT
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PPATWI (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-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  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 PPATWI(*)
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='DPPA'
      ISUBN2='WI  '
C
      NUMPAT=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 DPPAWI--')
      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)MAXPAT,NUMPAT
   53 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPW
   55 FORMAT('PDEFPW = ',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)PPATWI(1)
   70 FORMAT('PPATWI(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PPATWI(I)
   76 FORMAT('I,PPATWI(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.0)GOTO9000
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      IF(NUMARG.EQ.3)GOTO1130
      GOTO1140
C
 1110 CONTINUE
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1='    '
      IF(IHARG(2).EQ.'ALL')HOLD1=PDEFPW
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
      IF(IHARG(2).EQ.'ALL')HOLD1=ARG(3)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(3).EQ.'ALL')HOLD1=ARG(2)
      IF(IHARG(3).EQ.'ALL')GOTO1300
      GOTO1200
C
 1140 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMPAT=1
      PPATWI(1)=PDEFPW
      GOTO1270
C
 1220 CONTINUE
      NUMPAT=NUMARG-1
      IF(NUMPAT.GT.MAXPAT)NUMPAT=MAXPAT
      DO1225I=1,NUMPAT
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPW
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPW
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPW
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPW
      PPATWI(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMPAT
      WRITE(ICOUT,1276)I,PPATWI(I)
 1276 FORMAT('PATTERN WIDTH ',I6,' HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 2--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMPAT=MAXPAT
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFPW
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFPW
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFPW
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFPW
      DO1315I=1,NUMPAT
      PPATWI(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)PPATWI(I)
 1316 FORMAT('ALL PATTERN WIDTHS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPAWI--')
      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)MAXPAT,NUMPAT
 9013 FORMAT('MAXPAT,NUMPAT = ',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)PDEFPW
 9015 FORMAT('PDEFPW = ',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)PPATWI(1)
 9030 FORMAT('PPATWI(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PPATWI(I)
 9036 FORMAT('I,PPATWI(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPCPL(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A PARALLEL COORDINATES PLOT--
C              A PARALLEL COORDINATES PLOT DOES THE FOLLOWING:
C              1) STANDARDIZE ALL VARIABLES
C              2) FOR P VARIABLES AND N POINTS, LET X(I,J) = THE
C                 STANDARDIZED VALUE OF OBSERVATION (ROW) I AND
C                 VARIABLE (COLUMN) J.
C              3) GENERATE THE FOLLOWING PLOT COORDINATES:
C                    (X(I-1,K-1), K-1) - (X(I,K),K) FOR I = 2, ..., N
C                                                   FOR K = 2, ..., P
C     WRITTEN BY--ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     REFERENCE--ED WEGMAN, xxxxx
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--2003/3
C     ORIGINAL VERSION--MARCH     2003.
C     UPDATED         --MAY       2003. GROUP PARALLEL COORDINATES
C                                       PLOT
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 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
C  MAXPCC IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  PARALLEL COORDINATES PLOT
C
      PARAMETER(MAXPCC=30)
C
      DIMENSION IVARN1(MAXPCC)
      DIMENSION IVARN2(MAXPCC)
      DIMENSION ILIS(MAXPCC)
      DIMENSION Z(MAXOBV,MAXPCC)
      DIMENSION TEMP(MAXOBV)
      DIMENSION XIDTEM(MAXOBV)
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),Z(1,1))
      EQUIVALENCE (G2RBAG(IGAR51),TEMP(1))
      EQUIVALENCE (G2RBAG(IGAR52),XIDTEM(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPPC'
      ISUBN2='PL  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
C
      ICOLH=0
C
C               ************************************************
C               **  TREAT THE PARALLEL COORDINATES PLOT CASE  **
C               ************************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PCPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPCPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG2,IBUGG3,IBUGQ,ISUBRO
   52 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='PCPL'
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'COOR'.AND.IHARG(2).EQ.'PLOT')THEN
        ILASTC=2
        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
        IFOUND='YES'
        ICASPL='PCPL'
      ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'PARA'.AND.
     1  IHARG(2).EQ.'COOR'.AND.IHARG(3).EQ.'PLOT')THEN
        ILASTC=3
        CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
        IFOUND='YES'
        ICASPL='PCPG'
      ELSE
        IFOUND='NO'
        GOTO9000
      ENDIF
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      IF(ICASPL.EQ.'PCPG')MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 11--                          **
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='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1180
      DO1100J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ')GOTO1110
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ')GOTO1110
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ')GOTO1120
 1100 CONTINUE
      GOTO1180
 1110 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1190
 1120 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1190
C
 1180 CONTINUE
      GOTO1190
C
 1190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PCPL')GOTO1195
      WRITE(ICOUT,1191)NUMARG,ILOCQ,ICASEQ
 1191 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 1195 CONTINUE
C
C               **************************************************
C               **  STEP 12--                                   **
C               **  DETERMINE THE NUMBER OF VARIABLES           **
C               **  TO BE INCLUDED AS PLOT COMPONENTS           **
C               **  IF THE   TO   FEATURE IS USED IN THE        **
C               **  ARGUMENT LIST, TRANSLATE THE   TO   TO      **
C               **  EXPLICIT VARIABLE NAMES                     **
C               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXPCC,
     1IHNAME,IHNAM2,IUSE,NUMNAM,
     1IVARN1,IVARN2,NUMVAR,IBUGG2,ISUBRO,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
 1290 CONTINUE
C
C               ***************************************
C               **  STEP 13--                        **
C               **  CHECK THE VALIDITY OF EACH       **
C               **  OF THE VARIABLES.                **
C               **  ALSO CHECK TO ASSURE THAT EACH   **
C               **  OF THE VARIABLES HAS AT LEAST    **
C               **  2 OBSERVATIONS.                  **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IFLAG=0
      DO1300I=1,NUMVAR
C
        IHRIGH=IVARN1(I)
        IHRIG2=IVARN2(I)
        IHWUSE='V'
        MESSAG='YES'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        NRIGHT=IN(ILOCV)
        IF(I.EQ.1)THEN
          NTEMP=NRIGHT
        ELSE
          IF(NRIGHT.NE.NTEMP)IFLAG=1
        ENDIF
        ILIS(I)=ILOCV
        IF(NRIGHT.LT.MINN2)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1311)
 1311     FORMAT('***** ERROR IN DPPCPL--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1312)
 1312     FORMAT('      THE INPUT NUMBER OF OBSERVATIONS FOR WHICH A')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1321)
 1321     FORMAT('      PARALLEL COORDINATES PLOT WAS TO HAVE BEEN')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1326)MINN2
 1326     FORMAT('      FORMED MUST BE ',I8,' OR LARGER;  SUCH WAS ',
     1           '      NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1328)
 1328     FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
          CALL DPWRST('XXX','BUG ')
          IF(IWIDTH.GE.1)THEN
            WRITE(ICOUT,1329)(IANS(J),J=1,MIN(80,IWIDTH))
 1329       FORMAT('      ',80A1)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IERROR='YES'
          GOTO9000
        ENDIF
C
 1300 CONTINUE
C
C
C               ******************************************************
C               **  STEP 1.4--                                      **
C               **  CHECK THAT VARIABLES HAVE THE SAME NUMBER OF    **
C               **  ELEMENTS.                                       **
C               ******************************************************
C
 1400 CONTINUE
      ISTEPN='1.4'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.NE.0)THEN
        WRITE(ICOUT,1411)
 1411   FORMAT('***** ERROR IN DPPCPL--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1413)
 1413   FORMAT('      THE NUMBER OF OBSERVATIONS IN ALL VARIABLES ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,1415)
 1415   FORMAT('      MUST BE THE SAME.  SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        DO1417I=1,NUMVAR
          I2=ILIS(I)
          WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416     FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1           ' OBSERVATIONS;')
          CALL DPWRST('XXX','BUG ')
 1417   CONTINUE
        WRITE(ICOUT,1420)
 1420   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,1421)(IANS(I),I=1,MIN(80,IWIDTH))
 1421     FORMAT('      ',100A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *************************************************
C               **  STEP 21--                                  **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;         **
C               **  (BASED ON THE QUALIFIER)                   **
C               **  THEN FOR  EACH OF THE RESPONSE VARIABLES   **
C               **  EXTRACT THE DATA SUBSET                    **
C               **  (USUALLY ONLY 1 OBSERVATION)               **
C               **  AND ALSO EXTRACT THE                       **
C               **  MIN AND MAX FOR THE FULL VARIABLE          **
C               *************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2110
      IF(ICASEQ.EQ.'SUBS')GOTO2120
      IF(ICASEQ.EQ.'FOR')GOTO2130
C
 2110 CONTINUE
      DO2115I=1,NRIGHT
      ISUB(I)=1
 2115 CONTINUE
      NQ=NRIGHT
      GOTO2190
C
 2120 CONTINUE
      NIOLD=NRIGHT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2190
C
 2130 CONTINUE
      NIOLD=NRIGHT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2190
C
 2190 CONTINUE
C
C               *************************************************
C               **  STEP 22--                                  **
C               **  FOR EACH OF THE RESPONSE VARIABLES,        **
C               **  EXTRACT THE DATA SUBSET                    **
C               **  (FREQUENTLY ONLY 1 OBSERVATION)            **
C               **  AND ALSO EXTRACT THE                       **
C               **  MIN AND MAX FOR THE FULL VARIABLE          **
C               *************************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2200K=1,NUMVAR
        IHRIGH=IVARN1(K)
        IHRIG2=IVARN2(K)
C
        DO2210I=1,NUMNAM
          I2=I
          IF(IHRIGH.EQ.IHNAME(I).AND.IHRIG2.EQ.IHNAM2(I).AND.
     1      IUSE(I).EQ.'V')GOTO2219
 2210   CONTINUE
C
        WRITE(ICOUT,2211)
 2211   FORMAT('***** INTERNAL ERROR IN DPPCPL AT POINT 2210--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2212)IHRIGH,IHRIG2
 2212   FORMAT('      THE VARIABLE ',A4,A4,'WAS NOT FOUND IN THE ',
     1         'INTERNAL')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2214)
 2214   FORMAT('      NAME LIST ALTHOUGH IT WAS FOUND EARLIER.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2215)
 2215   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,2216)(IANS(J),J=1,MIN(80,IWIDTH))
 2216     FORMAT('      ',80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
 2219   CONTINUE
C
        ILISTR=I2
        ICOLR=IVALUE(ILISTR)
        NRIGHT=IN(ILISTR)
C
        J=0
        IMAX=NRIGHT
        IF(NQ.LT.NRIGHT)IMAX=NQ
        IF(ICASPL.EQ.'PCPG'.AND.K.EQ.NUMVAR)THEN
          DO2230I=1,IMAX
            IF(ISUB(I).EQ.0)GOTO2230
            J=J+1
            IJ=MAXN*(ICOLR-1)+I
            IF(ICOLR.LE.MAXCOL)XIDTEM(J)=V(IJ)
            IF(ICOLR.EQ.MAXCP1)XIDTEM(J)=PRED(I)
            IF(ICOLR.EQ.MAXCP2)XIDTEM(J)=RES(I)
            IF(ICOLR.EQ.MAXCP3)XIDTEM(J)=YPLOT(I)
            IF(ICOLR.EQ.MAXCP4)XIDTEM(J)=XPLOT(I)
            IF(ICOLR.EQ.MAXCP5)XIDTEM(J)=X2PLOT(I)
            IF(ICOLR.EQ.MAXCP6)XIDTEM(J)=TAGPLO(I)
 2230     CONTINUE
        ELSE
          DO2240I=1,IMAX
            IF(ISUB(I).EQ.0)GOTO2240
            J=J+1
            IJ=MAXN*(ICOLR-1)+I
            IF(ICOLR.LE.MAXCOL)Z(J,K)=V(IJ)
            IF(ICOLR.EQ.MAXCP1)Z(J,K)=PRED(I)
            IF(ICOLR.EQ.MAXCP2)Z(J,K)=RES(I)
            IF(ICOLR.EQ.MAXCP3)Z(J,K)=YPLOT(I)
            IF(ICOLR.EQ.MAXCP4)Z(J,K)=XPLOT(I)
            IF(ICOLR.EQ.MAXCP5)Z(J,K)=X2PLOT(I)
            IF(ICOLR.EQ.MAXCP6)Z(J,K)=TAGPLO(I)
 2240     CONTINUE
        ENDIF
        NLOCAL=J
        NSUB=NLOCAL
C
 2200 CONTINUE
      NZ=NUMVAR
      IF(ICASPL.EQ.'PCPG')NZ=NZ-1
C
C               *******************************************************
C               **  STEP 31--                                        **
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS            **
C               **  VALUES Y(.) AND X(.) FOR THE PLOT.               **
C               **  DEFINE THE VECTOR D(.) SO THAT EACH ANDREW'S     **
C               **  CURVE HAS ITS OWNS TAG NUMBER.                   **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'PCPL')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPPCP2(Z,NZ,XIDTEM,TEMP,DFILL,ICASPL,IPCCST,
     1NLOCAL,MAXOBV,MAXPCC,MAXPOP,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'PCPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPCPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NSUB
 9021 FORMAT('NSUB = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NSUB.LE.0)GOTO9024
      DO9022I=1,NSUB
      WRITE(ICOUT,9023)I,(Z(I,K),K=1,NUMVAR)
 9023 FORMAT('I,Z(I,K) = ',I8,20E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
      WRITE(ICOUT,9041)NZ
 9041 FORMAT('NZ = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I)
 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPCP2(Z,NZ,XIDTEM,TEMP,DFILL,ICASPL,IPCCST,
     1NOBS,MAXOBV,MAXPCC,MAXPOP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A ANDREWS PLOT
C              (USEFUL FOR MULTIVARIATE ANALYSIS).
C     WRITTEN BY--ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003/3
C     ORIGINAL VERSION--MARCH     2003.
C     MAY             --MAY       2003. SUPPORT FOR "GROUP" CASE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IPCCST
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Z(MAXOBV,MAXPCC)
C
      DIMENSION XIDTEM(*)
      DIMENSION TEMP(*)
      DIMENSION DFILL(*)
C
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      EXTERNAL RANGE
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='DPPC'
      ISUBN2='P2  '
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NOBS.LT.1)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN PARALLEL COORDINATES PLOT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)NZ
   34   FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PCP2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,71)
   71   FORMAT('***** AT THE BEGINNING OF DPPCP2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,72)ICASPL,NZ,NOBS,NPLOTV
   72   FORMAT('ICASPL,NZ,NOBS,NPLOTV = ',A4,2X,3I8)
        CALL DPWRST('XXX','BUG ')
        IF(NZ.GT.0)THEN
          DO81I=1,NZ
            WRITE(ICOUT,82)I,(Z(I,K),K=1,NZ)
   82       FORMAT('I,Z(I,K) = ',I8,20E12.5)
            CALL DPWRST('XXX','BUG ')
   81     CONTINUE
        ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 11--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      IWRITE='OFF'
C
      IF(ICASPL.EQ.'PCPG')THEN
        CALL CODE(XIDTEM,NOBS,IWRITE,TEMP,IBUGG3,IERROR)
        DO110I=1,NOBS
          XIDTEM(I)=TEMP(I)
  110   CONTINUE
      ENDIF
C
      DO200J=1,NZ
        IF(IPCCST.EQ.'ZSCO')THEN
          DO210I=1,NOBS
            TEMP(I)=Z(I,J)
  210     CONTINUE
          CALL MEAN(TEMP,NOBS,IWRITE,XMEAN,IBUGG3,IERROR)
          CALL SD(TEMP,NOBS,IWRITE,XSD,IBUGG3,IERROR)
          DO220I=1,NOBS
            Z(I,J)=0.0
            IF(XSD.GT.0.0)Z(I,J)=(TEMP(I)-XMEAN)/XSD
  220     CONTINUE
        ELSEIF(IPCCST.EQ.'USCO')THEN
          DO310I=1,NOBS
            TEMP(I)=Z(I,J)
  310     CONTINUE
          CALL MINIM(TEMP,NOBS,IWRITE,XMIN,IBUGG3,IERROR)
          CALL RANGE(TEMP,NOBS,IWRITE,XRANGE,IBUGG3,IERROR)
          DO320I=1,NOBS
            Z(I,J)=0.0
            IF(XRANGE.GT.0.0)Z(I,J)=(TEMP(I)-XMIN)/XRANGE
  320     CONTINUE
        ENDIF
  200 CONTINUE
C
      ICOUNT=0
      DO600ICASE=1,NOBS
C
        IF(ICOUNT.GT.MAXPOP-2)THEN
          WRITE(ICOUT,601)
 601      FORMAT('****** ERROR IN PARALLEL COORDINATES PLOT.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,602)
 602      FORMAT('       MAXIMUM NUMBER OF PLOT POINTS EXCEEDED.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
C
        DO700J=2,NZ
          XCOOR1=Z(ICASE,J-1)
          XCOOR2=Z(ICASE,J)
          YCOOR1=REAL(J-1) - 1.0
          YCOOR2=YCOOR1+1.0
          ICOUNT=ICOUNT+1
C
          X2(ICOUNT)=XCOOR1
          Y2(ICOUNT)=YCOOR1
          D2(ICOUNT)=REAL(ICASE)
          DFILL(ICOUNT)=XIDTEM(ICASE)
C
          ICOUNT=ICOUNT+1
          X2(ICOUNT)=XCOOR2
          Y2(ICOUNT)=YCOOR2
          D2(ICOUNT)=REAL(ICASE)
          DFILL(ICOUNT)=XIDTEM(ICASE)
  700   CONTINUE
  600 CONTINUE
C
      N2=ICOUNT
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PCP2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DPPCP2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)ICASPL,NZ,N2,IERROR
 9012   FORMAT('ICASPL,NZ,N2,IERROR = ',A4,2I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9031)N2,NPLOTV
 9031   FORMAT('N2,NPLOTV = ',2I8)
        CALL DPWRST('XXX','BUG ')
        DO9035I=1,N2
          WRITE(ICOUT,9036)I,Y2(I),X2(I),D2(I)
 9036     FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
          CALL DPWRST('XXX','BUG ')
 9035   CONTINUE
      ENDIF
C
      RETURN
      END
      SUBROUTINE DPPCTY(IHARG,NUMARG,
     1IDEFPT,
     1IPCMTY,
     1IBUGS2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PRINCIPLE COMPONENT TYPE
C              CAN BE:
C                   DATA         COVARIANCE   (DACV)
C                   DATA         CORRELATION  (DACR)
C                   COVARIANCE   COVARIANCE   (CVCV)
C                   COVARIANCE   CORRELATION  (CVCR)
C                   CORRELATION  COVARIANCE   (CRCV)
C                   CORRELATION  CORRELATION  (CRCR)
C              THIS SWITCH CONTROLS HOW THE PRINCIPLE COMPONENTS ARE
C              COMPUTED.
C
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFPT (A  CHARACTER VARIABLE)
C                     --IBUGS2 (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IPCMTY (A CHARACTER 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--93/7
C     ORIGINAL VERSION--JULY     1993.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFPT
      CHARACTER*4 IPCMTY
      CHARACTER*4 IBUGS2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPCTY--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFPT
   53 FORMAT('IDEFPT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.2)GOTO1150
      IF(NUMARG.EQ.3)GOTO1120
      IF(NUMARG.EQ.4)GOTO1110
      IF(NUMARG.GT.4)GOTO9000
C
 1110 CONTINUE
      IF(IHARG(3).EQ.'DATA'.AND.IHARG(4).EQ.'COVA')THEN
        IHOLD='DACV'
      ELSEIF(IHARG(3).EQ.'DATA'.AND.IHARG(4).EQ.'CORR')THEN
        IHOLD='DACR'
      ELSEIF(IHARG(3).EQ.'CORR'.AND.IHARG(4).EQ.'CORR')THEN
        IHOLD='CRCR'
      ELSEIF(IHARG(3).EQ.'CORR'.AND.IHARG(4).EQ.'COVA')THEN
        IHOLD='CRCV'
      ELSEIF(IHARG(3).EQ.'COVA'.AND.IHARG(4).EQ.'COVA')THEN
        IHOLD='CVCV'
      ELSEIF(IHARG(3).EQ.'COVA'.AND.IHARG(4).EQ.'CORR')THEN
        IHOLD='CVCR'
      ELSE
        IERROR='YES'
        IFOUND='YES'
        WRITE(ICOUT,1111)IHARG(3),IHARG(4)
 1111   FORMAT('THE PRINCIPLE COMPONENT TYPE ',A4,A4,
     1  ' IS NOT RECOGNIZED')
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
      GOTO1180
C
 1120 CONTINUE
      IF(IHARG(2).EQ.'AUTO')GOTO1150
      IF(IHARG(2).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IHOLD=IDEFPT
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(3)
      IF(IHOLD.EQ.'DACV')GOTO1180
      IF(IHOLD.EQ.'DACR')GOTO1180
      IF(IHOLD.EQ.'CRCR')GOTO1180
      IF(IHOLD.EQ.'CRCV')GOTO1180
      IF(IHOLD.EQ.'CVCV')GOTO1180
      IF(IHOLD.EQ.'CVCR')GOTO1180
      GOTO1170
C
 1170 CONTINUE
      IERROR='YES'
      IFOUND='YES'
      WRITE(ICOUT,1171)IHOLD
 1171 FORMAT('THE PRINCIPLE COMPONENT TYPE SWITCH ',A4,
     1' IS NOT RECOGNIZED')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1180 CONTINUE
      IFOUND='YES'
      IPCMTY=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPCMTY
 1181 FORMAT(
     1'THE PRINCIPLE COMPONENT TYPE SWITCH HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPCTY')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IFOUND,IERROR
 9012 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IDEFPT,IPCMTY
 9013 FORMAT('IDEFPT,IPCMTY = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPEBA(IHARG,IARGT,ARG,NUMARG,
     1DEPBA,APEDBA,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE BASE
C              FOR THE 3-D PEDESTAL.
C              THE BASE FOR THE PEDESTAL WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE APEDBA.
C              THE BASE FOR THE PEDESTAL WILL BE
C              IN UNITS OF THE Z AXIS VARIABLE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --DEPBA
C     OUTPUT ARGUMENTS--APEDBA
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 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.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPPEBA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL SYNTAX FOR THE PEDESTAL BASE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER SYNTAX--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE Z AXIS DATA RANGES FROM ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      500 TO 2000 ,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      PLOT PEDESTAL TO HAVE A BASE AT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      Z = 100; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE PROPER SYNTAX IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('         PEDESTAL BASE 100 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      APEDBA=DEPBA
      GOTO1180
C
 1160 CONTINUE
      APEDBA=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)APEDBA
 1181 FORMAT('THE (3-D) PEDESTAL BASE ',
     1'HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPECL(IHARG,NUMARG,IDEPCO,IPEDCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D PEDESTAL.
C              THE COLOR FOR THE PEDESTAL WILL BE PLACED
C              IN THE CHARACTER VARIABLE IPEDCO.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEPCO
C     OUTPUT ARGUMENTS--IPEDCO
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1988. (WITH GENERAL 3-D UPDATE)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEPCO
      CHARACTER*4 IPEDCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IPEDCO=IDEPCO
      GOTO1180
C
 1160 CONTINUE
      IPEDCO=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPEDCO
 1181 FORMAT('THE (3-D) PEDESTAL COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPED(IHARG,NUMARG,IPEDSW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D PEDESTAL SWITCH IPEDSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IPEDSW   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --FEBRUARY  1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1988. (WITH GENERAL 3-D UPDATE)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IPEDSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IPEDSW='ON'
      GOTO1180
C
 1160 CONTINUE
      IPEDSW='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPEDSW
 1181 FORMAT('THE (3-D) PEDESTAL SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPEGC(IHARG,NUMARG,IDEPGC,IPEDGC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR THE 3-D PEDESTAL GRID.
C              THE COLOR FOR THE PEDESTAL GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE IPEDGC.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEPGC
C     OUTPUT ARGUMENTS--IPEDGC
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEPGC
      CHARACTER*4 IPEDGC
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      GOTO1160
C
 1150 CONTINUE
      IPEDGC=IDEPGC
      GOTO1180
C
 1160 CONTINUE
      IPEDGC=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPEDGC
 1181 FORMAT('THE (3-D) PEDESTAL GRID COLOR ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPEGP(IHARG,NUMARG,IDEPGP,IPEDGP,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR THE 3-D PEDESTAL GRID.
C              THE PATTERN FOR THE PEDESTAL GRID WILL BE PLACED
C              IN THE CHARACTER VARIABLE IPEDGP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEPGP
C     OUTPUT ARGUMENTS--IPEDGP
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGPON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/10
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEPGP
      CHARACTER*4 IPEDGP
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.LE.1)GOTO1199
      IF(NUMARG.EQ.2)GOTO1160
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1150 CONTINUE
      IPEDGP='SOLI'
      GOTO1180
C
 1160 CONTINUE
      IPEDGP='BLAN'
      GOTO1180
C
 1170 CONTINUE
      IPEDGP=IDEPGP
      GOTO1180
C
 1175 CONTINUE
      IPEDGP=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPEDGP
 1181 FORMAT('THE (3-D) PEDESTAL GRID PATTERN ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPEGR(IHARG,NUMARG,IDEPGR,IPEDGR,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 3-D PEDESTAL GRID SWITCH IPEDGR.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEPGR
C     OUTPUT ARGUMENTS--IPEDGR   ('ON'  OR 'OFF')
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--88/11
C     ORIGINAL VERSION--SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEPGR
      CHARACTER*4 IPEDGR
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1170
      GOTO1199
C
 1150 CONTINUE
      IPEDGR='ON'
      GOTO1180
C
 1160 CONTINUE
      IPEDGR='OFF'
      GOTO1180
C
 1170 CONTINUE
      IPEDGR=IDEPGR
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IPEDGR
 1181 FORMAT('THE (3-D) PEDESTAL GRID SWITCH ',
     1'HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPEI2(Y1,Y2,N,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              1) AUTOPERIODOGRAM
C              2) CO-PERIODOGRAM;
C              3) QUADRATURE PERIODOGRAM;
C              4) CROSS-PERIODOGRAM (CO-PERIODOGRAMM AND CROSS-PERIODOGRAMM);
C      NOTE--AN AUTOPERIODOGRAM,
C            IN ORDER THAT THE RESULTS OF THE TIME SERIES ANALYSIS
C            BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C            IN X SHOULD BE EQUI-SPACED IN TIME
C            (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C
C              THE HORIZONTAL AXIS OF THE PERIODOGRAM PRODUCED
C              BY THIS SUBROUTINE IS FREQUENCY.
C              THIS FREQUENCY IS MEASURED IN UNITS OF
C              CYCLES PER 'DATA POINT' OR, MORE PRECISELY, IN
C              CYCLES PER UNIT TIME WHERE
C              'UNIT TIME' IS DEFINED AS THE
C              ELAPSED TIME BETWEEN ADJACENT OBSERVATIONS.
C              THE RANGE OF THE FREQUENCY AXIS IS 0.0 TO 0.5.
C
C     INPUT ARGUMENTS--Y1     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS
C                               FOR THE FIRST  VARIABLE.
C                    --Y2     = THE SINGLE PRECISION VECTOR OF
C                               (UNSORTED) OBSERVATIONS.
C                               FOR THE SECOND VARIABLE.
C                      N      = THE INTEGER NUMBER OF OBSERVATIONS
C                               IN THE VECTOR X.
C     PRINTING--YES.
C     RESTRICTIONS--THE SAMPLE SIZE N MUST BE
C                   SMALLER THAN OR EQUAL TO 1000.
C                 --THE SAMPLE SIZE N MUST BE GREATER
C                   THAN OR EQUAL TO 3.
C     OTHER DATAPAC   SUBROUTINES NEEDED--PLOTC0, PLOTSP, AND CHSPPF.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--THE 'FAST FOURIER TRANSFORM' IS NOT USED
C              IN THIS VERSION OF TIME, BUT WILL BE
C              IMPLEMENTED IN A FUTURE VERSION.
C            --THE USUAL MAXIMUM NUMBER OF LAGS
C              FOR WHICH THE AUTOCORRELATION IS
C              COMPUTED IS N/4 WHERE N IS
C              THE SAMPLE SIZE (LENGTH OF THE
C              DATA RECORD IN THE VECTOR X).
C              THIS RULE IS OVERRIDDEN IN
C              LARGE DATA SETS AND IS REPLACED
C              BY THE RULE THAT THE MAXIMUM
C              NUMBER OF LAGS = 500
C              (WHICH CORRESPONDS TO AN
C              AUTOCORRELATION PLOT COVERING
C              5 COMPUTER PAGES).
C              IF MORE LAGS ARE DESIRED,
C              CHANGE THE VALUE OF THE
C              VARIABLE     MAXLAG
C              WITHIN THIS SUBROUTINE
C              FROM 500 TO WHATEVER DESIRED,
C              AND ALSO CHANGE THE DIMENSION OF
C              THE VECTOR R FROM ITS PRESENT 500 TO HOWEVER
C              MANY LAGS ARE DESIRED.
C            --IF THE INPUT OBSERVATIONS IN X ARE CONSIDERED
C              TO HAVE BEEN COLLECTED 1 SECOND APART IN TIME,
C              THEN THE FREQUENCY AXIS OF THE RESULTING
C              PERIODOGRAM WOULD BE IN UNITS OF HERTZ
C              (= CYCLES PER SECOND).
C            --THE FREQUENCY OF 0.0 CORRESPONDS TO A CYCLE
C              IN THE DATA OF INFINITE (= 1/(0.0))
C              LENGTH OR PERIOD.
C              THE FREQUENCY OF 0.5 CORRESPONDS TO A CYCLE
C              IN THE DATA OF LENGTH = 1/(0.5) = 2 DATA POINTS.
C            --ANY EQUI-SPACED TIME SERIES ANALYSIS IS
C              INTRINSICALLY LIMITED TO DETECTING FREQUENCIES
C              NO LARGER THAN 0.5 CYCLES PER DATA POINT;
C              THIS CORRESPONDS TO THE FACT THAT THE
C              SMALLEST DETECTABLE CYCLE IN THE DATA
C              IS 2 DATA POINTS PER CYCLE.
C     REFERENCES--JENKINS AND WATTS, ESPECIALLY PAGE 290.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--AUGUST    1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.14159265359/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPPE'
      ISUBN2='I2  '
C
      IERROR='NO'
C
      Y2BAR=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 DPPEI2--')
      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 DPPEI2--')
      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=Y1(1)
      DO60I=1,N
      IF(Y1(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DPPEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL ELEMENTS IN Y1 ')
      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 DPPEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,MAXN
   71 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y1(I),Y2(I)
   74 FORMAT('I, Y1(I), Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   80 CONTINUE
C
C               *******************************
C               **  STEP 1--                 **
C               **  COMPUTE THE SAMPLE MEAN  **
C               *******************************
C
      AN=N
      SUM=0.0
      DO100I=1,N
      SUM=SUM+Y1(I)
  100 CONTINUE
      Y1BAR=SUM/AN
C
      IF(ICASPL.EQ.'AUPE')GOTO190
C
      SUM=0.0
      DO110I=1,N
      SUM=SUM+Y2(I)
  110 CONTINUE
      Y2BAR=SUM/AN
C
  190 CONTINUE
C
C               *************************************
C               **  STEP 2--                       **
C               **  COMPUTE THE SAMPLE VARIANCE    **
C               **  AND SUM OF SQUARED DEVIATIONS  **
C               *************************************
C
      SUM=0.0
      DO200I=1,N
      SUM=SUM+(Y1(I)-Y1BAR)*(Y1(I)-Y1BAR)
  200 CONTINUE
      SSQY1=SUM
      VARBY1=SSQY1/AN
      VARY1=SSQY1/(AN-1.0)
      IF(VARY1.LE.0.0)SDY1=0.0
      IF(VARY1.GT.0.0)SDY1=SQRT(VARY1)
C
      IF(ICASPL.EQ.'AUPE')GOTO290
C
      SUM=0.0
      DO210I=1,N
      SUM=SUM+(Y2(I)-Y2BAR)*(Y2(I)-Y2BAR)
  210 CONTINUE
      SSQY2=SUM
      VARBY2=SSQY2/AN
      VARY2=SSQY2/(AN-1.0)
      IF(VARY2.LE.0.0)SDY2=0.0
      IF(VARY2.GT.0.0)SDY2=SQRT(VARY2)
C
      SUM=0.0
      DO220I=1,N
      SUM=SUM+(Y1(I)-Y1BAR)*(Y2(I)-Y2BAR)
  220 CONTINUE
      SSQ12=SUM
      COVB12=SSQ12/AN
      COVB21=COVB12
C
  290 CONTINUE
C
C
C
C               **************************************
C               **  STEP 4--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **  AND DETERMINE PLOT COORDINATES  **
C               **************************************
C
C               ****************************************************************
C               **  STEP 4.1--
C               **  COMPUTE AUTOPERIODOGRAM FOR Y1
C               **  REFERENCE--JUNKINS AND WATTS--PAGES 21 AND 22 (2.1.12)
C               ****************************************************************
C
 1000 CONTINUE
      IF(ICASPL.EQ.'AUPE')GOTO1100
      GOTO1900
C
 1100 CONTINUE
C
      NHALF=N/2
      NHALFP=NHALF+1
      IMAX=NHALFP
      IF(NHALFP.GT.MAXN)IMAX=MAXN
      IEVODD=N-2*(N/2)
      DEL=(AN+1.0)/2.0
      IF(IEVODD.EQ.0)DEL=(AN+2.0)/2.0
C
      J=0
CCCCC DO1110IP1=1,IMAX
      DO1110IP1=2,IMAX
      J=J+1
      I=IP1-1
      AI=I
      FREQI=AI/AN
      SUMA=0.0
      SUMB=0.0
C
      DO1120K=1,N
      AK=K
      OMEGA=2.0*PI*(AI/AN)
      SUMA=SUMA+Y1(K)*COS(OMEGA*(AK-DEL))
      SUMB=SUMB+Y1(K)*SIN(OMEGA*(AK-DEL))
      Z=AK-DEL
 1120 CONTINUE
      AICOEF=SUMA/AN
      BICOEF=SUMB/AN
      RSQ=AICOEF*AICOEF+BICOEF*BICOEF
      POWERI=2.0*RSQ
      IF(I.EQ.0)POWERI=POWERI/2.0
      IF(I.EQ.NHALF.AND.IEVODD.EQ.0)POWERI=POWERI/2.0
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1121)J,I,AI,AICOEF,BICOEF,RSQ,POWERI
 1121 FORMAT('J,I,AI,AICOEF,BICOEF,RSQ,POWERI = ',I8,I8,5E15.7)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      Y(J)=POWERI
      X(J)=FREQI
      D(J)=1.0
C
 1110 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
 1900 CONTINUE
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 DPPEI2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IERROR,NPLOTP,NPLOTV
 9012 FORMAT('ICASPL,IERROR,NPLOTP,NPLOTV = ',A4,2X,A4,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPER2(Y,X,N,IDATSW,CLWID,XSTART,XSTOP,
CCCCC ADD FOLLOWING LINE SEPTEMBER 1998.
     1IPPTBI,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A PERCENT POINT PLOT
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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     UPDATED         --SEPTEMBER 1998. OPTION TO NOT BIN THE DATA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IDATSW
      CHARACTER*4 IPPTBI
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRIT2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
CCCCC DOUBLE PRECISION DSUM
CCCCC DOUBLE PRECISION DN
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
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='DPPE'
      ISUBN2='R2  '
C
      IERROR='NO'
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 DPPER2--')
      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 DPPER2--')
      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 DPPER2--')
      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 DPPER2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IDATSW,IPPTBI
   71 FORMAT('IDATSW,IPPTBI = ',A4,1X,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.0--                              **
C               **  HANDLE CASE FOR UNBINNED DATA           **
C               **********************************************
C
      IF(IPPTBI.EQ.'UNBI')THEN
        CALL SORT(X,N,X)
        DO91I=1,N
          Y2(I)=X(I)
          X2(I)=100.0*REAL(I)/N
          D2(I)=1.0
   91   CONTINUE
        N2=N
        GOTO9000
      ENDIF
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 DPPER2--')
      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
 1100 CONTINUE
      SUM=0.0
      DO1110J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
 1110 CONTINUE
      AN3=SUM
C
      DENOM=AN3
C
      K=0
      SUM=0.0
      DO1120J=1,NUMCLA
      K=K+1
      AJ=J
      CLMINJ=XSTART+(AJ-1.0)*CLWID
      CLMAXJ=XSTART+AJ*CLWID
      IF(CLMAXJ.GT.XSTOP)CLMAXJ=XSTOP
      FJ=D2(J)
      SUM=SUM+FJ
      CUMFJ=SUM
      X2(K)=100.0*(CUMFJ/DENOM)
      Y2(K)=(CLMINJ+CLMAXJ)/2.0
 1120 CONTINUE
      N2=K
      NPLOTV=2
C
      K=0
      DO1130J=1,NUMCLA
      K=K+1
      D2(K)=1.0
 1130 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 DPPER2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N2
 9012 FORMAT('N2 = ',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,2E11.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPERC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE THE FOLLOWING PLOT--
C              A PERCENT POINT PLOT;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--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     UPDATED         --SEPTEMBER 1998. OPTION TO NOT BIN THE DATA
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 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(*)
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
CCCCC ADD FOLLOWING LINE  SEPTEMBER 1998.
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPPE'
      ISUBN2='RC  '
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 PERCENT POINT PLOT  **
C               ************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPERC--')
      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(NUMARG.GE.2.AND.
     1ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'POIN'.AND.IHARG(2).EQ.'PLOT')
     1GOTO110
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      ICASPL='PERC'
      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 DPPERC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A PERCENT POINT PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 4--                           **
C               **  CHECK TO SEE THE TYPE 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 DPPERC')
      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 DPPERC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A PERCENT POINT PLOT, ')
      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 DPPERC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A PERCENT POINT PLOT, ')
      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)
      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 DPPER2(Y1,X1,NLOCAL,IDATSW,CLWID,XSTART,XSTOP,
CCCCC ADD FOLLOWING LINE SEPTEMBER 1998.
     1IPPTBI,
     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 DPPERC--')
      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)CLWID,XSTART,XSTOP
 9014 FORMAT('CLWID,XSTART,XSTOP = ',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 DPPERI(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM
C              1) AUTOPERIODOGRAM
C              2) CO-PERIODOGRAM;
C              3) QUADRATURE PERIODOGRAM;
C              4) CROSS-PERIODOGRAM (CO-PERIODOGRAM AND QUADRATURE-PERIODOGRAM)
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1981.
C     UPDATED         --DECEMBER  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 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHVA21
      CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(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='DPPE'
      ISUBN2='RI  '
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
      ICOLV2=0
C
C               ****************************************************************
C               **  TREAT THE FOLLOWING CASES--                                *
C               **        1) AUTOPERIODOGRAM                                   *
C               **        2) CO-PERIODOGRAM;                                   *
C               **        3) QUADRATURE PERIODOGRAM;                           *
C               **        4) CROSS-PERIODOGRAM (CO-PERIODOGRAM AND QUAD-PERI); *
C               ****************************************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPERI--')
      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 ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      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
C               *************************************************
C               **  STEP 1.1--                                 **
C               **  SEARCH FOR PERIODOGRAM OR AUTOPERIODOGRAM  **
C               *************************************************
C
      ICASPL='AUPE'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'PERI'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'PERI'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'PERI'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'PERI'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C
C               ********************************
C               **  STEP 1.2--                **
C               **  SEARCH FOR COPERIODOGRAM  **
C               ********************************
C
      ICASPL='COPE'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CO'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CO'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COPE'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COPE'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C
C               *****************************************
C               **  STEP 1.3--                         **
C               **  SEARCH FOR QUADRATURE PERIODOGRAM  **
C               *****************************************
C
      ICASPL='QUPE'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
C
C               ************************************
C               **  STEP 1.4--                    **
C               **  SEARCH FOR CROSS-PERIODOGRAM  **
C               ************************************
C
      ICASPL='CRPE'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'PERI'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CROS'.AND.ICOM2.EQ.'SPER'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CROS'.AND.ICOM2.EQ.'SPER'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C
      ICASPL='    '
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ILASTC=0
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
      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='2'
      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
      IF(ICASPL.EQ.'AUPE')GOTO270
      IF(ICASPL.EQ.'COPE')GOTO280
      IF(ICASPL.EQ.'QUPE')GOTO280
      IF(ICASPL.EQ.'CRPE')GOTO280
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPPERI')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,262)
  262 FORMAT('      AT BRANCH POINT 261--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,263)
  263 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE 4--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,264)
  264 FORMAT('      AUPE, COPE, QUPE,    OR   CRPE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,266)ICASPL
  266 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,267)
  267 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,268)(IANS(I),I=1,IWIDTH)
  268 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  270 CONTINUE
      MAXV2=1
      GOTO290
C
  280 CONTINUE
      MAXV2=2
      GOTO290
C
  290 CONTINUE
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      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)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS POSITIVE.               **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPPERI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A PERIODOGRAM ANALYSIS  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ***********************************************
C               **  STEP 6--                                 **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EXACTLY 1                               **
C               **  FOR AN AUTOPERIODOGRAM ANALYSIS;         **
C               **  EXACTLY 2                                **
C               **  FOR A CROSS-PERIODOGRAM ANALYSIS.        **
C               **  ALSO, FOR A CROSS-PERIODOGRAM ANALYSIS,  **
C               **  CHECK THE VALIDITY                       **
C               **  OF THE SECOND VARIABLE.                  **
C               **  DOES THE NAME EXIST IN THE TABLE?        **
C               **  DOES THE NUMBER OF ELEMENTS              **
C               **  IN THE SECOND VARIABLE                   **
C               **  AGREE WITH THE NUMBER OF ELEMENTS        **
C               **  IN THE FIRST VARIABLE?                   **
C               ***********************************************
C
      ISTEPN='6'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(1.LE.NUMV2.AND.NUMV2.LE.MAXV2)GOTO509
      GOTO550
C
  509 CONTINUE
      IF(NUMV2.LE.1)GOTO590
      IHVA21=IHARG(2)
      IHVA22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHVA21,IHVA22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLV2=IVALUE(ILOCV)
      NVAR2=IN(ILOCV)
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,511)IHVA21,IHVA22,ICOLV2,NVAR2
  511 FORMAT('IHVA21,IHVA22,ICOLV2,NVAR2 = ',A4,2X,A4,I8,I8)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NVAR2.NE.NLEFT)GOTO570
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPPERI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A CROSS-PERIODOGRAM ANALYSIS, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)NUMV2
  557 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DPPERI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A CROSS-PERIODOGRAM ANALYSIS, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,573)
  573 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,574)
  574 FORMAT('      IN THE 2 VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,575)
  575 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,576)
  576 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,577)IHLEFT,IHLEF2,NLEFT
  577 FORMAT('      THE FIRST  VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,578)IHVA21,IHVA22,NVAR2
  578 FORMAT('      THE SECOND VARIABLE ',
     1'(',A4,A4,') HAS ',I8, 'ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,580)(IANS(I),I=1,IWIDTH)
  580 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE FIRST  VARIABLE; **
C               **  ALSO, FOR A CROSS-PERIODOGRAM ANALYSIS, **
C               **  FORM THE VARIABLE Y2(.)                 **
C               **  WHICH WILL CONTAIN THE SECOND VARIABLE. **
C               **  FORM THESE VARIABLES BY                 **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE    **
C               **  (FULL, SUBSET, OR FOR).                 **
C               **********************************************
C
      ISTEPN='7'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASQ.EQ.'FULL')GOTO610
      IF(ICASQ.EQ.'SUBS')GOTO620
      IF(ICASQ.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,IERROR)
      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
      IF(NQ.GE.MINN2)GOTO660
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,651)
  651 FORMAT('***** ERROR IN DPPERI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,652)
  652 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,653)IHLEFT,IHLEF2
  653 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,654)
  654 FORMAT('      (FOR WHICH AN AUTO OR CROSS-PERIODOGRAM ',
     1'ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,656)MINN2
  656 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,657)
  657 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,658)
  658 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,659)(IANS(I),I=1,IWIDTH)
  659 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  660 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO670I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO670
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,666)I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ)
  666 FORMAT('I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ) = ',6I8,E15.7)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      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)
      IF(MAXV2.LE.1)GOTO670
C
      IJ=MAXN*(ICOLV2-1)+I
      IF(ICOLV2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLV2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLV2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLV2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLV2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLV2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLV2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
  670 CONTINUE
      NS=J
C
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE ALL ONES FOR ALL 7 CASES EXCEPT               *
C               **  WHEN THE COMMAND    CROSS-SPECTRUM    IS ENTERED           *
C               **  WHICH WILL RESULT IN 2 SUPERIMPOSED CURVES--               *
C               **  THE CO-SPECTRUM AND THE QUADRATURE SPECTRUM                *
C               **  AND SO D(.) WILL RETURN WITH ALL ONES FOR
C               **  THE CO-SPECTRUM PART, AND ALL TWOS                         *
C               **  FOR THE QUADRATURE SPECTRUM PART.                          *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='9'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPPEI2(Y1,Y2,NS,ICASPL,MAXN,
     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 DPPERI--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPESZ(IHARG,IARGT,ARG,NUMARG,
     1PDEPSZ,PPEDSZ,
     1IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SIZE FOR THE 3-D PEDESTAL.
C              THE SIZE FOR THE PEDESTAL WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE PPEDSZ.
C              THE SIZE FOR THE PEDESTAL WILL BE
C              IN UNITS OF THE Z AXIS VARIABLE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C                     --PDEPSZ
C     OUTPUT ARGUMENTS--PPEDSZ
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     NOTE--THIS SUBROUTINE ASSUMES A
C           COMPLICATED-TO-SIMPLE CHECKING ORDER
C           (IN MAIPC4) OF THE VARIOUS PEDESTAL COMMANDS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 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.EQ.1)GOTO1150
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPPESZ--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL SYNTAX FOR THE PEDESTAL SIZE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER SYNTAX--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE Z AXIS DATA RANGES FROM ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      500 TO 2000 (FOR A DIFFERENCE OF 1500 UNITS), ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND SUPPOSE THE ANALYST WISHES THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      PLOT PEDESTAL TO HAVE A HEIGHT OF ABOUT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      200 SUCH UNITS; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      THEN THE PROPER SYNTAX IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('         PEDESTAL SIZE 200 ')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      PPEDSZ=PDEPSZ
      GOTO1180
C
 1160 CONTINUE
      PPEDSZ=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)PPEDSZ
 1181 FORMAT('THE (3-D) PEDESTAL SIZE (HEIGHT) ',
     1'HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPPHD(ICASAN,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
***** <NOT YET DONE> *****
C     PURPOSE--CARRY OUT A (YATES) PHD ANALYSIS
C              (USEFUL FOR COMPUTING THE EFFECTS IN A 2**K
C              AND A 2**(K-P) EXPERIMENT)
C     NOTE--THIS CODE ASSUMES THE DATA IS IN
C           STANDARD YATES/HUNTER/BOX ORDER.
C           FOR EXAMPLE, FOR A 2**3--
C                 - - -
C                 + - -
C                 - + -
C                 + + -
C                 - - +
C                 + - +
C                 - + +
C                 + + +
C     NOTE--IF HAVE REPLICATION, THEN THE REPLICATES
C           MAY EITHER BE IMMEDIATELY WITHIN
C           OR MAY BE IN BLOCKS AFTER.
C     EXAMPLE--PHD Y
C              PHD Y SET
C              PHD ANALYSIS Y
C              PHD ANALYSIS Y SET
C              DEX FIT Y
C              DEX FIT Y REP
C              2**K DEX FIT Y
C              2**K DEX FIT Y REP
C              + OTHER COMBINATIONS OF SYNONYMS
C     NOTE--IF THERE ARE NO REPLICATIONS IN THE DATA,
C           THEN THIS COMMAND TAKES 1 ARGUMENT.
C           IF HAVE REPLCATION,
C           THEN THIS COMMAND TAKES 2 ARGUMENTS
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/7
C     ORIGINAL VERSION--SEPTEMBER 1993.
C     UPDATED         --JUNE      1989.  SYNONYM = (2**K) DEX FIT
C     UPDATED         --NOVEMBER  1989.  SELECTIVE PRINTING OF COEF
C     UPDATED         --JUNE      1990.  TEMPORARY ARRAYS TO GARBAGE COMMON
C                                        MOVE SOME DPPHD2 DIMENSIONS TO DPPHD
C     UPDATED         --NOVEMBER  1991.  ALLOW 2**1 ANALYSIS
C     UPDATED         --APRIL     1992. DEFINE CUTOFF
C     UPDATED         --APRIL     1992. DELETE MAXNPP
C     UPDATED         --APRIL     1992. DELETE NPLOTP,X(.),Y(.),D(.)
C     UPDATED         --FEBRUARY  1995. RENAME COMMAND TO DEX PHD,
C                                       MINOR BUG FIX
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
C
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT   APRIL 1992
CCCCC CHARACTER*4 IANGLU
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
CCCCC THE FOLLOWING LINE WAS ADDED   APRIL 1992 (ALAN)
      INCLUDE 'DPCOHO.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
C
      DIMENSION COEF(MAXOBV)
      DIMENSION SSQCOE(MAXOBV)
      DIMENSION TCOEF(MAXOBV)
      DIMENSION RSDCOE(MAXOBV)
      DIMENSION TAGCOE(MAXOBV)
      DIMENSION TAGCO2(MAXOBV)
C
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      INCLUDE 'DPCOZI.INC'
      DIMENSION REPD(MAXOBV)
      DIMENSION IFLAG(MAXOBV)
      DIMENSION RSDCOC(MAXOBV)
      DIMENSION ITAG(MAXOBV)
      DIMENSION ITAGCO(MAXOBV)
      DIMENSION YMEAN(MAXOBV)
      DIMENSION YVAR(MAXOBV)
      DIMENSION DUMMY(MAXOBV)
      DIMENSION DUMMY2(MAXOBV)
      DIMENSION AINDEX(MAXOBV)
      DIMENSION AINDE2(MAXOBV)
      DIMENSION TEMP(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),COEF(1))
      EQUIVALENCE (GARBAG(IGARB4),SSQCOE(1))
      EQUIVALENCE (GARBAG(IGARB5),TCOEF(1))
      EQUIVALENCE (GARBAG(IGARB6),RSDCOE(1))
      EQUIVALENCE (GARBAG(IGARB7),TAGCOE(1))
      EQUIVALENCE (GARBAG(IGARB8),TAGCO2(1))
      EQUIVALENCE (GARBAG(IGARB9),REPD(1))
      EQUIVALENCE (GARBAG(IGAR10),RSDCOC(1))
      EQUIVALENCE (G2RBAG(IGAR11),YMEAN(1))
      EQUIVALENCE (G2RBAG(IGAR12),YVAR(1))
      EQUIVALENCE (G2RBAG(IGAR13),DUMMY(1))
      EQUIVALENCE (G2RBAG(IGAR14),DUMMY2(1))
      EQUIVALENCE (G2RBAG(IGAR15),AINDEX(1))
      EQUIVALENCE (G2RBAG(IGAR16),AINDE2(1))
      EQUIVALENCE (G2RBAG(IGAR17),TEMP(1))
      EQUIVALENCE (IGARBG(IIGAR1),IFLAG(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITAG(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITAGCO(1))
CCCCC END CHANGE
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
      INCLUDE 'DPCODE.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='DPPH'
      ISUBN2='D   '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IWRITE='YES'
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED   APRIL 1992 (ALAN)
      ICUTMX=NUMBPW
      IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
      IF(IHOST1.EQ.'205 ')ICUTMX=48
      CUTOFF=2**(ICUTMX-3)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'PHD ')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASAN
   53 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,54)IANGLU,IBUGA2,IBUGA3,IBUGQ
CCC54 FORMAT('IANGLU,IBUGA2,IBUGA3,IBUGQ = ',
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IBUGA2,IBUGA3,IBUGQ
   54 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASAN,MAXN
   56 FORMAT('ICASAN,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC WRITE(ICOUT,58)MAXNPP
CCC58 FORMAT('MAXNPP = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989
      WRITE(ICOUT,61)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
   61 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  TREAT THE (YATES) PHD ANALYSIS CASE  **
C               *************************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
CCCCC FEBRUARY 1995.  RENAME COMMAND FROM PHD TO DEX PHD
CCCCC ACCEPTED SYNONYMS ARE:
CCCCC      DEX PHD
CCCCC      DEX PHD ANALYSIS
CCCCC      DEX PHD FIT
CCCCC      PHD DEX 
CCCCC      PHD DEX ANALYSIS
CCCCC      PHD DEX FIT
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC FEBRUARY 1995.  MODIFY FOLLOWING SECTION
CCCCC IF(NUMARG.GE.1.AND.
CCCCC1IHARG(1).EQ.'ANAL'.AND.IHARG2(1).EQ.'YSIS')GOTO1110
CCCCC THE FOLLOWING 5 LINES WERE ADDED JUNE 1989
CCCCC IF(NUMARG.GE.1.AND.
CCCCC1IHARG(1).EQ.'FIT')GOTO1110
CCCCC IF(NUMARG.GE.2.AND.
CCCCC1IHARG(1).EQ.'DEX'.AND.
CCCCC1IHARG(2).EQ.'FIT')GOTO1120
C
      IF(ICOM.EQ.'DEX')THEN
        IF(NUMARG.GE.2.AND.
     1    IHARG(1).EQ.'PHD'.AND.
     1    IHARG(2).EQ.'ANAL'.AND.IHARG2(2).EQ.'YSIS')GOTO1120
        IF(NUMARG.GE.2.AND.
     1    IHARG(1).EQ.'PHD'.AND.
     1    IHARG(2).EQ.'FIT')GOTO1120
        IF(NUMARG.GE.1.AND.
     1    IHARG(1).EQ.'PHD')GOTO1110
      ENDIF
      IF(ICOM.EQ.'PHD')THEN
        IF(NUMARG.GE.2.AND.
     1    IHARG(1).EQ.'DEX'.AND.
     1    IHARG(2).EQ.'ANAL'.AND.IHARG2(2).EQ.'YSIS')GOTO1120
        IF(NUMARG.GE.2.AND.
     1    IHARG(1).EQ.'DEX'.AND.
     1    IHARG(2).EQ.'FIT')GOTO1120
        IF(NUMARG.GE.1.AND.
     1    IHARG(1).EQ.'DEX')GOTO1110
      ENDIF
C
      GOTO1190
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED JUNE 1989
 1120 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
CCCCC THE FOLLOWING LINE WAS CHANGED JUNE 1989
CCCCC ICASAN='PHD '
      ICASAN='DEXF'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL 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 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'PHD ')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE 1 OR 2).                            **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.1)GOTO1490
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1412)
 1412 FORMAT('      FOR A YATES PHD ANALYSIS, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EITHER 1 OR 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      IF(NUMVAR.LE.1)GOTO1590
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.LE.1)GOTO2190
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN YATES PHD ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE PERFORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE RESPONSE VARIABLE              **
C               **       THE REPLICATION-TAG VARIABLE       **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1WRITE(ICOUT,780)N,NIRIG1,NQ,IMAX
  780 FORMAT(' N,NIRIG1,NQ,IMAX = ',4I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL DPWRST('XXX','BUG ')
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IF(NUMVAR.LE.1)Y2(J)=1.0
      IF(NUMVAR.LE.1)GOTO3300
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1WRITE(ICOUT,776)J,NS
  776 FORMAT('J,NS = ',2I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL DPWRST('XXX','BUG ')
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT THE            **
C               **  SUBSETTING DOES NOT RESULT IN          **
C               **  TOO FEW DATA POINTS RESULTING          **
C               **  (AT LEAST 2)                           **
C               **  WITH WHICH TO DO A YATES PHD ANALYSIS.     **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUNT=0
      IF(NS.LE.2)ICOUNT=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
CCCCC WRITE(ICOUT,777)I,ICOUNT,NS,MINN2,Y2(I)
CC777 FORMAT('I,ICOUNT,NS,MINN2,Y2(I) = ',I8,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUNT=ICOUNT+1
 3400 CONTINUE
 3410 CONTINUE
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC IF(ICOUNT.LE.MINN2)GOTO3450
      IF(ICOUNT.LT.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)IHRI11,IHRI12
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH A YATES PHD ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE PERFORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)ICOUNT
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE (ICOUNT = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)
 3459 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3460)(IANS(I),I=1,IWIDTH)
 3460 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ***************************************
C               **  STEP 41--                        **
C               **  CARRY OUT THE YATES PHD ANALYSIS     **
C               ***************************************
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PHD ')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JUNE, 1990.  MOVE SOME DIMENSIONS FROM DPPHD2 TO DPPHD
      CALL DPPHD2(Y1,Y2,NS,ICASAN,MAXN,IWRITE,
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
     1YATCCU,YATTCU,YATRCU,IYATOS,IYATRS,
     1COEF,SSQCOE,TCOEF,RSDCOE,TAGCOE,TAGCO2,NCOEF,
     1PRESSD,PRESDF,REPSD,REPDF,REFSD,REFDF,SDCOEF,
     1REPD,IFLAG,RSDCOC,ITAG,ITAGCO,YMEAN,
     1YVAR,DUMMY,DUMMY2,AINDEX,AINDE2,TEMP,
     1IBUGA3,ISUBRO,IERROR)
C
C               ***************************************
C               **  STEP 51--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='51'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      NPASS=7
      DO5100IPASS=1,NPASS
      IF(IPASS.EQ.1)IH='PRES'
      IF(IPASS.EQ.1)IH2='SD  '
      IF(IPASS.EQ.2)IH='PRES'
      IF(IPASS.EQ.2)IH2='DF  '
      IF(IPASS.EQ.3)IH='REPS'
      IF(IPASS.EQ.3)IH2='D  '
      IF(IPASS.EQ.4)IH='REPD'
      IF(IPASS.EQ.4)IH2='F   '
      IF(IPASS.EQ.5)IH='REFS'
      IF(IPASS.EQ.5)IH2='D  '
      IF(IPASS.EQ.6)IH='REFD'
      IF(IPASS.EQ.6)IH2='F   '
      IF(IPASS.EQ.7)IH='SDCO'
      IF(IPASS.EQ.7)IH2='EF  '
C
      DO5150I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO5180
 5150 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO5170
      WRITE(ICOUT,5151)
 5151 FORMAT('***** ERROR IN DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5152)
 5152 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5153)MAXNAM
 5153 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5154)
 5154 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5155)
 5155 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5156)
 5156 FORMAT('      HAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5157)
 5157 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5158)
 5158 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5159)
 5159 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5160)
 5160 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5161)
 5161 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5162)
 5162 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,5163)(IANS(I),I=1,IWIDTH)
 5163 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 5170 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      IF(IPASS.EQ.1)VALUE(ILOC)=PRESSD
      IF(IPASS.EQ.2)VALUE(ILOC)=PRESDF
      IF(IPASS.EQ.3)VALUE(ILOC)=REPSD
      IF(IPASS.EQ.4)VALUE(ILOC)=REPDF
      IF(IPASS.EQ.5)VALUE(ILOC)=REFSD
      IF(IPASS.EQ.6)VALUE(ILOC)=REFDF
      IF(IPASS.EQ.7)VALUE(ILOC)=SDCOEF
      VAL=VALUE(ILOC)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(ILOC)=IVAL
      GOTO5100
C
 5180 CONTINUE
      IF(IPASS.EQ.1)VALUE(I2)=PRESSD
      IF(IPASS.EQ.2)VALUE(I2)=PRESDF
      IF(IPASS.EQ.3)VALUE(I2)=REPSD
      IF(IPASS.EQ.4)VALUE(I2)=REPDF
      IF(IPASS.EQ.5)VALUE(I2)=REFSD
      IF(IPASS.EQ.6)VALUE(I2)=REFDF
      IF(IPASS.EQ.7)VALUE(I2)=SDCOEF
      VAL=VALUE(I2)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(I2)=IVAL
      GOTO5100
C
 5100 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'PHD ')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPHD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASAN
 9013 FORMAT('ICASAN = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)MAXN,NUMVAR
 9014 FORMAT('MAXN,NUMVAR = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 6 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC IF(NPLOTP.LE.0)GOTO9029
CCCCC DO9020I=1,NPLOTP
CCCCC WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
C9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
CCCCC CALL DPWRST('XXX','BUG ')
C9020 CONTINUE
C9029 CONTINUE
      WRITE(ICOUT,9031)ICOUNT
 9031 FORMAT('ICOUNT = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9050I=1,NIRIG1
      WRITE(ICOUT,9051)I,Y1(I),Y2(I),ISUB(I)
 9051 FORMAT('I,Y1(I),Y2(I),ISUB(I) = ',I8,2E15.7,I8)
      CALL DPWRST('XXX','BUG ')
 9050 CONTINUE
      WRITE(ICOUT,9061)IHRI11,IHRI12
 9061 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9062)IHRI21,IHRI22
 9062 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE INSERTED NOVEMBER 1989
      WRITE(ICOUT,9071)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
 9071 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPHD2(Y,REP,N,ICASPL,MAXN,IWRITE,
     1YATCCU,YATTCU,YATRCU,IYATOS,IYATRS,
     1COEF,SSQCOE,TCOEF,RSDCOE,TAGCOE,TAGCO2,NCOEF,
     1PRESSD,PRESDF,REPSD,REPDF,REFSD,REFDF,SDCOEF,
     1REPD,IFLAG,RSDCOC,ITAG,ITAGCO,YMEAN,
     1YVAR,DUMMY,DUMMY2,AINDEX,AINDE2,TEMP,
     1IBUGA3,ISUBRO,IERROR)
C
C     PURPOSE--CARRY OUT A (YATES) PHD ANALYSIS (DEX FIT FOR 2**K DESIGNS)
C              (USEFUL FOR COMPUTING THE EFFECTS IN A 2**K
C              AND A 2**(K-P) EXPERIMENT)
C     NOTE--THIS CODE ASSUMES THE DATA IS IN
C           STANDARD YATES/HUNTER/BOX ORDER.
C           FOR EXAMPLE, FOR A 2**3--
C                 - - -
C                 + - -
C                 - + -
C                 + + -
C                 - - +
C                 + - +
C                 - + +
C                 + + +
C     NOTE--IF HAVE REPLICATION, THEN THE REPLICATES
C           MAY EITHER BE IMMEDIATELY WITHIN
C           OR MAY BE IN BLOCKS AFTER.
C     EXAMPLE--PHD Y
C              PHD Y REP
C              PHD ANALYSIS Y
C              PHD ANALYSIS Y REP
C              DEX FIT Y
C              DEX FIT Y REP
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/7
C     ORIGINAL VERSION--SEPTEMBER 1993.
C     UPDATED         --FEBRUARY  1995.
C     UPDATED         --AUGUST    1995.  REPLACE NUMERICAL RECIPE
C                                        ROUTINE WITH CMLIB ROUTINE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IWRITE
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 IREP
      CHARACTER*4 ICASE
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC BECAUSE THE CALLING ROUTINE (DPYATE) HAD IFLAG NOVEMBER 1991
CCCCC EQUIVALANCED TO IGARBG WHICH WAS INTEGER BUT NOVEMBER 1991
CCCCC DPPHD2 WAS TRYING TO USE IFLAG AS CHARACTER*2 NOVEMBER 1991
CCCCC CHARACTER*2 IFLAG
      CHARACTER*2 STAR
C
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED OCTOBER 1991
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*4 ISUBN0
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
CCCCC THE FOLLOWING LINE WAS INSERTED NOVEMBER 1989
      CHARACTER*4 IYATOS
      CHARACTER*4 IYATRS
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
CCCCC JUNE, 1990.  FOLLOWING INCLUDE FILE NO LONGER NEEDED.
CCCCC       INCLUDE 'DPCOPA.INC'
C
CCCCC THE FOLLOWING INCLUDE STATEMENT WAS ADDED OCTOBER 1991
      INCLUDE 'DPCOF2.INC'
C
      DIMENSION Y(*)
      DIMENSION REP(*)
C
      DIMENSION COEF(*)
      DIMENSION SSQCOE(*)
      DIMENSION TCOEF(*)
      DIMENSION RSDCOE(*)
      DIMENSION TAGCOE(*)
      DIMENSION TAGCO2(*)
C
CCCCC FOLLOWING DIMENSIONS MOVED TO DPYATE
CCCCC DIMENSION REPD(MAXOBV)
CCCCC DIMENSION IFLAG(MAXOBV)
CCCCC DIMENSION RSDCOC(MAXOBV)
CCCCC DIMENSION ITAG(MAXOBV)
CCCCC DIMENSION ITAGCO(MAXOBV)
CCCCC DIMENSION YMEAN(MAXOBV)
CCCCC DIMENSION YVAR(MAXOBV)
CCCCC DIMENSION DUMMY(MAXOBV)
CCCCC DIMENSION DUMMY2(MAXOBV)
CCCCC DIMENSION AINDEX(MAXOBV)
CCCCC DIMENSION AINDE2(MAXOBV)
CCCCC DIMENSION TEMP(MAXOBV)
      DIMENSION REPD(*)
      DIMENSION IFLAG(*)
      DIMENSION RSDCOC(*)
      DIMENSION ITAG(*)
      DIMENSION ITAGCO(*)
      DIMENSION YMEAN(*)
      DIMENSION YVAR(*)
      DIMENSION DUMMY(*)
      DIMENSION DUMMY2(*)
      DIMENSION AINDEX(*)
      DIMENSION AINDE2(*)
      DIMENSION TEMP(*)
C
CCCCC FEBRUARY 1995.  SET MAXIMUM FACTORS TO 12 (ALSO DEFINE MAXIMUM
CCCCC WITH PARAMETER STATEMENT).
CCCCC DIMENSION AMAIN(10)
CCCCC DIMENSION PREDLIN(10)
CCCCC DIMENSION RESLIN(10)
C
CCCCC DIMENSION A(10,10)
CCCCC DIMENSION EIGVAL(10)
CCCCC DIMENSION EIGVA2(10)
CCCCC DIMENSION EIGVA3(10)
CCCCC DIMENSION EIGVEC(10,10)
CCCCC DIMENSION ITAG2(10)
CCCCC DIMENSION ITAG3(10)
CCCCC DIMENSION PHD1(10)
CCCCC DIMENSION PHD2(10)
CCCCC DIMENSION PHD3(10)
CCCCC DIMENSION PHD4(10)
CCCCC DIMENSION PHD5(10)
C
      PARAMETER (MAXFAC=12)
C
      DIMENSION AMAIN(MAXFAC)
      DIMENSION PREDLIN(MAXFAC)
      DIMENSION RESLIN(MAXFAC)
C
      DIMENSION A(MAXFAC,MAXFAC)
      DIMENSION EIGVAL(MAXFAC)
      DIMENSION EIGVA2(MAXFAC)
      DIMENSION EIGVA3(MAXFAC)
      DIMENSION EIGVEC(MAXFAC,MAXFAC)
      DIMENSION ITAG2(MAXFAC)
      DIMENSION ITAG3(MAXFAC)
      DIMENSION PHD1(MAXFAC)
      DIMENSION PHD2(MAXFAC)
      DIMENSION PHD3(MAXFAC)
      DIMENSION PHD4(MAXFAC)
      DIMENSION PHD5(MAXFAC)
      DIMENSION VJUNK(2*MAXFAC)
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='DPPH'
      ISUBN2='D2  '
C
CCCCC MAXCOL=10
      MAXCOL=MAXFAC
C
      IERROR='NO'
C
      AN=N
      CUTOFF=999999.0
C
      CCUTP=YATCCU
      CCUTN=(-YATCCU)
      TCUTP=YATTCU
      TCUTN=(-YATTCU)
      RCUTP=YATRCU
      RCUTN=(-YATRCU)
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'PHD2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPHD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,ISUBRO
   52 FORMAT('IBUGA3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN
   53 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)PRESSD,PRESDF,REPSD,REPDF
   55 FORMAT('PRESSD,PRESDF,REPSD,REPDF = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)REFDF,REFDF,SDCOEF
   56 FORMAT('REFDF,REFDF,SDCOEF = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)N
   60 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO63
      DO61I=1,N
      WRITE(ICOUT,62)I,Y(I),REP(I)
   62 FORMAT('I,Y(I),REP(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
      WRITE(ICOUT,71)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
   71 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)CCUTN,CCUTP
   72 FORMAT('CCUTN,CCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)TCUTN,TCUTP
   73 FORMAT('TCUTN,TCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)RCUTN,RCUTP
   74 FORMAT('RCUTN,RCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   63 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPPHD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPPHD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,N
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPPHD2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
CCCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1995
C               **************************************************
C               **  STEP 15--                                   **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
 1500 CONTINUE
      ISTEPN='15'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='PHD2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='PHD2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='PHD2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='PHD2'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               **************************************************
C               **  STEP 20--                                   **
C               **  COMPUTE GRAND MEAN                          **
C               **  COMPUTE GRAND STANDARD DEVIATION            **
C               **************************************************
C
      SUM=0.0
      DO2000I=1,N
      SUM=SUM+Y(I)
 2000 CONTINUE
      GMEAN=SUM/AN
C
      SUM=0.0
      DO2020I=1,N
      SUM=SUM+(Y(I)-GMEAN)**2
 2020 CONTINUE
      GSSQ=SUM
      GVAR=GSSQ/(AN-1.0)
      GSD=0.0
      IF(GVAR.GT.0.0)GSD=SQRT(GVAR)
C
C               ****************************************************
C               **  STEP 21--                                     **
C               **  EXTRACT THE DISTINCT REPLICATION VALUES       **
C               **  IN ORDER TO                                   **
C               **  DETERMINE THE TYPE OF REPLICATION CASE--      **
C               **     1) NO REPLICATION                          **
C               **     2) REPLICATION 'WITHIN', AS IN             **
C               **        (FOR A 2**2 WITH 3 REPLICATIONS)--      **
C               **          X1  X2  REP                           **
C               **           -   +   1                            **
C               **           -   +   2                            **
C               **           -   +   3                            **
C               **                                                **
C               **           +   +   1                            **
C               **           +   +   2                            **
C               **           +   +   3                            **
C               **                                                **
C               **           -   -   1                            **
C               **           -   -   2                            **
C               **           -   -   3                            **
C               **                                                **
C               **           +   +   1                            **
C               **           +   +   2                            **
C               **           +   +   3                            **
C               **     3) REPLICATION 'BETWEEN', AS IN            **
C               **        (FOR A 2**2 WITH 3 REPLICATIONS)--      **
C               **          X1  X2  REP                           **
C               **           -   +   1                            **
C               **           +   +   1                            **
C               **           -   -   1                            **
C               **           +   +   1                            **
C               **                                                **
C               **           -   +   2                            **
C               **           +   +   2                            **
C               **           -   -   2                            **
C               **           +   +   2                            **
C               **                                                **
C               **           -   +   3                            **
C               **           +   +   3                            **
C               **           -   -   3                            **
C               **           +   +   3                            **
C               **                                                **
C               ****************************************************
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL DISTIN(REP,N,IWRITE,REPD,NREPD,IBUGA3,IERROR)
C
      NUMREP=NREPD
      ANUMRE=NUMREP
      IREP='NO'
      ICASE='-999'
      IF(NUMREP.EQ.1)GOTO2190
      IREP='YES'
      ICASE='BETW'
      IF(REP(2).NE.REP(1))ICASE='WITH'
 2190 CONTINUE
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1WRITE(ICOUT,2191)REPD(1),REPD(2),REPD(3),REPD(4)
 2191 FORMAT('REPD(1),REPD(2),REPD(3),REPD(4) = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1CALL DPWRST('XXX','BUG ')
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1WRITE(ICOUT,2192)NREPD,IREP,ICASE
 2192 FORMAT('NREPD,IREP,ICASE = ',I8,2X,A4,2X,A4)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1CALL DPWRST('XXX','BUG ')
C
C               **************************************************
C               **  STEP 22--                                   **
C               **  COMPUTE CELL MEANS                          **
C               **************************************************
C
      IF(IREP.EQ.'NO')GOTO2210
      IF(ICASE.EQ.'WITH')GOTO2220
      GOTO2230
C
 2210 CONTINUE
      NMEAN=N
      ANMEAN=NMEAN
      DO2211I=1,N
      YMEAN(I)=Y(I)
 2211 CONTINUE
      GOTO2290
C
 2220 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      DO2221I=1,NMEAN
      SUM=0.0
      JMIN=NUMREP*(I-1)+1
      JMAX=NUMREP*I
      DO2222J=JMIN,JMAX
      SUM=SUM+Y(J)
 2222 CONTINUE
      YMEAN(I)=SUM/ANUMRE
 2221 CONTINUE
      GOTO2290
C
 2230 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      DO2231I=1,NMEAN
      SUM=0.0
      DO2232J=I,N,NMEAN
      SUM=SUM+Y(J)
 2232 CONTINUE
      YMEAN(I)=SUM/ANUMRE
 2231 CONTINUE
      GOTO2290
C
 2290 CONTINUE
      NCOEF=NMEAN
C
C               **************************************************
C               **  STEP 23--                                   **
C               **  IF HAVE REPLICATION,                        **
C               **  COMPUTE REPLICATION STANDARD DEVIATION      **
C               **************************************************
C
      IREPDF=0
      REPDF=0.0
      REPVAR=0.0
      REPSD=0.0
      LOFCDF=0.0
      IF(IREP.EQ.'NO')GOTO2390
      IF(ICASE.EQ.'WITH')GOTO2320
      GOTO2330
C
 2320 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      SUMT=0.0
      DO2321I=1,NMEAN
      SUM=0.0
      JMIN=NUMREP*(I-1)+1
      JMAX=NUMREP*I
      DO2322J=JMIN,JMAX
      SUM=SUM+(Y(J)-YMEAN(I))**2
      SUMT=SUMT+(Y(J)-YMEAN(I))**2
 2322 CONTINUE
      YVAR(I)=SUM/(ANUMRE-1.0)
 2321 CONTINUE
      IREPDF=NMEAN
      REPDF=ANMEAN
      REPVAR=SUMT/REPDF
      REPSD=0.0
      IF(REPVAR.GT.0.0)REPSD=SQRT(REPVAR)
      GOTO2390
C
 2330 CONTINUE
      NMEAN=N/NUMREP
      ANMEAN=NMEAN
      SUMT=0.0
      DO2331I=1,NMEAN
      SUM=0.0
      DO2332J=I,N,NMEAN
      SUM=SUM+(Y(J)-YMEAN(I))**2
      SUMT=SUMT+(Y(J)-YMEAN(I))**2
 2332 CONTINUE
      YVAR(I)=SUM/(ANUMRE-1.0)
 2331 CONTINUE
      IREPDF=NMEAN
      REPDF=ANMEAN
      REPVAR=SUMT/REPDF
      REPSD=0.0
      IF(REPVAR.GT.0.0)REPSD=SQRT(REPVAR)
      GOTO2390
C
 2390 CONTINUE
      NCOEF=NMEAN
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  COMPUTE EFFECTS                             **
C               **  (VIA THE YATES ALGORITHM ?)                   **
C               **************************************************
C
      DO2410I=1,NMEAN
      COEF(I)=YMEAN(I)
 2410 CONTINUE
C
      NPASS=(ALOG10(ANMEAN)/0.30103)+0.5
      NUMFAC=NPASS
CCCCC FEBRUARY 1995.  FOLLOWING SECTION ADDED.
      IF(NUMFAC.GT.MAXFAC)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2412)MAXFAC
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,2414)NUMFAC
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
 2412 FORMAT('*****ERROR FROM DEX PHD COMMAND.  THE MAXIMUM NUMBER ',
     1'FACTORS (',I2,') EXCEEDED.')
 2414 FORMAT('     DATA SET HAS ',I5,' FACTORS. ')
C
      DO2420IPASS=1,NPASS
C
      DO2430I=1,NMEAN
      DUMMY(I)=COEF(I)
 2430 CONTINUE
C
      J1=0
      J2=NMEAN/2
      DO2440I=1,NMEAN,2
      IP1=I+1
      J1=J1+1
      J2=J2+1
      COEF(J1)=DUMMY(IP1)+DUMMY(I)
      COEF(J2)=DUMMY(IP1)-DUMMY(I)
 2440 CONTINUE
C
 2420 CONTINUE
C
      COEF(1)=COEF(1)/ANMEAN
      DO2450I=2,NMEAN
      COEF(I)=COEF(I)/(ANMEAN/2.0)
 2450 CONTINUE
C
C               **************************************************
C               **  STEP 24--                                   **
C               **  COMPUTE SUM OF SQUARES FOR EACH EFFECT      **
C               **  REFERENCE--HUNTER DESIGN OF EXP. COURSE,    **
C               **             VOLUME 4, PAGE 71                **
C               **************************************************
C
      SSQCOE(1)=GSSQ
      DO2500I=2,NMEAN
      SSQCOE(I)=ANMEAN*COEF(I)*COEF(I)/4.0
 2500 CONTINUE
C
C               **************************************************
C               **  STEP 26--                                   **
C               **  DEFINE IDENTIFIERS                          **
C               **************************************************
C
      J=0
      JP1=1
CCCCC TAGCOE(JP1)=0.0
      ITAGCO(JP1)=0.0
C
      J=1
      JP1=2
      ITAG(J)=1
CCCCC TAGCOE(JP1)=ITAG(J)
      ITAGCO(JP1)=ITAG(J)
C
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1991
      IF(NUMFAC.LE.1)GOTO2629
      DO2610IFAC=2,NUMFAC
      JMIN=2**(IFAC-1)
      JMAX=(2**IFAC)-1
      K=0
      DO2620J=JMIN,JMAX
      JP1=J+1
      IF(J.EQ.JMIN)ITAG(J)=IFAC
CCCCC IF(J.EQ.JMIN)TAGCOE(JP1)=ITAG(J)
      IF(J.EQ.JMIN)ITAGCO(JP1)=ITAG(J)
      IF(J.EQ.JMIN.AND.IFAC.GE.10)ITAGCO(JP1)=ITAGCO(JP1)-10
      IF(J.EQ.JMIN)GOTO2620
      K=K+1
      ITAG(J)=10*ITAG(K)+IFAC
CCCCC TAGCOE(JP1)=ITAG(J)
      ITAGCO(JP1)=ITAG(J)
      IF(IFAC.GE.10)ITAGCO(JP1)=ITAGCO(JP1)-10
 2620 CONTINUE
 2610 CONTINUE
CCCCC THE FOLLOWING LINE WAS ADDED NOVEMBER 1991
 2629 CONTINUE
C
      TAGCO2(1)=0.0
      IF(NUMFAC.LE.0)GOTO2639
      DO2630I=2,NMEAN
      AJUNK=ITAGCO(I)
CCCCC ATEMP=ALOG10(TAGCOE(I)+0.5)
      ATEMP=ALOG10(AJUNK+0.5)
      ATEMP=ATEMP+1.0
      ITEMP=ATEMP
      TAGCO2(I)=ITEMP
 2630 CONTINUE
 2639 CONTINUE
C
C               **************************************************
C               **  STEP 27--                                   **
C               **  COMPUTE PSEUDO-REPLIC. STANDARD DEVIATION   **
C               **************************************************
C
      SUM=0.0
      SUMI=0.0
      DO2700I=1,NMEAN
      IF(TAGCO2(I).GE.2.5)SUM=SUM+SSQCOE(I)
      IF(TAGCO2(I).GE.2.5)SUMI=SUMI+1.0
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1WRITE(ICOUT,2701)I,TAGCO2(I),COEF(I),SSQCOE(I),SUMI,SUM
 2701 FORMAT('I,TAGCO2(I),COEF(I),SSQCOE(I),SUMI,SUM = ',I8,5E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1CALL DPWRST('XXX','BUG ')
 2700 CONTINUE
      PRESSS=SUM
      PRESDF=SUMI
      IPRESD=PRESDF+0.5
      PRESVA=0.0
      IF(PRESDF.GT.0.1)PRESVA=PRESSS/PRESDF
      PRESSD=0.0
      IF(PRESVA.GT.0.0)PRESSD=SQRT(PRESVA)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1WRITE(ICOUT,2702)PRESSS,PRESVA,PRESDF,PRESSD
 2702 FORMAT('PRESSS,PRESVA,PRESDF,PRESSD = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1CALL DPWRST('XXX','BUG ')
C
C               ****************************************************************
C               **  STEP 28--                                                  *
C               **  COMPUTE A REFERENCE STANDARD DEVIATION                     *
C               **  WHICH EQUALS                                               *
C               **     THE REPLICATION ST. DEV.     (IF HAVE REPLICATION)      *
C               **     THE PSEUDO-REPLIC. ST. DEV. (IF NOT HAVE REPLICATION)   *
C               ****************************************************************
C
      IREFDF=0
      IF(IREP.EQ.'NO')IREFDF=IPRESD
      IF(IREP.EQ.'YES')IREFDF=IREPDF
C
      REFVAR=0.0
      IF(IREP.EQ.'NO')REFVAR=PRESVA
C
      IF(IREP.EQ.'YES')REFVAR=REPVAR
      REFSD=0.0
      IF(REFVAR.GT.0.0)REFSD=SQRT(REFVAR)
C
C               **************************************************
C               **  STEP 29--                                   **
C               **  COMPUTE STANDARD DEV. FOR EACH COEF         **
C               **  REFERENCE--HUNTER DESIGN OF EXP. COURSE,    **
C               **             VOLUME 4, PAGE 82                **
C               **************************************************
C
      VCOER=0.0
      VCOER=2.0*(REPVAR/(AN/2.0))
      SDCOER=0.0
      IF(VCOER.GT.0.0)SDCOER=SQRT(VCOER)
C
      VCOEP=0.0
      VCOEP=2.0*(PRESVA/(AN/2.0))
      SDCOEP=0.0
      IF(VCOEP.GT.0.0)SDCOEP=SQRT(VCOEP)
C
      VCOEF=0.0
      VCOEF=2.0*(REFVAR/(AN/2.0))
      SDCOEF=0.0
      IF(VCOEF.GT.0.0)SDCOEF=SQRT(VCOEF)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED OCTOBER 1991
      VGMEAN=0.0
      VGMEAN=REFVAR/AN
      SDGMEA=0.0
      IF(VGMEAN.GT.0.0)SDGMEA=SQRT(VGMEAN)
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1WRITE(ICOUT,2903)REFVAR,REFSD,VCOEF,SDCOEF
 2903 FORMAT('REFVAR,REFSD,VCOEF,SDCOEF = ',4E15.7)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'PHD2')
     1CALL DPWRST('XXX','BUG ')
C
C               **************************************************
C               **  STEP 30--                                   **
C               **  COMPUTE T VALUE FOR EACH COEF               **
C               **************************************************
C
      DO3010I=1,NMEAN
      TCOEF(I)=0.0
      IF(SDCOEF.GT.0.0)TCOEF(I)=COEF(I)/SDCOEF
      IF(SDCOEF.GT.0.0.AND.TCOEF(I).GT.CUTOFF)TCOEF(I)=CUTOFF
      IF(SDCOEF.GT.0.0.AND.TCOEF(I).LT.-CUTOFF)TCOEF(I)=(-CUTOFF)
 3010 CONTINUE
C
C               **************************************************
C               **  STEP 31--                                   **
C               **  COMPUTE A SORT INDEX BASED ON               **
C               **  THE MAGNITUDE OF THE EFFECTS                **
C               **************************************************
C
      DO3110I=1,NMEAN
      DUMMY(I)=(-ABS(COEF(I)))
      AINDEX(I)=I
 3110 CONTINUE
C
      AMIN=DUMMY(1)
      DO3120I=1,NMEAN
      IF(DUMMY(I).LT.AMIN)AMIN=DUMMY(I)
 3120 CONTINUE
      DUMMY(1)=AMIN-10.0
C
      CALL SORTC(DUMMY,AINDEX,NMEAN,DUMMY2,AINDE2)
C
C               **************************************************
C               **  STEP 32--                                   **
C               **  COMPUTE THE RESIDUAL STANDARD DEVIATION     **
C               **  THAT WOULD RESULT IF FIT EACH TERM          **
C               **  INDIVIDUALLY, AS IN                         **
C               **  RESPONSE = CONSTANT + TERM + ERROR          **
C               **************************************************
C
CCCCC DO3210I=1,NMEAN
CCCCC CALL DMV(TAGCOE(I),NMEAN,TEMP)
CCCCC COEFFI=COEF(I)
CCCCC SUM=0.0
CCCCC DO3220J=1,NMEAN
CCCCC PREDJ=GMEAN+COEFFI*TEMP(J)
CCCCC RESJ=Y(J)-PREDJ
CCCCC SUM=SUM+RESJ*RESJ
C3220 CONTINUE
CCCCC RESVI=SUM/(AN-2.0)
CCCCC RESSDI=0.0
CCCCC IF(RESVI.GT.0.0)RESSDI=SQRT(RESVI)
CCCCC RSDCOE(I)=RESSDI
C3210 CONTINUE
C
      DO3210I=1,NMEAN
CCCCC THE FOLLOWING LINE WAS INSERTED JUNE 1992 (JJF)
      RVAR=0.0
CCCCC IF(I.EQ.1)RVAR=SSQCOE(1)/(ANMEAN-1.0)
      IF(I.EQ.1)RVAR=SSQCOE(1)/(AN-1.0)
CCCCC IF(I.GE.2)RVAR=(SSQCOE(1)-SSQCOE(I))/(ANMEAN-1.0-1.0)
CCCCC THE FOLLOWING LINE WAS FIXED NOVEMBER 1991
CCCCC IF(I.GE.2)RVAR=(SSQCOE(1)-SSQCOE(I))/(AN-1.0-1.0)
      IDENOM=N-1-1
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT & MOVED UP JUNE 1992 (JJF)
CCCCC RVAR=0.0
      IF(I.GE.2.AND.IDENOM.GE.1)RVAR=(SSQCOE(1)-SSQCOE(I))/
     1(AN-1.0-1.0)
      RSDCOE(I)=0.0
      IF(RVAR.GT.0.0)RSDCOE(I)=SQRT(RVAR)
 3210 CONTINUE
C
      DO3220I=1,NMEAN
      AI=I
      I2=AINDE2(I)+0.5
      IF(I.EQ.1)CUMSSQ=0.0
      IF(I.GE.2)CUMSSQ=CUMSSQ+SSQCOE(I2)
CCCCC IF(I.LT.NMEAN)RVAR=(SSQCOE(1)-CUMSSQ)/(ANMEAN-AI)
      IF(I.LT.NMEAN)RVAR=(SSQCOE(1)-CUMSSQ)/(AN-AI)
      IF(I.EQ.NMEAN.AND.IREP.EQ.'YES')RVAR=(SSQCOE(1)-CUMSSQ)/(AN-AI)
      IF(I.EQ.NMEAN.AND.IREP.EQ.'NO')RVAR=0.0
      RSDCOC(I2)=0.0
      IF(RVAR.GT.0.0)RSDCOC(I2)=SQRT(RVAR)
 3220 CONTINUE
C
C               **************************************************
C               **  STEP 33--                                   **
C               **  COMPUTE 97.5 AND 99.5 PERCENT POINTS        **
C               **  COMPUTE 95% AND 99% CONFIDENCE LIMITS       **
C               **************************************************
C
      NU=IREFDF
C
      P=0.975
      CALL TPPF(P,NU,T975)
      CL95=T975*SDCOEF
C
      P=0.995
      CALL TPPF(P,NU,T995)
      CL99=T995*SDCOEF
C
C               **************************************************
C               **  STEP 34--                                   **
C               **  FLAG THOSE EFFECTS WHICH HAVE T VALUES      **
C               **  LARGER (IN MAGNITUDE) THAT T975, AND        **
C               **  LARGER (IN MAGNITUDE) THAT T995             **
C               **************************************************
C
      DO3400I=1,NMEAN
CCCCC THE FOLLOWING 3 LINES WERE FIXED NOVEMBER 1991
CCCCC IFLAG(I)='  '
CCCCC IF(ABS(TCOEF(I)).GT.T975)IFLAG(I)='* '
CCCCC IF(ABS(TCOEF(I)).GT.T995)IFLAG(I)='**'
      IFLAG(I)=0
      IF(ABS(TCOEF(I)).GT.T975)IFLAG(I)=1
      IF(ABS(TCOEF(I)).GT.T995)IFLAG(I)=2
 3400 CONTINUE
C
C               ****************************
C               **  STEP 71--             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='71'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO7690
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7101)
 7101 FORMAT('                *****************************')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7102)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS REWORDED JUNE 1989
 7102 FORMAT('                **      2**K DEX FIT       ** ')
      WRITE(ICOUT,7101)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED JUNE 1989
      WRITE(ICOUT,7112)
 7112 FORMAT('      (NOTE--DATA MUST BE IN STANDARD ORDER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7113)N
 7113 FORMAT('      NUMBER OF OBSERVATIONS           = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7114)NUMFAC
 7114 FORMAT('      NUMBER OF FACTORS                = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'NO')WRITE(ICOUT,7115)
 7115 FORMAT('      NO REPLICATION CASE')
      IF(IREP.EQ.'NO')CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')WRITE(ICOUT,7116)
 7116 FORMAT('      REPLICATION CASE')
      IF(IREP.EQ.'YES')CALL DPWRST('XXX','BUG ')
C
      IF(IYATOS.EQ.'1'.OR.IYATOS.EQ.'12'.OR.IYATOS.EQ.'13'.OR.
     1IYATOS.EQ.'123')GOTO7120
      GOTO7290
 7120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 4 LINES WERE COMMENTED OUT NOVEMBER 1991
CCCCC WRITE(ICOUT,7121)RESSD
C7121 FORMAT('      RESIDUAL    STANDARD DEVIATION   = ',E20.11)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7122)IRESDF
C7122 FORMAT('      RESIDUAL    DEGREES OF FREEDOM   = ',I8)
CCCCC CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')WRITE(ICOUT,7123)REPSD
 7123 FORMAT('      REPLICATION STANDARD DEVIATION   = ',E20.11)
      IF(IREP.EQ.'YES')CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')WRITE(ICOUT,7124)IREPDF
 7124 FORMAT('      REPLICATION DEGREES OF FREEDOM   = ',I8)
      IF(IREP.EQ.'YES')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7125)PRESSD
 7125 FORMAT('      PSEUDO-REPLICATION STAND. DEV.   = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7126)IPRESD
 7126 FORMAT('      PSEUDO-DEGREES OF FREEDOM        = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7127)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS REWORDED JUNE 1989
 7127 FORMAT('      (THE PSEUDO-REP. STAND. DEV. ASSUMES ALL')
      WRITE(ICOUT,7128)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS REWORDED JUNE 1989
 7128 FORMAT('      3, 4, 5, ...-TERM INTERACTIONS ARE NOT REAL,')
CCCCC THE FOLLOWING 2 LINES WERE ADDED JUNE 1989
      WRITE(ICOUT,7129)
 7129 FORMAT('      BUT MANIFESTATIONS OF RANDOM ERROR)')
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')
     1WRITE(ICOUT,7131)SDCOER
 7131 FORMAT('      STANDARD DEVIATION OF A COEF.    = ',E20.11)
      IF(IREP.EQ.'YES')
     1CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'YES')
     1WRITE(ICOUT,7132)
 7132 FORMAT('      (BASED ON REPLICATION ST. DEV.)')
      IF(IREP.EQ.'YES')
     1CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'NO')
     1WRITE(ICOUT,7133)SDCOEP
 7133 FORMAT('      STANDARD DEVIATION OF A COEF.    = ',E20.11)
      IF(IREP.EQ.'NO')
     1CALL DPWRST('XXX','BUG ')
      IF(IREP.EQ.'NO')
     1WRITE(ICOUT,7134)
 7134 FORMAT('      (BASED ON PSEUDO-REP. ST. DEV.)')
      IF(IREP.EQ.'NO')
     1CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7211)GMEAN
 7211 FORMAT('      GRAND MEAN                       = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7212)GSD
 7212 FORMAT('      GRAND STANDARD DEVIATION         = ',E20.11)
      CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7224)CL99
 7224 FORMAT('      99% CONFIDENCE LIMITS (+-)       = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7223)CL95
 7223 FORMAT('      95% CONFIDENCE LIMITS (+-)       = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7222)T995
 7222 FORMAT('      99.5% POINT OF T DISTRIBUTION    = ',E20.11)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7221)T975
 7221 FORMAT('      97.5% POINT OF T DISTRIBUTION    = ',E20.11)
      CALL DPWRST('XXX','BUG ')
C
 7290 CONTINUE
C
      IF(IYATOS.EQ.'3'.OR.IYATOS.EQ.'13'.OR.IYATOS.EQ.'23'.OR.
     1IYATOS.EQ.'123')GOTO7400
      GOTO7490
C
 7400 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7411)
 7411 FORMAT('                   IDENTIFIER    EFFECT   ',
     1'     T VALUE      RESSD      RESSD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7412)
 7412 FORMAT(37X,2X,
     1'                 MEAN+TERM  MEAN+TERMS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7413)
 7413 FORMAT('-----------------------------------------------',
     1'------------------------------')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7431)GMEAN,RSDCOE(1),RSDCOE(1)
 7431 FORMAT(11X,'           MEAN',F14.5,13X,2X,F11.5,F11.5)
      CALL DPWRST('XXX','BUG ')
C
      ITAGCO(1)=0
      TCOEF(1)=-999.99
      IF(SDGMEA.GT.0.0)TCOEF(1)=GMEAN/SDGMEA
      IFLAG(1)=0
C
      DO7440I=2,NMEAN
      I2=AINDE2(I)+0.5
      IF(CCUTP.GE.CPUMAX.AND.
     1   TCUTP.GE.CPUMAX.AND.
     1   RCUTP.GE.CPUMAX)GOTO7441
      IF(CCUTP.LT.CPUMAX.AND.
     1CCUTN.LE.COEF(I2).AND.COEF(I2).LE.CCUTP)GOTO7440
      IF(TCUTP.LT.CPUMAX.AND.
     1TCUTN.LE.TCOEF(I2).AND.TCOEF(I2).LE.TCUTP)GOTO7440
      IF(RCUTP.LT.CPUMAX.AND.
     1RCUTN.LE.RSDCOC(I2).AND.RSDCOC(I2).LE.RCUTP)GOTO7440
 7441 CONTINUE
      STAR='  '
      IF(IFLAG(I2).EQ.1)STAR='* '
      IF(IFLAG(I2).EQ.2)STAR='**'
      WRITE(ICOUT,7442)ITAGCO(I2),COEF(I2),TCOEF(I2),STAR,
     1RSDCOE(I2),RSDCOC(I2)
 7442 FORMAT(15X,I11,F14.5,F13.1,A2,F11.5,F11.5)
      CALL DPWRST('XXX','BUG ')
 7440 CONTINUE
 7490 CONTINUE
C
 7690 CONTINUE
C
CCCCC FEBRUARY 1995.  COMMENT OUT FOLLOWING MESSAGE SINCE
CCCCC DON'T CURRENTLY ACTUALLY DO THIS.
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7711)
C7711 FORMAT('NOTE--TAG, COEF, TCOEF, RESSD, & CUMULATIVE RESSD')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,7712)
C7712 FORMAT('      WRITTEN TO FILES DPST1F.DAT AND DPST2F.DAT')
CCCCC CALL DPWRST('XXX','BUG ')
C
C     FORM VECTOR OF ESTIMATED MAIN EFFECTS.
C
      IMAX=2**NUMFAC
      DO8100I=1,IMAX
         IVALUE=ITAGCO(I)
         IF(0.LE.IVALUE.AND.IVALUE.LE.9)THEN
            IUNITS=IVALUE
            IF(IUNITS.LE.0)IUNITS=10
            AMAIN(IUNITS)=COEF(I)
         ENDIF
 8100 CONTINUE
C
C     FORM PREDICTED VALUES AND RESIDUALS FOR MAIN EFFECTS MODEL
C
      DO8110I=1,N
         SUM=0.0
         DO8120J=1,NUMFAC
            CALL YATES(I,J,XIJ)
            SUM=SUM+AMAIN(J)*XIJ
 8120    CONTINUE
         SUM=0.5*SUM
         SUM=SUM+GMEAN
         PREDLIN(I)=SUM
         RESLIN(I)=Y(I)-PREDLIN(I)
 8110 CONTINUE
C
C     FORM THE MATRIX OF 2-TERM INTERACTION EFFECTS
C
      DO8200I=1,NUMFAC
      A(I,I)=0.0
 8200 CONTINUE
C
      IMAX=2**NUMFAC
      DO8210I=1,IMAX
         IVALUE=ITAGCO(I)
         IF(10.LE.IVALUE.AND.IVALUE.LE.99)THEN
            ITENS=IVALUE/10
            ITERM=10*ITENS
            IUNITS=IVALUE-ITERM
            IF(ITENS.LE.0)ITENS=10
            IF(IUNITS.LE.0)IUNITS=10
            A(ITENS,IUNITS)=COEF(I)
            A(IUNITS,ITENS)=COEF(I)
         ENDIF
 8210 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IMAX=2**NUMFAC
      DO8250I=1,IMAX
CCCCC FEBRUARY 1995.  CONVERT TO STANDARD DATAPLOT I/O
CCCCC WRITE(6,8255)I,ITAGCO(I),COEF(I)
      WRITE(ICOUT,8255)I,ITAGCO(I),COEF(I)
 8255 FORMAT(1H ,'I,ITAGCO(I),COEF(I) = ',2I8,F10.3)
      CALL DPWRST('XXX','BUG ')
 8250 CONTINUE
C
      DO8300I=1,NUMFAC
CCCCC FEBRUARY 1995.  CONVERT TO STANDARD DATAPLOT I/O
CCCCC FEBRUARY 1995.  WRITE TO DPST1F.DAT AW WELL
CCCCC WRITE(6,8305)(A(I,J),J=1,NUMFAC)
      WRITE(ICOUT,8305)(A(I,J),J=1,NUMFAC)
 8305 FORMAT(1H ,10F10.3)
      CALL DPWRST('XXX','BUG ')
      WRITE(IOUNI1,8306)(A(I,J),J=1,NUMFAC)
 8306 FORMAT(12(1X,E15.7))
 8300 CONTINUE
C
C     DETERMINE THE EIGENVALUES AND EIGENVECTORS OF THE MATRIX
C
CCCCC AUGUST 1995.  REPLACE NUMERICAL RECIPES ROUTINE WITH
CCCCC EISPACK ROUTINE.  SSIEV IS FOR SYMMETRIC CASE.
CCCCC CALL JACOBI(A,NUMFAC,MAXCOL,EIGVAL,EIGVEC,JACROT)
      IERR2=0
      IJOB=1
      DO8341JJ=1,MAXFAC
      DO8342II=1,MAXFAC
      EIGVEC(II,JJ)=A(II,JJ)
 8342 CONTINUE
 8341 CONTINUE
      CALL SSIEV(EIGVEC,MAXCOL,NUMFAC,EIGVAL,VJUNK,IJOB,IERR2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC FEBRUARY 1995.  CONVERT TO STANDARD DATAPLOT I/O
      DO8410I=1,NUMFAC
CCCCC WRITE(6,8411)EIGVAL(I)
      WRITE(ICOUT,8411)EIGVAL(I)
 8411 FORMAT(1H ,10F10.3)
      CALL DPWRST('XXX','BUG ')
 8410 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC FEBRUARY 1995.  CONVERT TO STANDARD DATAPLOT I/O
      DO8510I=1,NUMFAC
CCCCC WRITE(6,8511)(EIGVEC(I,J),J=1,NUMFAC)
      WRITE(ICOUT,8511)(EIGVEC(I,J),J=1,NUMFAC)
 8511 FORMAT(1H ,10F10.3)
      CALL DPWRST('XXX','BUG ')
      WRITE(IOUNI3,8512)(EIGVEC(I,J),J=1,NUMFAC)
 8512 FORMAT(12(1X,E15.7))
 8510 CONTINUE
C
C     DETERMINE THE 2 LARGEST (IN MAGNITUDE) EIGENVALUES
C     AND WHAT EIGENVECTORS THEY ARE ASSOCIATED WITH
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO8600I=1,NUMFAC
      EIGVA2(I)=ABS(EIGVAL(I))
      EIGVA2(I)=(-EIGVA2(I))
      ITAG2(I)=I
 8600 CONTINUE
C
      CALL SORTC(EIGVA2,ITAG2,NUMFAC,EIGVA3,ITAG3)
C
      DO8610I=1,NUMFAC
      EIGVA2(I)=(-EIGVA2(I))
      EIGVA3(I)=(-EIGVA3(I))
 8610 CONTINUE
C
C     COMPUTE PHD'S
C
      INDEX1=ITAG3(1)
      INDEX2=ITAG3(2)
      INDEX3=ITAG3(3)
      INDEX4=ITAG3(4)
CCCCC APRIL 1996.  CHANGE FOLLOWING LINE
CCCCC INDEX4=ITAG3(5)
      INDEX5=ITAG3(5)
      DO8710I=1,N
         SUM1=0.0
         SUM2=0.0
         SUM3=0.0
         SUM4=0.0
         SUM5=0.0
         DO8720J=1,NUMFAC
            CALL YATES(I,J,XIJ)
            SUM1=SUM1+XIJ*EIGVEC(J,INDEX1)
            SUM2=SUM2+XIJ*EIGVEC(J,INDEX2)
            SUM3=SUM3+XIJ*EIGVEC(J,INDEX3)
            SUM4=SUM4+XIJ*EIGVEC(J,INDEX4)
            SUM5=SUM5+XIJ*EIGVEC(J,INDEX5)
 8720    CONTINUE
         PHD1(I)=SUM1
         PHD2(I)=SUM2
         PHD3(I)=SUM3
         PHD4(I)=SUM4
         PHD5(I)=SUM5
 8710 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
CCCCC FEBRUARY 1995.  PRINT EIGENVALIES (UNORDERED AND ORDERED) TO
CCCCC FILE DPST2F.DAT
      DO8800I=1,NUMFAC
CCCCC WRITE(IPR,8810)I,ITAG3(I),EIGVA3(I)
      WRITE(ICOUT,8810)I,ITAG3(I),EIGVA3(I)
 8810 FORMAT(1H ,'I,ITAG3(I),EIGVA3(I) = ',I8,I8,F10.3)
      CALL DPWRST('XXX','BUG ')
      WRITE(IOUNI2,8811)EIGVAL(I),ITAG3(I),EIGVAL(ITAG3(I))
 8811 FORMAT(1X,E15.7,1X,I5,1X,E15.7)
 8800 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO8820I=1,N
CCCCC WRITE(IPR,8830)I,Y(I),PREDLIN(I),RESLIN(I),PHD1(I),PHD2(I)
      WRITE(ICOUT,8830)I,Y(I),PREDLIN(I),RESLIN(I),PHD1(I),PHD2(I)
 8830 FORMAT(1H ,'I,Y(I),PREDLIN(I),RESLIN(I),PHD1(I),PHD2(I) = ',
     1I8,5F10.3)
      CALL DPWRST('XXX','BUG ')
 8820 CONTINUE
CCCCC FEBRUARY 1995.  PRINT PRED, RES, AND FIRST 5 PHD EIGENVECTORS
CCCCC TO FILE DPST4F.DAT
      DO8860I=1,N
      WRITE(IOUNI4,8870)PREDLIN(I),RESLIN(I),PHD1(I),PHD2(I),
     &PHD3(I),PHD4(I),PHD5(I)
 8870 FORMAT(7(1X,E15.7))
      CALL DPWRST('XXX','BUG ')
 8860 CONTINUE
C
CCCCC THE FOLLOWING WAS ADDED FEBRUARY 1995
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8891)
 8891 FORMAT('NOTE--THE MATRIX OF 2-TERM INTERACTIONS WRITTEN TO ',
     &'FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8892)
 8892 FORMAT('    --THE EIGENVALUES OF THE MATRIX WRITTEN TO ',
     &'FILE DPST3F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8893)
 8893 FORMAT('    --THE EIGENVECTORS OF THE MATRIX WRITTEN TO ',
     &'FILE DPST3F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8894)
 8894 FORMAT('    --THE PREDICTED, VALUES, RESIDUALS, AND FIRST 5 ',
     &'PHD VECOTRS WRITTEN TO FILE DPST4F.DAT')
      CALL DPWRST('XXX','BUG ')
C
CCCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1995
C               **************************************
C               **  STEP 89--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
 8900 CONTINUE
C
      ISTEPN='89'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'YAT2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'PHD2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPPHD2--')
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE FIXED   APRIL 1992
CCCCC WRITE(ICOUT,9012)IFOUND,IERROR
C9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NUMREP,IREP,ICASE
 9013 FORMAT('N,NUMREP,IREP,ICASE = ',2I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)GMEAN,GSSQ,GVAR,GSD
 9014 FORMAT('GMEAN,GSSQ,GVAR,GSD = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PRESSD,PRESDF,REPSD,REPDF
 9015 FORMAT('PRESSD,PRESDF,REPSD,REPDF = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)REFDF,REFDF,SDCOEF
 9016 FORMAT('REFDF,REFDF,SDCOEF = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9021I=1,NMEAN
      WRITE(ICOUT,9022)I,YMEAN(I),COEF(I),YVAR(I)
 9022 FORMAT('I,YMEAN(I),COEF(I),YVAR(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
      WRITE(ICOUT,9031)YATCCU,YATTCU,YATRCU,IYATOS,IYATRS
 9031 FORMAT('YATCCU,YATTCU,YATRCU,IYATOS,IYATRS = ',3E15.7,
     12X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)CCUTN,CCUTP
 9032 FORMAT('CCUTN,CCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)TCUTN,TCUTP
 9033 FORMAT('TCUTN,TCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)RCUTN,RCUTP
 9034 FORMAT('RCUTN,RCUTP = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPPIE(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1CLLIMI,CLWIDT,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE THE FOLLOWING PLOT--
C              A PIE CHART;
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     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     UPDATED         --NOVEMBER  1993. ADDITIONAL ARRAY FOR DPPIE2
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 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(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION X1(MAXOBV)
CCCCC NOVEMBER 1993.  ADD FOLLOWING LINE (AND ADD EQUIVALENCE)
      DIMENSION YTEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),YTEMP(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='DPPI'
      ISUBN2='E   '
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 PIE CHART  **
C               ***************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPPIE--')
      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(NUMARG.GE.1.AND.
     1ICOM.EQ.'PIE'.AND.IHARG(1).EQ.'CHAR')GOTO110
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      ICASPL='PIEC'
      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 DPPIE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('      (FOR WHICH A PIE CHART ')
      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 DPPIE')
      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 DPPIE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A PIE CHART, ')
      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 DPPIE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A PIE CHART, ')
      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)
      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 DPPIE2(Y1,X1,NLOCAL,IDATSW,CLWID,XSTART,XSTOP,
CCCCC NOVEMBER 1993.  ADD FOLLOWING LINE
     1YTEMP,
     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 DPPIE--')
      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)CLWID,XSTART,XSTOP
 9014 FORMAT('CLWID,XSTART,XSTOP = ',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 DPPIE2(Y,X,N,IDATSW,CLWID,XSTART,XSTOP,
CCCCC NOVEMBER 1993.  ADD FOLLOWING LINE
     1YTEMP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A PIE CHART
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     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         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1993. EACH SLICE HAS SAME TAG TO
C                                       ALLOW ATTRIBUTE SETTING (ALAN)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      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(*)
CCCCC NOVEMBER 1993.  ADD FOLLOWING LINE
      DIMENSION YTEMP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----DATA STATEMENTS-------------------------------------------------
C
      DATA PI/3.1415926535878/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPPI'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      KP1=0
      NWITHI=0
      JWITHI=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 DPPIE2--')
      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 DPPIE2--')
      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 DPPIE2--')
      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 DPPIE2--')
      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 DPPIE2--')
      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
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
  595 CONTINUE
C
C               **********************************
C               **  STEP 4--                    **
C               **  DETERMINE PLOT COORDINATES  **
C               **********************************
C
 1100 CONTINUE
      SUM=0.0
      DO1110J=1,NUMCLA
      SUM=SUM+D2(J)
 1110 CONTINUE
      AN2=SUM
C
CCCCC NOVEMBER, 1993.  FOLLOWING SECTION MODIFIED TO MAKE PIE SEGMENTS
CCCCC HAVE A COMMON "TAG".  THIS WILL ALLOW REGION ATTRIBUTES TO BE
CCCCC SET (E.G., FILL, COLOR, FILL PATTERN) INDIVIDUALLY FOR EACH PIE
CCCCC SLICE (PREVIOUSLY, SETTING REGION ATTRIBUTES CAUSED VERY 
CCCCC STRANGE AND UNDESIRABLE RESULTS).
      SUM=0.0
      DO1115J=1,NUMCLA
      FJ=D2(J)
      SUM=SUM+FJ
      CUMFJ=SUM
      FRACT=CUMFJ/AN2
      YTEMP(J)=FRACT
 1115 CONTINUE
CCCCC JANUARY 1998.  ON SOME PLATFORMS, THE FOLLOWING:
CCCCC     LET Y = DATA 2 8 10
CCCCC     LET X = DATA 1 2 3
CCCCCC    PIE CHART Y X
CCCCCC CAUSES A PROBLEM.  IN THIS CASE, THE BOTTOM HALF OF THE
CCCCCC PIE CHART IS A SINGLE SEMI-CIRCLE (I.E., 50% OF DATA),
CCCCCC ALGORITHM BELOW RECOGNIZED RADOLD AS EQUAL TO RAD2.  BASE
CCCCCC COMPARISON BELOW (WHICH IS USED TO SKIP EMPTY SLICES) ON
CCCCC VALUES OF FRACT INSTEAD.
CCCCC RADOLD=-999.0
      RADOLD=0.0
      FRACTO=-1.0
      K=0
      J2=0
CCCCC SUM=0.0
      DO1120J=1,NUMCLA
C
CCCCC FJ=D2(J)
CCCCC SUM=SUM+FJ
CCCCC CUMFJ=SUM
C
CCCCC FRACT=CUMFJ/AN2
      FRACT=YTEMP(J)
      RAD=FRACT*(2.0*PI)
      IF(RAD.LE.PI)RAD2=PI-RAD
      IF(RAD.GT.PI)RAD2=3.0*PI-RAD
C
CCCCC IF(RAD2.EQ.RADOLD)GOTO1120
      IF(FRACT.EQ.FRACTO)GOTO1120
C
CCCCC RADOLD=RAD2
CCCCC J2=J2+1
CCCCC K=2*(J2-1)+1
CCCCC KP1=K+1
C
      K=K+1
      J2=J2+1
C
      X2(K)=0.0
      Y2(K)=0.0
      D2(K)=J2
C
CCCCC X2(KP1)=COS(RAD2)
CCCCC Y2(KP1)=SIN(RAD2)
      K=K+1
      X2(K)=COS(RAD2)
      Y2(K)=SIN(RAD2)
      D2(K)=J2
C
      RADTMP=RAD
 1125 CONTINUE
      RADTMP=RADTMP-0.015
      IF(RADTMP.LT.RADOLD)GOTO1129
      IF(RADTMP.LE.PI)RAD2=PI-RADTMP
      IF(RADTMP.GT.PI)RAD2=3.0*PI-RADTMP
      K=K+1
      X2(K)=COS(RAD2)
      Y2(K)=SIN(RAD2)
      D2(K)=J2
      GOTO1125
C
 1129 CONTINUE
      K=K+1
      IF(RADOLD.LE.PI)RAD2=PI-RADOLD
      IF(RADOLD.GT.PI)RAD2=3.0*PI-RADOLD
      X2(K)=COS(RAD2)
      Y2(K)=SIN(RAD2)
      D2(K)=J2
C
      K=K+1
      X2(K)=0.0
      Y2(K)=0.0
      D2(K)=J2
      RADOLD=RAD
C
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,1121)J,J2,KP1,RAD2,RAD,PI,FRACT,
     1CUMFJ,
     1FJ,AN2,NUMCLA
 1121 FORMAT('J,J2,KP1,RAD2,RAD,PI,FRACT,CUMFJ,FJ,AN2,NUMCLA = ',
     13I3,7F9.3,I6)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
 1120 CONTINUE
CCCCC NOVEMBER 1993.  FOLLOWING SECTION NOW DONE IN ABOVE LOOP.
CCCCC NWITHI=KP1
CCCCC JWITHI=J2
C
CCCCC DO1130J2=1,JWITHI
CCCCC K=2*(J2-1)+1
CCCCC KP1=K+1
CCCCC D2(K)=J2
CCCCC D2(KP1)=J2
C1130 CONTINUE
C
CCCCC K=NWITHI
CCCCC NUMSEG=360
CCCCC ANUMSE=NUMSEG
CCCCC NUMSEP=NUMSEG+1
CCCCC DO1140J=1,NUMSEP
CCCCC JM1=J-1
C
CCCCC K=K+1
C
CCCCC DEG=JM1
CCCCC FRACT=DEG/ANUMSE
CCCCC RAD=FRACT*(2.0*PI)
CCCCC IF(RAD.LE.PI)RAD2=PI-RAD
CCCCC IF(RAD.GT.PI)RAD2=3.0*PI-RAD
C
CCCCC X2(K)=COS(RAD2)
CCCCC Y2(K)=SIN(RAD2)
CCCCC D2(K)=JWITHI+1.0
C
C1140 CONTINUE
      N2=K
      NPLOTV=3
      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 DPPIE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)N2
 9012 FORMAT('N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)JWITHI,NWITHI
 9013 FORMAT('JWITHI,NWITHI = ',I8,I8)
      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
 9090 CONTINUE
C
      RETURN
      END
