      SUBROUTINE DPSORT(X,N,Y)
C
C     ***** NOTE--THIS SUBROUTINE IS IDENTICAL TO THE SUBROUTINE SORT
C                 AND HAS BEEN REPRODUCED TO FACILITATE EXECUTION EFFICIENCY.
C
C     PURPOSE--THIS SUBROUTINE SORTS (IN ASCENDING ORDER)
C              THE N ELEMENTS OF THE SINGLE PRECISION VECTOR X
C              AND PUTS THE RESULTING N SORTED VALUES INTO THE
C              SINGLE PRECISION VECTOR Y.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VECTOR OF
C                                OBSERVATIONS TO BE SORTED.
C                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
C                                IN THE VECTOR X.
C     OUTPUT ARGUMENTS--Y      = THE SINGLE PRECISION VECTOR
C                                INTO WHICH THE SORTED DATA VALUES
C                                FROM X WILL BE PLACED.
C     OUTPUT--THE SINGLE PRECISION VECTOR Y
C             CONTAINING THE SORTED
C             (IN ASCENDING ORDER) VALUES
C             OF THE SINGLE PRECISION VECTOR X.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU
C                   (DEFINED AND USED INTERNALLY WITHIN
C                   THIS SUBROUTINE) DICTATE THE MAXIMUM
C                   ALLOWABLE VALUE OF N FOR THIS SUBROUTINE.
C                   IF IL AND IU EACH HAVE DIMENSION K,
C                   THEN N MAY NOT EXCEED 2**(K+1) - 1.
C                   FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS
C                   OF IL AND IU HAVE BEEN SET TO 36,
C                   THUS THE MAXIMUM ALLOWABLE VALUE OF N IS
C                   APPROXIMATELY 137 BILLION.
C                   SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE
C                   VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS,
C                   AND SINCE A SORT OF 137 BILLION ELEMENTS
C                   IS PRESENTLY IMPRACTICAL AND UNLIKELY,
C                   THEN THERE IS NO PRACTICAL RESTRICTION
C                   ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE.
C                   (IN LIGHT OF THE ABOVE, NO CHECK OF THE
C                   UPPER LIMIT OF N HAS BEEN INCORPORATED
C                   INTO THIS SUBROUTINE.)
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X
C              WILL BE PLACED IN THE FIRST POSITION
C              OF THE VECTOR Y,
C              THE SECOND SMALLEST ELEMENT IN THE VECTOR X
C              WILL BE PLACED IN THE SECOND POSITION
C              OF THE VECTOR Y, ETC.
C     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
C     COMMENT--IF THE ANALYST DESIRES A SORT 'IN PLACE',
C              THIS IS DONE BY HAVING THE SAME
C              OUTPUT VECTOR AS INPUT VECTOR IN THE CALLING SEQUENCE.
C              THUS, FOR EXAMPLE, THE CALLING SEQUENCE
C              CALL DPSORT(X,N,X)
C              IS ALLOWABLE AND WILL RESULT IN
C              THE DESIRED 'IN-PLACE' SORT.
C     COMMENT--THE SORTING ALGORTHM USED HEREIN
C              IS THE  QUICKSORT.
C              THIS ALGORTHIM IS EXTREMELY FAST AS THE
C              FOLLOWING TIME TRIALS INDICATE.
C              THESE TIME TRIALS WERE CARRIED OUT ON THE
C              UNIVAC 1108 EXEC 8 SYSTEM AT NBS
C              IN AUGUST OF 1974.
C              BY WAY OF COMPARISON, THE TIME TRIAL VALUES
C              FOR THE EASY-TO-PROGRAM BUT EXTREMELY
C              INEFFICIENT BUBBLE SORT ALGORITHM HAVE
C              ALSO BEEN INCLUDED--
C              NUMBER OF RANDOM         QUICKSORT       BUBBLE SORT
C               NUMBERS SORTED
C                N = 10                 .002 SEC          .002 SEC
C                N = 100                .011 SEC          .045 SEC
C                N = 1000               .141 SEC         4.332 SEC
C                N = 3000               .476 SEC        37.683 SEC
C                N = 10000             1.887 SEC      NOT COMPUTED
C     REFERENCES--CACM MARCH 1969, PAGE 186 ( QUICKSORT ALGORITHM
C                 BY RICHARD C. SINGLETON).
C               --CACM JANUARY 1970, PAGE 54.
C               --CACM OCTOBER 1970, PAGE 624.
C               --JACM JANUARY 1961, PAGE 41.
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     LANGUAGE--ANSI FORTRAN (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82.6
C     ORIGINAL VERSION--JUNE      1972.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --JUNE      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION IU(36)
      DIMENSION IL(36)
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='DPSO'
      ISUBN2='RT  '
C
      IERROR='NO'
      IBUGA3='OFF'
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 SORT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N
   53 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,X(I)
   56 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ************************
C               **  SORT THE VALUES.  **
C               ************************
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO119
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN SORT--',
     1'THE SECOND INPUT ARGUMENT (N) IS SMALLER THAN 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,118)N
  118 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
  119 CONTINUE
C
      IF(N.EQ.1)GOTO120
      GOTO129
  120 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,121)
  121 FORMAT('***** NON-FATAL DIAGNOSTIC IN SORT--',
     1'THE SECOND INPUT ARGUMENT (N) HAS THE VALUE 1')
CCCCC CALL DPWRST('XXX','BUG ')
      Y(1)=X(1)
      GOTO9000
  129 CONTINUE
C
      HOLD=X(1)
      DO135I=2,N
      IF(X(I).NE.HOLD)GOTO139
  135 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,136)HOLD
  136 FORMAT('***** NON-FATAL DIAGNOSTIC IN SORT--',
     1'THE FIRST INPUT ARGUMENT (A VECTOR) HAS ALL ELEMENTS = ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      DO137I=1,N
      Y(I)=X(I)
  137 CONTINUE
      GOTO9000
  139 CONTINUE
C
  190 CONTINUE
C
C               *******************************************
C               **  STEP 2--                             **
C               **  COPY THE VECTOR X INTO THE VECTOR Y  **
C               *******************************************
C
      DO200I=1,N
      Y(I)=X(I)
  200 CONTINUE
C
C               **********************************************************
C               **  STEP 3--                                            **
C               **  CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED  **
C               **********************************************************
C
      NM1=N-1
      DO250I=1,NM1
      IP1=I+1
      IF(Y(I).LE.Y(IP1))GOTO250
      GOTO290
  250 CONTINUE
      GOTO9000
  290 CONTINUE
C
C               ***************************
C               **  STEP 4--             **
C               **  CARRY OUT THE SORT.  **
C               ***************************
C
      M=1
      I=1
      J=N
  305 IF(I.GE.J)GOTO370
  310 K=I
      MID=(I+J)/2
      AMED=Y(MID)
      IF(Y(I).LE.AMED)GOTO320
      Y(MID)=Y(I)
      Y(I)=AMED
      AMED=Y(MID)
  320 L=J
      IF(Y(J).GE.AMED)GOTO340
      Y(MID)=Y(J)
      Y(J)=AMED
      AMED=Y(MID)
      IF(Y(I).LE.AMED)GOTO340
      Y(MID)=Y(I)
      Y(I)=AMED
      AMED=Y(MID)
      GOTO340
  330 Y(L)=Y(K)
      Y(K)=TT
  340 L=L-1
      IF(Y(L).GT.AMED)GOTO340
      TT=Y(L)
  350 K=K+1
      IF(Y(K).LT.AMED)GOTO350
      IF(K.LE.L)GOTO330
      LMI=L-I
      JMK=J-K
      IF(LMI.LE.JMK)GOTO360
      IL(M)=I
      IU(M)=L
      I=K
      M=M+1
      GOTO380
  360 IL(M)=K
      IU(M)=J
      J=L
      M=M+1
      GOTO380
  370 M=M-1
      IF(M.EQ.0)GOTO9000
      I=IL(M)
      J=IU(M)
  380 JMI=J-I
      IF(JMI.GE.11)GOTO310
      IF(I.EQ.1)GOTO305
      I=I-1
  390 I=I+1
      IF(I.EQ.J)GOTO370
      AMED=Y(I+1)
      IF(Y(I).LE.AMED)GOTO390
      K=I
  395 Y(K+1)=Y(K)
      K=K-1
      IF(AMED.LT.Y(K))GOTO395
      Y(K+1)=AMED
      GOTO390
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF SORT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N
 9013 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,X(I),Y(I)
 9016 FORMAT('I,X(I),Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
CCCCC JULY 2002.  ADD ISEED FOR HODGES-LEHMAN PLOT
     1ISEED,
     1ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE ONE OF THE FOLLOWING STATISTIC PLOTS--
C                 MEAN STATISTIC PLOT
C                 MIDM STATISTIC PLOT
C                 MEDI STATISTIC PLOT
C                 SD STATISTIC PLOT
C                 REL SD STATISTIC PLOT
C                 COEFFICIENT OF VARIATION STATISTIC PLOT
C                 SD MEAN STATISTIC PLOT
C                 VARI STATISTIC PLOT
C                 REL VARI STATISTIC PLOT
C                 VARI MEAN STATISTIC PLOT
C                 RANG STATISTIC PLOT
C                 MINI STATISTIC PLOT
C                 MAXI STATISTIC PLOT
C                 EXTREME STATISTIC PLOT
C                 SKEW STATISTIC PLOT
C                 KURT STATISTIC PLOT
C                 AUCR STATISTIC PLOT
C                 SDM STATISTIC PLOT
C                 AUCV STATISTIC PLOT
C                 RACV STATISTIC PLOT
C                 LOWH STATISTIC PLOT
C                 UPPH STATISTIC PLOT
C                 LOWQ STATISTIC PLOT
C                 UPPQ STATISTIC PLOT
C                 TRIM STATISTIC PLOT
C                 WINM STATISTIC PLOT
C                 MIDQ STATISTIC PLOT
C                 1DEC STATISTIC PLOT
C                 2DEC STATISTIC PLOT
C                 3DEC STATISTIC PLOT
C                 4DEC STATISTIC PLOT
C                 5DEC STATISTIC PLOT
C                 6DEC STATISTIC PLOT
C                 7DEC STATISTIC PLOT
C                 8DEC STATISTIC PLOT
C                 9DEC STATISTIC PLOT
C                 SINE FREQUENCY STATISTIC PLOT
C                 SINE AMPLITUDE STATISTIC PLOT
C                 TAGUCHI SIGNAL-TO-NOISE PLOTS
C                 CP PLOT
C                 CPL PLOT
C                 CPU PLOT
C                 CPK PLOT
C                 CPM PLOT
C                 CC PLOT
C                 CNPK PLOT
C                 PERCENT DEFECTIVE PLOT
C                 EXPECTED LOSS PLOT
C                 NORM PPCC STATISTIC PLOT
C                 AAD PLOT
C                 MAD PLOT
C                 SN PLOT
C                 QN PLOT
C                 PERCENTILE PLOT
C                 GEOMETRIC MEAN PLOT
C                 GEOMETRIC STANDARD DEVIATION PLOT
C                 HARMONIC MEAN PLOT
C                 INTERQUARTILE RANGE PLOT
C                 BIWEIGHT LOCATION PLOT
C                 BIWEIGHT SCALE PLOT
C                 WINSORIZED VARIANCE PLOT
C                 WINSORIZED SD PLOT
C                 BIWEIGHT MIDVARIANCE PLOT
C                 PERCENTAGE BEND MIDVARIANCE PLOT
C                 HODGES LEHMAN PLOT
C                 QUANTILE PLOT
C                 QUANTILE STANDARD ERROR PLOT
C                 TRIMMED MEAN STANDARD ERROR PLOT
C
C                 FOLLOWING REQUIRE TWO RESPONSE VARIABLES
C                 COVARIANCE PLOT
C                 RANK COVARIANCE PLOT
C                 CORRELATION PLOT
C                 RANK CORRELATION PLOT
C                 KENDELL TAU PLOT
C                 COMOVEMENT PLOT
C                 RANK COMOVEMENT PLOT
C                 WINSORIZED COVARIANCE PLOT
C                 WINSORIZED CORRELATION PLOT
C                 BIWEIGHT MIDCOVARIANCE PLOT
C                 BIWEIGHT MIDCORRELATION PLOT
C                 PERCENTAGE BEND CORRELATION PLOT
C                 LINEAR INTERCEPT STATISTIC PLOT
C                 LINEAR SLOPE STATISTIC PLOT
C                 LINEAR RESSD STATISTIC PLOT
C                 LINEAR CORRELATION STATISTIC PLOT
C                 REPEATABILITY SD STATISTIC PLOT
C                 REPRODUCABILITY SD STATISTIC PLOT
C                 WEIGHTED MEAN PLOT
C                 WEIGHTED SD PLOT
C                 WEIGHTED VARIANCE PLOT
C                 WEIGHTED TRIMMED MEAN PLOT
C                 RATIO PLOT
C
C                 FOLLOWING STATISTICS COMPUTE DIFFERENCE IN
C                 STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR
C                 LOCATION AND SCALE STATISTICS):
C   
C                 LOCATION:
C                 DIFFERENCE OF MEANS PLOT X1 X2
C                 DIFFERENCE OF MIDMEANS PLOT X1 X2
C                 DIFFERENCE OF MEDIANS PLOT X1 X2
C                 DIFFERENCE OF TRIMMED MEANS PLOT X1 X2
C                 DIFFERENCE OF WINSORIZED MEANS PLOT X1 X2
C                 DIFFERENCE OF GEOMETRIC MEANS PLOT X1 X2
C                 DIFFERENCE OF HARMONIC MEANS PLOT X1 X2
C                 DIFFERENCE OF HODGES-LEHMAN PLOT X1 X2
C                 DIFFERENCE OF BIWEIGHT LOCATION PLOT X1 X2
C   
C                 SCALE:
C                 DIFFERENCE OF STANDARD DEVIATIONS PLOT X1 X2
C                 DIFFERENCE OF VARIANCES PLOT X1 X2
C                 DIFFERENCE OF AAD PLOT X1 X2
C                 DIFFERENCE OF MAD PLOT X1 X2
C                 DIFFERENCE OF SN PLOT X1 X2
C                 DIFFERENCE OF QN PLOT X1 X2
C                 DIFFERENCE OF INTERQUARTILE RANGE PLOT X1 X2
C                 DIFFERENCE OF WINSORIZED SD PLOT X1 X2
C                 DIFFERENCE OF WINSORIZED VARIANCE PLOT X1 X2
C                 DIFFERENCE OF BIWEIGHT MIDVARIANCE PLOT X1 X2
C                 DIFFERENCE OF BIWEIGHT SCALE PLOT X1 X2
C                 DIFFERENCE OF PERCENTAGE BEND PLOT X1 X2
C                 DIFFERENCE OF GEOMETRIC SD PLOT X1 X2
C                 DIFFERENCE OF RANGE PLOT X1 X2
C                 DIFFERENCE OF MIDRANGE PLOT X1 X2
C                 DIFFERENCE OF QUANTILE PLOT X1 X2
C                 DIFFERENCE OF SKEWNESS PLOT X1 X2
C                 DIFFERENCE OF KURTOSIS PLOT X1 X2
C                 DIFFERENCE OF RELATIVE SD PLOT X1 X2
C                 DIFFERENCE OF SD OF MEAN PLOT X1 X2
C                 DIFFERENCE OF RELATIVE VARIANCE PLOT X1 X2
C                 DIFFERENCE OF VARIANCE OF THE MEAN PLOT X1 X2
C                 DIFFERENCE OF MINIMUM PLOT X1 X2
C                 DIFFERENCE OF MAXIMUM PLOT X1 X2
C                 DIFFERENCE OF EXTREMES PLOT X1 X2
C                 DIFFERENCE OF COEFFICENT OF VARI PLOT X1 X2
C                 DIFFERENCE OF COUNTS PLOT X1 X2
C                 DIFFERENCE OF SUM PLOT X1 X2
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-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--88/1
C     ORIGINAL VERSION--JANUARY   1988.
C     UPDATED         --MARCH     1988.  LINEAR INTERCEPT & SLOPE PLOTS
C     UPDATED         --MARCH     1988.  LINEAR RESSD AND CORRELATION PLOTS
C     UPDATED         --AUGUST    1988.  TAGUCHI SIGNAL-TO-NOISE PLOTS
C     UPDATED         --MAY       1989.  CAN OMIT 'TAGUCHI' IN SN.. PLOTS
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C     UPDATED         --SEPTEMBER 1992. FIX DEBUG SECTION AT EXIT
C     UPDATED         --SEPTEMBER 1993. CP PLOT
C     UPDATED         --SEPTEMBER 1993. CPK PLOT
C     UPDATED         --SEPTEMBER 1993. PERCENT DEFECTIVE PLOT
C     UPDATED         --SEPTEMBER 1993. EXPECTED LOSS PLOT
C     UPDATED         --DECEMBER  1993. SYNONYMS FOR TAGUCHI S/N PLOTS
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: SDM => SDME
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: VM => VAME
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: RSD => RESD
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: RVAR => REVA
C     UPDATED         --FEBRUARY  1994. ALLOW SD MEAN
C     UPDATED         --FEBRUARY  1994. ADD VARI OF MEAN
C     UPDATED         --FEBRUARY  1994. ADD EXTREME
C     UPDATED         --FEBRUARY  1994. ADD NORMAL PPCC
C     UPDATED         --MARCH     1994. WINSORIZED MEAN AS SYNONYM TO
C                                       WINDSORIZED MEAN.
C     UPDATED         --MARCH     1995. ADD AAD AND MAD
C     UPDATED         --JANUARY   1998. NAME CONFLICT FOR MINIMUM AND
C                                       MAXIMUM WITH BLOCK PLOT
C     UPDATED         --NOVEMBER  1998. ADD PERCENTILE PLOT
C     UPDATED         --NOVEMBER  1998. ADD CPM PLOT, CC PLOT
C     UPDATED         --MARCH     1999. ADD GEOMETRIC MEAN PLOT
C     UPDATED         --MARCH     1999. ADD GEOMETRIC STANDARD DEVIATION PLOT
C     UPDATED         --MARCH     1999. ADD HARMONIC MEAN PLOT
C     UPDATED         --OCTOBER   1999. SAVE INTERNAL PARAMETER
C                                       ALOWHIGH
C     UPDATED         --APRIL     2001. ADD CPL PLOT, CPU PLOT
C     UPDATED         --SEPTEMBER 2001. ADD IQ RANGE PLOT
C     UPDATED         --NOVEMBER  2001. ADD BIWEIGHT LOCATION PLOT
C     UPDATED         --NOVEMBER  2001. ADD BIWEIGHT SCALE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED VARIANCE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED SD PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCORRELATION PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C                                           PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND CORRELATION
C                                           PLOT
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE PLOT
C     UPDATED         --JULY      2002. ADD QUANTILE STANDARD ERROR PLOT
C     UPDATED         --JULY      2002. ADD TRIMMED MEAN STANDARD ERROR
C                                           PLOT
C     UPDATED         --MARCH     2003. ADD 35 "DIFFERENCE OF" STATISTICS
C     UPDATED         --MARCH     2003. ADD WEIGHTED MEAN, WEIGHTED SD,
C                                       WEIGHTED VARIANCE
C     UPDATED         --APRIL     2003. ADD SN AND QN (AND DIFFERENCE
C                                       OF), REQUIRED ADDITIONAL
C                                       SCRATCH ARRAYS
C     UPDATED         --MAY       2003. ADD WEIGHTED TRIMMED MEAN
C     UPDATED         --OCTOBER   2004. ADD KENDELL TAU
C     UPDATED         --FEBRUARY  2005. ADD REPEATABILITY SD
C     UPDATED         --FEBRUARY  2005. ADD REPRODUCABILITY SD
C     UPDATED         --SEPTEMBER 2005. ADD RATIO (SUM1/SUM2)
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      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 IH
      CHARACTER*4 IH2
      CHARACTER*4 IERRO2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHHOR
      CHARACTER*4 IHHOR2
      CHARACTER*4 IHX
      CHARACTER*4 IHX2
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Z1(MAXOBV)
      DIMENSION X1(MAXOBV)
      DIMENSION XTEMP3(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),X1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y1(1))
      EQUIVALENCE (GARBAG(IGARB3),Z1(1))
      EQUIVALENCE (GARBAG(IGARB4),XTEMP3(1))
CCCCC END CHANGE
C
CCCCC JULY 2002. ADD INTEGER ARRAYS FOR HODGES-LEHMAN PLOT.
      INCLUDE 'DPCOZI.INC'
C
      INTEGER ITEMP1(MAXOBV)
      INTEGER ITEMP2(MAXOBV)
      INTEGER ITEMP3(MAXOBV)
      INTEGER ITEMP4(MAXOBV)
      INTEGER ITEMP5(MAXOBV)
      INTEGER ITEMP6(MAXOBV)
      EQUIVALENCE (IGARBG(IIGAR1),ITEMP1(1))
      EQUIVALENCE (IGARBG(IIGAR2),ITEMP2(1))
      EQUIVALENCE (IGARBG(IIGAR3),ITEMP3(1))
      EQUIVALENCE (IGARBG(IIGAR4),ITEMP4(1))
      EQUIVALENCE (IGARBG(IIGAR5),ITEMP5(1))
      EQUIVALENCE (IGARBG(IIGAR6),ITEMP6(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.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='DPSP'
      ISUBN2='    '
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
      ICOLL=0
      ICOLH=0
      ICOLX=0
C
C               ************************************
C               **  TREAT THE STATISTIC PLOT CASE  **
C               ************************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DPSP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
   52 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,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='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE IF OF THIS TYPE  **
C               **  AND BRANCH ACCORDINGLY.    **
C               *********************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)GOTO9000
C
      IF(ICOM.EQ.'NUMB'.AND.ICOM2.EQ.'ER  ')GOTO201
      IF(ICOM.EQ.'COUN'.AND.ICOM2.EQ.'T   ')GOTO201
      IF(ICOM.EQ.'COUN'.AND.ICOM2.EQ.'TS  ')GOTO201
      IF(ICOM.EQ.'SIZE'.AND.ICOM2.EQ.'    ')GOTO201
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SAMP'.AND.IHARG(1).EQ.'SIZE')GOTO202
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SUBS'.AND.IHARG(1).EQ.'SIZE')GOTO202
C
      IF(ICOM.EQ.'SUM '.AND.ICOM2.EQ.'    ')GOTO211
      IF(ICOM.EQ.'PROD'.AND.ICOM2.EQ.'UCT ')GOTO212
      IF(ICOM.EQ.'INTE'.AND.ICOM2.EQ.'GRAL')GOTO213
C
      IF(ICOM.EQ.'MIDR'.AND.ICOM2.EQ.'ANGE')GOTO221
      IF(ICOM.EQ.'MEAN'.AND.ICOM2.EQ.'    ')GOTO222
CCCCC MARCH 1995.  CHECK FOR AVERAGE ABSOLUTE DEVIATION AND AAD
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AVER'.AND.ICOM2.EQ.'AGE '.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')GOTO413
      IF(ICOM.EQ.'AAD '.AND.ICOM2.EQ.'    ')GOTO414
C
      IF(ICOM.EQ.'AVER'.AND.ICOM2.EQ.'AGE ')GOTO222
      IF(ICOM.EQ.'MIDM'.AND.ICOM2.EQ.'EAN ')GOTO223
CCCCC MARCH 1995.  CHECK FOR MEDIAN ABSOLUTE DEVIATION AND MAD
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'MEDI'.AND.ICOM2.EQ.'AN  '.AND.IHARG(1).EQ.'ABSO'.AND.
     1IHARG(2).EQ.'DEVI')GOTO415
      IF(ICOM.EQ.'MAD '.AND.ICOM2.EQ.'    ')GOTO416
C
      IF(ICOM.EQ.'MEDI'.AND.ICOM2.EQ.'AN  ')GOTO224
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.
     1(IHARG(2).NE.'STAN'.AND.IHARG(3).NE.'ERRO'))GOTO225
CCCCC MARCH 1994.  RECOGNIZE CORRECT SPELLING.
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'MEAN')GOTO226
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WIND'.AND.IHARG(1).EQ.'MEAN')GOTO226
C
      IF(ICOM.EQ.'R   '.AND.ICOM2.EQ.'    ')GOTO241
      IF(ICOM.EQ.'RANG'.AND.ICOM2.EQ.'E   ')GOTO241
CCCCC JANUARY 1998. CHECK FOR BLOCK PLOT CONFLICT
      IF(ICOM.EQ.'MINI'.AND.ICOM2.EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MINI')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MIN '.AND.ICOM2.EQ.'    ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO242
      ENDIF
      IF(ICOM.EQ.'MAXI'.AND.ICOM2.EQ.'MUM ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(ICOM.EQ.'MAXI')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
      IF(ICOM.EQ.'MAX '.AND.ICOM2.EQ.'    ')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'BLOC'.AND.IHARG(2).EQ.'PLOT')
     1    GOTO9000
        GOTO243
      ENDIF
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'VARI'.AND.IHARG(1).EQ.'MEAN')GOTO253
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'ANCE')GOTO254
CCCCC THE FOLLOWING LINE WAS ADDED    FEBRUARY 1994
      IF(ICOM.EQ.'VARI'.AND.ICOM2.EQ.'    ')GOTO254
C
CCCCC THE FOLLOWING SECTION WAS ADDED    FEBRUARY 1994
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO251
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO252
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'VAR '.AND.IHARG(1).EQ.'MEAN')GOTO253
      IF(ICOM.EQ.'VAR '.AND.ICOM2.EQ.'    ')GOTO254
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'OF  '.AND.IHARG(3).EQ.'THE '.AND.
     1IHARG(4).EQ.'MEAN')GOTO261
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'OF  '.AND.IHARG(3).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI'.AND.
     1IHARG(2).EQ.'MEAN')GOTO263
C
CCCCC THE FOLLOWING SECTION WAS ADDED     FEBRUARY 1994
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'THE '.AND.IHARG(3).EQ.'MEAN')GOTO262
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'MEAN')GOTO263
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SD  '.AND.IHARG(1).EQ.'MEAN')GOTO266
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'DEVI')GOTO264
      IF(ICOM.EQ.'SD  '.AND.ICOM2.EQ.'    ')GOTO265
      IF(ICOM.EQ.'S   '.AND.ICOM2.EQ.'    ')GOTO265
C
      IF(ICOM.EQ.'RS  '.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RSD '.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RELS'.AND.ICOM2.EQ.'    ')GOTO271
      IF(ICOM.EQ.'RELS'.AND.ICOM2.EQ.'D   ')GOTO271
      IF(ICOM.EQ.'RV  '.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RVAR'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'    ')GOTO272
      IF(ICOM.EQ.'RELV'.AND.ICOM2.EQ.'AR  ')GOTO272
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'OF  '.AND.
     1IHARG(2).EQ.'VARI')GOTO273
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COEF'.AND.IHARG(1).EQ.'VARI')GOTO274
C
CCCCC THE FOLLOWING X LINES WERE ADDED     FEBRUARY 1994
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'SD  ')GOTO276
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO277
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VAR ')GOTO278
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RELA'.AND.IHARG(1).EQ.'VARI')GOTO278
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'QUAR')GOTO301
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'QUAR')GOTO302
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'QUAR')GOTO303
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LOWE'.AND.IHARG(1).EQ.'HING')GOTO304
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'UPPE'.AND.IHARG(1).EQ.'HING')GOTO305
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'THIR'.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO311
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'3RD '.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO311
      IF(ICOM.EQ.'SKEW'.AND.ICOM2.EQ.'NESS')GOTO312
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'FOUR'.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO313
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'STAN'.AND.IHARG(1).EQ.'4TH '.AND.
     1IHARG(2).EQ.'CENT'.AND.IHARG(3).EQ.'MOME')GOTO313
      IF(ICOM.EQ.'KURT'.AND.ICOM2.EQ.'OSIS')GOTO314
C
CCCCC IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'COVA')GOTO321
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'COVA'.AND.
     1IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')GOTO321
CCCCC IF(ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'CORR')GOTO322
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'CORR'.AND.
     1IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')GOTO322
C
      IF(ICOM.EQ.'COVA'.AND.ICOM2.EQ.'RIAN')GOTO331
      IF(ICOM.EQ.'CORR'.AND.ICOM2.EQ.'ELAT')GOTO332
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RANK'.AND.IHARG(1).EQ.'COVA')GOTO333
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RANK'.AND.IHARG(1).EQ.'CORR')GOTO334
      IF(ICOM.EQ.'COMO'.AND.ICOM2.EQ.'VEME')GOTO335
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'RANK'.AND.IHARG(1).EQ.'COMO')GOTO336
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'KEND'.AND.IHARG(1).EQ.'TAU ')GOTO337
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DECI')GOTO111
      GOTO119
  111 CONTINUE
      IF(ICOM.EQ.'FIRS')GOTO341
      IF(ICOM.EQ.'SECO')GOTO342
      IF(ICOM.EQ.'THIR')GOTO343
      IF(ICOM.EQ.'FOUR')GOTO344
      IF(ICOM.EQ.'FIFT')GOTO345
      IF(ICOM.EQ.'SIXT')GOTO346
      IF(ICOM.EQ.'SEVE')GOTO347
      IF(ICOM.EQ.'EIGH')GOTO348
      IF(ICOM.EQ.'NINT')GOTO349
  119 CONTINUE
C
      IF(ICOM.EQ.'PERC'.AND.IHARG(1).NE.'BEND'.AND.IHARG(1).NE.'DEFE')
     1   GOTO350
C
      IF(ICOM.EQ.'SN'.AND.IHARG(1).EQ.'SCAL')GOTO493
      IF(ICOM.EQ.'QN'.AND.IHARG(1).EQ.'SCAL')GOTO495
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'FREQ')GOTO361
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'AMP')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'AMP')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SIN'.AND.IHARG(1).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SINE'.AND.IHARG(1).EQ.'AMPL')GOTO362
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'INTE')GOTO363
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'SLOP')GOTO364
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'RESS')GOTO365
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'CORR')GOTO366
C
CCCCC THE FOLLOWING SECTION WAS DRASTICALLY SIMPLIFIED MAY 1989
      IF(NUMARG.GE.1.AND.ICOM.EQ.'TAGU')GOTO130
      GOTO139
  130 CONTINUE
      IF(IHARG(1).EQ.'SN')GOTO371
      IF(IHARG(1).EQ.'S/N')GOTO371
      IF(IHARG(1).EQ.'SN0')GOTO371
      IF(IHARG(1).EQ.'S/N0')GOTO371
      IF(IHARG(1).EQ.'SNT')GOTO371
      IF(IHARG(1).EQ.'S/NT')GOTO371
      IF(IHARG(1).EQ.'SN+')GOTO372
      IF(IHARG(1).EQ.'S/N+')GOTO372
CCCCC DECEMBER 1993.  ADD FOLLOWING LINE
      IF(IHARG(1).EQ.'SNL')GOTO372
      IF(IHARG(1).EQ.'SN-')GOTO373
      IF(IHARG(1).EQ.'S/N-')GOTO373
CCCCC DECEMBER 1993.  ADD FOLLOWING LINE
      IF(IHARG(1).EQ.'SNS')GOTO373
      IF(IHARG(1).EQ.'SN00')GOTO374
      IF(IHARG(1).EQ.'SNT2')GOTO374
      IF(IHARG(1).EQ.'S/N2')GOTO374
CCCCC DECEMBER 1993.  ADD FOLLOWING LINE
      IF(IHARG(1).EQ.'SN2')GOTO374
  139 CONTINUE
C
CCCCC THE FOLLOWING 12 LINES WERE ADDED MAY 1989
      IF(ICOM.EQ.'SN')GOTO381
      IF(ICOM.EQ.'S/N')GOTO381
      IF(ICOM.EQ.'SN0')GOTO381
      IF(ICOM.EQ.'S/N0')GOTO381
      IF(ICOM.EQ.'SNT')GOTO381
      IF(ICOM.EQ.'S/NT')GOTO381
      IF(ICOM.EQ.'SN+')GOTO382
      IF(ICOM.EQ.'S/N+')GOTO382
CCCCC DECEMBER 1993.  ADD FOLLOWING LINE
      IF(ICOM.EQ.'SNL ')GOTO382
      IF(ICOM.EQ.'SN-')GOTO383
      IF(ICOM.EQ.'S/N-')GOTO383
CCCCC DECEMBER 1993.  ADD FOLLOWING LINE
      IF(ICOM.EQ.'SNS')GOTO383
      IF(ICOM.EQ.'SN00')GOTO384
      IF(ICOM.EQ.'SNT2')GOTO384
      IF(ICOM.EQ.'S/N2')GOTO384
CCCCC DECEMBER 1993.  ADD FOLLOWING LINE
      IF(ICOM.EQ.'SN2')GOTO384
C
CCCCC THE FOLLOWING 6 LINES WERE ADDED     SEPTEMBER 1993
      IF(ICOM.EQ.'CP')GOTO401
      IF(ICOM.EQ.'CPK')GOTO402
      IF(ICOM.EQ.'CNPK')GOTO398
      IF(ICOM.EQ.'CPM')GOTO400
      IF(ICOM.EQ.'CC')GOTO399
      IF(ICOM.EQ.'CPL')GOTO396
      IF(ICOM.EQ.'CPU')GOTO397
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'DEFE')GOTO403
         IF(ICOM.EQ.'EXPE'.AND.IHARG(1).EQ.'LOSS')GOTO404
      ENDIF
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    FEBRUARY 1994
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'NORM'.AND.IHARG(1).EQ.'PPCC')GOTO411
      ENDIF
C
CCCCC THE FOLLOWING 3 LINES WERE ADDED    FEBRUARY 1994
      IF(NUMARG.GE.1)THEN
         IF(ICOM.EQ.'EXTR')GOTO412
      ENDIF
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'GEOM'.AND.ICOM2.EQ.'ETRI'.AND.IHARG(1).EQ.'MEAN')GOTO426
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'GEOM'.AND.ICOM2.EQ.'ETRI'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO436
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'HARM'.AND.IHARG(1).EQ.'MEAN')GOTO446
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'INTE'.AND.IHARG(1).EQ.'RANG')GOTO456
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'IQ  '.AND.IHARG(1).EQ.'RANG')GOTO456
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'LOCA')GOTO457
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'SCAL')GOTO458
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'VARI')GOTO460
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'SD')GOTO462
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI')
     1GOTO464
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'COVA')GOTO466
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WINS'.AND.IHARG(1).EQ.'CORR')GOTO468
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'MIDV')GOTO470
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.
     1IHARG(1).EQ.'MIDC'.AND.IHARG2(1).EQ.'ORRE')GOTO473
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'BIWE'.AND.IHARG(1).EQ.'MIDC')GOTO472
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'BEND'.AND.
     1IHARG(2).EQ.'MIDV')GOTO474
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'HODG'.AND.IHARG(1).EQ.'LEHM')GOTO476
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAN'.AND.IHARG(1).EQ.'PLOT')GOTO478
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'QUAN'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'ERRO'.AND.IHARG(3).EQ.'PLOT')GOTO480
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'TRIM'.AND.IHARG(1).EQ.'MEAN'.AND.IHARG(2).EQ.'STAN'.AND.
     1IHARG(3).EQ.'ERRO'.AND.IHARG(4).EQ.'PLOT')GOTO482
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PERC'.AND.IHARG(1).EQ.'BEND'.AND.
     1IHARG(2).EQ.'CORR')GOTO484
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WEIG'.AND.IHARG(1).EQ.'MEAN')GOTO486
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WEIG'.AND.IHARG(1).EQ.'VARI')GOTO488
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'WEIG'.AND.IHARG(1).EQ.'SD')GOTO490
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'WEIG'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO491
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'WEIG'.AND.IHARG(1).EQ.'TRIM'.AND.
     1IHARG(2).EQ.'MEAN')GOTO492
C
      IF(NUMARG.GE.1.AND.ICOM.EQ.'DIFF'.AND.IHARG(1).EQ.'OF')THEN
        IF(IHARG(2).EQ.'AVER'.AND.IHARG(3).EQ.'ABSO'.AND.
     1     IHARG(4).EQ.'DEVI')GOTO623
        IF(IHARG(2).EQ.'AAD')GOTO523
        IF(IHARG(2).EQ.'MEAN' .OR. IHARG(2).EQ.'AVER')GOTO501
        IF(IHARG(2).EQ.'MIDM')GOTO502
        IF(IHARG(2).EQ.'MEDI'.AND.IHARG(3).EQ.'ABSO'.AND.
     1     IHARG(4).EQ.'DEVI')GOTO624
        IF(IHARG(2).EQ.'MAD')GOTO524
        IF(IHARG(2).EQ.'MEDI')GOTO503
        IF(IHARG(2).EQ.'TRIM'.AND.IHARG(3).EQ.'MEAN')GOTO504
        IF(IHARG(2).EQ.'WINS'.AND.IHARG(3).EQ.'MEAN')GOTO505
        IF(IHARG(2).EQ.'GEOM'.AND.IHARG(3).EQ.'MEAN')GOTO506
        IF(IHARG(2).EQ.'HARM'.AND.IHARG(3).EQ.'MEAN')GOTO507
        IF(IHARG(2).EQ.'HODG'.AND.IHARG(3).EQ.'LEHM')GOTO508
        IF(IHARG(2).EQ.'BIWE'.AND.IHARG(3).EQ.'LOCA')GOTO509
        IF(IHARG(2).EQ.'SD'.AND.IHARG(3).EQ.'OF'.AND.
     1     IHARG(4).EQ.'THE'.AND.IHARG(5).EQ.'MEAN')GOTO738
        IF(IHARG(2).EQ.'SD'.AND.IHARG(3).EQ.'OF'.AND.
     1     IHARG(4).EQ.'MEAN')GOTO638
        IF(IHARG(2).EQ.'SD'.AND.IHARG(3).EQ.'MEAN')GOTO538
        IF(IHARG(2).EQ.'SD')GOTO520
        IF(IHARG(2).EQ.'STAN'.AND.IHARG(3).EQ.'DEVI')GOTO521
        IF(IHARG(2).EQ.'VARI'.AND.IHARG(3).EQ.'OF'.AND.
     1     IHARG(4).EQ.'THE'.AND.IHARG(5).EQ.'MEAN')GOTO740
        IF(IHARG(2).EQ.'VARI'.AND.IHARG(3).EQ.'OF'.AND.
     1     IHARG(4).EQ.'MEAN')GOTO640
        IF(IHARG(2).EQ.'VARI'.AND.IHARG(3).EQ.'MEAN')GOTO540
        IF(IHARG(2).EQ.'VARI')GOTO522
        IF(IHARG(2).EQ.'INTE'.AND.IHARG(3).EQ.'RANG')GOTO525
        IF(IHARG(2).EQ.'IQ  '.AND.IHARG(3).EQ.'RANG')GOTO525
        IF(IHARG(2).EQ.'WINS'.AND.IHARG(3).EQ.'STAN'.AND.
     1     IHARG(4).EQ.'DEVI')GOTO626
        IF(IHARG(2).EQ.'WINS'.AND.IHARG(3).EQ.'SD')GOTO526
        IF(IHARG(2).EQ.'WINS'.AND.IHARG(3).EQ.'VARI')GOTO527
        IF(IHARG(2).EQ.'BIWE'.AND.IHARG(3).EQ.'MIDV')GOTO528
        IF(IHARG(2).EQ.'BIWE'.AND.IHARG(3).EQ.'SCAL')GOTO529
        IF(IHARG(2).EQ.'PERC'.AND.IHARG(3).EQ.'BEND'.AND.
     1     IHARG(4).EQ.'MIDV')GOTO530
        IF(IHARG(2).EQ.'GEOM'.AND.IHARG(3).EQ.'STAN'.AND.
     1     IHARG(4).EQ.'DEVI')GOTO631
        IF(IHARG(2).EQ.'GEOM'.AND.IHARG(3).EQ.'SD')GOTO531
        IF(IHARG(2).EQ.'RANG')GOTO532
        IF(IHARG(2).EQ.'MIDR')GOTO533
        IF(IHARG(2).EQ.'QUAN')GOTO534
        IF(IHARG(2).EQ.'SKEW')GOTO535
        IF(IHARG(2).EQ.'KURT')GOTO536
        IF(IHARG(2).EQ.'RELA'.AND.IHARG(3).EQ.'SD')GOTO537
        IF(IHARG(2).EQ.'RELA'.AND.IHARG(3).EQ.'VARI')GOTO539
        IF(IHARG(2).EQ.'MINI')GOTO541
        IF(IHARG(2).EQ.'MAXI')GOTO542
        IF(IHARG(2).EQ.'EXTR')GOTO543
        IF(IHARG(2).EQ.'COEF'.AND.IHARG(3).EQ.'OF'.AND.
     1     IHARG(4).EQ.'VARI')GOTO554
        IF(IHARG(2).EQ.'COEF'.AND.IHARG(3).EQ.'VARI')GOTO544
        IF(IHARG(2).EQ.'SN')GOTO545
        IF(IHARG(2).EQ.'QN')GOTO546
        IF(IHARG(2).EQ.'SUM')GOTO551
        IF(IHARG(2).EQ.'SUMS')GOTO551
CCCCC SIZE MAKES NO SENSE IN THIS CONTEXT BECAUSE IT WILL ALWAYS
CCCCC RETURN 0 (I.E., GROUP SIZE IS SAME FOR BOTH VARIABLES)
CCCCC   IF(IHARG(2).EQ.'SIZE')GOTO552
CCCCC   IF(IHARG(2).EQ.'NUMB')GOTO552
CCCCC   IF(IHARG(2).EQ.'COUN')GOTO552
      ENDIF
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'REPE'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO561
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'REPE'.AND.IHARG(1).EQ.'SD  ')GOTO562
C
C     NOTE: NEED TO CHECK FOR CONFLICT WITH REPEAT COMMAND
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'REPE'.AND.
     1(IHARG(1).EQ.'STAT'.OR.IHARG(1).EQ.'PLOT'))GOTO563
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'REPR'.AND.IHARG(1).EQ.'STAN'.AND.
     1IHARG(2).EQ.'DEVI')GOTO564
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'REPR'.AND.IHARG(1).EQ.'SD  ')GOTO565
C
      IF(ICOM.EQ.'REPR')GOTO566
C
      IF(ICOM.EQ.'RATI'.AND.ICOM2.EQ.'O   ')GOTO567
C
      IFOUND='NO'
      GOTO9000
C
C               **********************
C               **  STEP 2--        **
C               **  DEFINE ICASPL.  **
C               **********************
C
  201 CONTINUE
      ICASPL='NUMB'
      GOTO701
C
  202 CONTINUE
      ICASPL='NUMB'
      GOTO702
C
  211 CONTINUE
      ICASPL='SUM'
      GOTO701
C
  212 CONTINUE
      ICASPL='PROD'
      GOTO701
C
  213 CONTINUE
      ICASPL='INTE'
      GOTO701
C
  221 CONTINUE
      ICASPL='MIDR'
      GOTO701
C
  222 CONTINUE
      ICASPL='MEAN'
      GOTO701
C
  223 CONTINUE
      ICASPL='MIDM'
      GOTO701
C
  224 CONTINUE
      ICASPL='MEDI'
      GOTO701
C
  225 CONTINUE
      ICASPL='TRIM'
      GOTO702
C
  226 CONTINUE
      ICASPL='WINM'
      GOTO702
C
  241 CONTINUE
      ICASPL='RANG'
      GOTO701
C
  242 CONTINUE
      ICASPL='MINI'
      GOTO701
C
  243 CONTINUE
      ICASPL='MAXI'
      GOTO701
C
  251 CONTINUE
      ICASPL='VAME'
      GOTO704
C
  252 CONTINUE
      ICASPL='VAME'
      GOTO703
C
  253 CONTINUE
      ICASPL='VAME'
      GOTO702
C
  254 CONTINUE
      ICASPL='VARI'
      GOTO701
C
  261 CONTINUE
      ICASPL='SDME'
      GOTO705
C
  262 CONTINUE
      ICASPL='SDME'
      GOTO704
C
  263 CONTINUE
      ICASPL='SDME'
      GOTO703
C
  264 CONTINUE
      ICASPL='SD'
      GOTO702
C
  265 CONTINUE
      ICASPL='SD'
      GOTO701
C
  266 CONTINUE
      ICASPL='SDME'
      GOTO702
C
  271 CONTINUE
      ICASPL='RESD'
      GOTO701
C
  272 CONTINUE
      ICASPL='REVA'
      GOTO701
C
  273 CONTINUE
      ICASPL='CVAR'
      GOTO703
C
  274 CONTINUE
      ICASPL='CVAR'
      GOTO702
C
CCCCC THE FOLLOWING 3 SECTIONS WERE ADDED    FEBRUARY 1994
  276 CONTINUE
      ICASPL='RESD'
      GOTO702
C
  277 CONTINUE
      ICASPL='RESD'
      GOTO703
C
  278 CONTINUE
      ICASPL='REVA'
      GOTO702
C
  301 CONTINUE
      ICASPL='LOWQ'
      GOTO702
C
  302 CONTINUE
      ICASPL='MIDQ'
      GOTO702
C
  303 CONTINUE
      ICASPL='UPPQ'
      GOTO702
C
  304 CONTINUE
      ICASPL='LOWH'
      GOTO702
C
  305 CONTINUE
      ICASPL='UPPH'
      GOTO702
C
  311 CONTINUE
      ICASPL='SKEW'
      GOTO704
C
  312 CONTINUE
      ICASPL='SKEW'
      GOTO701
C
  313 CONTINUE
      ICASPL='KURT'
      GOTO704
C
  314 CONTINUE
      ICASPL='KURT'
      GOTO701
C
  321 CONTINUE
      ICASPL='AUCV'
      GOTO701
C
  322 CONTINUE
      ICASPL='AUCR'
      GOTO701
C
  331 CONTINUE
      ICASPL='COVA'
      GOTO701
C
  332 CONTINUE
      ICASPL='CORR'
      GOTO701
C
  333 CONTINUE
      ICASPL='RACV'
      GOTO702
C
  334 CONTINUE
      ICASPL='RACR'
      GOTO702
C
  335 CONTINUE
      ICASPL='COMO'
      GOTO701
C
  336 CONTINUE
      ICASPL='RACM'
      GOTO702
C
  337 CONTINUE
      ICASPL='KTAU'
      GOTO702
C
  341 CONTINUE
      ICASPL='1DEC'
      GOTO702
C
  342 CONTINUE
      ICASPL='2DEC'
      GOTO702
C
  343 CONTINUE
      ICASPL='3DEC'
      GOTO702
C
  344 CONTINUE
      ICASPL='4DEC'
      GOTO702
C
  345 CONTINUE
      ICASPL='5DEC'
      GOTO702
C
  346 CONTINUE
      ICASPL='6DEC'
      GOTO702
C
  347 CONTINUE
      ICASPL='7DEC'
      GOTO702
C
  348 CONTINUE
      ICASPL='8DEC'
      GOTO702
C
  349 CONTINUE
      ICASPL='9DEC'
      GOTO702
C
  350 CONTINUE
      ICASPL='PERC'
      GOTO701
C
  361 CONTINUE
      ICASPL='SIFR'
      GOTO702
C
  362 CONTINUE
      ICASPL='SIAM'
      GOTO702
C
  363 CONTINUE
      ICASPL='LIIN'
      GOTO702
C
  364 CONTINUE
      ICASPL='LISL'
      GOTO702
C
  365 CONTINUE
      ICASPL='LIRE'
      GOTO702
C
  366 CONTINUE
      ICASPL='LICO'
      GOTO702
C
  371 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1989
      ICASPL='SN0'
      GOTO702
C
  372 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1989
      ICASPL='SN+'
      GOTO702
C
  373 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1989
      ICASPL='SN-'
      GOTO702
C
  374 CONTINUE
CCCCC THE FOLLOWING LINE WAS CHANGED MAY 1989
      ICASPL='SN00'
      GOTO702
C
CCCCC THE FOLLOWING SECTIONS (381 TO 384) WERE ADDED   MAY 1989
  381 CONTINUE
      ICASPL='SN0'
      GOTO701
C
  382 CONTINUE
      ICASPL='SN+'
      GOTO701
C
  383 CONTINUE
      ICASPL='SN-'
      GOTO701
C
  384 CONTINUE
      ICASPL='SN00'
      GOTO701
C
  396 CONTINUE
      ICASPL='CPL'
      GOTO701
C
  397 CONTINUE
      ICASPL='CPU'
      GOTO701
C
  398 CONTINUE
      ICASPL='CNPK'
      GOTO701
C
  399 CONTINUE
      ICASPL='CC'
      GOTO701
C
  400 CONTINUE
      ICASPL='CPM'
      GOTO701
C
CCCCC THE FOLLOWING 4 SECTIONS (401 TO 404) WERE ADDED   SEPTEMBER 1993
  401 CONTINUE
      ICASPL='CP'
      GOTO701
C
  402 CONTINUE
      ICASPL='CPK'
      GOTO701
C
  403 CONTINUE
      ICASPL='PEDE'
      GOTO702
C
  404 CONTINUE
      ICASPL='EXLO'
      GOTO702
C
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED     FEBRUARY 1994
  411 CONTINUE
      ICASPL='NOPP'
      GOTO702
C
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED     FEBRUARY 1994
  412 CONTINUE
      ICASPL='EXTR'
      GOTO701
C
  413 CONTINUE
      ICASPL='AAD '
      GOTO703
C
  414 CONTINUE
      ICASPL='AAD '
      GOTO701
C
  415 CONTINUE
      ICASPL='MAD '
      GOTO703
C
  416 CONTINUE
      ICASPL='MAD '
      GOTO701
C
  426 CONTINUE
      ICASPL='GEME'
      GOTO702
C
  436 CONTINUE
      ICASPL='GESD'
      GOTO703
C
  446 CONTINUE
      ICASPL='HAME'
      GOTO702
C
  456 CONTINUE
      ICASPL='IQRA'
      GOTO702
C
  457 CONTINUE
      ICASPL='BILO'
      GOTO702
C
  458 CONTINUE
      ICASPL='BISC'
      GOTO702
C
  460 CONTINUE
      ICASPL='WIVA'
      GOTO702
C
  462 CONTINUE
      ICASPL='WISD'
      GOTO702
C
  464 CONTINUE
      ICASPL='WISD'
      GOTO703
C
  466 CONTINUE
      ICASPL='WICV'
      GOTO702
C
  468 CONTINUE
      ICASPL='WICR'
      GOTO702
C
  470 CONTINUE
      ICASPL='BIMV'
      GOTO702
C
  472 CONTINUE
      ICASPL='BIMC'
      GOTO702
C
  473 CONTINUE
      ICASPL='BICR'
      GOTO702
C
  474 CONTINUE
      ICASPL='PBMV'
      GOTO703
C
  476 CONTINUE
      ICASPL='HLEH'
      GOTO702
C
  478 CONTINUE
      ICASPL='QUAN'
      GOTO701
C
  480 CONTINUE
      ICASPL='QUSE'
      GOTO703
C
  482 CONTINUE
      ICASPL='TMSE'
      GOTO704
C
  484 CONTINUE
      ICASPL='PBCR'
      GOTO703
C
  486 CONTINUE
      ICASPL='WEME'
      GOTO702
C
  488 CONTINUE
      ICASPL='WEVA'
      GOTO702
C
  490 CONTINUE
      ICASPL='WESD'
      GOTO702
C
  491 CONTINUE
      ICASPL='WESD'
      GOTO703
C
  492 CONTINUE
      ICASPL='WETM'
      GOTO703
C
  493 CONTINUE
      ICASPL='SNSC'
      GOTO702
C
  495 CONTINUE
      ICASPL='QNSC'
      GOTO702
C
  501 CONTINUE
      IF(IHARG(3).EQ.'CONF' .AND.
     1  (IHARG(4).EQ.'INTE' .OR. IHARG(4).EQ.'LIMI'))THEN
        IFOUND='NO'
        GOTO9000
      ENDIF
      ICASPL='DMEA'
      GOTO703
C
  502 CONTINUE
      ICASPL='DMDM'
      GOTO703
C
  503 CONTINUE
      ICASPL='DMED'
      GOTO703
C
  504 CONTINUE
      ICASPL='DTRM'
      GOTO704
C
  505 CONTINUE
      ICASPL='DWNM'
      GOTO704
C
  506 CONTINUE
      ICASPL='DGEO'
      GOTO704
C
  507 CONTINUE
      ICASPL='DHAR'
      GOTO704
C
  508 CONTINUE
      ICASPL='DHDL'
      GOTO704
C
  509 CONTINUE
      ICASPL='DBIW'
      GOTO704
C
  520 CONTINUE
      ICASPL='DSD '
      GOTO703
C
  521 CONTINUE
      ICASPL='DSD '
      GOTO704
C
  522 CONTINUE
      ICASPL='DVAR'
      GOTO703
C
  623 CONTINUE
      ICASPL='DAAD'
      GOTO705
C
  523 CONTINUE
      ICASPL='DAAD'
      GOTO703
C
  624 CONTINUE
      ICASPL='MAAD'
      GOTO705
C
  524 CONTINUE
      ICASPL='DMAD'
      GOTO703
C
  525 CONTINUE
      ICASPL='DIQR'
      GOTO704
C
  626 CONTINUE
      ICASPL='DWSD'
      GOTO705
C
  526 CONTINUE
      ICASPL='DWSD'
      GOTO704
C
  527 CONTINUE
      ICASPL='DWVA'
      GOTO704
C
  528 CONTINUE
      ICASPL='DBIM'
      GOTO704
C
  529 CONTINUE
      ICASPL='DBIS'
      GOTO704
C
  530 CONTINUE
      ICASPL='DPBN'
      GOTO705
C
  631 CONTINUE
      ICASPL='DGSD'
      GOTO705
C
  531 CONTINUE
      ICASPL='DGSD'
      GOTO704
C
  532 CONTINUE
      ICASPL='DRAN'
      GOTO703
C
  533 CONTINUE
      ICASPL='DMDR'
      GOTO703
C
  534 CONTINUE
      ICASPL='DQUA'
      GOTO703
C
  535 CONTINUE
      ICASPL='DSKE'
      GOTO703
C
  536 CONTINUE
      ICASPL='DKUR'
      GOTO703
C
  537 CONTINUE
      ICASPL='DRSD'
      GOTO704
C
  738 CONTINUE
      ICASPL='DSDM'
      GOTO706
C
  638 CONTINUE
      ICASPL='DSDM'
      GOTO705
C
  538 CONTINUE
      ICASPL='DSDM'
      GOTO704
C
  539 CONTINUE
      ICASPL='DRVA'
      GOTO704
C
  740 CONTINUE
      ICASPL='DVAM'
      GOTO706
C
  640 CONTINUE
      ICASPL='DVAM'
      GOTO705
C
  540 CONTINUE
      ICASPL='DVAM'
      GOTO704
C
  541 CONTINUE
      ICASPL='DMIN'
      GOTO703
C
  542 CONTINUE
      ICASPL='DMAX'
      GOTO703
C
  543 CONTINUE
      ICASPL='DEXT'
      GOTO703
C
  554 CONTINUE
      ICASPL='DCVA'
      GOTO705
C
  544 CONTINUE
      ICASPL='DCVA'
      GOTO704
C
  545 CONTINUE
      ICASPL='DSN'
      GOTO703
C
  546 CONTINUE
      ICASPL='DQN'
      GOTO703
C
  551 CONTINUE
      ICASPL='DSUM'
      GOTO703
C
  552 CONTINUE
      ICASPL='DCOU'
      GOTO703
C
  561 CONTINUE
      ICASPL='REPE'
      GOTO703
C
  562 CONTINUE
      ICASPL='REPE'
      GOTO702
C
  563 CONTINUE
      ICASPL='REPE'
      GOTO701
C
  564 CONTINUE
      ICASPL='REPR'
      GOTO703
C
  565 CONTINUE
      ICASPL='REPR'
      GOTO702
C
  566 CONTINUE
      ICASPL='REPR'
      GOTO701
C
  567 CONTINUE
      ICASPL='RATI'
      GOTO701
C
C               *****************************************************
C               **  STEP 2--                                       **
C               **  DETERMINE THE LOCATION     (IN IHARG(.))       **
C               **  OF THE WORD      PLOT                          **
C               **  PLACE IT IN    ILASTC                          **
C               *****************************************************
C
  701 CONTINUE
      IF(NUMARG.LT.1)GOTO780
      IF(IHARG(1).EQ.'PLOT')GOTO801
      IF(NUMARG.LT.2)GOTO780
      IF(IHARG(1).EQ.'STAT'.AND.IHARG(2).EQ.'PLOT')GOTO802
      GOTO780
C
  702 CONTINUE
      IF(NUMARG.LT.2)GOTO780
      IF(IHARG(2).EQ.'PLOT')GOTO802
      IF(NUMARG.LT.3)GOTO780
      IF(IHARG(2).EQ.'STAT'.AND.IHARG(3).EQ.'PLOT')GOTO803
      GOTO780
C
  703 CONTINUE
      IF(NUMARG.LT.3)GOTO780
      IF(IHARG(3).EQ.'PLOT')GOTO803
      IF(NUMARG.LT.4)GOTO780
      IF(IHARG(3).EQ.'STAT'.AND.IHARG(4).EQ.'PLOT')GOTO804
      GOTO780
C
  704 CONTINUE
      IF(NUMARG.LT.4)GOTO780
      IF(IHARG(4).EQ.'PLOT')GOTO804
      IF(NUMARG.LT.5)GOTO780
      IF(IHARG(4).EQ.'STAT'.AND.IHARG(5).EQ.'PLOT')GOTO805
      GOTO780
C
  705 CONTINUE
      IF(NUMARG.LT.5)GOTO780
      IF(IHARG(5).EQ.'PLOT')GOTO805
      IF(NUMARG.LT.6)GOTO780
      IF(IHARG(5).EQ.'STAT'.AND.IHARG(6).EQ.'PLOT')GOTO806
      GOTO780
C
  706 CONTINUE
      IF(NUMARG.LT.6)GOTO780
      IF(IHARG(6).EQ.'PLOT')GOTO806
      IF(NUMARG.LT.7)GOTO780
      IF(IHARG(6).EQ.'STAT'.AND.IHARG(7).EQ.'PLOT')GOTO807
      GOTO780
C
  707 CONTINUE
      IF(NUMARG.LT.7)GOTO780
      IF(IHARG(7).EQ.'PLOT')GOTO807
      IF(NUMARG.LT.8)GOTO780
      IF(IHARG(7).EQ.'STAT'.AND.IHARG(8).EQ.'PLOT')GOTO808
      GOTO780
C
  780 CONTINUE
      IFOUND='NO'
      ICASPL='UNKN'
      GOTO9000
C
  801 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  802 CONTINUE
      ILASTC=2
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  803 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  804 CONTINUE
      ILASTC=4
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  805 CONTINUE
      ILASTC=5
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  806 CONTINUE
      ILASTC=6
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  807 CONTINUE
      ILASTC=7
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  808 CONTINUE
      ILASTC=8
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO890
C
  890 CONTINUE
      IFOUND='YES'
C
C               ***********************************************************
C               **  STEP 21--                                            **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.      **
C               ***********************************************************
C
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     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 22--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='22'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL 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'.OR.ISUBRO.EQ.'DPSP')
     1WRITE(ICOUT,2211)IHLEFT,ICOLL,NLEFT
 2211 FORMAT('IHLEFT,ICOLL,NLEFT = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL DPWRST('XXX','BUG ')
C
C               ***************************************************************
C               **  STEP 23--                                                **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)      **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.                **
C               ***************************************************************
C
      ISTEPN='23'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO2390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN DPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('      (FOR WHICH A ... STATISTIC PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)MINN2
 2315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2317)
 2317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2318)(IANS(I),I=1,IWIDTH)
 2318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2390 CONTINUE
C
C               *****************************************
C               **  STEP 24--                          **
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='24'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO2480
      DO2400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO2410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO2410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO2420
 2400 CONTINUE
      GOTO2490
 2410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO2490
 2420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO2490
C
 2480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2481)
 2481 FORMAT('***** INTERNAL ERROR IN DPSP')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2482)
 2482 FORMAT('      AT BRANCH POINT 2481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2483)
 2483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2484)
 2484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2485)NUMARG
 2485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2486)
 2486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2487)(IANS(I),I=1,IWIDTH)
 2487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2490 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DPSP')GOTO2495
      WRITE(ICOUT,2491)NUMARG,ILOCQ,ICASEQ
 2491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 2495 CONTINUE
C
C               *****************************************
C               **  STEP 24.5--                        **
C               **  DETERMINE THE NUMBER OF VARIABLES  **
C               *****************************************
C
      ISTEPN='24.5'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
C
C               ************************************************************
C               **  STEP 25--                                             **
C               **  IF A SECOND ARGUMENT EXISTS, THEN THIS                **
C               **  INDICATES THAT THE VALUES IN THE                      **
C               **  FIRST VARIABLE ARE TO BE GROUPED                      **
C               **  BASED ON VALUES OF THE SECOND VARIABLE;               **
C               **  THAT IS, THE SECOND VARAIBLE DEFINES THE              **
C               **  GROUP NUMBERS WITHIN WHICH THE MEANS,                 **
C               **  STANDARD DEVIATIONS, RANGES, AND                      **
C               **  CUMULATIVE SUMS ARE TO BE COMPUTED.                   **
C               **  THE VALUES IN THE SECOND VARIABLE                     **
C               **  ARE THE X VALUES FOR EACH MEAN, STANDARD DEVIATION,   **
C               **  ETC.  IN THE RESULTING STATISTIC PLOT.                 **
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='25'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.EQ.1)GOTO2590
      IF(NUMV2.EQ.2)GOTO2530
      IF(NUMV2.EQ.3)GOTO2540
      GOTO2510
C
 2510 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2511)
 2511 FORMAT('***** ERROR IN DPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2512)
 2512 FORMAT('      FOR A ... STATISTIC PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2518)
 2518 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2519)
 2519 FORMAT('      MUST BE EITHER 1, 2, OR 3 ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2520)
 2520 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2521)
 2521 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2522)NUMV2
 2522 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2523)
 2523 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2524)(IANS(I),I=1,IWIDTH)
 2524 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2530 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'.OR.ISUBRO.EQ.'DPSP')
     1WRITE(ICOUT,2531)IHHOR,ICOLH,NHOR
 2531 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL DPWRST('XXX','BUG ')
      GOTO2570
C
 2540 CONTINUE
      IHX=IHARG(2)
      IHX2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHX,IHX2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLX=IVALUE(ILOCV)
      NX=IN(ILOCV)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1WRITE(ICOUT,2541)IHX,ICOLX,NX
 2541 FORMAT('IHX,ICOLX,NX   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL DPWRST('XXX','BUG ')
C
      IHHOR=IHARG(3)
      IHHOR2=IHARG2(3)
      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'.OR.ISUBRO.EQ.'DPSP')
     1WRITE(ICOUT,2542)IHHOR,ICOLH,NHOR
 2542 FORMAT('IHHOR,ICOLH,NHOR   = ',A4,I8,I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL DPWRST('XXX','BUG ')
      GOTO2570
C
 2570 CONTINUE
      IF(NUMV2.EQ.2.AND.NHOR.EQ.NLEFT)GOTO2590
      IF(NUMV2.EQ.3.AND.NX.EQ.NLEFT.AND.NHOR.EQ.NLEFT)GOTO2590
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2571)
 2571 FORMAT('***** ERROR IN DPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2572)
 2572 FORMAT('      FOR A ... STATISTIC PLOT, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2578)NUMV2
 2578 FORMAT('      WHEN HAVE ',I8,' VARIABLES SPECIFIED, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2579)
 2579 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2580)NUMV2
 2580 FORMAT('      IN THE ',I8,' VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2581)
 2581 FORMAT('      MUST BE THE SAME; ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2582)
 2582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2583)IHLEFT,NLEFT
 2583 FORMAT('        VARIABLE 1 ',A4,' HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.2)WRITE(ICOUT,2584)IHHOR,NHOR
 2584 FORMAT('        VARIABLE 2 ',A4,' HAS ',I8,' ELEMENTS')
      IF(NUMV2.EQ.2)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.3)WRITE(ICOUT,2585)IHX,NX
 2585 FORMAT('        VARIABLE 2 ',A4,' HAS ',I8,' ELEMENTS')
      IF(NUMV2.EQ.3)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.EQ.3)WRITE(ICOUT,2586)IHHOR,NHOR
 2586 FORMAT('        VARIABLE 3 ',A4,' HAS ',I8,' ELEMENTS')
      IF(NUMV2.EQ.3)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2587)
 2587 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2588)(IANS(I),I=1,IWIDTH)
 2588 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2590 CONTINUE
C
C               *************************************************
C               **  STEP 26--                                  **
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='26'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO2610
      IF(ICASEQ.EQ.'SUBS')GOTO2620
      IF(ICASEQ.EQ.'FOR')GOTO2630
C
 2610 CONTINUE
      DO2615I=1,NLEFT
      ISUB(I)=1
 2615 CONTINUE
      NQ=NLEFT
      GOTO2650
C
 2620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO2650
C
 2630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO2650
C
 2650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO2660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2660
      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)GOTO2660
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)
      IF(NUMV2.LE.2)GOTO2660
C
      IJ=MAXN*(ICOLX-1)+I
      IF(ICOLX.LE.MAXCOL)Z1(J)=V(IJ)
      IF(ICOLX.EQ.MAXCP1)Z1(J)=PRED(I)
      IF(ICOLX.EQ.MAXCP2)Z1(J)=RES(I)
      IF(ICOLX.EQ.MAXCP3)Z1(J)=YPLOT(I)
      IF(ICOLX.EQ.MAXCP4)Z1(J)=XPLOT(I)
      IF(ICOLX.EQ.MAXCP5)Z1(J)=X2PLOT(I)
      IF(ICOLX.EQ.MAXCP6)Z1(J)=TAGPLO(I)
      GOTO2660
C
 2660 CONTINUE
      NLOCAL=J
C
C               ****************************************************************
C               **  STEP 27--                                                 **
C               **  FOR THE 1-VARIABLE CASE ONLY,                             *
C               **  DETERMINE IF THE ANALYST                                  **
C               **  HAS SPECIFIED    THE GROUP SIZE,                          **
C               **  FOR THE STATISTIC PLOT ANALYSIS.                           *
C               **  THE GROUP SIZE SETTING IS DEFINED BY SEARCHING THE        **
C               **  INTERNAL TABLE FOR THE PARAMETER NAME      NI   ;         **
C               **  IF FOUND, USE THE SPECIFIED VALUE.                        **
C               **  IF NOT FOUND, GENERATE AN ERROR MESSAGE.                  **
C               ****************************************************************
C
      ISTEPN='27'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.GE.2)GOTO2790
C
      IH='NI  '
      IH2='    '
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERRO2)
      IERROR=IERRO2
      IF(IERRO2.EQ.'YES')GOTO9000
      ISIZE=VALUE(ILOCP)+0.5
 2790 CONTINUE
C
C               *************************************************************
C               **  STEP 28--                                              **
C               **  COMPUTE THE APPROPRIATE STATISTIC PLOT STATISTIC--       **
C               **  (MEAN, STANDARD DEVIATION, RANGE, OR CUSUM).           **
C               **  COMPUTE CONFIDENCE LINES.                              **
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='28'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'DPSP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPSP2(Y1,Z1,X1,NLOCAL,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
CCCCC JULY 2002.  ADD FOLLOWING LINE FOR HODGES-LEHMAN
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1Y,X,D,NPLOTP,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C
C               *************************************************
C               **  STEP 29--                                  **
C               **  SAVE DIFFERENCE BETWEEN HIGHEST VALUE AND  **
C               **  LOWEST VALUE OF STATISTIC IN INTERNAL      **
C               **  PARAMETER ALOWHIGH                         **
C               *************************************************
      AMINS=CPUMAX
      AMAXS=CPUMIN
      DO2910I=1,NPLOTP
        IF(D(I).NE.1.0)GOTO2910
        IF(Y(I).GT.AMAXS)THEN
          AMAXS=Y(I)
          IMAXIN=I
        ENDIF
        IF(Y(I).LT.AMINS)THEN
          AMINS=Y(I)
          IMININ=I
        ENDIF
 2910 CONTINUE
      ADIFF=AMAXS-AMINS
      IF(IMAXIN.GT.IMININ)ADIFF=-ADIFF
C
      ISUBN0='DPSP'
C
      IH='ALOW'
      IH2='HIGH'
      VALUE0=ADIFF
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGG3,IERROR)
C
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'DPSP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ
 9012 FORMAT('ICONT,ISUBRO,IBUGG2,IBUGG3,IBUGQ  = ',
     1A4,2X,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,9015)ISIZE
 9015 FORMAT('ISIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NUMV2
 9016 FORMAT('NUMV2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IHLEFT,IHLEF2,ICOLL,NLEFT
 9017 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,2X,A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.2)WRITE(ICOUT,9018)IHHOR,IHHOR2,ICOLH,NHOR
 9018 FORMAT('IHHOR,IHHOR2,ICOLH,NHOR = ',A4,2X,A4,I8,I8)
      IF(NUMV2.GE.2)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.3)WRITE(ICOUT,9019)IHX,IHX2,ICOLX,NX
 9019 FORMAT('IHX,IHX2,ICOLX,NX = ',A4,2X,A4,I8,I8)
      IF(NUMV2.GE.3)CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING LINE WAS CHANGED SEPTEMBER 1992
CCCCC IF(NPLOTP.LE.0)GOTO9090
      IF(IFOUND.EQ.'NO'.OR.NPLOTP.LE.0)GOTO9090
      DO9025I=1,NPLOTP
      WRITE(ICOUT,9026)I,Y(I),X(I),D(I)
 9026 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSP2(Y,Z,X,N,NUMV2,ICASPL,ISIZE,ICONT,
     1TEMP,TEMPZ,XIDTEM,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
CCCCC JULY 2002.  ADD FOLLOWING LINE FOR HODGES-LEHMAN
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1Y2,X2,D2,N2,NPLOTV,ISUBRO,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE A PLOT
C              OF THE FOLLOWING TYPES--
C                 MEAN STATISTIC PLOT
C                 MIDM STATISTIC PLOT
C                 MEDI STATISTIC PLOT
C                 SD STATISTIC PLOT
C                 REL SD STATISTIC PLOT
C                 SD MEAN STATISTIC PLOT
C                 VARI STATISTIC PLOT
C                 REL VARI STATISTIC PLOT
C                 VARI MEAN STATISTIC PLOT
C                 RANG STATISTIC PLOT
C                 MINI STATISTIC PLOT
C                 MAXI STATISTIC PLOT
C                 EXTREME STATISTIC PLOT
C                 SKEW STATISTIC PLOT
C                 KURT STATISTIC PLOT
C                 AUCR STATISTIC PLOT
C                 SDM STATISTIC PLOT
C                 AUCV STATISTIC PLOT
C                 RACV STATISTIC PLOT
C                 LOWH STATISTIC PLOT
C                 UPPH STATISTIC PLOT
C                 LOWQ STATISTIC PLOT
C                 UPPQ STATISTIC PLOT
C                 TRIM STATISTIC PLOT
C                 WINM STATISTIC PLOT
C                 MIDQ STATISTIC PLOT
C                 1DEC STATISTIC PLOT
C                 2DEC STATISTIC PLOT
C                 3DEC STATISTIC PLOT
C                 4DEC STATISTIC PLOT
C                 5DEC STATISTIC PLOT
C                 6DEC STATISTIC PLOT
C                 7DEC STATISTIC PLOT
C                 8DEC STATISTIC PLOT
C                 9DEC STATISTIC PLOT
C                 SIN FREQUENCY STATISTIC PLOT
C                 SIN AMPLITUDE STATISTIC PLOT
C                 LINEAR INTERCEPT STATISTIC PLOT
C                 LINEAR SLOPE STATISTIC PLOT
C                 LINEAR RESSD STATISTIC PLOT
C                 LINEAR CORRELATION STATISTIC PLOT
C                 TAGUCHI SIGNAL-TO-NOISE PLOTS
C                 CP PLOT
C                 CPK PLOT
C                 CNPK PLOT
C                 CPM PLOT
C                 CC PLOT
C                 PERCENT DEFECTIVE PLOT
C                 EXPECTED LOSS PLOT
C                 NORM PPCC STATISTIC PLOT
C                 AAD PLOT
C                 MAD PLOT
C                 PERCENTILE PLOT
C                 GEOMETRIC MEAN PLOT
C                 GEOMETRIC STANDARD DEVIATION PLOT
C                 BIWEIGHT LOCATION PLOT
C                 BIWEIGHT SCALE PLOT
C                 WINSORIZED VARIANCE PLOT
C                 WINSORIZED SD PLOT
C                 WINSORIZED COVARIANCE PLOT
C                 WINSORIZED CORRELATION PLOT
C                 BIWEIGHT MIDVARIANCE PLOT
C                 BIWEIGHT MIDCOVARIANCE PLOT
C                 PERCENTAGE BEND MIDVARIANCE PLOT
C                 HODGES-LEHMAN PLOT
C                 SN PLOT
C                 QN PLOT
C                 KENDELL TAU 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-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     REFERENCE--ASTM MANUAL STP-15D, PAGES 78-84, 100-105
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--JANUARY   1988.
C     UPDATED         --MARCH     1988.   LINEAR INTERCEPT & SLOPE PLOTS
C     UPDATED         --MARCH     1988.   LINEAR RESSD & CORRELATION PLOTS
C     UPDATED         --AUGUST    1988.   TAGUCHI SIGNAL TO NOISE PLOTS
C     UPDATED         --SEPTEMBER 1988.   4 MISSING CHARACTER*4 STATEMENTS
C     UPDATED         --MAY       1989.   CHANGE TAGUCHI S/N DESIGNATIONS
C     UPDATED         --SEPTEMBER 1993. CP PLOT
C     UPDATED         --SEPTEMBER 1993. CPK PLOT
C     UPDATED         --SEPTEMBER 1993. PERCENT DEFECTIVE PLOT
C     UPDATED         --SEPTEMBER 1993. EXPECTED LOSS PLOT
C     UPDATED         --DECEMBER  1993. LINFIT ARGS
C     UPDATED         --DECEMBER  1993. LINFIT ARGS; PROTECT RESSD/DF
C     UPDATED         --FEBRUARY  1994. IFLAG='ACTU'
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: SDM => SDME
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: VM => VAME
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: RSD => RESD
C     UPDATED         --FEBRUARY  1994. CHANGE ICASPL: RVAR => REVA
C     UPDATED         --FEBRUARY  1994. ALLOW SD MEAN
C     UPDATED         --FEBRUARY  1994. ADD VARI OF MEAN
C     UPDATED         --FEBRUARY  1994. ADD VARI OF MEAN
C     UPDATED         --FEBRUARY  1994. ADD NORMAL PPCC
C     UPDATED         --NOVEMBER  1998. ADD PERCENTILE
C     UPDATED         --NOVEMBER  1998. ADD CPM, CC
C     UPDATED         --MARCH     1999. ADD CNPK
C     UPDATED         --MARCH     1999. ADD GEOMETRIC MEAN
C     UPDATED         --MARCH     1999. ADD GEOMETRIC STANDARD DEVIATION
C     UPDATED         --APRIL     2001. ARGUMENT LIST TO CP, CPK, CPM
C     UPDATED         --SEPTEMBER 2001. ADD IQ RANGE
C     UPDATED         --NOVEMBER  2001. ADD BIWEIGHT LOCATION
C     UPDATED         --NOVEMBER  2001. ADD BIWEIGHT SCALE
C     UPDATED         --JULY      2002. ADD WINSORIZED VARIANCE
C     UPDATED         --JULY      2002. ADD WINSORIZED SD
C     UPDATED         --JULY      2002. ADD WINSORIZED COVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD WINSORIZED CORRELATION PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCOVARIANCE PLOT
C     UPDATED         --JULY      2002. ADD BIWEIGHT MIDCORRELATION PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND MIDVARIANCE
C                                           PLOT
C     UPDATED         --JULY      2002. ADD PERCENTAGE BEND CoRRELATION
C                                           PLOT
C     UPDATED         --JULY      2002. ADD HODGES LEHMAN PLOT
C     UPDATED         --AUGUST    2002. USE "CMPSTA" TO COMPUTE THE
C                                       STATISTIC
C     UPDATED         --APRIL     2003. ADD SN AND QN (AND DIFFERENCE
C                                       OF), REQUIRED ADDITIONAL
C                                       SCRATCH ARRAY
C     UPDATED         --OCTOBER   2004. ADD KENDELL TAU
C     UPDATED         --FEBRUARY  2005. ADD REPEATABILITY SD
C     UPDATED         --FEBRUARY  2005. ADD REPRODUCABILITY SD
C     UPDATED         --SEPTEMBER 2005. ADD RATIO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICONT
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IQUAME
      CHARACTER*4 IQUASE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Z(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
      DIMENSION TEMP(*)
      DIMENSION TEMPZ(*)
      DIMENSION XIDTEM(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      INTEGER ITEMP1(*)
      INTEGER ITEMP2(*)
      INTEGER ITEMP3(*)
      INTEGER ITEMP4(*)
      INTEGER ITEMP5(*)
      INTEGER ITEMP6(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSP'
      ISUBN2='2   '
C
      IWRITE='OFF'
C
      I2=0
      ISIZE2=0
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPSP2--')
      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
CCCCC IF(N.GE.2)GOTO49
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,46)
CCC46 FORMAT('***** ERROR IN DPSP2--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,47)
CCC47 FORMAT('      THE NUMBER OF OBSERVATIONS')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,48)
CCC48 FORMAT('      WAS EXACTLY EQUAL TO 1.')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
CCC49 CONTINUE
C
CCCCC HOLD=Y(1)
CCCCC DO60I=1,N
CCCCC IF(Y(I).NE.HOLD)GOTO69
CCC60 CONTINUE
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,61)
CCC61 FORMAT('***** ERROR IN DPSP2--')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,62)
CCC62 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,63)HOLD
CCC63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,999)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
CCC69 CONTINUE
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSP2')GOTO90
      WRITE(ICOUT,70)
   70 FORMAT('AT THE BEGINNING OF DPSP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)IBUGG3,ISUBRO
   71 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N,ICASPL,NUMV2,ISIZE,ICONT
   72 FORMAT('N,ICASPL,NUMV2,ISIZE,ICONT = ',I8,2X,A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      IF(NUMV2.LE.2)WRITE(ICOUT,74)I,Y(I),X(I)
   74 FORMAT('I, Y(I),X(I) = ',I8,2F15.7)
      IF(NUMV2.LE.2)CALL DPWRST('XXX','BUG ')
      IF(NUMV2.GE.3)WRITE(ICOUT,75)I,Y(I),Z(I),X(I)
   75 FORMAT('I, Y(I),Z(I),X(I) = ',I8,3F15.7)
      IF(NUMV2.GE.3)CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   90 CONTINUE
C
C               ********************************************************
C               **  STEP 1--                                          **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES           **
C               **  FOR THE GROUP VARIABLE (USUALLY VAR. 2)           **
C               **  IF ALL VALUES ARE DISTINCT, THEN THIS             **
C               **  IMPLIES WE HAVE THE NO REPLICATION CASE           **
C               **  WHICH IS AN ERROR CONDITION FOR A PLOT.           **
C               ********************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMV2.EQ.1)GOTO110
      IF(NUMV2.EQ.2)GOTO150
      IF(NUMV2.EQ.3)GOTO150
C
  110 CONTINUE
      NUMSET=0
      DO120I=ISIZE,N,ISIZE
      I2=I
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=NUMSET
  120 CONTINUE
      IF(I2.LT.N)GOTO130
      GOTO140
  130 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=NUMSET
  140 CONTINUE
      DO145I=1,N
      IGROUP=1+((I-1)/ISIZE)
      IMID=(IGROUP-1)*ISIZE+(ISIZE/2)
      X(I)=IMID
  145 CONTINUE
      GOTO190
C
  150 CONTINUE
      NUMSET=0
      DO151I=1,N
      IF(NUMSET.EQ.0)GOTO153
      DO152J=1,NUMSET
      IF(X(I).EQ.XIDTEM(J))GOTO151
  152 CONTINUE
  153 CONTINUE
      NUMSET=NUMSET+1
      XIDTEM(NUMSET)=X(I)
  151 CONTINUE
      CALL SORT(XIDTEM,NUMSET,XIDTEM)
C
  190 CONTINUE
C
      IF(NUMSET.GE.1)GOTO194
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,191)
  191 FORMAT('***** ERROR IN DPSP2 SUBROUTINE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,192)
  192 FORMAT('      NUMBER OF SETS    NUMSET = 0 ')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  194 CONTINUE
C
CCCC JANUARY 2005.  IF NUMBER OF SETS EQUAL NUMBER OF OBSERVATIONS
CCCCC               (I.E., ALL GROUPS HAVE 1 OBSERVATION), TREAT AS
CCCCC               A WARNING RATHER THAN AN ERROR.  NOTE THAT SOME
CCCCC               STATISTICS MAY SUBSEQUENTLY GENERATE AN ERROR
CCCCC               MESSAGE FOR EACH GROUP.
C
      IF(NUMSET.NE.N)GOTO199
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,195)
  195 FORMAT('***** WARNING IN DPSP2 SUBROUTINE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,196)NUMSET
  196 FORMAT('      THE NUMBER OF SETS ',I8,' IS IDENTICAL TO ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,197)N
  197 FORMAT('      THE NUMBER OF OBSERVATIONS  ',I8,'.')
      CALL DPWRST('XXX','BUG ')
CCCCC IERROR='YES'
CCCCC GOTO9000
  199 CONTINUE
C
      AN=N
      ANUMSE=NUMSET
C
C               ******************************************
C               **  STEP 11--                           **
C               **  COMPUTE THE SPECIFIED STATISTIC     **
C               **  FOR EACH SUBSET OF THE DATA, AND    **
C               **  THEN FOR THE FULL DATA SET          **
C               ******************************************
C
      ISTEPN='11'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSP2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      ISETMX=NUMSET+1
      DO11000ISET=1,ISETMX
C
      IF(ISET.LE.NUMSET)GOTO11010
      GOTO11020
C
11010 CONTINUE
      K=0
      DO11011I=1,N
      IF(X(I).NE.XIDTEM(ISET))GOTO11011
      K=K+1
      TEMP(K)=Y(I)
      TEMPZ(K)=Z(I)
CCCCC IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSP2')
CCCCC1WRITE(ICOUT,11012)NUMSET,ISET,J,XIDTEM(ISET)
11012 FORMAT('NUMSET,ISET,J,XIDTEM(ISET)            = ',3I6,E12.4)
CCCCC IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSP2')
CCCCC1CALL DPWRST('XXX','BUG ')
CCCCC IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSP2')
CCCCC1WRITE(ICOUT,11013)N,I,K,X(I),Y(I),Z(I),TEMP(K),TEMPZ(K)
11013 FORMAT('N,I,K,X(I),Y(I),Z(I),TEMP(K),TEMPZ(K) = ',3I6,5E12.4)
CCCCC IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'PSP2')
CCCCC1CALL DPWRST('XXX','BUG ')
11011 CONTINUE
      NI=K
      NS2=NI
      GOTO11080
C
CCCCC FEBRUARY 2005: FOR REPEATABILITY SD AND REPRODUCABILITY SD,
CCCCC                OMIT FULL SAMPLE COMPUTATION (SINCE FULL SAMPLE
CCCCC                STATISTIC IS NOT MEANINGFUL AND DISTORTS THE
CCCCC                PLOT)
C
11020 CONTINUE
      IF(ICASPL.EQ.'REPE' .OR. ICASPL.EQ.'REPR')GOTO11000
      DO11021I=1,N
      TEMP(I)=Y(I)
      TEMPZ(I)=Z(I)
11021 CONTINUE
      NS2=N
      GOTO11080
C
11080 CONTINUE
      IF(NS2.GE.1)GOTO11090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11081)
11081 FORMAT('***** INTERNAL ERROR IN DPSP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11082)
11082 FORMAT('NI FOR SOME CLASS = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,11083)ISET,XIDTEM(ISET),NI
11083 FORMAT('ISET,XIDTEM(ISET),NI = ',I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
11090 CONTINUE
C
CCCCC AUGUST 2002: USE SUBROUTINE TO COMPUTE THE STATISTIC RATHER
CCCCC THAN CODING HERE.
C
      CALL CMPSTA(
     1TEMP,TEMPZ,XTEMP1,XTEMP2,XTEMP3,MAXNXT,NS2,NS2,NUMV2,ICASPL,
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IQUAME,IQUASE,
     1RIGHT,
     1ISUBRO,IBUGG3,IERROR)
C
C     ---------------------------
C
79000 CONTINUE
      IF(ISET.LE.NUMSET)GOTO79001
      GOTO79002
79001 CONTINUE
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XIDTEM(ISET)
      D2(J)=1.0
      GOTO79009
79002 CONTINUE
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XIDTEM(1)
      D2(J)=2.0
      J=J+1
      Y2(J)=RIGHT
      X2(J)=XIDTEM(NUMSET)
      D2(J)=2.0
      GOTO79009
79009 CONTINUE
C
11000 CONTINUE
      N2=J
      NPLOTV=3
      GOTO9000
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'PSP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3,ISUBRO
 9012 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL,N,NUMSET,N2,IERROR
 9013 FORMAT('ICASPL,N,NUMSET,N2,IERROR = ',A4,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMV2,ISIZE
 9014 FORMAT('NUMV2,ISIZE = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I),D2(I)
 9021 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPAC(IHARG,NUMARG,
     1IDEFSP,
     1ITEXSP,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPACING TYPE (FIXED OR PROPORTIONAL) FOR
C              TITLE, LABEL, AND LEGEND SCRIPT
C              ON A PLOT.
C              THE SPACING FOR THE SCRIPT WILL BE PLACED
C              IN THE CHARACTER VARIABLE ITEXSP.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSP
C                     --IBUGD2
C     OUTPUT ARGUMENTS--ITEXSP
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSP
      CHARACTER*4 ITEXSP
      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 DPSPAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFSP
   53 FORMAT('IDEFSP = ',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
C               ***************************
C               **  TREAT THE SPACING CASE  **
C               ***************************
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1120
      IF(IHARG(NUMARG).EQ.'ON')GOTO1120
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1120
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1120
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1120
      GOTO1140
C
 1120 CONTINUE
      ITEXSP=IDEFSP
      GOTO1180
C
 1140 CONTINUE
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'EQUA')GOTO1141
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'FIXE')GOTO1141
      IF(NUMARG.EQ.1.AND.IHARG(1).EQ.'PROP')GOTO1142
C
 1130 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPSPAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL ENTRY FOR SPACING ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)
 1133 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      SUPPOSE THE THE ANALYST WISHES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      TO SET THE SPACING TO PROPORTIONAL ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      FOR PLOT TITLES, LABELS, ETC.,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      THEN 2 ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('            SPACING PROPORTIONAL ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('            SPACING PROP ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1141 CONTINUE
      ITEXSP='FIXE'
      GOTO1180
C
 1142 CONTINUE
      ITEXSP='PROP'
      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 SPACING (FIXED OR PROPORTIONAL)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('FOR PLOT SCRIPT AND TEXT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)ITEXSP
 1183 FORMAT('HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGD2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPAC--')
      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)IDEFSP,ITEXSP
 9013 FORMAT('IDEFSP,ITEXSP = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPBA(IHARG,IARGT,ARG,NUMARG,ADEFSB,MAXSPI,ASPIBA,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE BASES.
C              THESE ARE LOCATED IN THE VECTOR ASPIBA(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --ADEFSB
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ASPIBA (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
      DIMENSION ASPIBA(*)
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='DPSP'
      ISUBN2='BA  '
C
      NUMSPI=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 DPSPBA--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)ADEFSB
   55 FORMAT('ADEFSB = ',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)ASPIBA(1)
   70 FORMAT('ASPIBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ASPIBA(I)
   76 FORMAT('I,ASPIBA(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=ADEFSB
      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
      NUMSPI=1
      ASPIBA(1)=ADEFSB
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG-1
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEFSB
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEFSB
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEFSB
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEFSB
      ASPIBA(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,ASPIBA(I)
 1276 FORMAT('SPIKE BASE ',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
      NUMSPI=MAXSPI
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=ADEFSB
      IF(IHOLD1.EQ.'OFF')HOLD2=ADEFSB
      IF(IHOLD1.EQ.'AUTO')HOLD2=ADEFSB
      IF(IHOLD1.EQ.'DEFA')HOLD2=ADEFSB
      DO1315I=1,NUMSPI
      ASPIBA(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)ASPIBA(I)
 1316 FORMAT('ALL SPIKE BASES 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 DPSPBA--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)ADEFSB
 9015 FORMAT('ADEFSB = ',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)ASPIBA(1)
 9030 FORMAT('ASPIBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ASPIBA(I)
 9036 FORMAT('I,ASPIBA(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPCO(IHARG,NUMARG,IDEFSC,MAXSPI,ISPICO,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE COLORS.
C              THESE ARE LOCATED IN THE VECTOR ISPICO(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSC
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ISPICO (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSC
      CHARACTER*4 ISPICO
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 ISPICO(*)
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='DPSP'
      ISUBN2='CO  '
C
      NUMSPI=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 DPSPCO--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSC
   55 FORMAT('IDEFSC = ',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)ISPICO(1)
   70 FORMAT('ISPICO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ISPICO(I)
   76 FORMAT('I,ISPICO(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=IDEFSC
      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
      NUMSPI=1
      ISPICO(1)=IDEFSC
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG-1
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEFSC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEFSC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSC
      ISPICO(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,ISPICO(I)
 1276 FORMAT('SPIKE 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
      NUMSPI=MAXSPI
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2=IDEFSC
      IF(IHOLD1.EQ.'OFF')IHOLD2=IDEFSC
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSC
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSC
      DO1315I=1,NUMSPI
      ISPICO(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)ISPICO(I)
 1316 FORMAT('ALL SPIKE 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 DPSPCO--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSC
 9015 FORMAT('IDEFSC = ',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)ISPICO(1)
 9030 FORMAT('ISPICO(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ISPICO(I)
 9036 FORMAT('I,ISPICO(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPDI(IHARG,NUMARG,IDEFSD,MAXSPI,ISPIDI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE DIRECTION--
C              VERT = VERTICAL
C              HORI = HORIZONTAL
C              HOR2 = HORIZONTAL TOWARD X2-X3 PLANE (FOR 3D PLOTS)
C              THESE ARE LOCATED IN THE VECTOR ISPIDI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSD
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ISPIDI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--87/5
C     ORIGINAL VERSION--MAY       1987.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSD
      CHARACTER*4 ISPIDI
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 ISPIDI(*)
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='DPSP'
      ISUBN2='DI  '
C
      NUMSPI=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 DPSPDI--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSD
   55 FORMAT('IDEFSD = ',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)ISPIDI(1)
   70 FORMAT('ISPIDI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ISPIDI(I)
   76 FORMAT('I,ISPIDI(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='VERT'
      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 SINGLE     SPECIFICATION   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
      NUMSPI=1
      ISPIDI(1)='VERT'
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG-1
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      J=I+1
      IHOLD1=IHARG(J)
      IHOLD2=IHOLD1
C???? IF(IHOLD1.EQ.'VERT')IHOLD2='VERT'
C???? IF(IHOLD1.EQ.'3')IHOLD2='3'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSD
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSD
      ISPIDI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,ISPIDI(I)
 1276 FORMAT('SPIKE DIRECTION ',I6,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1278 CONTINUE
 1279 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               **************************
C               **  STEP 3--            **
C               **  TREAT THE ALL CASE  **
C               **************************
C
 1300 CONTINUE
      ISTEPN='3'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMSPI=MAXSPI
      IHOLD2=IHOLD1
C???? IF(IHOLD1.EQ.'2')IHOLD2='2'
C???? IF(IHOLD1.EQ.'3')IHOLD2='3'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSD
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSD
      DO1315I=1,NUMSPI
      ISPIDI(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)ISPIDI(I)
 1316 FORMAT('ALL SPIKE DIRECTIONS',
     1'HAVE JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPDI--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSD
 9015 FORMAT('IDEFSD = ',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)ISPIDI(1)
 9030 FORMAT('ISPIDI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ISPIDI(I)
 9036 FORMAT('I,ISPIDI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPE2(Y1,Y2,N,ICASPL,NUMLAG,MAXN,
     1COV11,COV22,COV12,COV21,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              1) AUTOSPECTRUM
C              2) CO-SPECTRUM;
C              3) QUADRATURE SPECTRUM;
C              4) CROSS-SPECTRUM (CO-SPECTRUM AND CROSS-SPECTRUM);
C              5) COHERENCY DIAGRAM;
C              6) AMPLITUDE DIAGRAM;
C              7) PHASE DIAGRAM;
C              8) GAIN DIAGRAM;
C              9) ARGAND DIAGRAM.
C      NOTE--AN AUTOSPECTRAL PLOT,
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 SPECTRA 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 VEERSION OF TIME, BUT WILL BE
C              IMPLEMENTED IN A FUTURE VEERSION.
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              SPECTRA 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-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 (1966)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1978.
C     UPDATED         --JULY      1979.
C     UPDATED         --JANUARY   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1988. (SPECTRUM POINTS FROM 120 TO N/2 TO 1000
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
      DIMENSION COV11(*)
      DIMENSION COV22(*)
      DIMENSION COV12(*)
      DIMENSION COV21(*)
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='DPSP'
      ISUBN2='E2  '
C
      IERROR='NO'
C
      KMAX=0
C
      Y2BAR=0.0
      VARBY2=0.0
      COVB12=0.0
      ALK=0.0
      QK=0.0
      AMPLIT=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 DPSPE2--')
      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 DPSPE2--')
      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 DPSPE2--')
      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 DPSPE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,NUMLAG,MAXN
   71 FORMAT('N,ICASPL,NUMLAG,MAXN = ',I8,2X,A4,I8,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               *******************************
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.'AUSP')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.'AUSP')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               **  STEP 3--                 **
C               **  IF NECESSARY,            **
C               **  COMPUTE THE MAXIMUM LAG  **
C               *******************************
C
      MAXLAG=MAXN
      IF(NUMLAG.GE.1)KMAX=NUMLAG
      IF(NUMLAG.LE.0)KMAX=N/4
      IF(NUMLAG.LE.0.AND.N.LE.32)KMAX=N/2
      IF(NUMLAG.LE.0.AND.N.LE.16)KMAX=N
      IF(KMAX.GT.MAXLAG)KMAX=MAXLAG
      NM1=N-1
      IF(KMAX.GT.NM1)KMAX=NM1
      KMAXM1=KMAX-1
      AKMAXM=KMAXM1
C
C               *****************************************************
C               **  STEP 3--                                       **
C               **  COMPUTE THE AUTOCORRELATIONS FOR THE Y1 DATA.  **
C               **  REFERENCE--JENKINS AND WATTS, PAGE 382 (9.3.1) **
C               **  IF NECESSRY,                                   **
C               **  COMPUTE THE AUTOCORRELATIONS FOR THE Y2 DATA.  **
C               **  REFERENCE--JENKINS AND WATTS, PAGE 382 (9.3.3) **
C               **  IF NECESSRY,                                   **
C               **  COMPUTE THE SAMPLE CROSS-CORRELATIONS          **
C               **  REFERENCE--JENKINS AND WATTS, PAGE 383 (9.3.5) **
C               *****************************************************
C
      COV110=VARBY1
      COV220=VARBY2
      COV120=COVB12
      COV210=COVB12
      DO340K=1,KMAXM1
      SUM11=0.0
      SUM22=0.0
      SUM12=0.0
      SUM21=0.0
      NMK=N-K
      DO350I=1,NMK
      J=I+K
      SUM11=SUM11+(Y1(I)-Y1BAR)*(Y1(J)-Y1BAR)
      IF(ICASPL.EQ.'AUSP')GOTO350
      SUM22=SUM22+(Y2(I)-Y2BAR)*(Y2(J)-Y2BAR)
      SUM12=SUM12+(Y1(I)-Y1BAR)*(Y2(J)-Y2BAR)
      SUM21=SUM21+(Y2(I)-Y2BAR)*(Y1(J)-Y1BAR)
  350 CONTINUE
      COV11(K)=SUM11/AN
      IF(ICASPL.EQ.'AUSP')GOTO340
      COV22(K)=SUM22/AN
      COV12(K)=SUM12/AN
      COV21(K)=SUM21/AN
  340 CONTINUE
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 AUTOSPECTRA FOR Y1
C               **  REFERENCE--JENKINS AND WATTS--PAGES 382 AND 383 (9.3.2 AND 9
C               ****************************************************************
C
 1000 CONTINUE
      IF(ICASPL.EQ.'AUSP')GOTO1100
      GOTO1900
C
 1100 CONTINUE
CCCCC IMAX=120
      IMAX=(N/2)
      IF(IMAX.LT.120)IMAX=120
      IF(IMAX.GT.1000)IMAX=1000
      AIMAX=IMAX
      NUMFRE=IMAX+1
C
      J=0
CCCCC DO1110IP1=1,NUMFRE
      DO1110IP1=2,NUMFRE
      J=J+1
      I=IP1-1
      AI=I
      SUM11=0.0
C
      DO1120K=1,KMAXM1
      AK=K
      ARG1=PI*AK/AKMAXM
      ARG2=PI*AI*AK/AIMAX
      WK=0.5*(1.0+COS(ARG1))
      AFACT=WK*COS(ARG2)
      SUM11=SUM11+COV11(K)*AFACT
 1120 CONTINUE
C
      FREQJ=0.5*AI/AIMAX
      SP11J=2.0*(COV110+2.0*SUM11)
      IF(SP11J.LE.0.0)SP11J=0.000001
C
      Y(J)=SP11J
      X(J)=FREQJ
      D(J)=1.0
C
 1110 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
 1900 CONTINUE
C
C               ****************************************************************
C               **  COMPUTE COSPECTRUM AND QUADRATURE SPECTRUM.
C               **  REFERENCE--JENKINS AND WATTS--PAGE 383 (9.3.8 AND 9.3.9)
C               **  COMPUTE COHERENCY PLOT.
C               **  COMPUTE AMPLITUDE PLOT.
C               **  COMPUTE PHASE PLOT.
C               **  COMPUTE GAIN PLOT.
C               **  COMPUTE ARGAND PLOT.
C               **  REFERENCE--JENKINS AND WATTS--PAGE 383 (9.3.10, 9.3.11, 9.3.
C               **  REFERENCE--GRANGER AND HATANAKA, PAGE 77-79.           **
C               ****************************************************************
C
 2000 CONTINUE
CCCCC IMAX=120
      IMAX=(N/2)
      IF(IMAX.LT.120)IMAX=120
      IF(IMAX.GT.1000)IMAX=1000
      AIMAX=IMAX
      NUMFRE=IMAX+1
C
      J=0
      JPF=0
      DO2010IP1=1,NUMFRE
      J=J+1
      I=IP1-1
      AI=I
      SUM11=0.0
      SUM22=0.0
      SUM12=0.0
      SUM21=0.0
      AL0=(COV120+COV210)/2.0
      Q0=(COV120-COV210)/2.0
C
      DO2020K=1,KMAXM1
      AK=K
      ARG1=PI*AK/AKMAXM
      ARG2=PI*AI*AK/AIMAX
      WK=0.5*(1.0+COS(ARG1))
      AFACTC=WK*COS(ARG2)
      AFACTS=WK*SIN(ARG2)
      SUM11=SUM11+COV11(K)*AFACTC
      SUM22=SUM22+COV22(K)*AFACTC
      ALK=(COV12(K)+COV21(K))/2.0
      QK=(COV12(K)-COV21(K))/2.0
      SUM12=SUM12+ALK*AFACTC
      SUM21=SUM21+QK*AFACTS
 2020 CONTINUE
C
      FREQJ=0.5*AI/AIMAX
      SP11J=2.0*(COV110+2.0*SUM11)
      SP22J=2.0*(COV220+2.0*SUM22)
      COSPJ=2.0*(AL0+2.0*SUM12)
      QUSPJ=2.0*(Q0+2.0*SUM21)
C
      IF(IBUGG3.EQ.'ON')
     1WRITE(ICOUT,2121)J,ALK,QK,SP11J,SP22J,COSPJ,QUSPJ
 2121 FORMAT('I,ALK,QK,SP11J,SP22J,COSPJ,QUSPJ = ',
     1I8,6F10.5)
      IF(IBUGG3.EQ.'ON')
     1CALL DPWRST('XXX','BUG ')
C
      IF(ICASPL.EQ.'COSP')GOTO2100
      IF(ICASPL.EQ.'QUSP')GOTO2200
      IF(ICASPL.EQ.'CRSP')GOTO2300
      IF(ICASPL.EQ.'COHE')GOTO2400
      IF(ICASPL.EQ.'AMPL')GOTO2500
      IF(ICASPL.EQ.'PHAS')GOTO2600
      IF(ICASPL.EQ.'GAIN')GOTO2700
      IF(ICASPL.EQ.'ARGA')GOTO2800
C
 2030 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** INTERNAL ERROR IN DPSPE2')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      AT BRANCH POINT 681--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)
 2313 FORMAT('      ICASPL NOT EQUAL ONE OF THE ALLOWABLE 9--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      AUSP, COSP, QUSP, CRSP, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)
 2315 FORMAT('      COHE, AMPL, PHAS, GAIN, ARGA. ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)ICASPL
 2316 FORMAT('      ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2100 CONTINUE
      Y(J)=COSPJ
      X(J)=FREQJ
      D(J)=1.0
      GOTO2010
C
 2200 CONTINUE
      Y(J)=QUSPJ
      X(J)=FREQJ
      D(J)=1.0
      GOTO2010
C
 2300 CONTINUE
      Y(J)=COSPJ
      X(J)=FREQJ
      D(J)=1.0
      JPF=J+NUMFRE
      Y(JPF)=QUSPJ
      X(JPF)=FREQJ
      D(JPF)=2.0
      GOTO2010
C
 2400 CONTINUE
      ARG=(COSPJ**2)+(QUSPJ**2)
      IF(ARG.LE.0.0)AMPLIT=0.0
      IF(ARG.GT.0.0)AMPLIT=SQRT(ARG)
      Y(J)=AMPLIT*AMPLIT/(SP11J*SP22J)
      X(J)=FREQJ
      D(J)=1.0
      GOTO2010
C
 2500 CONTINUE
      ARG=(COSPJ**2)+(QUSPJ**2)
      IF(ARG.LE.0.0)Y(J)=0.0
      IF(ARG.GT.0.0)Y(J)=SQRT(ARG)
      X(J)=FREQJ
      D(J)=1.0
      GOTO2010
C
 2600 CONTINUE
      ARG=-QUSPJ/COSPJ
      Y(J)=ATAN(ARG)
      X(J)=FREQJ
      D(J)=1.0
      GOTO2010
C
 2700 CONTINUE
      ARG=(COSPJ**2)+(QUSPJ**2)
      IF(ARG.LE.0.0)AMPLIT=0.0
      IF(ARG.GT.0.0)AMPLIT=SQRT(ARG)
      Y(J)=AMPLIT/SP11J
      X(J)=FREQJ
      D(J)=1.0
      GOTO2010
C
 2800 CONTINUE
      Y(J)=COSPJ/SP11J
      X(J)=QUSPJ/SP22J
      D(J)=1.0
      GOTO2010
C
 2010 CONTINUE
      NPLOTP=J
      IF(ICASPL.EQ.'CRSP')NPLOTP=JPF
      NPLOTV=2
      IF(ICASPL.EQ.'CRSP')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 DPSPE2--')
      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 DPSPEC(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM
C              1) AUTOSPECTRUM
C              2) CO-SPECTRUM;
C              3) QUADRATURE SPECTRUM;
C              4) CROSS-SPECTRUM (CO-SPECTRUM AND CROSS-SPECTRUM);
C              5) COHERENCY DIAGRAM;
C              6) AMPLITUDE DIAGRAM;
C              7) PHASE DIAGRAM;
C              8) GAIN DIAGRAM;
C              9) ARGAND DIAGRAM.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MAY       1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1979.
C     UPDATED         --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 IH
      CHARACTER*4 IH2
      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)
      DIMENSION COV11(MAXOBV)
      DIMENSION COV22(MAXOBV)
      DIMENSION COV12(MAXOBV)
      DIMENSION COV21(MAXOBV)
CCCCC THE FOLLOWING INCLUDE & 6 EQUIV. WERE ADDED JUNE 1990 (ALAN)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
      EQUIVALENCE (GARBAG(IGARB3),COV11(1))
      EQUIVALENCE (GARBAG(IGARB4),COV22(1))
CCCCC THE FOLLOWING 2 EQUIVALENCES WERE FIXED JANUARY 1991
CCCCC TO FIX A QUADRATURE SPECTRUM PROBLEM (BOULDER) JANUARY 1991
      EQUIVALENCE (GARBAG(IGARB5),COV12(1))
      EQUIVALENCE (GARBAG(IGARB6),COV21(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='DPSP'
      ISUBN2='EC  '
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) AUTOSPECTRUM                                      *
C               **        2) CO-SPECTRUM;                                      *
C               **        3) QUADRATURE SPECTRUM;                              *
C               **        4) CROSS-SPECTRUM (CO-SPECTRUM AND CROSS-SPECTRUM);  *
C               **        5) COHERENCY DIAGRAM;                                *
C               **        6) PHASE DIAGRAM;                                    *
C               **        7) GAIN DIAGRAM;                                     *
C               **        8) ARGAND DIAGRAM.                                   *
C               ****************************************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSPEC--')
      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
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *******************************************
C               **  STEP 1.1--                           **
C               **  SEARCH FOR SPECTRUM OR AUTOSPECTRUM  **
C               *******************************************
C
      ICASPL='AUSP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AUTO'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'SPEC'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AUTO'.AND.ICOM2.EQ.'SPEC'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SPEC'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'SPEC'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C
C               *****************************
C               **  STEP 1.2--             **
C               **  SEARCH FOR COSPECTRUM  **
C               *****************************
C
      ICASPL='COSP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CO'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CO'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COSP'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COSP'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C
C               **************************************
C               **  STEP 1.3--                      **
C               **  SEARCH FOR QUADRATURE SPECTRUM  **
C               **************************************
C
      ICASPL='QUSP'
C  BUG FIX: AUGUST, 1987, QUADRATIC SPLINE FIT COMMAND WAS GOING TO
C  QUADRATURE SPECTRUM PLOT
      IF(ICOM.EQ.'QUAD'.AND.ICOM2.EQ.'RATI')GOTO20
C  END FIX
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C  BUG FIX
 20   CONTINUE
C  END FIX
C
C               *********************************
C               **  STEP 1.4--                 **
C               **  SEARCH FOR CROSS-SPECTRUM  **
C               *********************************
C
      ICASPL='CRSP'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CROS'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CROS'.AND.ICOM2.EQ.'SSPE'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'CROS'.AND.ICOM2.EQ.'SSPE'.AND.IHARG(1).NE.'PLOT')
     1GOTO110
C
C               ************************************
C               **  STEP 1.5--                    **
C               **  SEARCH FOR COHERENCY DIAGRAM  **
C               ************************************
C
      ICASPL='COHE'
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COHE'.AND.IHARG(1).EQ.'DIAG')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'COHE'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'COHE'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'COHE'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
C
C               ************************************
C               **  STEP 1.6--                    **
C               **  SEARCH FOR AMPLITUDE DIAGRAM  **
C               ************************************
C
      ICASPL='AMPL'
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AMPL'.AND.IHARG(1).EQ.'DIAG')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AMPL'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AMPL'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'AMPL'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
C
C
C               ********************************
C               **  STEP 1.7--                **
C               **  SEARCH FOR PHASE DIAGRAM  **
C               ********************************
C
      ICASPL='PHAS'
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'PHAS'.AND.IHARG(1).EQ.'DIAG')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'PHAS'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PHAS'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'PHAS'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
C
C               *******************************
C               **  STEP 1.8--               **
C               **  SEARCH FOR GAIN DIAGRAM  **
C               *******************************
C
      ICASPL='GAIN'
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'GAIN'.AND.IHARG(1).EQ.'DIAG')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'GAIN'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'GAIN'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'GAIN'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
C
C               *********************************
C               **  STEP 1.9--                 **
C               **  SEARCH FOR ARGAND DIAGRAM  **
C               *********************************
C
      ICASPL='ARGA'
C
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ARGA'.AND.IHARG(1).EQ.'DIAG')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ARGA'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ARGA'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ARGA'.AND.IHARG(1).EQ.'SPEC'.AND.IHARG(2).NE.'PLOT')
     1GOTO111
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.'AUSP')GOTO270
      IF(ICASPL.EQ.'COSP')GOTO280
      IF(ICASPL.EQ.'QUSP')GOTO280
      IF(ICASPL.EQ.'CRSP')GOTO280
      IF(ICASPL.EQ.'COHE')GOTO280
      IF(ICASPL.EQ.'AMPL')GOTO280
      IF(ICASPL.EQ.'PHAS')GOTO280
      IF(ICASPL.EQ.'GAIN')GOTO280
      IF(ICASPL.EQ.'ARGA')GOTO280
C
  260 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPSPEC')
      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 9--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,264)
  264 FORMAT('      AUSP, COSP, QUSP, CRSP,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,265)
  265 FORMAT('      COHE, AMPL, PHAS, GAIN, ARGA. ')
      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 DPSPEC--')
      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 SPECTRAL 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 AUTOSPECTRAL ANALYSIS;            **
C               **  EXACTLY 2                                **
C               **  FOR A CROSS-SPECTRAL ANALYSIS.           **
C               **  ALSO, FOR A CROSS-SPECTRAL 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 DPSPEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A CROSS-SPECTRAL 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 DPSPEC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A CROSS-SPECTRAL 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-SPECTRAL 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 DPSPEC--')
      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-SPECTRAL 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(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               **  STEP 8--                                            **
C               **  DETERMINE IF THE ANALYST                            **
C               **  HAS SPECIFIED THE NUMBER OF LAGS DESIRED            **
C               **  FOR THE CROSS-SPECTRAL ANALYSIS.                    **
C               **  THE LAG SETTING IS DONE BY SEARCHING THE            **
C               **  INTERNAL TABLE FOR THE PARAMETER NAMES              **
C               **  LAGS, LAG, OR NUMLAG                                **
C               **  (WITH THE SEARCH CONDUCTED IN THAT ORDER            **
C               **  AND WITH THE FIRST FIND TERMINATING                 **
C               **  THE SEARCH.)                                        **
C               **  IF FOUND, USE THE SPECIFIED VALUE                   **
C               **  (WHICH MUST BE BETWEEN 1 AND 1000, INCLUSIVE);      **
C               **  IF NOT FOUND, USE THE DEFAULT VALUE                 **
C               **  (USUALLY NS/4) WHICH WILL BE DEFINED                **
C               **  IN THE SUBROUTINE DPSPE2.                           **
C               **********************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMLAG=0
C
      IH='LAGS'
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')NUMLAG=VALUE(ILOCV)+0.5
      IF(IERROR.EQ.'NO')GOTO790
C
      IH='LAG '
      IH2='    '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')NUMLAG=VALUE(ILOCV)+0.5
      IF(IERROR.EQ.'NO')GOTO790
C
      IH='NUML'
      IH2='AG  '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IH,IH2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'NO')NUMLAG=VALUE(ILOCV)+0.5
      IF(IERROR.EQ.'NO')GOTO790
C
  790 CONTINUE
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 DPSPE2(Y1,Y2,NS,ICASPL,NUMLAG,MAXN,
     1COV11,COV22,COV12,COV21,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C     TEMPORARY PATCH FOR STEFAN (FOR CEPSTRAL CALCULATIONS)--
C
CCCCC DO800I=1,NPLOTP       NO LONGER NEEDED (DEC. 1986)
CCCCC PRED(I)=Y(I)
CCCCC RES(I)=X(I)
CC800 CONTINUE
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 DPSPEC--')
      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)NUMLAG,MAXN
 9014 FORMAT('NUMLAG,MAXN = ',I8,I8)
      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 DPSPL(IBUGA2,IBUGA3,IBUGQ,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT A SPLINE FIT
C              (ANY DEGREE FROM 1 TO 10).
C     NOTE--FOR A GIVEN DEGREE, ALL LOW-ORDER
C           DERIVATIVES WILL BE SET SO THAT THE FUNCTION
C           WILL BE SMOOTH AT THE KNOTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1978.
C     UPDATED         --JUNE      1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --OCTOBER   1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --MARCH     1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --JUNE      1990.      TEMPORARY ARRAYS TO GARBAGE COMMON
C                                            MOVE SOME DIMENSIONS TO DPSPL
C
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASSF
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IOP
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
      CHARACTER*4 IBUGJU
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION ICOLIV(10)
      DIMENSION NIV(10)
C
      DIMENSION B(100)
      DIMENSION SDB(100)
      DIMENSION B2(100)
      DIMENSION SDB2(100)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      DIMENSION XKNOT(MAXOBV)
      DIMENSION W(MAXOBV)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C---------------------------------------------------------------------
C
      EQUIVALENCE (XKNOT(1),X3D(1))
      EQUIVALENCE (W(1),D(1))
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      DIMENSION V1(MAXOBV)
      DIMENSION V2(MAXOBV)
      DIMENSION DUM1(MAXOBV)
      DIMENSION DUM2(MAXOBV)
      DIMENSION AJUNK(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),PRED2(1))
      EQUIVALENCE (GARBAG(IGARB2),RES2(1))
      EQUIVALENCE (GARBAG(IGARB3),V1(1))
      EQUIVALENCE (GARBAG(IGARB4),V2(1))
      EQUIVALENCE (GARBAG(IGARB5),DUM1(1))
      EQUIVALENCE (GARBAG(IGARB6),DUM2(1))
      EQUIVALENCE (GARBAG(IGARB7),AJUNK(1))
      EQUIVALENCE (GARBAG(IGARB8),SDB(1))
      EQUIVALENCE (GARBAG(IGARB8+100),SDB2(1))
      EQUIVALENCE (GARBAG(IGARB8+200),B(1))
      EQUIVALENCE (GARBAG(IGARB8+300),B2(1))
CCCCC END CHANGE
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='DPSP'
      ISUBN2='L   '
C
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=3
      MINN2=2
C
      MAXFAC=MAXV2
C
      MINDEG=1
      MAXDEG=10
C
      NUMCHA=0
C
      ICASEQ='UNKN'
C
C               *********************************
C               **  TREAT THE SPLINE FIT CASE  **
C               *********************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53 FORMAT('IBUGA2,IBUGA3,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(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *********************************
C               **  STEP 1.1--                 **
C               **  SEARCH FOR SPLINE FIT      **
C               **  (WITH UNSPECIFIED DEGREE)  **
C               *********************************
C
      ICASSF='SF'
C
      IF(ICOM.EQ.'SPLI'.AND.NUMARG.GE.1.AND.IHARG(1).EQ.'FIT')
     1GOTO111
C
C               *********************************************
C               **  STEP 1.21--                            **
C               **  SEARCH FOR 1-ST DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='1SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'ST'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'1ST'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'FIRS'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'1'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'ONE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'1'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'ONE'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'LINE'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.22--                            **
C               **  SEARCH FOR 2-ND DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='2SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'ND'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'2ND'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SECO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'2'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'TWO'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TWO'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAD'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.23--                            **
C               **  SEARCH FOR 3-RD DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='3SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'RD'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'3RD'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'THIR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'3'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'THRE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'3'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'THRE'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'CUBI'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.24--                            **
C               **  SEARCH FOR 4-TH DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='4SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'4TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'4'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'FOUR'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'4'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FOUR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUAR'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.25--                            **
C               **  SEARCH FOR 5-TH DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='5SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'5TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'FIFT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'5'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'FIVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'5'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'FIVE'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'QUIN'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.26--                            **
C               **  SEARCH FOR 6-TH DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='6SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'6TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SIXT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'6'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SIX'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'6'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SIX'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEXT'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.27--                            **
C               **  SEARCH FOR 7-TH DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='7SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'7TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'7'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'SEVE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'7'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'SEVE'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'SEPT'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.28--                            **
C               **  SEARCH FOR 8-TH DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='8SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'8TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'8'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'EIGH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'8'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'EIGH'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'OCTI'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.29--                            **
C               **  SEARCH FOR 9-TH DEGREE SPLINE FITTING  **
C               *********************************************
C
      ICASSF='9SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'9TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'NINT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'9'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'NINE'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'9'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'NINE'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'NONI'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               *********************************************
C               **  STEP 1.30--                            **
C               **  SEARCH FOR 10-TH DEGREE SPLINE FITTING **
C               *********************************************
C
      ICASSF='10SF'
C
      IF(NUMARG.GE.4.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'TH'.AND.IHARG(2).EQ.'DEGR'.AND.
     1IHARG(3).EQ.'SPLI'.AND.IHARG(4).EQ.'FIT')GOTO114
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'10TH'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'TENT'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'10'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'TEN'.AND.IHARG(1).EQ.'DEGR'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'10'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'DEGR'.AND.IHARG(1).EQ.'TEN'.AND.IHARG(2).EQ.'SPLI'.AND.
     1IHARG(3).EQ.'FIT')GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'DEXI'.AND.IHARG(1).EQ.'SPLI'.AND.IHARG(2).EQ.'FIT')
     1GOTO112
C
C               ********************************************
C               **  STEP 1.31--                           **
C               **  SINCE VALID COMMAND NOT FOUND, EXIT.  **
C               ********************************************
C
      ICASSF='    '
C
      IFOUND='NO'
      GOTO9000
C
  111 CONTINUE
CCCCC ILASTC=1
CCCCC CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  112 CONTINUE
CCCCC ILASTC=2
CCCCC CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  113 CONTINUE
CCCCC ILASTC=3
CCCCC CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  114 CONTINUE
CCCCC ILASTC=4
CCCCC 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(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=4
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 2--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO290
      DO200J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO210
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO210
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO220
  200 CONTINUE
      GOTO290
  210 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO290
  220 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO290
  290 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO295
      WRITE(ICOUT,291)NUMARG,ILOCQ
  291 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  295 CONTINUE
C
C               **********************************************************
C               **  STEP 4--                                            **
C               **  FOR ALL VARIATIONS OF THE SPLINE FIT COMMAND,       **
C               **  THE WORD AFTER     FIT     SHOULD BE THE RESPONSE   **
C               **  VARIABLE (= THE DEPENDENT VARIABLE).                **
C               **  EXTRACT THE RESPONSE VARIABLE AND DETERMINE         **
C               **  IF IT IS ALREADY IN THE NAME LIST AND IS, IN FACT,  **
C               **  A VARIABLE (AS OPPOSED TO A PARAMETER).             **
C               **********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      I2=0
      IF(ICOM.EQ.'FIT')GOTO2349
      IMAX=ILOCQ-1
      DO2330I=1,IMAX
      I2=I
      IF(IHARG(I).EQ.'FIT')GOTO2349
 2330 CONTINUE
      WRITE(ICOUT,2331)
 2331 FORMAT('***** INTERNAL ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2332)
 2332 FORMAT('      THE WORD     FIT     NOT FOUND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2333)
 2333 FORMAT('      IN THE ARGUMENT LIST, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3334)
 3334 FORMAT('      EVEN THOUGH IT HAD BEEN PREVIOSULY FOUND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2335)NUMARG,IMAX
 2335 FORMAT('      NUMARG, IMAX = ',2I10)
      CALL DPWRST('XXX','BUG ')
      DO2336I=1,NUMARG
      WRITE(ICOUT,2337)I,IHARG(I),IHARG2(I)
 2337 FORMAT('I,IHARG(I),IHARG2(I) = ',I8,A4,A4)
      CALL DPWRST('XXX','BUG ')
 2336 CONTINUE
      WRITE(ICOUT,2338)IWIDTH
 2338 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2339)(IANS(J),J=1,IWIDTH)
 2339 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2349 CONTINUE
      ILOCFI=I2
C
      ILOCF1=ILOCFI+1
      IHLEFT=IHARG(ILOCF1)
      IHLEF2=IHARG2(ILOCF1)
      DO2350I=1,NUMNAM
      I2=I
      IF(IHLEFT.EQ.IHNAME(I2).AND.IHLEF2.EQ.IHNAM2(I2).AND.
     1IUSE(I2).EQ.'V')GOTO2379
 2350 CONTINUE
      WRITE(ICOUT,2361)
 2361 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2362)
 2362 FORMAT('      THE NAME FOLLOWING THE WORD     FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2363)
 2363 FORMAT('      (WHICH SHOULD BE THE RESPONSE VARIABLE)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2364)
 2364 FORMAT('      EITHER DOES NOT EXIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2365)
 2365 FORMAT('      OR IS A PARAMETER (AS OPPOSED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2366)
 2366 FORMAT('      TO A VARIABLE) IN THE CURRENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2367)
 2367 FORMAT('      LIST OF AVAILABLE VARIABLE AND PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2368)
 2368 FORMAT('      NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2371)IHLEFT,IHLEF2
 2371 FORMAT('      NAME AFTER THE WORD    FIT = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2372)
 2372 FORMAT('      CURRENT LIST OF DEFINED VARIABLES AND ',
     1'PARAMETERS--')
      CALL DPWRST('XXX','BUG ')
      DO2373K2=1,NUMNAM
      WRITE(ICOUT,2374)IHNAME(K2),IHNAM2(K2),IUSE(K2),IVALUE(K2),
     1VALUE(K2)
 2374 FORMAT(6X,A4,A4,6X,A4,6X,I6,6X,E15.7)
      CALL DPWRST('XXX','BUG ')
 2373 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2375)IWIDTH
 2375 FORMAT('      NUMBER OF CHARACTERS IN COMMAND LINE = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2376)(IANS(J),J=1,IWIDTH)
 2376 FORMAT('      COMMAND LINE--',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2379 CONTINUE
      ILOCV=I2
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
 2390 CONTINUE
C
C               ***********************************************************
C               **  STEP 5--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR LARGER.            **
C               ***********************************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPSPL--')
      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 SPLINE FIT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN PERFORMED)')
      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
C
  390 CONTINUE
C
C               **************************************************************
C               **  STEP 5--                                                **
C               **  CHECK THE VALIDITY OF THE VARIABLES.                    **
C               **  CHECK THAT THERE ARE 2 OR 3 VARIABLES.                  **
C               **  (WHEN HAVE 2 ARGUMENTS, THEN MUST HAVE PRIOR            **
C               **  USE OF THE KNOTS COMMAND.)                              **
C               **  CHECK THE VALIDITY OF EACH OF THE VARIABLES.            **
C               **  DOES THE VARIABLE NAME EXIST IN THE TABLE?              **
C               **  IS THE NUMBER OF ELEMENTS FOR EACH VARIABLE POSITIVE?   **
C               **  DOES THE NUMBER OF ELEMENTS IN VARIABLE 2               **
C               **  AGREE WITH THE NUMBER OF ELEMENTS IN VARIABLE 1?        **
C               **************************************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMFAC=ILOCQ-ILOCFI-1
      IF(1.LE.NUMFAC.AND.NUMFAC.LE.MAXFAC)GOTO509
      WRITE(ICOUT,501)
  501 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,502)
  502 FORMAT('      FOR A SPLINE FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,503)
  503 FORMAT('      THE NUMBER OF VARIABLES MUST BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,504)
  504 FORMAT('      EITHER 2 OR 3;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,505)
  505 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,506)NUMFAC
  506 FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,507)
  507 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,508)(IANS(I),I=1,IWIDTH)
  508 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  509 CONTINUE
C
      IFACMN=ILOCFI+1
      IFACMX=ILOCFI+3
      DO510IFAC=IFACMN,IFACMX
      IHFACT=IHARG(IFAC)
      IHFAC2=IHARG2(IFAC)
      IF(NUMFAC.EQ.2.AND.IFAC.EQ.IFACMX)IHFACT=IKNOT1
      IF(NUMFAC.EQ.2.AND.IFAC.EQ.IFACMX)IHFAC2=IKNOT2
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHFACT,IHFAC2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLIV(IFAC)=IVALUE(ILOCV)
      NIV(IFAC)=IN(ILOCV)
      IF(IBUGA2.EQ.'ON')WRITE(ICOUT,666)IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),
     1NIV(IFAC)
  666 FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),NIV(IFAC) = ',
     1I8,2X,A4,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      DO515IFAC=IFACMN,IFACMX
      IF(NIV(IFAC).GE.1)GOTO515
      GOTO520
  515 CONTINUE
      GOTO529
C
  520 CONTINUE
      WRITE(ICOUT,521)
  521 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,522)
  522 FORMAT('      FOR A SPLINE FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,523)
  523 FORMAT('      ALL VARIABLES MUST HAVE AT LEAST 1 ELEMENT;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,524)
  524 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO525IFAC=IFACMN,IFACMX
      WRITE(ICOUT,526)IHARG(IFAC),IHARG2(IFAC),NIV(IFAC)
  526 FORMAT('      VARIABLE ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  525 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,527)
  527 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,528)(IANS(I),I=1,IWIDTH)
  528 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  529 CONTINUE
C
      J1=ILOCFI+1
      J2=ILOCFI+2
      J3=ILOCFI+3
      IF(NIV(J2).EQ.NIV(J1).AND.NIV(J3).LE.NIV(J2))GOTO549
      WRITE(ICOUT,531)
  531 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,532)
  532 FORMAT('      FOR A SPLINE FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,533)
  533 FORMAT('      THE NUMBER OF ELEMENTS IN VARIABLE 2 MUST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,534)
  534 FORMAT('      EQUAL THE NUMBER OF ELEMENTS IN VARIABLE 1;')
      CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.3)WRITE(ICOUT,536)
  536 FORMAT('      AND THE NUMBER OF ELEMENTS IN KNOTS VARIABLE ',
     1'(THE KNOTS) MUST')
      IF(NUMFAC.GE.3)CALL DPWRST('XXX','BUG ')
      IF(NUMFAC.GE.3)WRITE(ICOUT,537)
  537 FORMAT('      NOT EXCEED THE NUMBER OF ELEMENTS IN ',
     1'VARIABLE 2;')
      IF(NUMFAC.GE.3)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,538)
  538 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO545IFAC=IFACMN,IFACMX
      WRITE(ICOUT,546)IHARG(IFAC),IHARG2(IFAC),NIV(IFAC)
  546 FORMAT('      VARIABLE ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  545 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,547)
  547 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,548)(IANS(I),I=1,IWIDTH)
  548 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  549 CONTINUE
C
C               *********************************************
C               **  STEP 6--                               **
C               **  BRANCH TO THE APPROPRIATE SUBCASE;     **
C               **  THEN FORM THE RESPONSE VARIABLE        **
C               **  AND THE FACTORS                        **
C               **  AND CARRY OUT THE EXACT RATIONAL FIT.  **
C               *********************************************
C
      ISTEPN='6'
      IF(IBUGA2.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
      IFAC=ILOCFI+1
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.10)Y(J)=V(IJ)
      IF(ICOLR.EQ.11)Y(J)=PRED(I)
      IF(ICOLR.EQ.12)Y(J)=RES(I)
C
      IFAC=ILOCFI+2
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)X(J)=TAGPLO(I)
C
  660 CONTINUE
      NS=J
C
CCCCC IF(NUMFAC.LE.2)GOTO699
      J=0
      IFAC=ILOCFI+3
      IMAX=NIV(IFAC)
      DO670I=1,IMAX
      J=J+1
C
      IFAC=ILOCFI+3
      ICOLR=ICOLIV(IFAC)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)XKNOT(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)XKNOT(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)XKNOT(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)XKNOT(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)XKNOT(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)XKNOT(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)XKNOT(J)=TAGPLO(I)
C
  670 CONTINUE
      N34=IMAX
C
  699 CONTINUE
C
C               ***************************************************
C               **  STEP 7--                                     **
C               **  EXTRACT THE DEGREE OF THE SPLINE FUNCTION.   **
C               **  CHECK THAT THE DEGREE IS IN THE VALID RANGE  **
C               **  (1 TO 10).                                   **
C               ***************************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCRV=ILOCFI+1
      ILOCIV=ILOCFI+2
      ILOCW=ILOCFI+3
C
CCCCC IDEGRE=0
      IDEGRE=3
      IF(ICASSF.EQ.'SF'.AND.IDEG.GE.MINDEG.AND.IDEG.LE.MAXDEG)
     1IDEGRE=IDEG
      IF(ICASSF.EQ.'0SF')IDEGRE=0
      IF(ICASSF.EQ.'1SF')IDEGRE=1
      IF(ICASSF.EQ.'2SF')IDEGRE=2
      IF(ICASSF.EQ.'3SF')IDEGRE=3
      IF(ICASSF.EQ.'4SF')IDEGRE=4
      IF(ICASSF.EQ.'5SF')IDEGRE=5
      IF(ICASSF.EQ.'6SF')IDEGRE=6
      IF(ICASSF.EQ.'7SF')IDEGRE=7
      IF(ICASSF.EQ.'8SF')IDEGRE=8
      IF(ICASSF.EQ.'9SF')IDEGRE=9
      IF(ICASSF.EQ.'10FI')IDEGRE=10
      IF(ICASSF.EQ.'10SF')IDEGRE=10
C
      IF(MINDEG.LE.IDEGRE.AND.IDEGRE.LE.MAXDEG)GOTO899
      WRITE(ICOUT,821)
  821 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,822)
  822 FORMAT('      FOR A SPLINE FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,823)
  823 FORMAT('      THE DEGREE FOR THE FIT MUST BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,824)MINDEG,MAXDEG
  824 FORMAT('      BETWEEN ',I8,' AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,825)
  825 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,826)IDEGRE
  826 FORMAT('      THE SPECIFIED DEGREE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,828)
  828 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,829)(IANS(I),I=1,IWIDTH)
  829 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  899 CONTINUE
C
      NKNOT=NIV(ILOCW)
      K=IDEGRE+NKNOT+1
C
      IF(NS.GE.K)GOTO920
      WRITE(ICOUT,901)
  901 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,902)
  902 FORMAT('      FOR A SPLINE FIT,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,903)
  903 FORMAT('      THE NUMBER OF ELEMENTS IN THE FIRST VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,904)
  904 FORMAT('      (THAT IS, THE NUMBER OF POINTS TO BE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,905)
  905 FORMAT('      FITTED) MUST BE EQUAL TO OR GREATER THAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,906)
  906 FORMAT('      THE NUMBER OF COEFFICIENTS TO BE ESTIMATED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,907)
  907 FORMAT('      (THAT IS, MUST BE EQUAL TO OR GREATER THAN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,908)
  908 FORMAT('      (SPLINE DEGREE + NUMBER OF KNOTS + 1));')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,909)
  909 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,910)NS
  910 FORMAT('      NUMBER OF FIT POINTS FROM FIRST VARIABLE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,911)K
  911 FORMAT('      NUMBER OF ESTIMATED COEFFICIENTS         = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,912)IDEGRE
  912 FORMAT('      DEGREE OF SPLINE                         = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,913)NKNOT
  913 FORMAT('      NUMBER OF KNOTS                          = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,914)
  914 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,915)(IANS(I),I=1,IWIDTH)
  915 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  920 CONTINUE
C
C               ******************************************************
C               **  STEP 9--                                        **
C               **  CHECK THAT THE PRODUCT OF THE NUMBER OF POINTS  **
C               **  TO BE FITTED (NS) AND THE NUMBER OF B-SPLINE  **
C               **  COEFFICIENTS TO BE ESTIMATED (K)                **
C               **  DOES NOT EXCEED MAXNK--THUS THE ARRAY Z2(.)     **
C               **  IN THE SUBROUTINE DPSPL2 WILL NOT OVERFLOW.     **
C               ******************************************************
C
      INK=NS*K
      IF(INK.LE.MAXNK)GOTO929
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,921)
  921 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,922)
  922 FORMAT('      AN INTERNAL ARRAY WILL OVERFLOW')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,923)
  923 FORMAT('      IF THE PRODUCT OF THE NUMBER OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,924)
  924 FORMAT('      POINTS TO BE FITTED AND THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,925)
  925 FORMAT('      NUMBER OF B-SPLINE COEFFICIENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,926)MAXNK
  926 FORMAT('      TO BE ESTIMATED EXCEEDS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,927)
  927 FORMAT('      SUCH WOULD BE THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,928)NS,K,INK
  928 FORMAT('      N = ',I8,' K = ',I8,' N*K = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  929 CONTINUE
C
C               ****************************************************************
C               **  STEP 10--
C               **  PREPARE FOR ENTRANCE INTO DPSPL2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ****************************************************************
C
      ISTEPN='10'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO970I=1,NS
      W(I)=1.0
  970 CONTINUE
C
C               *********************************************************
C               **  STEP 11--                                          **
C               **  DUMP THE COMMON VECTOR V(.) OUT ONTO MASS STORAGE  **
C               **  SO AS TO PRESERVE THEIR CONTENTS FOR LATER USE     **
C               **  (AFTER DPSPL2).                                    **
C               *********************************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOP='WRIT'
      CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
C               *********************
C               **  STEP 12-       **
C               **  ENTER DPSPL2.  **
C               *********************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO6099
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6081)
 6081 FORMAT('***** FROM DPSPL, AS WE ARE ABOUT TO CALL DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6082)NUMCHA,NLEFT,MAXN,NS
 6082 FORMAT('NUMCHA,NLEFT,MAXN,NS = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO6083I=1,NS
      WRITE(ICOUT,6084)I,Y(I),X(I),W(I)
 6084 FORMAT('I,Y(I),X(I),W(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 6083 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,6091)IBUGA3
 6091 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 6099 CONTINUE
C
CCCCC JUNE, 1990.  MOVE SOME DIMENSIONS FROM DPSPL2 TO DPSPL
      CALL DPSPL2(Y,X,W,NS,XKNOT,NKNOT,IDEGRE,V,
     1B,SDB,B2,SDB2,PRED2,RES2,REPSD,REPDF,RESSD,RESDF,ALFCDF,
     1V1,V2,DUM1,DUM2,AJUNK,
     1IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 12--                        **
C               **  READ BACK IN FROM MASS STORAGE   **
C               **  THE CONTENTS OF THE V(.) MATRIX. **
C               ***************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1101)
 1101 FORMAT('WE ARE IN DPSPL AND ARE ABOUT TO READ V BACK IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1102)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS
 1102 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1103)V(1),PRED(1),RES(1)
 1103 FORMAT('V(1),PRED(1),RES(1) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 1109 CONTINUE
C
      IOP='READ'
      CALL DPSWAP(IOP,V,NUMNAM,IHNAME,IHNAM2,IUSE,IN,
     1IVALUE,MAXN,MAXCOL,MAXN2,MAXCO2,MAXIJ2,IBUGA3,ISUBRO,IERROR)
C
      IF(IBUGA2.EQ.'OFF')GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('WE ARE IN DPSPL AND HAVE JUST READ    V BACK IN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)MAXN2,MAXCO2,MAXIJ2,NLEFT,NS
 1112 FORMAT('MAXN2,MAXCO2,MAXIJ2,NLEFT,NS = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)V(1),PRED(1),RES(1)
 1113 FORMAT('V(1),PRED(1),RES(1) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
 1119 CONTINUE
C
C               ***************************************
C               **  STEP 14--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
      IREPU='ON'
      IRESU='ON'
      CALL UPDAPR(ICOLPR,ICOLRE,PRED2,RES2,PRED,RES,ISUB,NLEFT,
     1IREPU,REPSD,REPDF,IRESU,RESSD,RESDF,ALFCDF,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,ILOCN,IBUGA3,IERROR)
C
      IBUGJU='OFF'
C
      L=0
      IKNMAX=NKNOT+1
      JMAX=IDEGRE+1
      DO7500IKN=1,IKNMAX
      DO7600J=1,JMAX
      L=L+1
      JM1=J-1
      CALL COENAM(IKN,JM1,IH,IH2,IBUGJU,IERROR)
C
 7640 CONTINUE
      DO7650I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO7680
 7650 CONTINUE
      IF(NUMNAM.LT.MAXNAM)GOTO7670
      WRITE(ICOUT,7651)
 7651 FORMAT('***** ERROR IN DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7652)
 7652 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7653)MAXNAM
 7653 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7654)
 7654 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7655)
 7655 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7656)
 7656 FORMAT('      WAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7657)
 7657 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7658)
 7658 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7659)
 7659 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7660)
 7660 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7661)
 7661 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7662)
 7662 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,7663)(IANS(I),I=1,IWIDTH)
 7663 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 7670 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      VALUE(ILOC)=B2(L)
      GOTO7600
C
 7680 CONTINUE
      VALUE(I2)=B2(L)
      GOTO7600
C
 7600 CONTINUE
 7500 CONTINUE
C
C               ***************************************
C               **  STEP 15--                        **
C               **  ENTER A NOTE IN MODEL(.)         **
C               **  STATING THAT THE LAST FIT        **
C               **  WAS A SPLINE FIT                 **
C               **  OF WHATEVER DEGREE.              **
C               ***************************************
C
 8000 CONTINUE
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO8100I=1,IWIDTH
      MODEL(I)=IANS(I)
 8100 CONTINUE
      NUMCHA=IWIDTH
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NS,NKNOT,ICASSF,IDEGRE
 9014 FORMAT('NS,NKNOT,ICASSF,IDEGRE = ',2I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPL2(Y,X,W,N,XKNOT,NKNOT,IDEGRE,Z2,
     1B,SDB,B2,SDB2,PRED2,RES2,REPSD,REPDF,RESSD,RESDF,ALFCDF,
     1V1,V2,DUM1,DUM2,AJUNK,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES A LEAST SQUARES SPLINE FIT
C              FOR ANY DEGREE--LINEAR, QUADRATIC, CUBIC, ETC.
C     ALGORITHM USED--B-SPLINES (MODIFIED SO THAT SOME ELEMENTS
C                   SET = 0 RATHER THAN COMPUTED AS 0)
C     REFERENCE--WOLD, TECHNOMETRICS, 1974, PAGE 2
C     INPUT  ARGUMENTS--Y      = SINGLE PRECISION VECTOR OF
C                                RESPONSE DATA (THAT IS, THE
C                                DEPENDENT VARIABLE).
C                       X      = SINGLE PRECISION MATRIX OF
C                                THE DEPENDENT VARIABLE.
C                       W      = THE SINGLE PRECISION VECTOR
C                                OF WEIGHTS FOR THE RESPONSE
C                                VARIABLE.
C                       N      = THE INTEGER VALUE OF THE SAMPLE SIZE.
C                       XKNOT  = THE SINGLE PRECISION VECTOR OF KNOTS.
C                       NKNOT  = THE INTEGER NUMBER OF SPECIFIED KNOTS.
C                       IDEGRE = THE INTEGER DEGREE OF THE SPLINE.
C     OUTPUT ARGUMENTS--B      = THE SINGLE PRECISION VECTOR OF
C                                ESTIMATED REGRESSION COEFFICIENTS.
C                       SDB    = THE SINGLE PRECISION VECTOR OF
C                                ESTIMATED STANDARD DEVIATIONS OF THE
C                                ESTIMATED REGRESSION COEFFICIENTS.
C                       RESSD  = THE ESTIMATED RESIDUAL STANDARD
C                                DEVIATION.
C                       PRED2  = THE SINGLE PRECISION VECTOR OF
C                                PREDICTED VALUES.
C                       RES2   = THE SINGLE PRECISION VECTOR OF
C                                RESIDUALS FROM THE LEAST SQUARES FIT.
C     SUBROUTINES NEEDED--DECOMP, INVXWX, AND DOT.
C     NOTE--CODE MODIFIED SO THAT NUMBER OF KNOTS SHOULD NOT
C           EXCEED 50
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--MARCH     1975.
C     UPDATED         --NOVEMBER  1975.
C     UPDATED         --MAY       1976.
C     UPDATED         --DECEMBER  1978.
C     UPDATED         --AUGUST    1979.
C     UPDATED         --MARCH     1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --AUGUST    1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.  ADD LOFCDF
C     UPDATED         --JANUARY   1989.  DECLARE AJUNK AS ARRAY (DIM. 1) (ALAN)
C     UPDATED         --MAY       1989.  INCREACED DIMENSION FOR V1 AND V2
C                                        MOVE SOME DIMENSIONS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IREP
      CHARACTER*4 IBUGJU
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION W(*)
      DIMENSION XKNOT(*)
C
      DIMENSION B(*)
      DIMENSION SDB(*)
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
      DIMENSION B2(*)
      DIMENSION SDB2(*)
C
      DIMENSION Z2(*)
C
      DIMENSION XPX(50,50)
C
      DIMENSION SSQ(50,50)
      EQUIVALENCE (SSQ(1,1),XPX(1,1))
C
      DIMENSION XPY(50)
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1989
CCCCC DIMENSION V1(200)
CCCCC JUNE, 1990.  V1, V2, DUM1, DUM2, AJUNK NOW DIMENSIONED IN DPSPL
CCCCC DIMENSION V1(MAXOBV)
      DIMENSION V1(*)
CCCCC THE FOLLOWING LINE WAS FIXED MAY 1989
CCCCC DIMENSION V2(200)
CCCCC DIMENSION V2(MAXOBV)
      DIMENSION V2(*)
      DIMENSION RIGHT(50)
      DIMENSION BTEMP(100)
C
      DIMENSION A(50,50)
      EQUIVALENCE (A(1,1),XPX(1,1))
C
      DIMENSION EKNOT(200)
CCCCC DIMENSION COV(50,50)
CCCCC DIMENSION CORR(50,50)
C
CCCCC DIMENSION DUM1(MAXOBV)
CCCCC DIMENSION DUM2(MAXOBV)
C
CCCCC DIMENSION AJUNK(MAXOBV)
      DIMENSION DUM1(*)
      DIMENSION DUM2(*)
C
      DIMENSION AJUNK(*)
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='DPSP'
      ISUBN2='L2  '
C
      IERROR='NO'
C
      K2=0
C
      DIJ=0.0
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NKNOT,IDEGRE
   52 FORMAT('N,NKNOT,IDEGRE = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA3
   53 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I),X(I),W(I),XKNOT(I)
   56 FORMAT('I,Y(I),X(I),W(I),XKNOT(I) = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      AN=N
      K=NKNOT+IDEGRE+1
      AK=K
      DEG=IDEGRE
      KMAX=50
C
C               ***************************
C               **  STEP 1--             **
C               **  WRITE OUT THE TITLE  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('LEAST SQUARES SPLINE FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)N
  102 FORMAT('      SAMPLE SIZE N   = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.1)WRITE(ICOUT,111)
  111 FORMAT('      MODEL--LINEAR SPLINE')
      IF(IDEGRE.EQ.1)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.2)WRITE(ICOUT,112)
  112 FORMAT('      MODEL--QUADRATIC SPLINE')
      IF(IDEGRE.EQ.2)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.3)WRITE(ICOUT,113)
  113 FORMAT('      MODEL--CUBIC SPLINE')
      IF(IDEGRE.EQ.3)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.4)WRITE(ICOUT,114)
  114 FORMAT('      MODEL--4-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.4)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.5)WRITE(ICOUT,115)
  115 FORMAT('      MODEL--5-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.5)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.6)WRITE(ICOUT,116)
  116 FORMAT('      MODEL--6-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.6)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.7)WRITE(ICOUT,117)
  117 FORMAT('      MODEL--7-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.7)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.8)WRITE(ICOUT,118)
  118 FORMAT('      MODEL--8-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.8)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.9)WRITE(ICOUT,119)
  119 FORMAT('      MODEL--9-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.9)CALL DPWRST('XXX','BUG ')
      IF(IDEGRE.EQ.10)WRITE(ICOUT,120)
  120 FORMAT('      MODEL--10-TH DEGREE SPLINE')
      IF(IDEGRE.EQ.10)CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,121)NKNOT
  121 FORMAT('      NUMBER OF KNOTS = ',I8)
      CALL DPWRST('XXX','BUG ')
  129 CONTINUE
C
C               *****************************************
C               **  STEP 2--                           **
C               **  CHECK THE INPUT ARGUMENTS N AND K  **
C               *****************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(1.LE.K.AND.K.LE.KMAX)GOTO159
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,151)
  151 FORMAT('***** ERROR IN DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,152)
  152 FORMAT('      THE NUMBER OF SPLINE COEFFICIENTS (K = NDEG+1)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,153)
  153 FORMAT('      IS NON-POSITIVE OR LARGER THAN ALLOWABLE MAX')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,154)K,KMAX
  154 FORMAT('      K,KMAX = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  159 CONTINUE
C
      IF(K.LE.N)GOTO169
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,161)
  161 FORMAT('***** ERROR IN DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,162)
  162 FORMAT('      THE NUMBER OF SPLINE COEFFICIENTS (K = NDEG+1)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,163)
  163 FORMAT('      IS LARGER THAN THE NUMBER OF DATA POINTS (N).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,164)K,N
  164 FORMAT('      K,N = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  169 CONTINUE
C
      IF(NKNOT.LE.50)GOTO179
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,171)
  171 FORMAT('***** ERROR IN DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,172)NKNOT
  172 FORMAT('      THE NUMBER OF KNOTS (= ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,173)
  173 FORMAT('      HAS JUST EXCEEDED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,174)
  174 FORMAT('      THE ALLOWABLE MAXIMUM (= 50).')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  179 CONTINUE
C
C               ****************************************************************
C               **  STEP 3--
C               **  INSPECT THE WEIGHT VECTOR W--IF ALL ELEMENTS ARE IDENTICAL,
C               **  THEN RESET ALL ELEMENTS TO 1.0.  THIS AVOIDS THE
C               **  PROBLEM OF AN UNDEFINED EMPTY WEIGHT VECTOR W WHEN
C               **  IN FACT AN EQUAL WEIGHTING SCHEME IS DESIRED.
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWFLAG=0
      WHOLD=W(1)
      DO600I=1,N
      IF(W(I).EQ.WHOLD)GOTO600
      GOTO850
  600 CONTINUE
      IWFLAG=1
  850 CONTINUE
      IF(IBUGA3.EQ.'ON')THEN
         IF(IWFLAG.EQ.0)THEN
            WRITE(ICOUT,851)
  851       FORMAT('      UNEQUAL WEIGHTS CASE')
            CALL DPWRST('XXX','BUG ')
         ENDIF
         IF(IWFLAG.EQ.1)THEN
            WRITE(ICOUT,852)
  852       FORMAT('      EQUAL WEIGHTS CASE')
            CALL DPWRST('XXX','BUG ')
         ENDIF
      ENDIF
C
C               **************************************************************
C               **  STEP 3.5--                                              **
C               **  CHECK FOR REPLICATION AND IF EXISTENT                   **
C               **  COMPUTE A (MODEL-FREE) REPLICATION STANDARD DEVIATION.  **
C               **************************************************************
C
      ISTEPN='3.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=1
C
      IREP='NO'
      REPSD=0.0
      REPDF=0.0
      IREPDF=REPDF+0.5
      RESSD=0.0
      RESDF=0.0
      ALFCDF=(-999.99)
      CALL DPREPS(Y,X,AJUNK,AJUNK,AJUNK,AJUNK,N,NUMVAR,DUM1,DUM2,
     1IREP,REPSS,REPMS,REPSD,REPDF,NUMSET,IBUGA3,IERROR)
      IREPDF=REPDF+0.5
C
      IF(IREP.EQ.'NO')GOTO4800
      GOTO4900
C
 4800 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO4819
      WRITE(ICOUT,4811)
 4811 FORMAT('      NO REPLICATION CASE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4819 CONTINUE
      GOTO4999
C
 4900 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO4929
      WRITE(ICOUT,4911)
 4911 FORMAT('      REPLICATION CASE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4922)REPSD
 4922 FORMAT('      REPLICATION STANDARD DEVIATION = ',D20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4923)IREPDF
 4923 FORMAT('      REPLICATION DEGREES OF FREEDOM = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4924)NUMSET
 4924 FORMAT('      NUMBER OF DISTINCT SUBSETS     = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 4929 CONTINUE
      GOTO4999
C
 4999 CONTINUE
C
C               ****************************************************************
C               **  STEP 4--
C               **  FORM THE MATRIX X2 (WHICH CORRESPONDS TO THE USUAL X MATRIX
C               **  IN THE FIT SUBROUTINE BUT IS HERE CALLED X2 BECAUSE OF A
C               **  CONFLICT DUE TO THE INPUT VECTOR X).
C               **  B-SPLINES ARE USED HEREIN.
C               **  REFERENCE--WOLD, TECHNOMETRICS, 1974, PAGE 2.
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               **********************************
C               **  STEP 4.1--                  **
C               **  DETERMINE THE MIN X VALUE.  **
C               **  DETERMINE THE MAX X VALUE.  **
C               **********************************
C
      ISTEPN='4.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      XMIN=X(1)
      XMAX=X(1)
      DO900I=1,N
      IF(X(I).LT.XMIN)XMIN=X(I)
      IF(X(I).GT.XMAX)XMAX=X(I)
  900 CONTINUE
C
C               ************************************
C               **  STEP 4.2--                    **
C               **  DEFINE EXTENDED KNOTS         **
C               **  (ON EITHER END OF THE DATA).  **
C               **  THE NUMBER OF SUCH KNOTS      **
C               **  ON EACH SIDE WILL BE          **
C               **  DEGREE + 1.                   **
C               ************************************
C
      ISTEPN='4.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL SORT(XKNOT,NKNOT,XKNOT)
C
      IF(XKNOT(1).EQ.XMIN)GOTO910
      GOTO920
  910 CONTINUE
      RANGE=XMAX-XMIN
      DEL=RANGE/100.0
      GOTO930
  920 CONTINUE
      DEL=XKNOT(1)-XMIN
      DEL=ABS(DEL)
  930 CONTINUE
C
      L=0
C
      IMAX=IDEGRE+1
      DO940I=1,IMAX
      L=L+1
      AIREV=IMAX-I+1
      EKNOT(L)=XKNOT(1)-AIREV*DEL
  940 CONTINUE
C
      DO950I=1,NKNOT
      L=L+1
      EKNOT(L)=XKNOT(I)
  950 CONTINUE
C
      IF(XKNOT(NKNOT).EQ.XMAX)GOTO960
      GOTO970
  960 CONTINUE
      RANGE=XMAX-XMIN
      DEL=RANGE/100.0
      GOTO980
  970 CONTINUE
      DEL=XMAX-XKNOT(NKNOT)
      DEL=ABS(DEL)
  980 CONTINUE
C
      IMAX=IDEGRE+1
      DO990I=1,IMAX
      L=L+1
      AI=I
      EKNOT(L)=XKNOT(NKNOT)+AI*DEL
  990 CONTINUE
C
      NKNOT2=L
C
      IF(IBUGA3.EQ.'OFF')GOTO995
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,991)NKNOT,NKNOT2
  991 FORMAT('NKNOT,NKNOT2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,992)XMIN,XKNOT(1),XKNOT(NKNOT),XMAX,DEL
  992 FORMAT('XMIN,XKNOT(1),XKNOT(NKNOT),XMAX,DEL = ',5E15.7)
      CALL DPWRST('XXX','BUG ')
      DO993I=1,NKNOT2
      WRITE(ICOUT,994)I,EKNOT(I)
  994 FORMAT('I, EKNOT(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
  993 CONTINUE
  995 CONTINUE
C
C               ***************************************
C               **  STEP 4.3--                       **
C               **  COUNT THE NUMBER OF DATA POINTS  **
C               **  BETWEEN EACH SET OF KNOTS.       **
C               **  WRITE OUT THE KNOT VALUES        **
C               **  AND THE NUMBER OF OBSERVATIONS   **
C               **  BETWEEN KNOTS.                   **
C               ***************************************
C
      ISTEPN='4.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO1009
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1005)
 1005 FORMAT('      INTERVAL   LOWER         UPPER      NUMBER OF')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1006)
 1006 FORMAT('       NUMBER    KNOT          KNOT      OBSERVATIONS'
     1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1007)
 1007 FORMAT('                                         IN INTERVAL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1008)
 1008 FORMAT('      -----------------------------------------------'
     1)
      CALL DPWRST('XXX','BUG ')
 1009 CONTINUE
C
      L=1
      ISUM=0
      DO1100I=1,N
      IF(X(I).LT.XKNOT(1))ISUM=ISUM+1
 1100 CONTINUE
      IF(IPRINT.EQ.'ON')WRITE(ICOUT,1101)L,XKNOT(L),ISUM
 1101 FORMAT(3X,I8,'   -INFINITY  ',E14.7,I8)
      IF(IPRINT.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      IF(NKNOT.LT.2)GOTO1290
      DO1200L=2,NKNOT
      LM1=L-1
      ISUM=0
      DO1300I=1,N
      IF(XKNOT(LM1).LE.X(I).AND.X(I).LT.XKNOT(L))ISUM=ISUM+1
 1300 CONTINUE
      IF(IPRINT.EQ.'ON')WRITE(ICOUT,1301)L,XKNOT(LM1),XKNOT(L),ISUM
 1301 FORMAT(3X,I8,E14.7,E14.7,I8)
      IF(IPRINT.EQ.'ON')CALL DPWRST('XXX','BUG ')
 1200 CONTINUE
 1290 CONTINUE
C
      L=NKNOT+1
      ISUM=0
      DO1400I=1,N
      IF(XKNOT(NKNOT).LE.X(I))ISUM=ISUM+1
 1400 CONTINUE
      IF(IPRINT.EQ.'ON')WRITE(ICOUT,1401)L,XKNOT(NKNOT),ISUM
 1401 FORMAT(3X,I8,E14.7 ,'   +INFINITY  ',I8)
      IF(IPRINT.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               *******************************************
C               **  STEP 4.4--                           **
C               **  FORM THE LINEAR REGRESSION X MATRIX  **
C               **  (HERE CALLED X2)                     **
C               **  WHICH WILL CONTAIN THE B-SPLINE      **
C               **  REPRESENTATION OF THE SPLINE         **
C               **  PROBLEM.                             **
C               **  NOTE THAT K = THE NUMBER             **
C               **  OF ORIGINAL KNOTS + IDEGRE + 1.        **
C               *******************************************
C
      ISTEPN='4.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1500I=1,N
      DO1600J=1,K
C
      IJ=(I-1)*K+J
      Z2(IJ)=0.0
      LMAX=IDEGRE+J+1
      IF(X(I).LT.EKNOT(J).OR.X(I).GT.EKNOT(LMAX))GOTO1600
C
      SUM=0.0
      DO1700L=J,LMAX
      IF(X(I).LE.EKNOT(L))GOTO1700
      XI=X(I)
      EKNOL=EKNOT(L)
      ANUM=(XI-EKNOL)**DEG
      PROD=1.0
      DO1800M=J,LMAX
      IF(M.EQ.L)GOTO1800
      EKNOL=EKNOT(L)
      EKNOM=EKNOT(M)
      PROD=PROD*(EKNOL-EKNOM)
 1800 CONTINUE
      ADEN=PROD
C
      RATIO=ANUM/ADEN
      SUM=SUM+RATIO
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,1811)ANUM,ADEN,RATIO,SUM
 1811 FORMAT('ANUM,ADEN,RATIO,SUM = ',4E15.8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
 1700 CONTINUE
      IJ=(I-1)*K+J
      Z2(IJ)=SUM
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,1711)I,J,Z2(IJ)
 1711 FORMAT('I, J, Z2(IJ) = ',I8,I8,E15.8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
 1600 CONTINUE
 1500 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO1990
      WRITE(ICOUT,1901)
 1901 FORMAT('AFTER STEP 4.4 IN DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1902)
 1902 FORMAT('Z2(.,.) = ')
      CALL DPWRST('XXX','BUG ')
      DO1910I=1,N
      IJMIN=(I-1)*K+1
      IJMAX=I*K
      WRITE(ICOUT,1911)(Z2(IJ),IJ=IJMIN,IJMAX)
 1911 FORMAT(8E15.7)
      CALL DPWRST('XXX','BUG ')
 1910 CONTINUE
 1990 CONTINUE
C
CCCCC WRITE(ICOUT,131)Z2(1,1)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,131)Z2(2,2)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,131)Z2(3,3)
  131 FORMAT(E15.8)
CCCCC CALL DPWRST('XXX','BUG ')
C
C               *******************************
C               **  STEP 5--                 **
C               **  FORM THE X'X MATRIX      **
C               **  (HERE CALLED XPX)        **
C               **  THIS WILL HAVE K ROWS    **
C               **  AND K COLUMNS            **
C               **  WHERE K = THE NUMBER OF  **
C               **  ORIGINAL KNOTS + 4.      **
C               *******************************
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2100I=1,K
      DO2200J=1,K
      DO2300L=1,N
      LI=(L-1)*K+I
      V1(L)=Z2(LI)
      LJ=(L-1)*K+J
      V2(L)=Z2(LJ)
 2300 CONTINUE
      CALL DOTPRO(V1,V2,N,RESULT)
      XPX(I,J)=RESULT
CCCCC WRITE(ICOUT,111)Z2(1,1)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,133)I,J,N,Z2(I,J),XPX(I,J)
CCCCC CALL DPWRST('XXX','BUG ')
      IJ=(I-1)*K+J
  133 FORMAT('I,J,N,Z2(IJ),XPX(I,J) = ',3I6,2E15.8)
CCCCC WRITE(ICOUT,133)I,J,N,Z2(1,1),XPX(I,J)
CCCCC CALL DPWRST('XXX','BUG ')
 2200 CONTINUE
 2100 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO2390
      WRITE(ICOUT,2301)
 2301 FORMAT('AFTER STEP 5 IN DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2302)
 2302 FORMAT('Z2(.,.) = ')
      CALL DPWRST('XXX','BUG ')
      DO2310I=1,N
      JMIN=(I-1)*K+1
      JMAX=I*K
      WRITE(ICOUT,2311)(Z2(IJ),IJ=JMIN,JMAX)
 2311 FORMAT(8E15.7)
      CALL DPWRST('XXX','BUG ')
 2310 CONTINUE
      WRITE(ICOUT,2402)
 2402 FORMAT('XPX(.,.) = ')
      CALL DPWRST('XXX','BUG ')
      DO2410I=1,N
      WRITE(ICOUT,2411)(XPX(I,J),J=1,K)
 2411 FORMAT(8E15.7)
      CALL DPWRST('XXX','BUG ')
 2410 CONTINUE
 2390 CONTINUE
C
C               *****************************************
C               **  STEP 6--                           **
C               **  FORM THE INVERSE MATRIX (X'X)**-1  **
C               **  (HERE CALLED SSQ).                **
C               **  THIS WILL HAVE K ROWS              **
C               **  AND K COLUMNS                      **
C               **  WHERE K = THE NUMBER OF            **
C               **  ORIGINAL KNOTS + 4.                **
C               *****************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA3.EQ.'OFF')GOTO2690
      DO2610I=1,K
      DO2620J=1,K
      WRITE(ICOUT,2621)I,J,XPX(I,J)
 2621 FORMAT('I,J,XPX(I,J) = ',I8,I8,E15.8)
      CALL DPWRST('XXX','BUG ')
 2620 CONTINUE
 2610 CONTINUE
 2690 CONTINUE
C
      CALL MATI50(XPX,K,SSQ)
C
      IF(IBUGA3.EQ.'OFF')GOTO2790
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO2710I=1,K
      DO2720J=1,K
      WRITE(ICOUT,2721)I,J,SSQ(I,J)
 2721 FORMAT('I,J,SSQ(I,J) = ',I8,I8,E15.8)
      CALL DPWRST('XXX','BUG ')
 2720 CONTINUE
 2710 CONTINUE
 2790 CONTINUE
C
C               *********************************************
C               **  STEP 7--                               **
C               **  COMPUTE THE K REGRESSION COEFFICIENTS. **
C               *********************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO3100I=1,K
      DO3200L=1,N
      LI=(L-1)*K+I
      V1(L)=Z2(LI)
      V2(L)=Y(L)
 3200 CONTINUE
      CALL DOTPRO(V1,V2,N,XPY(I))
 3100 CONTINUE
C
      DO3600I=1,K
      DO3700L=1,K
      V1(L)=SSQ(L,I)
      V2(L)=XPY(L)
 3700 CONTINUE
      CALL DOTPRO(V1,V2,K,B(I))
 3600 CONTINUE
C
C               *********************************
C               **  STEP 8--                   **
C               **  COMPUTE PREDICTED VALUES.  **
C               **  COMPUTE RESIDUALS.         **
C               *********************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO4100I=1,N
      DO4200L=1,K
      IL=(I-1)*K+L
      V1(L)=Z2(IL)
      V2(L)=B(L)
 4200 CONTINUE
      CALL DOTPRO(V1,V2,K,PRED2(I))
 4100 CONTINUE
C
      DO4600I=1,N
      RES2(I)=Y(I)-PRED2(I)
 4600 CONTINUE
C
C               ********************************************
C               **  STEP 9--                              **
C               **  COMPUTE RESIDUAL STANDARD DEVIATION.  **
C               ********************************************
C
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO5100I=1,N
      SUM=SUM+RES2(I)**2
 5100 CONTINUE
      RESSS=SUM
      IRESDF=N-K
      RESDF=IRESDF
      IF(IRESDF.LE.0)GOTO5150
      RESVAR=RESSS/RESDF
      RESSD=0.0
      IF(RESVAR.GT.0.0)RESSD=SQRT(RESVAR)
      GOTO5190
 5150 CONTINUE
      RESSS=0.0
      RESVAR=0.0
      RESSD=0.0
 5190 CONTINUE
C
C               **************************************
C               **  STEP 10--                       **
C               **  COMPUTE THE COVARIANCE MATRIX   **
C               **  OF THE COEFFICIENTS.            **
C               **  COMPUTE THE CORRELATION MATRIX  **
C               **  OF THE COEFFICIENTS.            **
C               **************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC DO6100I=1,K
CCCCC DO6200J=1,K
CCCCC COV(I,J)=SSQ(I,J)*RESSD*RESSD
C6200 CONTINUE
C6100 CONTINUE
C
CCCCC DO6600I=1,K
CCCCC DO6700J=1,K
CCCCC ANUM=SSQ(I,J)
CCCCC ADEN=SQRT(SSQ(I,I)*SSQ(J,J))
CCCCC CORR(I,J)=ANUM/ADEN
C6700 CONTINUE
C6600 CONTINUE
C
C               ***************************************************
C               **  STEP 11--                                    **
C               **  COMPUTE STANDARD DEVIATION OF COEFFICIENTS.  **
C               ***************************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO7100I=1,K
      SDB(I)=0.0
      IF(SSQ(I,I).GT.0.0)SDB(I)=RESSD*SQRT(SSQ(I,I))
 7100 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO7290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7205)RESSD
 7205 FORMAT('S = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO7210I=1,K
      WRITE(ICOUT,7211)I,B(I),SDB(I)
 7211 FORMAT('I, B(I), SDB(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 7210 CONTINUE
 7290 CONTINUE
C
C               ******************************************************
C               **  STEP 12--                                       **
C               **  COMPUTE COEFFICIENTS FOR THE SPLINE POLYNOMIAL  **
C               **  OVER EACH INDIVIDUAL REGION (BETWEEN KNOTS).    **
C               ******************************************************
C
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ******************************************
C               **  STEP 12.1--                         **
C               **  LOOP THROUGH THE NKNOT+1 INTERVALS  **
C               ******************************************
C
      L3=0
      IKNMAX=NKNOT+1
      IMAX=IDEGRE+1
      DO8100IKN=1,IKNMAX
      IKN2=IKN+(IDEGRE+1)
      IKN2M1=IKN2-1
C
C               **************************************************
C               **  STEP 12.2--                                 **
C               **  FOR A GIVEN INTERVAL,                       **
C               **  FORM THE MATRIX OF COEFFICIENTS             **
C               **  FOR THE POLYNOMIALS IN THE INTERVAL         **
C               **  AND FOR THE DERIVATIVES OF THE POLYNOMIALS  **
C               **  WE ARE MERELY EXTRACTING COEFFICIENTS       **
C               **  OF POLYNOMIALS VIA DIFFERENTIATION.         **
C               **  EVALUATE THE DERIVATIVES AT THE MIDPOINTS   **
C               **  BETWEEN KNOTS.                              **
C               **************************************************
C
      DO8200I=1,IMAX
      IM1=I-1
      DO8300J=1,IMAX
      A(I,J)=0.0
      IF(I.GT.J)GOTO8300
      PROD=1.0
      IF(IM1.LT.1)GOTO8450
      AJ=J
      DO8400L=1,IM1
      AL=L
      PROD=PROD*(AJ-AL)
 8400 CONTINUE
C
 8450 CONTINUE
      CIJ=PROD
      XI=(EKNOT(IKN2)+EKNOT(IKN2M1))/2.0
      IF(I.EQ.J)DIJ=1.0
      IF(I.NE.J)DIJ=XI**(J-I)
      A(I,J)=CIJ*DIJ
 8300 CONTINUE
 8200 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO8290
      WRITE(ICOUT,8201)IKN
 8201 FORMAT('IN THE MIDDLE OF STEP 12 IN SPLINE. IKN = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8202)
 8202 FORMAT('A(.,.) = ')
      CALL DPWRST('XXX','BUG ')
      IDEGP1=IDEGRE+1
      DO8210I=1,IDEGP1
      WRITE(ICOUT,8211)(A(I,J),J=1,IDEGP1)
 8211 FORMAT(8E15.7)
      CALL DPWRST('XXX','BUG ')
 8210 CONTINUE
 8290 CONTINUE
C
      I=IKN
CCCCC XI=EKNOT(IKN2)
      XI=(EKNOT(IKN2)+EKNOT(IKN2M1))/2.0
C
C     IF I = 1, MAKE ALL EVALUATIONS BETWEEN KNOT 0 AND KNOT 1;
C     IF I = 2, MAKE ALL EVALUATIONS BETWEEN KNOT 1 AND KNOT 2;
C     IF I = 3, MAKE ALL EVALUATIONS BETWEEN KNOT 2 AND KNOT 3; ETC.
C
C               ****************************************************************
C               **  STEP 12.3--
C               **  COMPUTE THE RIGHT SIDE OF THE MATRIX EQUATION.
C               **  COMPUTE PREDICTED VALUES AND DERIVATIES OF PREDICTED CALUES
C               **  AT SELECTED POINTS (HALF WAY BETWEEN KNOTS).
C               ****************************************************************
C
      IROWMX=IDEGRE+1
      DO8500IROW=1,IROWMX
C
C     IF IROW = 1, EVALUATE S(X);
C     IF IROW = 2, EVALUATE S'(X);
C     IF IROW = 3, EVALUATE S''(X); ETC.
C     FOR DEGREE K, STOP (INCLUSIVELY) AT THE K-TH DERIVATIVE.
C
      RIGHT(IROW)=0.0
      DO8600J=1,K
C
      LMAX=IDEGRE+J+1
      IF(XI.LT.EKNOT(J).OR.XI.GT.EKNOT(LMAX))GOTO8600
C
      SUM=0.0
      DO8700L=J,LMAX
      IF(XI.LE.EKNOT(L))GOTO8700
      EKNOL=EKNOT(L)
C
      PROD=1.0
      NUMTER=IROW-1
      IF(NUMTER.LT.1)GOTO8770
      DO8760L2=1,NUMTER
      AL2=L2
      PROD=PROD*(DEG-AL2+1.0)
 8760 CONTINUE
 8770 CONTINUE
      CIJ=PROD
      IPOWER=IDEGRE-(IROW-1)
      DPOWER=IPOWER
      DIJ=(XI-EKNOL)**DPOWER
      ANUM=CIJ*DIJ
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,8771)IROW,DEG,IPOWER,XI,CIJ,DIJ,ANUM
 8771 FORMAT('XI,IROW,DEG,IPOWER,XI,CIJ,DIJ,ANUM = ',I8,E15.7,
     1I8,4E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
CCCCC SUM=0.0
      PROD=1.0
      DO8800M=J,LMAX
      IF(M.EQ.L)GOTO8800
      EKNOL=EKNOT(L)
      EKNOM=EKNOT(M)
      PROD=PROD*(EKNOL-EKNOM)
 8800 CONTINUE
      ADEN=PROD
      RATIO=ANUM/ADEN
      SUM=SUM+RATIO
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,8811)ANUM,ADEN,RATIO,SUM
 8811 FORMAT('ANUM,ADEN,RATIO,SUM = ',4E15.8)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
 8700 CONTINUE
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,8812)IROW,J,RIGHT(IROW),B(J),SUM
 8812 FORMAT('IROW,J,RIGHT(IROW),B(J),SUM = ',2I8,3E15.7)
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
      RIGHT(IROW)=RIGHT(IROW)+B(J)*SUM
      IF(IBUGA3.EQ.'ON')WRITE(ICOUT,8812)IROW,J,RIGHT(IROW),B(J),SUM
      IF(IBUGA3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
 8600 CONTINUE
 8500 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO8990
      WRITE(ICOUT,8901)
 8901 FORMAT('AFTER STEP 12 IN DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8902)
 8902 FORMAT('A(.,.), RIGHT(.) = ')
      CALL DPWRST('XXX','BUG ')
      DO8910I=1,IDEGP1
      WRITE(ICOUT,8911) (A(I,J),J=1,IDEGP1),RIGHT(I)
 8911 FORMAT(8E15.7)
      CALL DPWRST('XXX','BUG ')
 8910 CONTINUE
 8990 CONTINUE
C
      IDEGP1=IDEGRE+1
      CALL BACK50(A,IDEGP1,IDEGP1,RIGHT,BTEMP,IBUGA3)
C
      DO8950I=1,IDEGP1
      L3=L3+1
      B2(L3)=BTEMP(I)
 8950 CONTINUE
C
 8100 CONTINUE
      K2=L3
C
C               **********************************
C               **  STEP 13--                   **
C               **  WRITE OUT THE COEFFICIENTS  **
C               **********************************
C
      ISTEPN='13'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IBUGJU='OFF'
C
      IF(IPRINT.EQ.'OFF')GOTO7409
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7400)
 7400 FORMAT('      PARAMETER ESTIMATES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,7401)
 7401 FORMAT('      -----------------------------------------------'
     1)
      CALL DPWRST('XXX','BUG ')
 7409 CONTINUE
C
      L=0
      IKNMAX=NKNOT+1
      JMAX=IDEGRE+1
      DO7500IKN=1,IKNMAX
      DO7600J=1,JMAX
      L=L+1
      JM1=J-1
      CALL COENAM(IKN,JM1,IH,IH2,IBUGJU,IERROR)
      IF(IPRINT.EQ.'ON')WRITE(ICOUT,7611)IKN,IH,IH2,B2(L)
 7611 FORMAT('      INTERVAL ',I4,'--    ',A4,A4,' = ',E15.7)
      IF(IPRINT.EQ.'ON')CALL DPWRST('XXX','BUG ')
 7600 CONTINUE
      IF(IPRINT.EQ.'ON')WRITE(ICOUT,999)
      IF(IPRINT.EQ.'ON')CALL DPWRST('XXX','BUG ')
 7500 CONTINUE
C
C               *********************************************
C               **  STEP 14--                              **
C               **  PRINT OUT GOODNESS OF FIT INFORMATION  **
C               *********************************************
C
 5000 CONTINUE
      IF(IPRINT.EQ.'OFF')GOTO5129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5125)RESSD
 5125 FORMAT('      RESIDUAL    STANDARD DEVIATION = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5126)IRESDF
 5126 FORMAT('      RESIDUAL    DEGREES OF FREEDOM = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
 5129 CONTINUE
C
      IF(IREP.EQ.'NO')GOTO4950
      IF(IPRINT.EQ.'OFF')GOTO5139
      WRITE(ICOUT,5131)REPSD
 5131 FORMAT('      REPLICATION STANDARD DEVIATION = ',F20.10)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5133)IREPDF
 5133 FORMAT('      REPLICATION DEGREES OF FREEDOM = ',2X,I9)
      CALL DPWRST('XXX','BUG ')
 5139 CONTINUE
      IFITDF=IRESDF-IREPDF
      IF(IFITDF.GE.1)GOTO4961
      IF(IPRINT.EQ.'OFF')GOTO5149
      WRITE(ICOUT,5141)
 5141 FORMAT('      LACK OF FIT F TEST CANNOT BE DONE BECAUSE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5142)
 5142 FORMAT('      HAVE ONLY 0 DEGREES OF FREEDOM IN ',
     1'NUMERATOR OF F RATIO.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5143)
 5143 FORMAT('      THIS HAPPENS WHEN NUMBER OF PARAMETERS ',
     1'FITTED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5144)
 5144 FORMAT('      IS IDENTICAL TO NUMBER OF DISTINCT ',
     1'SUBSETS.')
      CALL DPWRST('XXX','BUG ')
 5149 CONTINUE
      GOTO4950
 4961 CONTINUE
C
      FITDF=IFITDF
      FITSS=RESSS-REPSS
      FITMS=FITSS/FITDF
      FSTAT=FITMS/REPMS
      CALL FCDF(FSTAT,IFITDF,IREPDF,CDF)
      CDF2=100.0*CDF
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1988.
      ALFCDF=CDF
      IF(IPRINT.EQ.'OFF')GOTO4949
      WRITE(ICOUT,4940)FSTAT,CDF2
 4940 FORMAT('      LACK OF FIT F RATIO = ',F10.4,' = THE ',
     1F8.4,'% POINT OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4945)IFITDF,IREPDF
 4945 FORMAT('      F DISTRIBUTION WITH ',I6,' AND ',I6,
     1' DEGREES OF FREEDOM')
      CALL DPWRST('XXX','BUG ')
 4949 CONTINUE
 4950 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 DPSPL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA3,IERROR
 9012 FORMAT('IBUGA3,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NKNOT,IDEGRE
 9013 FORMAT('N,NKNOT,IDEGRE = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)K2
 9014 FORMAT('K2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,K2
      WRITE(ICOUT,9016)I,B2(I),SDB2(I)
 9016 FORMAT('I,B2(I),SDB2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9021)NUMVAR
 9021 FORMAT('NUMVAR = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IREP
 9022 FORMAT('IREP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)REPSS,REPMS,REPSD,REPDF,NUMSET
 9023 FORMAT('REPSS,REPMS,REPSD,REPDF,NUMSET = ',4E15.7,I8)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,N
      WRITE(ICOUT,9026)I,Y(I),X(I),W(I),PRED2(I),RES2(I)
 9026 FORMAT('I,Y(I),X(I),W(I),PRED2(I),RES2(I) = ',I8,5E15.7)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPLC(IANS,IWIDTH,ITERCH,
     1IANSV,IWIDSV,IBUGGC,IERROR)
C
C     PURPOSE--SEARCH THE VECTOR IANS(.) FOR THE
C              SEPARATOR CHARACTOR.
C              REFORM IANS(.) AND IWIDTH BY OMITTING
C              FROM IANS(.) ALL CHARACTERS
C              FROM THE FIRST SEPARATOR CHARACTOR TO THE END
C              (THE SEPARATOR CHARACTOR ITSELF WILL BE OMITTED).
C              FORM IANSV(.) AND IWIDSV BY
C              SAVING ALL CHARACTERS IN THE ORIGINAL IANS(.)
C              AFTER THE FIRST SEPARATOR CHARACTOR.
C              THE ORIGINAL COMMAND LINE HAS THUS BEEN SPLIT INTO
C              2 PARTS WITH THE FIRST SEPARATOR CHARACTOR AS THE PARTITION.
C              THE FIRST PART WILL REMAIN IN IANS(.);
C              THE SECOND PART WILL BE SAVED IN IANSV(.).
C     NOTE--IANS AND IWIDTH ARE BOTH INPUT AND OUTPUT ARGUMENTS.
C           THE INPUT ARGUMENTS IANS AND IWIDTH BOTH GET CHANGED
C           DURING THE EXECUTION OF THIS SUBROUTINE.
C     INPUT  ARGUMENTS--IANS   (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              ORIGINAL INPUT COMMAND LINE.
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE ORIGINAL COMMAND LINE.
C                     --ITERCH (A  HOLLERITH VARIABLE WHICH
C                              CONTAINS THE TERMINATORCHARACTER.
C     OUTPUT ARGUMENTS--IANS   (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              FIRST PART OF THE ORIGINAL COMMAND LINE
C                              (UP TO BUT EXCLUDING THE TERMINATORCHARACTOR).
C                     --IWIDTH (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE FIRST PART OF THE ORIGINAL COMMAND LINE.
C                     --IANSV  (A  HOLLERITH VECTOR WHOSE
C                              I-TH ELEMENT CONTAINS THE
C                              I-TH CHARACTER OF THE
C                              SECOND PART OF THE COMMAND LINE
C                              (STARTING WITH THE CHARACTER AFTER
C                              THE TERMINATORCHARACTER).
C                     --IWIDSV (AN INTEGER VARIABLE WHICH
C                              CONTAINS THE NUMBER OF CHARACTERS
C                              IN THE SECOND PART OF THE ORIGINAL COMMAND LINE.
C                     --IBUGGC   (A HOLLERITH VARIABLE
C                              FOR DEBUGGING
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER  1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IANS
      CHARACTER*4 ITERCH
      CHARACTER*4 IANSV
      CHARACTER*4 IBUGGC
      CHARACTER*4 IERROR
C
      CHARACTER*4 IBLANK
C
C---------------------------------------------------------------------
C
      DIMENSION IANS(*)
      DIMENSION IANSV(*)
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
      IERROR='NO'
C
      IF(IBUGGC.EQ.'OFF')GOTO109
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('AT THE BEGINNING OF DPSPLC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)(IANS(I),I=1,IWIDTH)
  102 FORMAT('IANS(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)IWIDTH
  103 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)ITERCH
  104 FORMAT('ITERCH = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,105)(IANSV(I),I=1,IWIDSV)
  105 FORMAT('IANSV(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,106)IWIDSV
  106 FORMAT('IWIDSV = ',I8)
      CALL DPWRST('XXX','BUG ')
  109 CONTINUE
C
C               *************************************
C               **  STEP 1--                       **
C               **  TRIM THE VALUE OF IWIDTH       **
C               **  BY IGNORING BLANKS ON THE END  **
C               **  OF IANS(.)                     **
C               *************************************
C
      DO150I=1,IWIDTH
      IREV=IWIDTH-I+1
      IF(IANS(IREV).NE.' ')GOTO160
  150 CONTINUE
      IWIDTH=0
      IWIDSV=0
      GOTO900
  160 CONTINUE
      IWIDTH=IREV
C
C               *************************************
C               **  STEP 2--                       **
C               **  BLANK OUT THE IANSV(.) VECTOR. **
C               **  NOTE THAT THIS NEED ONLY BE    **
C               **  DONE OUT TO IWIDTH ELEMENTS    **
C               **  SINCE IANSV(.) WILL NEVER      **
C               **  BE LARGER THAN IANS(.)         **
C               *************************************
C
      IBLANK=' '
      DO200I=1,IWIDTH
      IANSV(I)=IBLANK
  200 CONTINUE
C
C               **********************************
C               **  STEP 3--                    **
C               **  SCAN THE IANS(.) VECTOR TO  **
C               **  SEARCH FOR THE TERMINATOR   **
C               **********************************
C
      DO300I=1,IWIDTH
      ILOCSP=I
      IF(IANS(I).EQ.ITERCH)GOTO390
  300 CONTINUE
      ILOCSP=IWIDTH+1
  390 CONTINUE
C
C               ***********************************
C               **  STEP 4--                     **
C               **  COMPUTE IANSV(.) AND IWIDSV  **
C               ***********************************
C
      J=0
      IMIN=ILOCSP+1
      IMAX=IWIDTH
      IF(IMIN.GT.IMAX)GOTO450
      DO400I=IMIN,IMAX
      J=J+1
      IANSV(J)=IANS(I)
  400 CONTINUE
  450 CONTINUE
      IWIDSV=J
C
C               *****************************************************
C               **  STEP 5--                                       **
C               **  RECOMPUTE THE VALUE OF IWIDTH--                **
C               **  FIRST BY DEFINING IT TO BE                     **
C               **  IMMEDIATELY BEFORE THE TERMINATOR CHARACTOR,   **
C               **  AND THEN TRIMMING IT FURTHER BY                **
C               **  IGNORING ANY BLANKS AT THE NEW END OF IANS(.)  **
C               *****************************************************
C
  500 CONTINUE
      IWIDTH=ILOCSP-1
C
      DO510I=1,IWIDTH
      IREV=IWIDTH-I+1
      IF(IANS(IREV).NE.' ')GOTO520
  510 CONTINUE
      IREV=0
  520 CONTINUE
      IWIDTH=IREV
C
C               ****************
C               **  STEP 9--  **
C               **  EXIT      **
C               ****************
C
  900 CONTINUE
      IF(IBUGGC.EQ.'OFF')GOTO909
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,901)
  901 FORMAT('AT THE END OF DPSPLC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,902)(IANS(I),I=1,IWIDTH)
  902 FORMAT('IANS(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,903)IWIDTH
  903 FORMAT('IWIDTH = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,904)ITERCH
  904 FORMAT('ITERCH = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,905)(IANSV(I),I=1,IWIDSV)
  905 FORMAT('IANSV(.) = ',120A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,906)IWIDSV
  906 FORMAT('IWIDSV = ',I8)
      CALL DPWRST('XXX','BUG ')
  909 CONTINUE
C
  990 CONTINUE
      RETURN
      END
      SUBROUTINE DPSPLI(IHARG,IHARG2,NUMARG,IDEFSL,MAXSPI,ISPILI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPSPLI(IHARG,NUMARG,IDEFSL,MAXSPI,ISPILI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE LINE TYPES.
C              THESE ARE LOCATED IN THE VECTOR ISPILI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSL
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ISPILI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEFSL
      CHARACTER*4 ISPILI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION ISPILI(*)
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='DPSP'
      ISUBN2='LI  '
C
      NUMSPI=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 DPSPLI--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSL
   55 FORMAT('IDEFSL = ',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)ISPILI(1)
   70 FORMAT('ISPILI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ISPILI(I)
   76 FORMAT('I,ISPILI(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
CCCCC IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(3)
CCCCC IF(IHARG(2).EQ.'ALL')GOTO1300
CCCCC IF(IHARG(3).EQ.'ALL')IHOLD1=IHARG(2)
CCCCC IF(IHARG(3).EQ.'ALL')GOTO1300
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(2).EQ.'ALL')THEN
        IHOLD1=IHARG(3)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(3).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(3).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(3).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(3).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(3).EQ.'ALL')THEN
        IHOLD1=IHARG(2)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      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
      NUMSPI=1
      ISPILI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG-1
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      J=I+1
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSL
      ISPILI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,ISPILI(I)
 1276 FORMAT('SPIKE 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
      NUMSPI=MAXSPI
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSL
      DO1315I=1,NUMSPI
      ISPILI(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)ISPILI(I)
 1316 FORMAT('ALL SPIKE 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 DPSPLI--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSL
 9015 FORMAT('IDEFSL = ',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)ISPILI(1)
 9030 FORMAT('ISPILI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ISPILI(I)
 9036 FORMAT('I,ISPILI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPMA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1CLLIMI,CLWIDT,
     1ICONT,NUMHPP,NUMVPP,IMANUF,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ALOWFR,ALOWDG,
     1IFORSW,
     1ANOPL1,ANOPL2,ISEED,IBOOSS,BARHEF,BARWEF,
     1ICAPSW,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1IFOUND,IERROR)
C
C     PURPOSE--GENERATE A SCATTER PLOT MATRIX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/9
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASEQ
CCCCC CHARACTER*4 ICASAN
      CHARACTER*4 ICONT
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IFORSW
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISQUAR
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IREPCH
      CHARACTER*4 IMPSW
      CHARACTER*4 IMPSW3
      CHARACTER*4 ISPMFZ
      CHARACTER*4 ISPMTZ
      CHARACTER*4 ISPMPZ
      CHARACTER*4 ISPMLZ
      CHARACTER*4 ISPML2
      CHARACTER*4 ISPMXZ
      CHARACTER*4 ISPMYZ
      CHARACTER*4 ISPMDZ
      CHARACTER*4 ISPMZT
      CHARACTER*4 ISPMZ2
      CHARACTER*4 ISPMZ3
      CHARACTER*4 ISPMZ4
      CHARACTER*4 IPLOTT
      CHARACTER*4 ISUBSZ
C
      CHARACTER*4 ICT
      CHARACTER*4 IC2T
      CHARACTER*4 IHT(5)
      CHARACTER*4 IH2T(5)
      CHARACTER*4 ICBT
      CHARACTER*4 IC2BT
      CHARACTER*4 IHBT(5)
      CHARACTER*4 IH2BT(5)
      CHARACTER*4 ISU2SW(MAXSUB)
C
      CHARACTER*4 IFEED9
C
      CHARACTER*4 IMANUF
C
      CHARACTER*4 ICHAP2(100)
      CHARACTER*4 ILINP2(100)
      CHARACTER*4 IBARS2(100)
      CHARACTER*4 ISPIS2(100)
      CHARACTER*4 IFENC2
      CHARACTER*4 IPPTB2
      CHARACTER*4 IERAS2
      CHARACTER*4 ISORS2
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
      CHARACTER*4 IX1LT2(MAXCH)
      CHARACTER*4 IX2LT2(MAXCH)
      CHARACTER*4 IY1LT2(MAXCH)
      CHARACTER*4 IY2LT2(MAXCH)
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY1LJ2
      CHARACTER*4 IY1LD2
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IX1MNS
      CHARACTER*4 IX1MXS
      CHARACTER*4 IX2MNS
      CHARACTER*4 IX2MXS
      CHARACTER*4 IX1FSV
      CHARACTER*4 IX2FSV
      CHARACTER*4 IY1FSV
      CHARACTER*4 IY2FSV
C
CCCCC CHARACTER*4 IWRITE
      CHARACTER*4 IEMPTY
C
      CHARACTER*80 IFILE5
      CHARACTER*12 ISTAT5
      CHARACTER*12 IFORM5
      CHARACTER*12 IACCE5
      CHARACTER*12 IPROT5
      CHARACTER*12 ICURS5
      CHARACTER*4 IERRF5
      CHARACTER*4 IENDF5
      CHARACTER*4 IREWI5
      INCLUDE 'DPCOF2.INC'
C
C
C  MAXY IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  SCATTER PLOT MATRIX CURVE
C
      PARAMETER(MAXY=25)
C
      DIMENSION IVARN1(MAXY)
      DIMENSION IVARN2(MAXY)
      DIMENSION ILIS(MAXY)
      DIMENSION ICOLL(MAXY)
C
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
C-----COMMON------------------------------------------------------
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOPC.INC'
      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
      IFOUND='YES'
      IERROR='NO'
C
      ISUBN1='DPSPMA'
      ISUBN2='    '
C
      ICASPL='SPMA'
      NDONE=0
C
C               *****************************************
C               **  TREAT THE SCATTER PLOT MATRIX CASE **
C               *****************************************
C
      IF(IBUGG2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSPMA--')
      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)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO69
      DO61I=1,NUMARG
      WRITE(ICOUT,62)I,IHARG(I),IARGT(I)
   62 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   69 CONTINUE
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  SHIFT COMMAND LINE ARGMENTS                      **
C               *******************************************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SPMA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2.AND.IHARG(1).EQ.'PLOT'.AND.
     1   IHARG(2).EQ.'MATR')THEN
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')THEN
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'YOUD'.AND.IHARG(1).EQ.'MATR'.AND.
     1   IHARG(2).EQ.'PLOT')THEN
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ISPMPZ=ISPMPT
        ISPMPT='YOUD'
      ELSEIF(NUMARG.GE.2.AND.ICOM.EQ.'DEX '.AND.IHARG(1).EQ.'INTE'.AND.
     1   IHARG2(1).EQ.'RACT'.AND.IHARG(2).EQ.'PLOT')THEN
        ISHIFT=2
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ISPMPZ=ISPMPT
        ISPMPT='DEXI'
        ISPMTZ=ISPMTA
        ISPMTA='OFF'
      ELSEIF(NUMARG.GE.4.AND.ICOM.EQ.'DEX '.AND.IHARG(2).EQ.'INTE'.AND.
     1   IHARG(3).EQ.'EFFE'.AND.IHARG(4).EQ.'PLOT')THEN
        ISHIFT=4
        ISPMPZ=ISPMPT
        ISPMPT='DEXS'
        ISPMTZ=ISPMTA
        ISPMTA='OFF'
        ISPMZT=ISPMST
        ISPMZ2=ISPMS2
        ISPMZ3=ISPMS3
        ISPMZ4=ISPMS4
        ISPMST=IHARG(1)
        ISPMS2=IHARG2(1)
        ISPMS3='    '
        ISPMS4='    '
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
      ELSEIF(NUMARG.GE.3.AND.ICOM.EQ.'DEX '.AND.IHARG(2).EQ.'INTE'.AND.
     1   IHARG(3).EQ.'PLOT')THEN
        ISHIFT=3
        ISPMPZ=ISPMPT
        ISPMPT='DEXS'
        ISPMTZ=ISPMTA
        ISPMTA='OFF'
        ISPMZT=ISPMST
        ISPMZ2=ISPMS2
        ISPMZ3=ISPMS3
        ISPMZ4=ISPMS4
        ISPMST=IHARG(1)
        ISPMS2=IHARG2(1)
        ISPMS3='    '
        ISPMS4='    '
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
      ELSEIF(NUMARG.GE.5.AND.ICOM.EQ.'DEX '.AND.IHARG(3).EQ.'INTE'.AND.
     1   IHARG(4).EQ.'EFFE'.AND.IHARG(5).EQ.'PLOT')THEN
        ISHIFT=5
        ISPMPZ=ISPMPT
        ISPMPT='DEXS'
        ISPMTZ=ISPMTA
        ISPMTA='OFF'
        ISPMZT=ISPMST
        ISPMZ2=ISPMS2
        ISPMZ3=ISPMS3
        ISPMZ4=ISPMS4
        ISPMST=IHARG(1)
        ISPMS2=IHARG2(1)
        ISPMS3=IHARG(2)
        ISPMS4=IHARG2(2)
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
      ELSEIF(NUMARG.GE.4.AND.ICOM.EQ.'DEX '.AND.IHARG(3).EQ.'INTE'.AND.
     1   IHARG(4).EQ.'PLOT')THEN
        ISHIFT=4
        ISPMPZ=ISPMPT
        ISPMPT='DEXS'
        ISPMTZ=ISPMTA
        ISPMTA='OFF'
        ISPMZT=ISPMST
        ISPMZ2=ISPMS2
        ISPMZ3=ISPMS3
        ISPMZ4=ISPMS4
        ISPMST=IHARG(1)
        ISPMS2=IHARG2(1)
        ISPMS3=IHARG(2)
        ISPMS4=IHARG2(2)
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
      ENDIF
C
      ICOM='PLOT'
      ICOM2='    '
      IFOUND='YES'
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.'SPMA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINN2=2
      MINNA=1
      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.'SPMA')
     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.'SPMA')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.'ANDR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      JMIN=1
      JMAX=ILOCQ-1
      CALL EXTVAR(IHARG,IHARG2,NUMARG,JMIN,JMAX,MAXY,
     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.'SPMA')
     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,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
      NRIGHT=IN(ILOCV)
      IF(I.EQ.1)THEN
        NTEMP=NRIGHT
      ELSE
        IF(ISPMPT.EQ.'DEXC'.AND.I.EQ.NUMVAR)THEN
          CONTINUE
        ELSE
          IF(NRIGHT.NE.NTEMP)IFLAG=1
        ENDIF
      ENDIF
      ILIS(I)=ILOCV
      IF(NRIGHT.GE.MINN2)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPSPMA--')
      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('      SCATTER PLOT MATRIX WAS TO HAVE BEEN FORMED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)MINN2
 1326 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE CASE',
     1' 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)WRITE(ICOUT,1329)(IANS(J),J=1,MIN(IWIDTH,100))
 1329 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
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.'SPMA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.EQ.0)GOTO1490
      IF(ISPMPT.EQ.'BIHI')GOTO1490
      IF(ISPMPT.EQ.'QQPL')GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPSPMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1413)
 1413 FORMAT('      THE NUMBER OF OBSERVATIONS IN ALL VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1414)
 1414 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(I),IVARN2(I),IN(I2)
 1416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,' 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)WRITE(ICOUT,1421)(IANS(I),I=1,MIN(IWIDTH,100))
 1421 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               **************************************************
C               **   STEP 1--                                   **
C               **   SAVE INITIAL SETTINGS                      **
C               **************************************************
C
      ISTEPN='1'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'SPMA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      PXMN2=PXMIN
      PXMX2=PXMAX
      PYMN2=PYMIN
      PYMX2=PYMAX
      PWXMN2=PWXMIN
      PWXMX2=PWXMAX
      PWYMN2=PWYMIN
      PWYMX2=PWYMAX
      IF(ISPMFR.EQ.'DEFA')THEN
        PXMIN=0.0
        PXMAX=100.0
        PYMIN=0.0
        PYMAX=100.0
      ENDIF
C
      IFENC2=IFENSW
      IERAS2=IERASW
      IPPTB2=IPPTBI
      ISORS2=ISORSW
      IX1TSV=IX1TSW
      IX2TSV=IX2TSW
      IY1TSV=IY1TSW
      IY2TSV=IY2TSW
      IX1ZSV=IX1ZSW
      IX2ZSV=IX2ZSW
      IY1ZSV=IY1ZSW
      IY2ZSV=IY2ZSW
      PX1LD2=PX1LDS
      PX2LD2=PX2LDS
      PY1LD2=PY1LDS
      PY1LA2=PY1LAN
      IY1LJ2=IY1LJU
      IY1LD2=IY1LDI
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
      GY2MNS=GY2MIN
      GY2MXS=GY2MAX
      GX1MNS=GX1MIN
      GX1MXS=GX1MAX
      GX2MNS=GX2MIN
      GX2MXS=GX2MAX
      IY1MNS=IY1MIN
      IY1MXS=IY1MAX
      IY2MNS=IY2MIN
      IY2MXS=IY2MAX
      IX1MNS=IX1MIN
      IX1MXS=IX1MAX
      IX2MNS=IX2MIN
      IX2MXS=IX2MAX
      IX1FSV=IX1FSW
      IX2FSV=IX2FSW
      IY1FSV=IY1FSW
      IY2FSV=IY2FSW
      PX1ZD2=PX1ZDS
      PX2ZD2=PX2ZDS
      PY1ZD2=PY1ZDS
      PY2ZD2=PY2ZDS
      DO1495I=1,100
        ICHAP2(I)=ICHAPA(I)
        ILINP2(I)=ILINPA(I)
        IBARS2(I)=IBARSW(I)
        ISPIS2(I)=ISPISW(I)
 1495 CONTINUE
C
      DO1500I=1,MAXCH
        IX1LT2(I)=IX1LTE(I)
        IX2LT2(I)=IX2LTE(I)
        IY1LT2(I)=IY1LTE(I)
        IY2LT2(I)=IY2LTE(I)
 1500 CONTINUE
      NCX1L2=NCX1LA
      NCX2L2=NCX2LA
      NCY1L2=NCY1LA
      NCY2L2=NCY2LA
C
      ISPMTZ=ISPMTA
      ISPMFZ=ISPMFR
      ISPMPZ=ISPMPT
      ISPMLZ=ISPMLD
      ISPML2=ISPMLA
      ISPMZT=ISPMST
      ISPMZ2=ISPMS2
      ISPMZ3=ISPMS3
      ISPMZ4=ISPMS4
      ISPMXZ=ISPMXA
      ISPMYZ=ISPMYA
      ISPMDZ=ISPMDI
      IF(ISPMLA.EQ.'BOX'.AND.ISPMPT.EQ.'BIHI')ISPMLA='ON'
      IF(ISPMFR.EQ.'USER'.AND.ISPMLA.EQ.'BOX')ISPMLA='ON'
      IF(ISPMFR.EQ.'CONN')ISPMFR='DEFA'
      IF(ISPMLA.EQ.'BOX ')THEN
        ISPMLD='ON'
CCCCC   ISPMXA='BOTT'
CCCCC   ISPMYA='LEFT'
        IF(ISPMDI.EQ.'BLAN')ISPMDI='LINE'
      ENDIF
C
      IOPTN=1
      IDX=0
      IDY=0
      CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1ISUBNU,
     1ISUBSW,
     1ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1ISUBN9,
     1ISUBSZ,
     1ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1PSPLSL,PSPLSU,PSPLSL,PSPLSU,
     1IBUGG2,ISUBRO,IERROR)
C
      IFEED9=IFEEDB
C
      IF(ISPMPT.EQ.'YOUD'.OR.ISPMPT.EQ.'DEXC')THEN
        ISPMTA='ON'
      ENDIF
C
      IF(ISPMTA.EQ.'ON')THEN
        ISHIFT=ILOCQ-1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ISHIFT=NUMVAR-1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DO1509I=1,NUMVAR-1
          IHARG(I)=IVARN1(I)
          IHARG2(I)=IVARN2(I)
 1509   CONTINUE
        NUMVAR=NUMVAR-1
        IF(NUMVAR.LT.2)GOTO9000
      ENDIF
C
      DO1530I=1,NUMVAR
      IHRIGH=IVARN1(I)
      IHRIG2=IVARN2(I)
      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
C
      ICOLL(I)=IVALUE(ILOCV)
 1530 CONTINUE
C
      IMPSW3=IMPSW
      IMPCO2=IMPCO
      IMPNR2=IMPNR
      IMPNC2=IMPNC
      IMPSW='ON'
      IMPCO=1
      IMPNR=NUMVAR
      IMPNC=NUMVAR
      NPLOTS=IMPNR*IMPNC
C
      IOUNI5=IST5NU
      IFILE5=IST5NA
      ISTAT5=IST5ST
      IFORM5=IST5FO
      IACCE5=IST5AC
      IPROT5=IST5PR
      ICURS5=IST5CS
      ISUBN0='SPMA'
      IERRF5='NO'
C
      IREWI5='ON'
      CALL DPOPFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')IOUNI5=0
C
C
C               *************************************
C               **   STEP 21--                     **
C               **   GENERATE THE SCATTER PLOTS    **
C               *************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DPSPMA')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISHIFT=NUMVAR
      CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ISHIFT=2
      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1IBUGG2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IHARG(1)=IVARN1(1)
      IHARG2(1)=IVARN2(1)
      IHARG(2)=IVARN1(1)
      IHARG2(2)=IVARN2(1)
C
      IF(ISPMLA.EQ.'BOX')THEN
        IMPNR=NUMVAR+1
        IMPNC=NUMVAR+1
      ENDIF
C
      IF(ISPMPT.EQ.'BIHI')THEN
        ICT='RELA'
        IC2T='TIVE'
        IHT(1)='BIHI'
        IH2T(1)='STOG'
        NCCOMM=1
        ICBT='RELA'
        IC2BT='TIVE'
        IHBT(1)='HIST'
        IH2BT(1)='OGRA'
        NCCOM2=1
        IPLOTT='BIHI'
        GOTO5000
      ENDIF
C
      IF(ISPMPT.EQ.'DEXI')THEN
        ICT='INTE'
        IC2T='RACT'
        NCCOMM=1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        ICBT=ICT
        IC2BT=IC2T
        NCCOM2=NCCOMM
        DO2105II=1,NCCOMM
          IHBT(II)=IHT(II)
          IH2BT(II)=IH2T(II)
 2105   CONTINUE
        IPLOTT='DEXI'
        IRESP=1
        GOTO6599
      ENDIF
      IF(ISPMPT.EQ.'DEXS')THEN
        IF(ISPMST.NE.'    ')THEN
          ICT=ISPMST
          IC2T=ISPMS2
          NCCOMM=0
          IF(ISPMS3.NE.'    ')THEN
            IHT(1)=ISPMS3
            IH2T(1)=ISPMS4
            NCCOMM=1
          ENDIF
        ELSE
          ICT='MEAN'
          IC2T='    '
          NCCOMM=0
        ENDIF
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='INTE'
        IH2T(NCCOMM)='RACT'
        NCCOMM=NCCOMM+1
        IHT(NCCOMM)='PLOT'
        IH2T(NCCOMM)='    '
        ICBT=ICT
        IC2BT=IC2T
        NCCOM2=NCCOMM
        DO2108II=1,NCCOMM
          IHBT(II)=IHT(II)
          IH2BT(II)=IH2T(II)
 2108   CONTINUE
        IPLOTT='DEXS'
        IRESP=1
        GOTO6599
      ENDIF
      IF(ISPMPT.EQ.'CROS')THEN
        IF(ISPMST.NE.'    ')THEN
          ICT='CROS'
          IC2T='S   '
          IHT(1)='TABU'
          IH2T(1)='LATE'
          IHT(2)=ISPMST
          IH2T(2)=ISPMS2
          NCCOMM=2
          IF(ISPMS3.NE.'    ')THEN
            IHT(3)=ISPMS3
            IH2T(3)=ISPMS4
            NCCOMM=3
          ENDIF
          NCCOMM=NCCOMM+1
          IHT(NCCOMM)='PLOT'
          IH2T(NCCOMM)='    '
          ICBT=ISPMST
          IC2BT=ISPMS2
          NCCOM2=0
          IF(ISPMS3.NE.'    ')THEN
            IHT(1)=ISPMS3
            IH2T(1)=ISPMS4
            NCCOM2=1
          ENDIF
          NCCOM2=NCCOM2+1
          IHBT(NCCOM2)='PLOT'
          IH2BT(NCCOM2)='    '
          IPLOTT='CRO2'
          IRESP=1
        ELSE
          ICT='CROS'
          IC2T='S   '
          IHT(1)='TABU'
          IH2T(1)='LATE'
          IHT(2)='PLOT'
          IH2T(2)='    '
          NCCOMM=2
          ICBT='PLOT'
          IC2BT='    '
          NCCOM2=0
          IPLOTT='CROS'
          IRESP=0
        ENDIF
        GOTO6599
      ENDIF
      IF(ISPMPT.EQ.'DEXC')THEN
        ICT='DEX '
        IC2T='    '
        IHT(1)='CONT'
        IH2T(1)='OUR '
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        ICBT='DEX '
        IC2BT='    '
        IHBT(1)='CONT'
        IH2BT(1)='OUR '
        IHBT(2)='PLOT'
        IH2BT(2)='    '
        NCCOM2=2
        IPLOTT='DEXC'
        IRESP=1
        GOTO6599
      ENDIF
      IF(ISPMPT.EQ.'QQPL')THEN
        ICT='QUAN'
        IC2T='TILE'
        IHT(1)='QUAN'
        IH2T(1)='TILE'
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        ICBT='PERC'
        IC2BT='ENT '
        IHBT(1)='POIN'
        IH2BT(1)='    '
        IHBT(2)='PLOT'
        IH2BT(2)='    '
        NCCOM2=2
        IPLOTT='QQSP'
        IPPTBI='UNBI'
        GOTO5000
      ENDIF
      IF(ISPMPT.EQ.'CORR')THEN
        ICT='CROS'
        IC2T='S   '
        IHT(1)='CORR'
        IH2T(1)='ELAT'
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        ICBT='AUTO'
        IC2BT='CORR'
        IHBT(1)='PLOT'
        IH2BT(1)='    '
        NCCOM2=1
        IPLOTT='CCOR'
        GX1MIN=0.0
        IX1MIN='FIXE'
        GOTO5000
      ENDIF
      IF(ISPMPT.EQ.'SPEC')THEN
        ICT='CROS'
        IC2T='S   '
        IHT(1)='SPEC'
        IH2T(1)='TRAL'
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        ICBT='SPEC'
        IC2BT='TRAL'
        IHBT(1)='PLOT'
        IH2BT(1)='    '
        NCCOM2=1
        IPLOTT='CSPE'
        ISPMFZ=ISPMFR
        IF(IY1MIN.NE.'FIXE'.OR.IY1MAX.NE.'FIXE'.OR.
     1     IY2MIN.NE.'FIXE'.OR.IY2MAX.NE.'FIXE')THEN
           ISPMFR='USER'
        ENDIF
        GOTO5000
      ENDIF
      IF(ISPMPT.EQ.'LAG ')THEN
        ICT='CROS'
        IC2T='S   '
        IHT(1)='LAG '
        IH2T(1)='    '
        IHT(2)='PLOT'
        IH2T(2)='    '
        NCCOMM=2
        ICBT='LAG '
        IC2BT='    '
        IHBT(1)='PLOT'
        IH2BT(1)='    '
        NCCOM2=1
        IPLOTT='CLAG'
        GOTO5000
      ENDIF
C
C               *************************************
C               **   SCATTER PLOT CASE             **
C               *************************************
C
      IF(ISPMTA.EQ.'ON')THEN
        ISHIFT=1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHARG(3)=IVARN1(NUMVAR+1)
        IHARG2(3)=IVARN2(NUMVAR+1)
      ENDIF
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'DPSPMA')THEN
        WRITE(ICOUT,1720)NUMVAR
 1720 FORMAT('      NUMVAR = ',I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      NARGT=NUMARG
      DO3000IROW=1,IMPNR
        DO4000ITEMP1=1,IMPNC
C
          IF(IROW.LE.NUMVAR)THEN
            IHARG(1)=IVARN1(IROW)
            IHARG2(1)=IVARN2(IROW)
            IDX=IROW
          ELSE
            IHARG(1)=IVARN1(NUMVAR)
            IHARG2(1)=IVARN2(NUMVAR)
            IDX=NUMVAR
          ENDIF
          ICOL=ITEMP1
          IEMPTY='NO'
          IF(ISPMLA.EQ.'BOX')THEN
            ICOL=ITEMP1-1
            IF(ICOL.EQ.0)IEMPTY='YES'
            IF(IROW.EQ.IMPNR)IEMPTY='YES'
          ENDIF
C
          IF(IROW.GT.ICOL.AND.ISPMLD.EQ.'OFF')THEN
            IMPCO=IMPCO+1
            GOTO4000
          ENDIF
C
          IF(ICOL.EQ.0)THEN
            IHARG(2)=IVARN1(1)
            IHARG2(2)=IVARN2(1)
            IDY=1
          ELSE
            IHARG(2)=IVARN1(ICOL)
            IHARG2(2)=IVARN2(ICOL)
            IDY=ICOL
          ENDIF
C
          IF(IEMPTY.EQ.'YES')THEN
            DO3104I=1,MAXSUB
              ISU2SW(I)=ISUBSW(I)
              ISUBSW(I)='OFF'
 3104       CONTINUE
          ENDIF
          IOPTN=3
          CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1                ISUBNU,ISUBSW,
     1                ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1                ISUBN9,ISUBSZ,
     1                ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1                PSPLSL,PSPLSU,PSPLSL,PSPLSU,
     1                IBUGG2,ISUBRO,IERROR)
C
          ICASPL='SPMA'
          CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1                IMPNR,IMPNC,IROW,ICOL,IROW,ICOL,IPLOT,
     1                NPLOTS,NUMVAR,
     1                ICHAP2,ILINP2,
     1                GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1                GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1                IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1                IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                PX1LD2,PX2LD2,
     1                IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1                IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1                NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1                PSPLLL,PSPLUL,PSPLLL,PSPLUL,ICOL,
     1                ISPMLA,ISPMLD,ISPMPT,ISPMFR,ISPMXA,ISPMYA,
     1                ISPMDI,
     1                ISPMTD,PSPMTD,IVNMEX,
     1                IBUGG2,ISUBRO)
          IERROR='NO'
C
          IF(IEMPTY.EQ.'YES')THEN
            DO3106I=1,100
              ICHAPA(I)='BLAN'
              ILINPA(I)='BLAN'
              ISPISW(I)='OFF'
              IBARSW(I)='OFF'
 3106        CONTINUE
             CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                   MAXNPP,ISEED,IBOOSS,
     1                   IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                   IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                   BARHEF,BARWEF,
     1                   IRHSTG,IHSTCW,
     1                   ICAPSW,IFORSW,
     1                   IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                   TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                   ISUBRO,IFOUND,IERROR)
             GOTO4089
          ENDIF
C
          IF(IROW.EQ.ICOL)THEN
            IF(ISPMDI.NE.'LINE')THEN
               DO3110I=1,100
                 ICHAPA(I)='BLAN'
                 ILINPA(I)='BLAN'
                 ISPISW(I)='OFF'
                 IBARSW(I)='OFF'
 3110          CONTINUE
            ENDIF
            CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                   MAXNPP,ISEED,IBOOSS,
     1                   IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                   IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                   BARHEF,BARWEF,
     1                   IRHSTG,IHSTCW,
     1                   ICAPSW,IFORSW,
     1                   IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                   TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                   ISUBRO,IFOUND,IERROR)
            IF(IERROR.EQ.'YES')GOTO4000
            ICONT=IDCONT(1)
            NUMHPP=IDNHPP(1)
            IMPARG=2
            CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                  XMATN,YMATN,XMITN,YMITN,
     1                  ISQUAR,
     1                  IVGMSW,IHGMSW,
     1                  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                  IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                  YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                  IMPSW,IMPNR,IMPNC,IMPCO,
     1                  IMPARG,
     1                  PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                  MAXCOL,
     1                  DSIZE,DSYMB,DCOLOR,DFILL,
     1                  ICAPSW,
     1                  IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                  IERROR)
            IF(IERROR.EQ.'NO')IAND1=IAND2
            DO3120I=1,100
              ICHAPA(I)=ICHAP2(I)
              ILINPA(I)=ILINP2(I)
              ISPISW(I)=ISPIS2(I)
              IBARSW(I)=IBARS2(I)
 3120       CONTINUE
            IERASW='OFF'
            IF(ISPMDI.EQ.'LINE'.OR.ISPMDI.EQ.'BLAN')GOTO4000
            IX1TSW='OFF'
            IX1ZSW='OFF'
            IX2TSW='OFF'
            IX2ZSW='OFF'
            IY1TSW='OFF'
            IY1ZSW='OFF'
            IY2TSW='OFF'
            IY2ZSW='OFF'
C
            IF(ISPMDI.EQ.'BOXP'.AND.ISPMTA.EQ.'ON')THEN
              IMPCO=IMPCO-1
              DO3130I=1,100
                ICHAPA(I)='BLAN'
                ILINPA(I)='BLAN'
                IBARSW(I)='OFF'
                ISPISW(I)='OFF'
 3130         CONTINUE
              ICHAPA(1)='X'
              ICHAPA(4)='X'
              ICHAPA(7)='X'
              ICHAPA(21)='CIRC'
              ICHAPA(22)='CIRC'
              ICHAPA(23)='CIRC'
              ICHAPA(24)='CIRC'
              ILINPA(8)='SOLI'
              ILINPA(13)='SOLI'
              ILINPA(14)='SOLI'
              ILINPA(15)='SOLI'
              ILINPA(16)='SOLI'
              ILINPA(20)='SOLI'
              IFENSW='ON'
              GY1MIN=FY1MNZ
              GY1MAX=FY1MXZ
              GY2MIN=GY1MIN
              GY2MAX=GY1MAX
              IY1MIN='FIXE'
              IY1MAX='FIXE'
              IY2MIN='FIXE'
              IY2MAX='FIXE'
              IX1MIN='FLOA'
              IX1MAX='FLOA'
              IX2MIN='FLOA'
              IX2MAX='FLOA'
              IX1TSW='OFF'
              IX1ZSW='OFF'
              IX2TSW='OFF'
              IX2ZSW='OFF'
              IY1TSW='OFF'
              IY1ZSW='OFF'
              IY2TSW='OFF'
              IY2ZSW='OFF'
              ICOM='BOX '
              ICOM2='    '
              IHARG(1)='PLOT'
              IHARG2(1)='    '
              IHARG(2)=IVARN1(IROW)
              IHARG2(2)=IVARN2(IROW)
              IHARG(3)=IVARN1(NUMVAR+1)
              IHARG2(3)=IVARN2(NUMVAR+1)
              CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                   MAXNPP,ISEED,IBOOSS,
     1                   IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                   IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                   BARHEF,BARWEF,
     1                   IRHSTG,IHSTCW,
     1                   ICAPSW,IFORSW,
     1                   IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                   TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                   ISUBRO,IFOUND,IERROR)
              ISHIFT=1
              CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                    IBUGG2,IERROR)
              ICOM='PLOT'
              ICOM2='    '
              IHARG(1)=IVARN1(IROW)
              IHARG2(1)=IVARN2(IROW)
              IHARG(2)=IVARN1(ICOL)
              IHARG2(2)=IVARN2(ICOL)
              IHARG(3)=IVARN1(NUMVAR+1)
              IHARG2(3)=IVARN2(NUMVAR+1)
              GOTO4089
            ELSEIF(ISPMDI.EQ.'HIST')THEN
              IMPCO=IMPCO-1
              ICOM='HIST'
              ICOM2='    '
              ISHIFT=1
              IF(ISPMTA.EQ.'ON')ISHIFT=2
              CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                    IBUGG2,IERROR)
              IHARG(1)=IVARN1(IROW)
              IHARG2(1)=IVARN2(IROW)
              CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                   MAXNPP,ISEED,IBOOSS,
     1                   IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                   IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                   BARHEF,BARWEF,
     1                   IRHSTG,IHSTCW,
     1                   ICAPSW,IFORSW,
     1                   IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                   TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                   ISUBRO,IFOUND,IERROR)
              ISHIFT=1
              IF(ISPMTA.EQ.'ON')ISHIFT=2
              CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                    IBUGG2,IERROR)
              ICOM='PLOT'
              ICOM2='    '
              IHARG(1)=IVARN1(ICOL)
              IHARG2(1)=IVARN2(ICOL)
              IHARG(2)=IVARN1(ICOL)
              IHARG2(2)=IVARN2(ICOL)
              IF(ISPMTA.EQ.'ON')THEN
                IHARG(3)=IVARN1(NUMVAR+1)
                IHARG2(3)=IVARN2(NUMVAR+1)
              ENDIF
              IY1MIN='FLOA'
              IY1MAX='FLOA'
              IY2MIN='FLOA'
              IY2MAX='FLOA'
              IX1MIN='FLOA'
              IX1MAX='FLOA'
              IX2MIN='FLOA'
              IX2MAX='FLOA'
              GOTO4089
            ENDIF
            GOTO4000
          ENDIF 
C
          CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                   MAXNPP,ISEED,IBOOSS,
     1                   IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                   IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                   BARHEF,BARWEF,
     1                   IRHSTG,IHSTCW,
     1                   ICAPSW,IFORSW,
     1                   IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                   TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                   ISUBRO,IFOUND,IERROR)
          IF(IEMPTY.EQ.'NO')THEN
            IF(
     1       (IROW.NE.ICOL.AND.(ISPX2L.EQ.'CORR'.OR.ISPX2L.EQ.'PCOR'))
     1       .OR.ISPX2L.EQ.'PACC'.OR.
     1       ISPX2L.EQ.'NACC'.OR.ISPX2L.EQ.'ATP '.OR.
     1       ISPX2L.EQ.'AT  ')
     1       CALL DPSPM3(ICASPL,IOUNI5,
     1                   IROW,ICOL,
     1                   PX2LD2,NPLOTP,
     1                   IFORSW,
     1                   ISPX2L,ISPX2P,ISPX2S,
     1                   IHRIGH,IHRIG2,IHWUSE,
     1                   ISUBN1,ISUBN2,MESSAG,
     1                   IBUGG2,ISUBRO,IERROR)
          ENDIF
C
          IF(IERROR.EQ.'YES')THEN
            IMPCO=IMPCO+1
            GOTO4000
          ENDIF
C
 4089     CONTINUE
          ICONT=IDCONT(1)
          NUMHPP=IDNHPP(1)
          IMPARG=2
          CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IMPARG,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                MAXCOL,
     1                DSIZE,DSYMB,DCOLOR,DFILL,
     1                ICAPSW,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                IERROR)
          IF(IERROR.EQ.'NO')IAND1=IAND2
          IF(ISPMFI.EQ.'NONE')GOTO4090
          IF(IEMPTY.EQ.'YES')GOTO4090
          IF(IROW.EQ.ICOL)GOTO4090
          IMPCO=IMPCO-1
          IF(IMPCO.LE.1)IERASW='OFF'
          IF(IERROR.EQ.'YES')GOTO4000
C
          CALL DPSPM2(ICASPL,IVARN1,IVARN2,ICOLL,NUMVAR,NPLOTP,
     1                IROW,ICOL,ICHAP2,ILINP2,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ALOWFR,ALOWDG,
     1                IANGLU,MAXNPP,IAND1,IAND2,
     1                ISPMFI,ISPMTA,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IREPCH,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,
     1                ISUBRO,IFOUND,IERROR)
C
 4090     CONTINUE
          PX1LDS=PX1LD2
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
          PX1ZDS=PX1ZD2
          PX2ZDS=PX2ZD2
          PY1ZDS=PY1ZD2
          PY2ZDS=PY2ZD2
          IF(IEMPTY.EQ.'YES')THEN
            DO4907I=1,MAXSUB
              ISUBSW(I)=ISU2SW(I)
 4907       CONTINUE
          ENDIF
          DO4098I=1,100
            ICHAPA(I)=ICHAP2(I)
            ILINPA(I)=ILINP2(I)
            ISPISW(I)=ISPIS2(I)
            IBARSW(I)=IBARS2(I)
 4098     CONTINUE
          ISHIFT=NARGT-NUMARG
          IF(ISHIFT.GT.0)THEN
            CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ELSEIF(ISHIFT.LT.0)THEN
            ISHIFT=-ISHIFT
            CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ENDIF
          ICOM='PLOT'
          ICOM2='    '
          IHARG(1)=IVARN1(ICOL)
          IHARG2(1)=IVARN2(ICOL)
          IHARG(2)=IVARN1(ICOL)
          IHARG2(2)=IVARN2(ICOL)
          IF(ISPMTA.EQ.'ON')THEN
            IHARG(3)=IVARN1(NUMVAR+1)
            IHARG2(3)=IVARN2(NUMVAR+1)
          ENDIF
C
 4000   CONTINUE
 3000 CONTINUE
      GOTO8000
C
C               *********************************************
C               **   BIHISTOGRAM           CASE            **
C               **   QUANTILE-QUANTILE     CASE            **
C               **   CROSS-CORRELATION     CASE            **
C               **   CROSS-SPECTRUM        CASE            **
C               **   CROSS-LAG             CASE            **
C               **   FOLLOWING ALL USE A SIMILAR STRUCTURE **
C               *********************************************
 5000 CONTINUE
      NARGT=NUMARG
      DO5100IROW=1,IMPNR
        DO5200ITEMP1=1,IMPNC
C
          ICOL=ITEMP1
          IEMPTY='NO'
          IF(ISPMLA.EQ.'BOX')THEN
            ICOL=ITEMP1-1
            IF(ICOL.EQ.0)IEMPTY='YES'
            IF(IROW.EQ.IMPNR)IEMPTY='YES'
          ENDIF
C
          IF(IROW.GT.ICOL.AND.ISPMLD.EQ.'OFF')THEN
            IMPCO=IMPCO+1
            GOTO5200
          ENDIF
C
          IF(IROW.LE.NUMVAR)THEN
            IHARG(1)=IVARN1(IROW)
            IHARG2(1)=IVARN2(IROW)
            IDX=IROW
          ELSE
            IHARG(1)=IVARN1(NUMVAR)
            IHARG2(1)=IVARN2(NUMVAR)
            IDX=NUMVAR
          ENDIF
          IF(ICOL.EQ.0)THEN
            IHARG(2)=IVARN1(1)
            IHARG2(2)=IVARN2(1)
            IDY=1
          ELSE
            IHARG(2)=IVARN1(ICOL)
            IHARG2(2)=IVARN2(ICOL)
            IDY=ICOL
          ENDIF
C
          IF(IEMPTY.EQ.'YES')THEN
            DO5104I=1,MAXSUB
              ISU2SW(I)=ISUBSW(I)
              ISUBSW(I)='OFF'
 5104       CONTINUE
          ENDIF
          IOPTN=3
          CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1                ISUBNU,ISUBSW,
     1                ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1                ISUBN9,ISUBSZ,
     1                ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1                PSPLSL,PSPLSU,PSPLSL,PSPLSU,
     1                IBUGG2,ISUBRO,IERROR)
C
          ICASPL='SPMA'
          CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1                IMPNR,IMPNC,IROW,ICOL,IROW,ICOL,IPLOT,
     1                NPLOTS,NUMVAR,
     1                ICHAP2,ILINP2,
     1                GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1                GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1                IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1                IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                PX1LD2,PX2LD2,
     1                IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1                IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1                NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1                PSPLLL,PSPLUL,PSPLLL,PSPLUL,ICOL,
     1                ISPMLA,ISPMLD,IPLOTT,ISPMFR,ISPMXA,ISPMYA,
     1                ISPMDI,
     1                ISPMTD,PSPMTD,IVNMEX,
     1                IBUGG2,ISUBRO)
C
          IF(IEMPTY.EQ.'YES')THEN
            DO5106I=1,100
              ICHAPA(I)='BLAN'
              ILINPA(I)='BLAN'
              ISPISW(I)='OFF'
              IBARSW(I)='OFF'
 5106       CONTINUE
          ENDIF
          IF(IROW.EQ.ICOL)THEN
            ISHIFT=1
            CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                  IBUGG2,IERROR)
            ISHIFT=NCCOM2
            IF(NCCOM2.GT.0)
     1      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                  IBUGG2,IERROR)
            ICOM=ICBT
            ICOM2=IC2BT
            IF(NCCOM2.GT.0)THEN
              DO5120II=1,NCCOM2
                IHARG(II)=IHBT(II)
                IHARG2(II)=IH2BT(II)
 5120         CONTINUE
            ENDIF
          ELSE
            ISHIFT=NCCOMM
            IF(NCCOMM.GT.0)
     1      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                  IBUGG2,IERROR)
            ICOM=ICT
            ICOM2=IC2T
            IF(NCCOMM.GT.0)THEN
              DO5130II=1,NCCOMM
                IHARG(II)=IHT(II)
                IHARG2(II)=IH2T(II)
 5130         CONTINUE
            ENDIF
          ENDIF
          CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                MAXNPP,ISEED,IBOOSS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                BARHEF,BARWEF,
     1                IRHSTG,IHSTCW,
     1                ICAPSW,IFORSW,
     1                IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ISUBRO,IFOUND,IERROR)
          IF(IEMPTY.EQ.'NO')THEN
            IF(
     1         ISPX2L.EQ.'PACC'.OR.
     1         ISPX2L.EQ.'NACC'.OR.ISPX2L.EQ.'ATP '.OR.
     1         ISPX2L.EQ.'AT  ')
     1         CALL DPSPM3(ICASPL,IOUNI5,
     1                     IROW,ICOL,
     1                     PX2LD2,NPLOTP,
     1                     IFORSW,
     1                     ISPX2L,ISPX2P,ISPX2S,
     1                     IHRIGH,IHRIG2,IHWUSE,
     1                     ISUBN1,ISUBN2,MESSAG,
     1                     IBUGG2,ISUBRO,IERROR)
          ENDIF
C
          ISHIFT=NARGT-NUMARG
          IF(ISHIFT.GT.0)THEN
            CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ELSEIF(ISHIFT.LT.0)THEN
            ISHIFT=-ISHIFT
            CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ENDIF
          ICOM='PLOT'
          ICOM2='    '
          IHARG(1)=IVARN1(ICOL)
          IHARG2(1)=IVARN2(ICOL)
          IHARG(2)=IVARN1(ICOL)
          IHARG2(2)=IVARN2(ICOL)
C
C               **************************************************
C               **   STEP 25--                                  **
C               **   PLOT THE CURRENT PLOT                      **
C               **************************************************
 5190     CONTINUE
          ICONT=IDCONT(1)
          NUMHPP=IDNHPP(1)
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'SPMA')THEN
            WRITE(ICOUT,5107)IMANUF,NUMDEV,IDMANU(1)
 5107       FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IMPARG=2
          CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IMPARG,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                MAXCOL,
     1                DSIZE,DSYMB,DCOLOR,DFILL,
     1                ICAPSW,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                IERROR)
          IF(IERROR.EQ.'NO')IAND1=IAND2
          IF(IEMPTY.EQ.'YES')THEN
            DO5207I=1,MAXSUB
              ISUBSW(I)=ISU2SW(I)
 5207       CONTINUE
          ENDIF
          PX1LDS=PX1LD2
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
          PX1ZDS=PX1ZD2
          PX2ZDS=PX2ZD2
          PY1ZDS=PY1ZD2
          PY2ZDS=PY2ZD2
C
 5200   CONTINUE
 5100 CONTINUE
      GOTO8000
C
C               *********************************************
C               **   CROSS TABULATE <STAT> PLOTS  CASE     **
C               **   DEX <STAT> PLOTS             CASE     **
C               **   DEX <STAT> INTERACTION PLOTS CASE     **
C               **   3D-PLOT                PLOTS CASE     **
C               **   DEX CONTOUR            PLOTS CASE     **
C               **   ALL OF THESE USE SIMILAR STRUCTURE    **
C               *********************************************
C
 6599 CONTINUE
C
      IF(IRESP.EQ.1)THEN
        ISHIFT=1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IHARG(1)=IVARN1(1)
        IHARG2(1)=IVARN2(1)
        IMPNR=IMPNR-1
        IMPNC=IMPNC-1
      ENDIF
C
      IF(ISPMPT.EQ.'DEXC')THEN
        GY1MIN=-2.0
        GY1MAX=2.0
        GY2MIN=-2.0
        GY2MAX=2.0
        IY1MIN='FIXE'
        IY1MAX='FIXE'
        IY2MIN='FIXE'
        IY2MAX='FIXE'
        GX1MIN=-2.0
        GX1MAX=2.0
        GX2MIN=-2.0
        GX2MAX=2.0
        IX1MIN='FIXE'
        IX1MAX='FIXE'
        IX2MIN='FIXE'
        IX2MAX='FIXE'
        ISHIFT=1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IHARG(4)=IVARN1(NUMVAR+1)
        IHARG2(4)=IVARN2(NUMVAR+1)
        IF(IERROR.EQ.'YES')GOTO9000
      ENDIF
C
      NARGT=NUMARG
C
      NPLOTS=IMPNR
      NPLOT2=IMPNR*IMPNC
      DO6600IROW=1,NPLOTS
        DO6700ITEMP1=1,NPLOTS
C
          ICOL=ITEMP1
          IFACT=ICOL+IRESP
          IEMPTY='NO'
          IF(ISPMLA.EQ.'BOX')THEN
            ICOL=ITEMP1-1
            IF(ICOL.EQ.0)IEMPTY='YES'
            IF(IROW.EQ.IMPNR)IEMPTY='YES'
          ENDIF
C
          IF(IROW.EQ.ICOL.AND.ISPMPT.NE.'DEXC')THEN
            ISHIFT=1
            CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                  IBUGG2,IERROR)
          ENDIF
C
          IFRST=0
          IF(IRESP.EQ.1)THEN
            IHARG(1)=IVARN1(1)
            IHARG2(1)=IVARN2(1)
            IFRST=1
          ENDIF
C
          IRES=IROW+IRESP
          IFRST=IFRST+1
          IF(IRES.LE.NUMVAR)THEN
            IHARG(IFRST)=IVARN1(IRES)
            IHARG2(IFRST)=IVARN2(IRES)
          ELSE
            IHARG(IFRST)=IVARN1(NUMVAR)
            IHARG2(IFRST)=IVARN2(NUMVAR)
          ENDIF
C
          IF(IROW.GT.ICOL.AND.ISPMLD.EQ.'OFF')THEN
            IMPCO=IMPCO+1
            GOTO6700
          ENDIF
C
          IF(IROW.NE.ICOL.OR.ISPMPT.EQ.'DEXC')THEN
            IFRST=IFRST+1
            IF(ICOL.EQ.0)THEN
              IHARG(IFRST)=IVARN1(2)
              IHARG2(IFRST)=IVARN2(2)
            ELSE
              IHARG(IFRST)=IVARN1(IFACT)
              IHARG2(IFRST)=IVARN2(IFACT)
            ENDIF
          ENDIF
C
          IF(ISPMPT.EQ.'DEXC')THEN
            IFRST=IFRST+1
            IHARG(IFRST)=IVARN1(NUMVAR+1)
            IHARG2(IFRST)=IVARN2(NUMVAR+1)
          ENDIF
C
          IF(ISPMPT.EQ.'DEXC'.AND.IROW.EQ.ICOL)IEMPTY='YES'
          IF(IEMPTY.EQ.'YES')THEN
            DO6604I=1,MAXSUB
              ISU2SW(I)=ISUBSW(I)
              ISUBSW(I)='OFF'
 6604       CONTINUE
          ENDIF
          IOPTN=3
          IDY=1
          IDX=2
          CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1                ISUBNU,ISUBSW,
     1                ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1                ISUBN9,ISUBSZ,
     1                ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1                PSPLSL,PSPLSU,PSPLSL,PSPLSU,
     1                IBUGG2,ISUBRO,IERROR)
C
          CALL DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1                IMPNR,IMPNC,IROW,ICOL,IRES,IFACT,IPLOT,
     1                NPLOT2,NUMVAR,
     1                ICHAP2,ILINP2,
     1                GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1                GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1                IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1                IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                PX1LD2,PX2LD2,
     1                IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1                IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1                NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1                PSPLLL,PSPLUL,PSPLLL,PSPLUL,ICOL,
     1                ISPMLA,ISPMLD,IPLOTT,ISPMFR,ISPMXA,ISPMYA,
     1                ISPMDI,
     1                ISPMTD,PSPMTD,IVNMEX,
     1                IBUGG2,ISUBRO)
C
          IF(IEMPTY.EQ.'YES')THEN
            DO6606I=1,100
              ICHAPA(I)='BLAN'
              ILINPA(I)='BLAN'
              ISPISW(I)='OFF'
              IBARSW(I)='OFF'
 6606        CONTINUE
          ENDIF
          IF(IROW.EQ.ICOL.AND.ISPMPT.EQ.'CROS'.AND.ISPMST.EQ.'    ')
     1    THEN
            ILINPA(1)='BLAN'
            ICHAPA(1)='BLAN'
            ISPISW(1)='OFF'
            IBARSW(1)='OFF'
          ENDIF
          IF(IROW.EQ.ICOL)THEN
            ISHIFT=NCCOM2
            IF(NCCOM2.GT.0)
     1      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                  IBUGG2,IERROR)
            ICOM=ICBT
            ICOM2=IC2BT
            IF(NCCOM2.GT.0)THEN
              DO6620II=1,NCCOM2
                IHARG(II)=IHBT(II)
                IHARG2(II)=IH2BT(II)
 6620         CONTINUE
            ENDIF
          ELSE
            ISHIFT=NCCOMM
            IF(NCCOMM.GT.0)
     1      CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                  IBUGG2,IERROR)
            ICOM=ICT
            ICOM2=IC2T
            IF(NCCOMM.GT.0)THEN
              DO6630II=1,NCCOMM
                IHARG(II)=IHT(II)
                IHARG2(II)=IH2T(II)
 6630         CONTINUE
            ENDIF
          ENDIF
          IF(IEMPTY.EQ.'YES'.AND.ISPMPT.EQ.'DEXC')THEN
            ISHIFT=NUMARG-2
            IF(ISHIFT.GT.0)THEN
              CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                    IBUGG2,IERROR)
            ENDIF
            ICOM='PLOT'
            ICOM2='    '
            IHARG(1)=IVARN1(IRES)
            IHARG2(1)=IVARN2(IRES)
            IHARG(2)=IVARN1(IFACT)
            IHARG2(2)=IVARN2(IFACT)
          ENDIF
          CALL MAINGR(ANOPL1,ANOPL2,NPLOTV,NPLOTP,NS,ICASPL,
     1                MAXNPP,ISEED,IBOOSS,
     1                IX1TSV,IX2TSV,IY1TSV,IY2TSV,
     1                IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1                BARHEF,BARWEF,
     1                IRHSTG,IHSTCW,
     1                ICAPSW,IFORSW,
     1                IAND1,IAND2,ICONT,NUMHPP,NUMVPP,
     1                TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1                ISUBRO,IFOUND,IERROR)
          IF(IEMPTY.EQ.'NO')THEN
            CALL DPSPM3(ICASPL,IOUNI5,
     1                  IROW,ICOL,
     1                  PX2LD2,NPLOTP,
     1                  IFORSW,
     1                  ISPX2L,ISPX2P,ISPX2S,
     1                  IHRIGH,IHRIG2,IHWUSE,
     1                  ISUBN1,ISUBN2,MESSAG,
     1                  IBUGG2,ISUBRO,IERROR)
          ENDIF
C
          ISHIFT=NARGT-NUMARG
          IF(ISHIFT.GT.0)THEN
            CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ELSEIF(ISHIFT.LT.0)THEN
            ISHIFT=-ISHIFT
            CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGG2,IERROR)
          ENDIF
          IF(IERROR.EQ.'YES')GOTO6699
          ICOM='PLOT'
          ICOM2='    '
          IF(IRESP.EQ.0)THEN
            IHARG(1)=IVARN1(ICOL)
            IHARG2(1)=IVARN2(ICOL)
            IHARG(2)=IVARN1(ICOL)
            IHARG2(2)=IVARN2(ICOL)
          ELSE
            IHARG(1)=IVARN1(1)
            IHARG2(1)=IVARN2(1)
            IHARG(2)=IVARN1(ICOL)
            IHARG2(2)=IVARN2(ICOL)
            IHARG(3)=IVARN1(ICOL)
            IHARG2(3)=IVARN2(ICOL)
          ENDIF
          IF(ISPMPT.EQ.'DEXC')THEN
            IHARG(4)=IVARN1(NUMVAR+1)
            IHARG2(4)=IVARN2(NUMVAR+1)
          ENDIF
          GOTO6690
C
 6690     CONTINUE
          ICONT=IDCONT(1)
          NUMHPP=IDNHPP(1)
          IMPARG=2
          CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IMPARG,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                MAXCOL,
     1                DSIZE,DSYMB,DCOLOR,DFILL,
     1                ICAPSW,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                IERROR)
 6699     CONTINUE
          IF(IERROR.EQ.'NO')IAND1=IAND2
          IF(IEMPTY.EQ.'YES')THEN
            DO6207I=1,MAXSUB
              ISUBSW(I)=ISU2SW(I)
 6207       CONTINUE
          ENDIF
          PX1LDS=PX1LD2
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
          PX1ZDS=PX1ZD2
          PX2ZDS=PX2ZD2
          PY1ZDS=PY1ZD2
          PY2ZDS=PY2ZD2
C
 6700   CONTINUE
 6600 CONTINUE
      GOTO8000
C
C               **************************************************
C               **   STEP 25--                                  **
C               **   PLOT THE CURRENT PLOT                      **
C               **************************************************
 7890     CONTINUE
          ICONT=IDCONT(1)
          NUMHPP=IDNHPP(1)
          IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'SPMA')THEN
            WRITE(ICOUT,7907)IMANUF,NUMDEV,IDMANU(1)
 7907       FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
            CALL DPWRST('XXX','BUG ')
          ENDIF
          IMPARG=2
          CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1                XMATN,YMATN,XMITN,YMITN,
     1                ISQUAR,
     1                IVGMSW,IHGMSW,
     1                IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1                IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1                YPLOT,XPLOT,X2PLOT,TAGPLO,
     1                IMPSW,IMPNR,IMPNC,IMPCO,
     1                IMPARG,
     1                PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1                MAXCOL,
     1                DSIZE,DSYMB,DCOLOR,DFILL,
     1                ICAPSW,
     1                IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1                IERROR)
          IF(IERROR.EQ.'NO')IAND1=IAND2
          IF(IERROR.EQ.'YES')GOTO7900
          PX1LDS=PX1LD2
          GX1MIN=GX1MNS
          GX1MAX=GX1MXS
          GX2MIN=GX2MNS
          GX2MAX=GX2MXS
          GY1MIN=GY1MNS
          GY1MAX=GY1MXS
          GY2MIN=GY2MNS
          GY2MAX=GY2MXS
          IX1MIN=IX1MNS
          IX1MAX=IX1MXS
          IX2MIN=IX2MNS
          IX2MAX=IX2MXS
          IY1MIN=IY1MNS
          IY1MAX=IY1MXS
          IY2MIN=IY2MNS
          IY2MAX=IY2MXS
          PX1ZDS=PX1ZD2
          PX2ZDS=PX2ZD2
          PY1ZDS=PY1ZD2
          PY2ZDS=PY2ZD2
C
 7900   CONTINUE
 7800 CONTINUE
      ISPMFR=ISPMFZ
      GOTO8000
C
C
C               **************************************************
C               **   STEP 28--                                  **
C               **   REINSTATE INITIAL SETTINGS                 **
C               **************************************************
C
 8000 CONTINUE
 2800 CONTINUE
      ISTEPN='28'
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'4PLO')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
      IF(IBUGG3.EQ.'ON')WRITE(ICOUT,8807)IMANUF,NUMDEV,IDMANU(1)
 8807 FORMAT('IMANUF,NUMDEV,IDMANU(1) = ',A4,I8,2X,A4)
      IF(IBUGG3.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      PWXMIN=PWXMN2
      PWXMAX=PWXMX2
      PWYMIN=PWYMN2
      PWYMAX=PWYMX2
      PXMIN=PXMN2
      PXMAX=PXMX2
      PYMIN=PYMN2
      PYMAX=PYMX2
      GX1MIN=GX1MNS
      GX1MAX=GX1MXS
      GX2MIN=GX2MNS
      GX2MAX=GX2MXS
      GY1MIN=GY1MNS
      GY1MAX=GY1MXS
      GY2MIN=GY2MNS
      GY2MAX=GY2MXS
      IX1MIN=IX1MNS
      IX1MAX=IX1MXS
      IX2MIN=IX2MNS
      IX2MAX=IX2MXS
      IY1MIN=IY1MNS
      IY1MAX=IY1MXS
      IY2MIN=IY2MNS
      IY2MAX=IY2MXS
      IX1TSW=IX1TSV
      IX2TSW=IX2TSV
      IY1TSW=IY1TSV
      IY2TSW=IY2TSV
      IX1ZSW=IX1ZSV
      IX2ZSW=IX2ZSV
      IY1ZSW=IY1ZSV
      IY2ZSW=IY2ZSV
      PX1LDS=PX1LD2
      PX2LDS=PX2LD2
      PY1LDS=PY1LD2
      PY1LAN=PY1LA2
      IY1LJU=IY1LJ2
      IY1LDI=IY1LD2
      PX1ZDS=PX1ZD2
      PX2ZDS=PX2ZD2
      PY1ZDS=PY1ZD2
      PY2ZDS=PY2ZD2
C
      DO8820I=1,100
        ICHAPA(I)=ICHAP2(I)
        ILINPA(I)=ILINP2(I)
        IBARSW(I)=IBARS2(I)
        ISPISW(I)=ISPIS2(I)
 8820 CONTINUE
C
CCCCC IMPSW=IMPSW3
      IMPSW='OFF'
      IMPCO=1
      IMPNR=IMPNR2
      IMPNC=IMPNC2
C
      IERASW=IERAS2
      IFENSW=IFENC2
      ISORSW=ISORS2
      IPPTBI=IPPTB2
C
      DO3500I=1,MAXCH
        IX1LTE(I)=IX1LT2(I)
        IX2LTE(I)=IX2LT2(I)
        IY1LTE(I)=IY1LT2(I)
        IY2LTE(I)=IY2LT2(I)
 3500 CONTINUE
      NCX1LA=NCX1L2
      NCY1LA=NCY1L2
      NCY2LA=NCY2L2
C
      ISPMTA=ISPMTZ
      ISPMFR=ISPMFZ
      ISPMPT=ISPMPZ
      ISPMLD=ISPMLZ
      ISPMLA=ISPML2
      ISPMXA=ISPMXZ
      ISPMYA=ISPMYZ
      ISPMDI=ISPMDZ
      ISPMST=ISPMZT
      ISPMS2=ISPMZ2
      ISPMS3=ISPMZ3
      ISPMS4=ISPMZ4
C
      IOPTN=2
      IDX=0
      IDY=0
      CALL DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1ISUBNU,
     1ISUBSW,
     1ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1ISUBN9,
     1ISUBSZ,
     1ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1PSPLSL,PSPLSU,PSPLSL,PSPLSU,
     1IBUGG2,ISUBRO,IERROR)
C
      IFEEDB=IFEED9
C
      IENDF5='OFF'
      IREWI5='ON'
      IF(IOUNI5.GT.0)
     1CALL DPCLFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IENDF5,IREWI5,ISUBN0,IERRF5,IBUGG3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
      IF(IERROR.EQ.'YES')GOTO9000
      GOTO9000
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 DPSPMA--')
      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)NUMARG
 9014 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMARG.LE.0)GOTO9029
      DO9021I=1,NUMARG
      WRITE(ICOUT,9022)I,IHARG(I),IARGT(I)
 9022 FORMAT('I,IHARG(I),IARGT(I) = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9029 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPM1(ICASPL,IVARN1,IVARN2,ICOLL,
     1IMPNR,IMPNC,IROW,ICOL,IRES,IFACT,IPLOT,NPLOTS,NUMVAR,
     1ICHAP2,ILINP2,
     1GY1MNS,GY1MXS,GY2MNS,GY2MXS,
     1GX1MNS,GX1MXS,GX2MNS,GX2MXS,
     1IY1MNS,IY1MXS,IY2MNS,IY2MXS,
     1IX1MNS,IX1MXS,IX2MNS,IX2MXS,
     1IX1TSV,IX2TSV,IY1TSV,IY2TSV,IX1ZSV,IX2ZSV,IY1ZSV,IY2ZSV,
     1PX1LD2,PX2LD2,
     1IY1LJ2,IY1LD2,PY1LD2,PY1LA2,
     1IX1LT2,IX2LT2,IY1LT2,IY2LT2,
     1NCX1L2,NCX2L2,NCY1L2,NCY2L2,
     1PSPXLL,PSPXUL,PSPYLL,PSPYUL,IXLIST,
     1ISPMLA,ISPMLD,ISPMPT,ISPMFR,ISPMXA,ISPMYA,ISPMDI,
     1ISPMTD,PSPMTD,IVNMEX,
     1IBUGG2,ISUBRO)
C
C     PURPOSE--UTILTY ROUTINE FOR SCATTER PLOT MATRIX.  GENERATE
C              TIC MARKS, TIC MARK LABELS, AXIS LABELS.  ALSO
C              USED BY FACTOR AND CONDITIONING PLOTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/11
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--NOVEMBER 1999.
C     UPDATED       --JUNE       2002.  UPDATES FOR PARTIAL REGRESSION
C     UPDATED       --JUNE       2002.  UPDATES FOR PARTIAL RESIDUAL
C     UPDATED       --JUNE       2002.  UPDATES FOR PARTIAL LEVERAGE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG2
C
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 ISPMLA
      CHARACTER*4 ISPMLD
      CHARACTER*4 ISPMPT
      CHARACTER*4 ISPMFR
      CHARACTER*4 ISPMXA
      CHARACTER*4 ISPMYA
      CHARACTER*4 ISPMDI
      CHARACTER*4 ISPMTD
      CHARACTER*4 IVNMEX
C
      CHARACTER*105 IXT
      CHARACTER*52 IX2T
      CHARACTER*52 IY1T
      CHARACTER*4 IXLABT(52)
      CHARACTER*4 IXLAB2(52)
      CHARACTER*4 IYLABT(52)
C
      CHARACTER*4 ICHAP2(100)
      CHARACTER*4 ILINP2(100)
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IY1LJ2
      CHARACTER*4 IY1LD2
      CHARACTER*4 IX1MNS
      CHARACTER*4 IX1MXS
      CHARACTER*4 IX2MNS
      CHARACTER*4 IX2MXS
      CHARACTER*4 IX1TSV
      CHARACTER*4 IX2TSV
      CHARACTER*4 IY1TSV
      CHARACTER*4 IY2TSV
      CHARACTER*4 IX1ZSV
      CHARACTER*4 IX2ZSV
      CHARACTER*4 IY1ZSV
      CHARACTER*4 IY2ZSV
      CHARACTER*4 IX1LT2(*)
      CHARACTER*4 IX2LT2(*)
      CHARACTER*4 IY1LT2(*)
      CHARACTER*4 IY2LT2(*)
C
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      DIMENSION ICOLL(*)
      DIMENSION IVARN1(*)
      DIMENSION IVARN2(*)
      DIMENSION PSPXLL(*)
      DIMENSION PSPXUL(*)
      DIMENSION PSPYLL(*)
      DIMENSION PSPYUL(*)
C
C-----COMMON------------------------------------------------------
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-------------------------------------------------
C
CCCCC IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SPM1')THEN
CCCCC ENDIF
C               ***************************************
C               **  STEP 1--                         **
C               **  TURN EVERYTHING OFF IF DATAPLOT  **
C               **  DETERMINES AXIS APPEARANCE AND   **
C               **  RESET DEFAULTS WHERE APPROPRIATE **
C               ***************************************
C
C
      DO10I=1,52
        IXLABT(I)=' '
        IXLAB2(I)=' '
        IYLABT(I)=' '
   10 CONTINUE
      DO15I=1,MAXCH
        IX1LTE(I)=IX1LT2(I)
        IX2LTE(I)=IX2LT2(I)
        IY1LTE(I)=IY1LT2(I)
        IY2LTE(I)=IY2LT2(I)
   15 CONTINUE
      IXT=' '
      IX2T=' '
      IY1T=' '
      NCX1LA=NCX1L2
      NCX2LA=NCX2L2
      NCY1LA=NCY1L2
      NCY2LA=NCY2L2
C
      IF(ISPMFR.EQ.'DEFA')THEN
        IX1TSW='OFF'
        IX1ZSW='OFF'
        IX2TSW='OFF'
        IX2ZSW='OFF'
        IY1TSW='OFF'
        IY1ZSW='OFF'
        IY2TSW='OFF'
        IY2ZSW='OFF'
        DO105I=1,MAXCH
          IX1LTE(I)='    '
          IX2LTE(I)='    '
          IY1LTE(I)='    '
          IY2LTE(I)='    '
  105   CONTINUE
        NCX1LA=0
        NCY1LA=0
        NCY2LA=0
        PX1LDS=PX1LD2
        PY1LDS=PY1LD2
        PY1LAN=PY1LA2
        IY1LJU=IY1LJ2
        IY1LDI=IY1LD2
      ELSE
        IX1TSW=IX1TSV
        IX1ZSW=IX1ZSV
        IX2TSW=IX2TSV
        IX2ZSW=IX2ZSV
        IY1TSW=IY1TSV
        IY1ZSW=IY1ZSV
        IY2TSW=IY2TSV
        IY2ZSW=IY2ZSV
      ENDIF
C
      DO110I=1,100
        ICHAPA(I)=ICHAP2(I)
        ILINPA(I)=ILINP2(I)
  110 CONTINUE
C
C               ***************************************
C               **  STEP 2--                         **
C               **  DETERMINE Y AXIS LIMITS (I.E.,   **
C               **  DEFAULT OR USER SPECIFIED)       **
C               ***************************************
C
      IF(IRES.GT.0)THEN
        YLOWL=PSPYLL(IRES)
        YUPPL=PSPYUL(IRES)
      ELSE
        YLOWL=CPUMIN
        YUPPL=CPUMIN
      ENDIF
      IF(IXLIST.GT.0)THEN
        XLOWL=PSPXLL(IXLIST)
        XUPPL=PSPXUL(IXLIST)
      ELSE
        XLOWL=CPUMIN
        XUPPL=CPUMIN
      ENDIF
      IF(YLOWL.NE.CPUMIN.AND.YUPPL.NE.CPUMIN)THEN
        GY1MIN=YLOWL
        GY1MAX=YUPPL
        GY2MIN=YLOWL
        GY2MAX=YUPPL
        IY1MIN='FIXE'
        IY1MAX='FIXE'
        IY2MIN='FIXE'
        IY2MAX='FIXE'
      ELSE
        IF(IY1MIN.NE.'FIXE')GY1MIN=GY1MNS
        IF(IY2MIN.NE.'FIXE')GY2MIN=GY2MNS
        IF(IY1MAX.NE.'FIXE')GY1MAX=GY1MXS
        IF(IY2MAX.NE.'FIXE')GY2MAX=GY2MXS
      ENDIF
C
C               ***************************************
C               **  STEP 3--                         **
C               **  DETERMINE X AXIS LIMITS (I.E.,   **
C               **  DEFAULT OR USER SPECIFIED)       **
C               ***************************************
C
      IF(XLOWL.NE.CPUMIN.AND.XUPPL.NE.CPUMIN)THEN
        GX1MIN=XLOWL
        GX1MAX=XUPPL
        GX2MIN=XLOWL
        GX2MAX=XUPPL
        IX1MIN='FIXE'
        IX1MAX='FIXE'
        IX2MIN='FIXE'
        IX2MAX='FIXE'
      ELSE
        IF(IX1MIN.NE.'FIXE')GX1MIN=GX1MNS
        IF(IX2MIN.NE.'FIXE')GX2MIN=GX2MNS
        IF(IX1MAX.NE.'FIXE')GX1MAX=GX1MXS
        IF(IX2MAX.NE.'FIXE')GX2MAX=GX2MXS
      ENDIF
C
C               ***************************************
C               **  STEP 4--                         **
C               **  DETERMINE TEXT FOR X AND Y AXIS  **
C               **  LABELS.  DO ONCE HERE TO SIMPLIFY**
C               **  CODE BELOW.                      **
C               ***************************************
C
      IF(ISPMLA.EQ.'OFF')GOTO9000
C
      IF(ISPMPT.EQ.'PLOT'.OR.ISPMPT.EQ.'QQSP'.OR.ISPMPT.EQ.'CROS')THEN
        IXT=' '
        NX1=-1
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=0
        IY1T=' '
        NY1=-1
      ELSEIF(ISPMPT.EQ.'PREG')THEN
        IXT=' '
        IXT='Res: '
        NX1=5
        NX1=NX1+1
        IXT(NX1:NX1+3)=IVARN1(IPLOT+1)(1:4)
        IXT(NX1+4:NX1+7)=IVARN2(IPLOT+1)(1:4)
        DO140I=NX1+7,NX1,-1
          NXTEMP=I
          IF(IXT(I:I).NE.'    ')GOTO145
  140   CONTINUE
  145   CONTINUE
        NX1=NXTEMP
        NX1=NX1+1
        NXTEMP=NX1+14
        IXT(NX1:NXTEMP)=' versus other X'
        NX1=NXTEMP
C
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=0
C
        NY1=5
        IY1T(1:NY1)='Res: '
        NY1=NY1+1
        IY1T(NY1:NY1+3)=IVARN1(IPLOT+1)(1:4)
        IY1T(NY1+4:NY1+7)=IVARN2(IPLOT+1)(1:4)
        DO130I=NY1+7,NY1,-1
          NYTEMP=I
          IF(IY1T(I:I).NE.'    ')GOTO135
  130   CONTINUE
  135   CONTINUE
        NY1=NYTEMP
        NY1=NY1+1
        NYTEMP=NY1+7
        IY1T(NY1:NYTEMP)=' Removed'
        NY1=NYTEMP
      ELSEIF(ISPMPT.EQ.'PLEV')THEN
        IXT=' '
        NX1=5
        IXT(1:NX1)='Index'
C
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=0
C
        IY1T=' '
        IY1T='Partial Leverage: '
        NY1=18
        NY1=NY1+1
        IY1T(NY1:NY1+3)=IVARN1(IPLOT+1)(1:4)
        IY1T(NY1+4:NY1+7)=IVARN2(IPLOT+1)(1:4)
        DO170I=NY1+7,NY1,-1
          NYTEMP=I
          IF(IY1T(I:I).NE.'    ')GOTO175
  170   CONTINUE
  175   CONTINUE
        NY1=NYTEMP
      ELSEIF(ISPMPT.EQ.'PRES'.OR.ISPMPT.EQ.'CCPR')THEN
        NX1=1
        IXT(NX1:NX1+3)=IVARN1(IPLOT+1)(1:4)
        IXT(NX1+4:NX1+7)=IVARN2(IPLOT+1)(1:4)
        DO150I=NX1+7,NX1,-1
          NXTEMP=I
          IF(IXT(I:I).NE.'    ')GOTO155
  150   CONTINUE
  155   CONTINUE
        NX1=NXTEMP
C
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=0
C
        IY1T=' '
        IY1T='Residuals + A'
        NY1=13
        IF(IPLOT.LE.9)THEN
          NY1=NY1+1
          WRITE(IY1T(NY1:NY1),'(I1)')IPLOT
        ELSE
          NY1=NY1+1
          NYTEMP=NY1+1
          WRITE(IY1T(NY1:NYTEMP),'(I2)')IPLOT
          NY1=NYTEMP
        ENDIF
        NY1=NY1+1
        IY1T(NY1:NY1)='*'
        NY1=NY1+1
        IY1T(NY1:NY1+3)=IVARN1(IPLOT+1)(1:4)
        IY1T(NY1+4:NY1+7)=IVARN2(IPLOT+1)(1:4)
        DO160I=NY1+7,NY1,-1
          NYTEMP=I
          IF(IY1T(I:I).NE.'    ')GOTO165
  160   CONTINUE
  165   CONTINUE
        NY1=NYTEMP
      ELSEIF(ISPMPT.EQ.'DEXS'.OR.ISPMPT.EQ.'DEXI'.OR.
     1       ISPMPT.EQ.'CRO2')THEN
        IXT=' '
        NX1=-2
        IX1DS=-1
        IX2T=' '
        NX2=0
        IX2DS=0
        IY1T=' '
        NY1=-1
      ELSEIF(ISPMPT.EQ.'DEXC')THEN
        IXT=' '
        NX1=-2
        IX1DS=-1
        IX2T=' '
        NX2=0
        IX2DS=0
        IY1T=' '
        NY1=0
      ELSEIF(ISPMPT.EQ.'BIHI')THEN
        IXT=' '
        NX1=-1
        IX1DS=-1
        IX2T=' '
        NX2=-1
        IX2DS=-2
        IY1T='Frequency'
        NY1=9
      ELSEIF(ISPMPT.EQ.'CCOR')THEN
        IXT='Lag'
        NX1=3
        IX1DS=1
        IX2T=' '
        NX2=-2
        IX2DS=-1
        IY1T='Correlation'
        NY1=11
      ELSEIF(ISPMPT.EQ.'CSPE')THEN
        IXT='Frequency'
        NX1=9
        IX1DS=1
        IX2T=' '
        NX2=-2
        IX2DS=-1
        IY1T='Power'
        NY1=5
      ELSEIF(ISPMPT.EQ.'CLAG')THEN
        IXT='I+1'
        NX1=3
        IX1DS=1
        IX2T=' '
        NX2=-2
        IX2DS=-1
        IY1T='I'
        NY1=1
      ELSEIF(ISPMPT.EQ.'FPLO'.OR.ISPMPT.EQ.'QQFP'.OR.
     1       ISPMPT.EQ.'STAT')THEN
        IXT=' '
        NX1=-1
        IX1DS=-1
        IX2T=' '
        NX2=0
        IX2DS=0
        IY1T=' '
        NY1=-1
      ELSEIF(ISPMPT.EQ.'BOXC')THEN
        IXT='Alpha'
        NX1=5
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T='Correlation'
        NY1=11
      ELSEIF(ISPMPT.EQ.'CBXC')THEN
        IXT='Alpha'
        NX1=5
        IX1DS=1
        IX2T=' '
        NX2=-2
        IX2DS=-1
        IY1T='Correlation'
        NY1=11
      ELSEIF(ISPMPT.EQ.'HIST')THEN
        IXT=' '
        NX1=-1
        IX1DS=-1
        IX2T=' '
        NX2=0
        IX2DS=-1
        IY1T='Frequency'
        NY1=9
      ELSEIF(ISPMPT.EQ.'CDEN')THEN
        IXT=' '
        NX1=-1
        IX1DS=-1
        IX2T=' '
        NX2=0
        IX2DS=-1
        IY1T='Density'
        NY1=7
      ELSEIF(ISPMPT.EQ.'RUNS')THEN
        IXT='Sequence'
        NX1=8
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T=' '
        NY1=0
      ELSEIF(ISPMPT.EQ.'LAG ')THEN
        IXT='I+1'
        NX1=3
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=-1
        IY1T='I'
        NY1=1
      ELSEIF(ISPMPT.EQ.'PERC')THEN
        IXT='Percentile'
        NX1=10
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T=' '
        NY1=0
      ELSEIF(ISPMPT.EQ.'CPER')THEN
        IXT='Percentile'
        NX1=10
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=-1
        IY1T=' '
        NY1=-1
      ELSEIF(ISPMPT.EQ.'AUTO')THEN
        IXT='Lag'
        NX1=3
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T='Frequency'
        NY1=9
      ELSEIF(ISPMPT.EQ.'SPEC')THEN
        IXT='Frequency'
        NX1=9
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T='Power'
        NY1=5
      ELSEIF(ISPMPT.EQ.'PROB')THEN
        IXT='Theoretical'
        NX1=11
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T='Data'
        NY1=4
      ELSEIF(ISPMPT.EQ.'PPCC')THEN
        IXT='Parameter'
        NX1=9
        IX1DS=1
        IX2T=' '
        NX2=-1
        IX2DS=-1
        IY1T='Correlation'
        NY1=11
      ELSE
        IXT=' '
        NX1=-1
        IX1DS=1
        IX2T=' '
        NX2=0
        IX2DS=0
        IY1T=' '
      ENDIF
C
C  X1LABEL
C
C  1) IF NX1 > 0, USE USER SPECIFIED LABEL IF ALREADY DEFINED,
C     OTHERWISE, DEFAULT TO A DATAPLOT SPECIFIED LABEL.
C  2) IF NX1 = 0, USE USER SPECIFIED LABEL IF ALREADY DEFINED,
C     BUT NO DEFAULT PROVIDED.
C  3) IF NX1 = -1, USE VARIABLE NAME (AND SUBSTITUTE VARIABLE
C     LABEL IF PROVIDED).
C  4) IF NX1 = -2, USE: VARIABLE1 * VARIABLE2 (AND SUBSTITUTE
C     VARIABLE LABEL IF PROVIDED).
C
      IF(ICOL.EQ.0)THEN
        NCXLA=0
        GOTO299
      ENDIF
C
      IF(NX1.GE.0)THEN
        IF(NCX1L2.GT.0)THEN
          DO210I=1,NCX1L2
            IXLABT(I)=IX1LT2(I)
  210     CONTINUE
          NCXLA=NCX1L2
        ELSE
          NCXLA=0
          IF(NX1.GT.0)THEN
            DO220I=1,NX1
              IXLABT(I)(1:1)=IXT(I:I)
  220       CONTINUE
            NCXLA=NX1
          ENDIF
        ENDIF
      ELSEIF(NX1.LT.0)THEN
        ITEMP=IFACT
        IF(NX1.EQ.-2 .OR. NX2.EQ.-2)ITEMP=IRES
        IF(ISPMPT.EQ.'BIHI')ITEMP=IRES
        ICOLID=ICOLL(ITEMP)
        IF(IVARLB(ICOLID).EQ.' '.OR.IVNMEX.EQ.'OFF')THEN
          DO230I=1,4
            IXLABT(I)=IVARN1(ITEMP)(I:I)
            IXLABT(I+4)=IVARN2(ITEMP)(I:I)
  230     CONTINUE
          NCXLA=8
          DO240I=8,1,-1
            NCXLA=I
            IF(IXLABT(I).NE.'    ')GOTO245
  240     CONTINUE
  245     CONTINUE
        ELSE
          ILAST=40
          DO250I=40,1,-1
            IF(IVARLB(ICOLID)(I:I).NE.' ')THEN
              ILAST=I
              GOTO259
            ENDIF
  250     CONTINUE
  259     CONTINUE
          DO270I=1,ILAST
            IXLABT(I)(1:1)=IVARLB(ICOLID)(I:I)
  270     CONTINUE
          NCXLA=ILAST
        ENDIF
        IF(NX1.EQ.-1 .OR. IRES.EQ.IFACT)GOTO299
        NCXLA=NCXLA+1
        IXLABT(NCXLA)='*'
        ITEMP=IFACT
        ICOLID=ICOLL(ITEMP)
        IF(IVARLB(ICOLID).EQ.' ')THEN
          DO280I=1,4
            IXLABT(NCXLA+I)=IVARN1(ITEMP)(I:I)
            IXLABT(NCXLA+I+4)=IVARN2(ITEMP)(I:I)
  280     CONTINUE
          ILAST=NCXLA+8
          DO285I=ILAST,1,-1
            NCXLA=I
            IF(IXLABT(I).NE.'    ')GOTO288
  285     CONTINUE
  288     CONTINUE
        ELSE
          ILAST=40
          DO290I=40,1,-1
            IF(IVARLB(ICOLID)(I:I).NE.' ')THEN
              ILAST=I
              GOTO293
            ENDIF
  290     CONTINUE
  293     CONTINUE
          DO295I=1,ILAST
            NCXLA=NCXLA+1
            IXLABT(NCXLA)(1:1)=IVARLB(ICOLID)(I:I)
  295     CONTINUE
        ENDIF
      ENDIF
  299 CONTINUE
C
C  X2LABEL
C
C  1) IF NX2 > 0, USE USER SPECIFIED LABEL IF ALREADY DEFINED,
C     OTHERWISE, DEFAULT TO A DATAPLOT SPECIFIED LABEL.
C  2) IF NX2 = 0, USE USER SPECIFIED LABEL IF ALREADY DEFINED,
C     BUT NO DEFAULT PROVIDED.
C  3) IF NX2 = -1, USE VARIABLE NAME (AND SUBSTITUTE VARIABLE
C     LABEL IF PROVIDED).
C  4) IF NX2 = -2, USE: VARIABLE1 * VARIABLE2 (AND SUBSTITUTE
C     VARIABLE LABEL IF PROVIDED).
C
      IF(ICOL.EQ.0)THEN
        NCXLA2=0
        GOTO399
      ENDIF
C
      IF((NX1.EQ.-1.AND.NX2.EQ.-1).AND.IRES.EQ.IFACT)THEN
         NCXLA2=0
         GOTO399
      ENDIF
      IF(NX2.GE.0)THEN
        IF(NCX2L2.GT.0)THEN
          DO310I=1,NCX2L2
            IXLAB2(I)=IX2LT2(I)
  310     CONTINUE
          NCXLA2=NCX2L2
        ELSE
          NCXLA2=0
          IF(NX2.GT.0)THEN
            DO320I=1,NX2
              IXLAB2(I)(1:1)=IX2T(I:I)
  320       CONTINUE
            NCXLA2=NX2
          ENDIF
        ENDIF
      ELSEIF(NX2.LT.0)THEN
        ITEMP=IFACT
        IF(NX2.EQ.-2)ITEMP=IRES
        IF(ISPMPT.EQ.'BIHI')ITEMP=IFACT
        ICOLID=ICOLL(ITEMP)
        IF(IVARLB(ICOLID).EQ.' '.OR.IVNMEX.EQ.'OFF')THEN
          DO330I=1,4
            IXLAB2(I)=IVARN1(ITEMP)(I:I)
            IXLAB2(I+4)=IVARN2(ITEMP)(I:I)
  330     CONTINUE
          NCXLA2=8
          DO340I=8,1,-1
            NCXLA2=I
            IF(IXLAB2(I).NE.'    ')GOTO345
  340     CONTINUE
  345     CONTINUE
        ELSE
          ILAST=40
          DO350I=40,1,-1
            IF(IVARLB(ICOLID)(I:I).NE.' ')THEN
              ILAST=I
              GOTO359
            ENDIF
  350     CONTINUE
  359     CONTINUE
          DO370I=1,ILAST
            IXLAB2(I)(1:1)=IVARLB(ICOLID)(I:I)
  370     CONTINUE
          NCXLA2=ILAST
        ENDIF
        IF(NX2.EQ.-1.OR.IRES.EQ.IFACT)GOTO399
        NCXLA2=NCXLA2+1
        IXLAB2(NCXLA2)='*'
        ITEMP=IFACT
        ICOLID=ICOLL(ITEMP)
        IF(IVARLB(ICOLID).EQ.' ')THEN
          DO380I=1,4
            IXLAB2(NCXLA2+I)=IVARN1(ITEMP)(I:I)
            IXLAB2(NCXLA2+I+4)=IVARN2(ITEMP)(I:I)
  380     CONTINUE
          ILAST=NCXLA2+8
          DO385I=ILAST,1,-1
            NCXLA2=I
            IF(IXLAB2(I).NE.'    ')GOTO388
  385     CONTINUE
  388     CONTINUE
        ELSE
          ILAST=40
          DO390I=40,1,-1
            IF(IVARLB(ICOLID)(I:I).NE.' ')THEN
              ILAST=I
              GOTO393
            ENDIF
  390     CONTINUE
  393     CONTINUE
          DO395I=1,ILAST
            NCXLA2=NCXLA2+1
            IXLAB2(NCXLA2)(1:1)=IVARLB(ICOLID)(I:I)
  395     CONTINUE
        ENDIF
      ENDIF
  399 CONTINUE
C
C  Y1LABEL
C
C  1) IF NY1 > 0, USE USER SPECIFIED LABEL IF ALREADY DEFINED,
C     OTHERWISE, DEFAULT TO A DATAPLOT SPECIFIED LABEL.
C  2) IF NY1 = 0, USE USER SPECIFIED LABEL IF ALREADY DEFINED,
C     BUT NO DEFAULT PROVIDED.
C  3) IF NY1 = -1, USE VARIABLE NAME (AND SUBSTITUTE VARIABLE
C     LABEL IF PROVIDED).
C
      IF(ISPMLA.EQ.'BOX'.AND.IROW.EQ.IMPNR)THEN
        NCYLA=0
        GOTO599
      ENDIF
C
      IF(NY1.GE.0)THEN
        IF(NCY1L2.GT.0)THEN
          DO510I=1,NCY1L2
            IYLABT(I)=IY1LT2(I)
  510     CONTINUE
          NCYLA=NCY1L2
        ELSE
          NCYLA=0
          IF(NY1.GT.0)THEN
            DO520I=1,NY1
              IYLABT(I)(1:1)=IY1T(I:I)
  520       CONTINUE
            NCYLA=NY1
          ENDIF
        ENDIF
      ELSEIF(NY1.LT.0)THEN
        ITEMP=IRES
        IF(ISPMPT.EQ.'DEXI'.OR.ISPMPT.EQ.'DEXS')ITEMP=1
        ICOLID=ICOLL(ITEMP)
        IF(IVARLB(ICOLID).EQ.' '.OR.IVNMEX.EQ.'OFF')THEN
          DO530I=1,4
            IYLABT(I)=IVARN1(ITEMP)(I:I)
            IYLABT(I+4)=IVARN2(ITEMP)(I:I)
  530     CONTINUE
          NCYLA=8
          DO540I=8,1,-1
            NCYLA=I
            IF(IYLABT(I).NE.'    ')GOTO545
  540     CONTINUE
  545     CONTINUE
        ELSE
          ILAST=40
          DO560I=40,1,-1
            IF(IVARLB(ICOLID)(I:I).NE.' ')THEN
              ILAST=I
              GOTO569
            ENDIF
  560     CONTINUE
  569     CONTINUE
          DO570I=1,ILAST
            IYLABT(I)(1:1)=IVARLB(ICOLID)(I:I)
  570     CONTINUE
          NCYLA=ILAST
        ENDIF
      ENDIF
  599 CONTINUE
C
C               ***************************************
C               **  STEP 5--                         **
C               **  USER SPECIFIES AXIS ATTRIBUTES,  **
C               **  BUT DATAPLOT MAY SUBSTITUTE      **
C               **  VARIABLE NAME (OR LABEL) FOR     **
C               **  X1LABEL AND Y1LABEL              **
C               ***************************************
C
 1000 CONTINUE
      IF(ISPMFR.EQ.'USER')THEN
        NCX1LA=NCXLA
        IF(NCX1LA.LE.0)GOTO1119
        DO1110I=1,NCX1LA
          IX1LTE(I)=IXLABT(I)
 1110   CONTINUE
 1119   CONTINUE
        IF(IX1DS.LT.0)PX1LDS=-((PYMAX-PYMIN)-PX1LD2)
        NCY1LA=NCYLA
        IF(NCY1LA.LE.0)GOTO1129
        DO1120I=1,NCY1LA
          IY1LTE(I)=IYLABT(I)
 1120   CONTINUE
 1129   CONTINUE
        NCX2LA=NCXLA2
        IF(NCX2LA.LE.0)GOTO1139
        DO1130I=1,NCX2LA
          IX2LTE(I)=IXLAB2(I)
 1130   CONTINUE
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
        IF(IX2DS.EQ.-2)PX2LDS=-PX2LD2
 1139   CONTINUE
C
C               *******************************************
C               **  STEP 6--                             **
C               **  DATAPLOT SPECIFIES AXIS ATTRIBUTES   **
C               *******************************************
C
      ELSEIF(ISPMFR.EQ.'DEFA')THEN
C
        ITEMP1=MOD(ICOL,2)
        ITEMP2=MOD(IROW,2)
        IROWL=IMPNR
        IF(ISPMLA.EQ.'BOX'.AND.ICASPL.EQ.'SPMA')IROWL=NUMVAR+1
        ICOLF=1
        IF(ISPMLA.EQ.'BOX')ICOLF=0
C
C  IX1DS < 0 OR IX2DS < 0 SPECIFIES THAT THIS LABEL IS DRAWN
C  ON ALL PLOTS (AND DISPLACEMENT IS DISTANCE FROM TOP FRAME)
C
        IF(IX1DS.LT.0.AND.ISPMLA.NE.'BOX')THEN
          NCX1LA=NCXLA
          IF(NCX1LA.GT.0)THEN
            DO1505I=1,NCX1LA
              IX1LTE(I)=IXLABT(I)
 1505       CONTINUE
          ENDIF
          PX1LDS=-((PYMAX-PYMIN)-PX1LD2)
        ENDIF
        IF(IX2DS.LT.0.AND.ISPMLA.NE.'BOX')THEN
          NCX2LA=NCXLA2
          IF(NCX2LA.GT.0)THEN
            DO1508I=1,NCX2LA
              IX2LTE(I)=IXLAB2(I)
 1508       CONTINUE
          ENDIF
          PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
          IF(IX2DS.EQ.-2)PX2LDS=-PX1LD2
        ENDIF
C
        IF(ISPMXA.EQ.'YON')GOTO1499
        IF(ISPMXA.EQ.'ALTE')THEN
          IF((IROW.EQ.IROWL.AND.ITEMP1.EQ.1).OR.
     1       (ISPMLD.EQ.'OFF'.AND.ITEMP1.EQ.1.AND.IROW.EQ.ICOL).OR.
     1       (IROW.EQ.IMPNR-1.AND.ICOL.EQ.IMPNC.AND.ITEMP.EQ.1.AND.
     1       NPLOTS.LT.IMPNR*IMPNC).OR.
     1       (ISPMLA.EQ.'BOX'.AND.IROW.EQ.IROWL)
     1       )THEN
            IF(ISPMLA.EQ.'BOX'.AND.ICOL.EQ.0)GOTO1519
            IF(ISPMLA.EQ.'BOX'.AND.ITEMP1.EQ.0)GOTO1512
            IF(ISPMLA.EQ.'YON')THEN
              IX1TSW='OFF'
              IX1ZSW='OFF'
            ELSE
              IX1TSW='ON'
              IX1ZSW='ON'
            ENDIF
            IX2TSW='OFF'
            IX2ZSW='OFF'
 1512       CONTINUE
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IX1DS.LT.0.AND.ISPMLA.NE.'BOX')IFLAG=1
            IFLAG2=0
            IF(IX2DS.LT.0.AND.ISPMLA.NE.'BOX')IFLAG2=1
            IF(IFLAG.EQ.0)THEN
              NCX1LA=NCXLA
              IF(NCX1LA.GT.0)THEN
                DO1510I=1,NCX1LA
                IX1LTE(I)=IXLABT(I)
 1510           CONTINUE
              ENDIF
            ENDIF
            IF(IFLAG2.EQ.0)THEN
              NCX2LA=NCXLA2
              IF(NCX2LA.GT.0)THEN
                DO1516I=1,NCX2LA
                IX2LTE(I)=IXLAB2(I)
 1516           CONTINUE
              ENDIF
            ENDIF
 1519       CONTINUE
            IF(ISPMLA.EQ.'BOX')PX1LDS=-((PYMAX-PYMIN)/2.0)
          ENDIF
C
          IF(IROW.EQ.1.AND.ITEMP1.EQ.0)THEN
            IF(ISPMLA.EQ.'BOX'.AND.ICOL.EQ.0)GOTO1529
            IX1TSW='OFF'
            IX1ZSW='OFF'
            IF(ISPMLA.EQ.'YON')THEN
              IX2TSW='OFF'
              IX2ZSW='OFF'
            ELSE
              IX2TSW='ON'
              IX2ZSW='ON'
            ENDIF
            IFLAG=0
            IF(ISPMLA.EQ.'BOX')IFLAG=1
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IX1DS.LT.0)IFLAG=1
            IFLAG2=0
            IF(IX2DS.LT.0)IFLAG2=1
            IF(IFLAG.EQ.0)THEN
              NCX1LA=NCXLA
              IF(NCX1LA.GT.0)THEN
                DO1520I=1,NCX1LA
                IX1LTE(I)=IXLABT(I)
 1520           CONTINUE
              ENDIF
            ENDIF
            IF(IFLAG2.EQ.0)THEN
              NCX2LA=NCXLA2
              IF(NCX2LA.GT.0)THEN
                DO1526I=1,NCX2LA
                IX2LTE(I)=IXLAB2(I)
 1526           CONTINUE
              ENDIF
            ENDIF
 1529       CONTINUE
            IF(IX1DS.GT.0)PX1LDS=-((PYMAX-PYMIN)+PX1LD2)
            IF(ISPMLA.EQ.'BOX')PX1LDS=-((PYMAX-PYMIN)/2.0)
          ENDIF
        ELSEIF(ISPMXA.EQ.'BOTT')THEN
          IF(IROW.EQ.IROWL.OR.(ISPMLD.EQ.'OFF'.AND.IROW.EQ.ICOL))THEN
            IF(ISPMLA.EQ.'BOX'.AND.ICOL.EQ.0)GOTO1619
            IF(ISPMLA.EQ.'YON')THEN
              IX1TSW='OFF'
              IX1ZSW='OFF'
            ELSE
              IX1TSW='ON'
              IX1ZSW='ON'
            ENDIF
            IF(ISPMTD.EQ.'STAG'.AND.ITEMP1.EQ.0)PX1ZDS=PSPMTD
            IX2TSW='OFF'
            IX2ZSW='OFF'
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IX1DS.LT.0.AND.ISPMLA.NE.'BOX')IFLAG=1
            IFLAG2=0
            IF(IX2DS.LT.0.AND.ISPMLA.NE.'BOX')IFLAG2=1
            IF(IFLAG.EQ.0)THEN
              NCX1LA=NCXLA
              IF(NCX1LA.GT.0)THEN
                DO1610I=1,NCX1LA
                IX1LTE(I)=IXLABT(I)
 1610           CONTINUE
              ENDIF
            ENDIF
            IF(IFLAG2.EQ.0)THEN
              NCX2LA=NCXLA2
              IF(NCX2LA.GT.0)THEN
                DO1616I=1,NCX2LA
                IX2LTE(I)=IXLAB2(I)
 1616           CONTINUE
              ENDIF
            ENDIF
 1619       CONTINUE
            IF(ISPMLA.EQ.'BOX')PX1LDS=-((PYMAX-PYMIN)/2.0)
          ENDIF
        ELSEIF(ISPMXA.EQ.'TOP')THEN
          IF(IROW.EQ.1)THEN
            IF(ISPMLA.EQ.'BOX'.AND.ICOL.EQ.0)GOTO1719
            IX1TSW='OFF'
            IX1ZSW='OFF'
            IF(ISPMLA.EQ.'YON')THEN
              IX2TSW='OFF'
              IX2ZSW='OFF'
            ELSE
              IX2TSW='ON'
              IX2ZSW='ON'
            ENDIF
            IF(ISPMTD.EQ.'STAG'.AND.ITEMP1.EQ.0)PX2ZDS=PSPMTD
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IX1DS.LT.0)IFLAG=1
            IF(ISPMLA.EQ.'BOX')GOTO1719
            IFLAG2=0
            IF(IX2DS.LT.0)IFLAG2=1
            IF(IFLAG.EQ.0)THEN
              NCX1LA=NCXLA
              IF(NCX1LA.GT.0)THEN
                DO1710I=1,NCX1LA
                IX1LTE(I)=IXLABT(I)
 1710           CONTINUE
              ENDIF
            ENDIF
            IF(IFLAG2.EQ.0)THEN
              NCX2LA=NCXLA2
              IF(NCX2LA.GT.0)THEN
                DO1716I=1,NCX2LA
                IX2LTE(I)=IXLAB2(I)
 1716           CONTINUE
              ENDIF
            ENDIF
 1719       CONTINUE
            PX1LDS=-(100.0+PX1LD2)
          ENDIF
C
          IF(ISPMLA.EQ.'BOX'.AND.IROW.EQ.IROWL.AND.ICOL.GT.0)THEN
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IX1DS.LT.0.AND.ISPMLA.NE.'BOX')IFLAG=1
            IFLAG2=0
            IF(IX2DS.LT.0.AND.ISPMLA.NE.'BOX')IFLAG2=1
            IF(IFLAG.EQ.0)THEN
              NCX1LA=NCXLA
              IF(NCX1LA.GT.0)THEN
                DO1720I=1,NCX1LA
                IX1LTE(I)=IXLABT(I)
 1720           CONTINUE
              ENDIF
            ENDIF
            PX1LDS=-(100.0+PX1LD2)
          ENDIF
        ENDIF
C
 1499   CONTINUE
        IF(ISPMYA.EQ.'OFF')GOTO1699
        IF(ISPMYA.EQ.'ALTE')THEN
          IF((ICOL.EQ.IMPNC.AND.ITEMP2.EQ.0).OR.
     1       (ISPMLA.EQ.'BOX'.AND.ICOL.EQ.IMPNC-1.AND.ITEMP2.EQ.0).OR.
     1       (IPLOT.EQ.NPLOTS.AND.ITEMP2.EQ.0))THEN
            IY1TSW='OFF'
            IY1ZSW='OFF'
            IF(ISPMLA.EQ.'XON')THEN
              IY2TSW='OFF'
              IY2ZSW='OFF'
            ELSE
              IY2TSW='ON'
              IY2ZSW='ON'
            ENDIF
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(ISPMLA.EQ.'BOX')IFLAG=1
            IF(IFLAG.EQ.0)THEN
              NCY2LA=NCYLA
              IF(NCY2LA.LE.0)GOTO1539
              DO1530I=1,NCY2LA
                IY2LTE(I)=IYLABT(I)
 1530         CONTINUE
 1539         CONTINUE
            ENDIF
          ENDIF
C
          IF(ICOL.EQ.ICOLF.AND.ITEMP2.EQ.1.OR.
     1      (ISPMLA.EQ.'BOX'.AND.ICOL.EQ.ICOLF).OR.
     1      (ISPMLD.EQ.'OFF'.AND.ITEMP2.EQ.1.AND.IROW.EQ.ICOL))THEN
            IF(ISPMLA.EQ.'BOX'.AND.IROW.EQ.IROWL)GOTO1549
            IF(ISPMLA.EQ.'BOX'.AND.ITEMP2.EQ.0)GOTO1542
            IF(ISPMLA.EQ.'XON')THEN
              IY1TSW='OFF'
              IY1ZSW='OFF'
            ELSE
              IY1TSW='ON'
              IY1ZSW='ON'
            ENDIF
            IY2TSW='OFF'
            IY2ZSW='OFF'
 1542       CONTINUE
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IFLAG.EQ.0)THEN
              NCY1LA=NCYLA
              IF(NCY1LA.LE.0)GOTO1549
              DO1540I=1,NCY1LA
                IY1LTE(I)=IYLABT(I)
 1540         CONTINUE
            ENDIF
            IF(ISPMLA.EQ.'BOX')THEN
              IY1LJU='CENT'
              PY1LDS=-((PXMAX-PXMIN)/2.0)
              PY1LAN=0.0
              IY1LDI='HORI'
            ENDIF
 1549       CONTINUE
          ENDIF
        ELSEIF(ISPMYA.EQ.'LEFT')THEN
          IF(ICOL.EQ.ICOLF.OR.(ISPMLD.EQ.'OFF'.AND.IROW.EQ.ICOL))THEN
            IF(ISPMLA.EQ.'BOX'.AND.IROW.EQ.IROWL)GOTO1649
            IF(ISPMLA.EQ.'XON')THEN
              IY1TSW='OFF'
              IY1ZSW='OFF'
            ELSE
              IY1TSW='ON'
              IY1ZSW='ON'
            ENDIF
            IF(ISPMTD.EQ.'STAG'.AND.ITEMP2.EQ.0)PY1ZDS=PSPMTD
            IY2TSW='OFF'
            IY2ZSW='OFF'
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IFLAG.EQ.0)THEN
              NCY1LA=NCYLA
              IF(NCY1LA.LE.0)GOTO1649
              DO1640I=1,NCY1LA
                IY1LTE(I)=IYLABT(I)
 1640         CONTINUE
            ENDIF
 1649       CONTINUE
            IF(ISPMLA.EQ.'BOX')THEN
              IY1LJU='CENT'
              PY1LDS=-((PXMAX-PXMIN)/2.0)
              PY1LAN=0.0
              IY1LDI='HORI'
            ENDIF
          ENDIF
        ELSEIF(ISPMYA.EQ.'RIGH')THEN
          IF(ICOL.EQ.IMPNC)THEN
            IF(ISPMLA.EQ.'BOX'.AND.IROW.EQ.IROWL)GOTO1839
            IY1TSW='OFF'
            IY1ZSW='OFF'
            IF(ISPMLA.EQ.'XON')THEN
              IY2TSW='OFF'
              IY2ZSW='OFF'
            ELSE
              IY2TSW='ON'
              IY2ZSW='ON'
            ENDIF
            IF(ISPMTD.EQ.'STAG'.AND.ITEMP2.EQ.0)PY2ZDS=PSPMTD
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(ISPMLA.EQ.'BOX')IFLAG=1
            IF(IFLAG.EQ.0)THEN
              NCY2LA=NCYLA
              IF(NCY2LA.LE.0)GOTO1839
              DO1830I=1,NCY2LA
                IY2LTE(I)=IYLABT(I)
 1830         CONTINUE
            ENDIF
 1839       CONTINUE
          ENDIF
C
          IF(ISPMLA.EQ.'BOX'.AND.ICOL.EQ.ICOLF.AND.IROW.LT.IROWL)THEN
            IFLAG=0
            IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1        ISPMDI.EQ.'BLAN')IFLAG=1
            IF(IFLAG.EQ.0)THEN
              NCY1LA=NCYLA
              IF(NCY1LA.LE.0)GOTO1849
              DO1840I=1,NCY1LA
                IY1LTE(I)=IYLABT(I)
 1840         CONTINUE
            ENDIF
 1849       CONTINUE
          ENDIF
        ENDIF
C
        IF(ICASPL.EQ.'SPMA'.AND.ISPMPT.EQ.'PLOT'.AND.
     1    ISPMDI.EQ.'BLAN'.AND.IROW.EQ.ICOL)THEN
          NCX1LA=NCXLA
          NCY1LA=0
          NCY2LA=0
          IF(NCX1LA.LE.0)GOTO1919
          DO1910I=1,NCX1LA
            IX1LTE(I)=IXLABT(I)
 1910     CONTINUE
 1919     CONTINUE
          PX1LDS=-((PYMAX-PYMIN)/2.0)
        ENDIF
 1699   CONTINUE
C
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SPM1')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPM1--')
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPM2(ICASPL,IVARN1,IVARN2,ICOLL,NUMVAR,NPLOTP,
     1IROW,ICOL,ICHAP2,ILINP2,
     1TEMP,TEMP2,TEMP3,XTEMP1,XTEMP2,MAXNXT,
     1ALOWFR,ALOWDG,
     1IANGLU,MAXNPP,IAND1,IAND2,
     1ISPMFI,ISPMTA,
     1XMATN,YMATN,XMITN,YMITN,
     1ISQUAR,
     1IVGMSW,IHGMSW,
     1IMPSW,IMPNR,IMPNC,IMPCO,
     1IREPCH,
     1PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1IBUGUG,IBUGU2,IBUGU3,IBUGU4,
     1ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--UTILTY ROUTINE FOR SCATTER PLOT MATRIX.  GENERATE
C              OVERLAID SMOOTH OR FITTED CURVE ON PLOT.  ALSO
C              USED BY FACTOR AND CONDITIONING PLOTS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/11
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--NOVEMBERR 1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICASAN
      CHARACTER*4 IANGLU
      CHARACTER*4 IMPSW
      CHARACTER*4 IREPCH
      CHARACTER*4 ISQUAR
      CHARACTER*4 IVGMSW
      CHARACTER*4 IHGMSW
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IFTEXP
      CHARACTER*4 IFTORD
      CHARACTER*4 IOPTME
      CHARACTER*4 IOPTHE
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGUG
      CHARACTER*4 IBUGU2
      CHARACTER*4 IBUGU3
      CHARACTER*4 IBUGU4
      CHARACTER*4 IBUGCO
      CHARACTER*4 IBUGEV
      CHARACTER*4 IBUGQ
C
      CHARACTER*4 ICONT
      CHARACTER*4 IWRITE
      CHARACTER*4 IFOUND
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISPMFI
      CHARACTER*4 ISPMTA
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICASP2
      CHARACTER*4 ICOMT
      CHARACTER*4 ICOM2T
C
      CHARACTER*4 ICHAP2(100)
      CHARACTER*4 ICH2PO(100)
      CHARACTER*4 ICH2FO(100)
      CHARACTER*4 ICH2CA(100)
      CHARACTER*4 ICH2JU(100)
      CHARACTER*4 ICH2DI(100)
      CHARACTER*4 ICH2FI(100)
      CHARACTER*4 ICH2CO(100)
      REAL PCH2HE(100)
      REAL PCH2WI(100)
      REAL PCH2VG(100)
      REAL PCH2HG(100)
      REAL PCH2HO(100)
      REAL PCH2VO(100)
      REAL ACH2AN(100)
C
      CHARACTER*4 ILINP2(100)
      CHARACTER*4 ILI2CO(100)
      REAL PLI2TH(100)
C
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      DIMENSION ICOLL(*)
      DIMENSION IVARN1(*)
      DIMENSION IVARN2(*)
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
      DIMENSION TEMP3(*)
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      CHARACTER*4 IY1MNS
      CHARACTER*4 IY1MXS
      CHARACTER*4 IY2MNS
      CHARACTER*4 IY2MXS
      CHARACTER*4 IX1MNS
      CHARACTER*4 IX1MXS
      CHARACTER*4 IX2MNS
      CHARACTER*4 IX2MXS
C
      PARAMETER (MAXART=20)
      CHARACTER*4 ITHARG
      CHARACTER*4 ITHAR2
      CHARACTER*4 ITARGT
      CHARACTER*4 ISU2SW(MAXSUB)
      CHARACTER*4 IANST
      DIMENSION ITHARG(MAXART)
      DIMENSION ITHAR2(MAXART)
      DIMENSION ITARG(MAXART)
      DIMENSION TARG(MAXART)
      DIMENSION ITARGT(MAXART)
      DIMENSION IANST(MAXSTR)
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-------------------------------------------------
C
CCCCC IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'SPM2')THEN
CCCCC ENDIF
C
CCCCC NOTE: CURRENTLY, LOWESS (AND OTHER) TYPE FITS ONLY
CCCCC       USED FOR "PLOT Y X" TYPE COMMANDS.  NOTE THAT
CCCCC       SOME OF THE LOGIC OF THIS ROUTINE WILL NEED TO
CCCCC       BE UPDATED IF THIS CAPABILITY IS EXTENDED TO
CCCCC       ADDITIONAL PLOT TYPES (I.E., SOME CARE NEEDS TO BE 
CCCCC       TAKEN TO ENSURE THAT SUBSET CLAUSES ARE CARRIED 
CCCCC       ALONG PROPERLY).
C
C               ***************************************
C               **  STEP 1--                         **
C               ***************************************
C
      ICAPSW='OFF'
      IERROR='NO'
C
C  PARTIAL REGRESSION, PARTIAL RESIDUAL, AND PARTIAL
C  LEVERAGE PLOT ALLOW FITTED CURVE TO OVERLAID.
C
      IF(ICASPL.EQ.'PREG' .OR. ICASPL.EQ.'PRES' .OR.
     1   ICASPL.EQ.'PLEV')THEN
        ICASP2='PLOT'
      ELSE
        IF(ICOM.NE.'PLOT')GOTO9000
      ENDIF
C
      ICOMT=ICOM
      ICOM2T=ICOM2
      ICASP2=ICASPL
      NUMART=NUMARG
      DO100I=1,NUMARG
        ITHARG(I)=IHARG(I)
        ITHAR2(I)=IHARG2(I)
        ITARG(I)=IARG(I)
        TARG(I)=ARG(I)
        ITARGT(I)=IARGT(I)
  100 CONTINUE
      DO102I=1,MAXSTR
        IANST(I)=IANS(I)
  102 CONTINUE
      IWIDT=IWIDTH
      DO105I=1,MAXSUB
        ISU2SW(I)=ISUBSW(I)
        ISUBSW(I)='OFF'
  105 CONTINUE
      DO110I=1,100
        ILI2CO(I)=ILINCO(I)
        PLI2TH(I)=PLINTH(I)
        ICH2PO(I)=ICHAPO(I)
        ICH2FO(I)=ICHAFO(I)
        ICH2CA(I)=ICHACA(I)
        ICH2JU(I)=ICHAJU(I)
        ICH2DI(I)=ICHADI(I)
        ICH2FI(I)=ICHAFI(I)
        ICH2CO(I)=ICHACO(I)
        PCH2HE(I)=PCHAHE(I)
        PCH2WI(I)=PCHAWI(I)
        PCH2VG(I)=PCHAVG(I)
        PCH2HG(I)=PCHAHG(I)
        PCH2HO(I)=PCHAHO(I)
        PCH2VO(I)=PCHAVO(I)
        ACH2AN(I)=ACHAAN(I)
  110 CONTINUE
C
      IF(ISPMTA.EQ.'ON')THEN
        ISHIFT=1
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        ITAGCO=3
        DO119I=1,NUMARG
          IF(I.EQ.ITAGCO)GOTO119
          IHARG(I)=ITHARG(I)
          IHARG2(I)=ITHAR2(I)
          IARG(I)=ITARG(I)
          ARG(I)=TARG(I)
          IARGT(I)=ITARGT(I)
  119   CONTINUE
      ENDIF
C
      GY1MNS=GY1MIN
      GY1MXS=GY1MAX
      GY2MNS=GY2MIN
      GY2MXS=GY2MAX
      GX1MNS=GX1MIN
      GX1MXS=GX1MAX
      GX2MNS=GX2MIN
      GX2MXS=GX2MAX
      IY1MNS=IY1MIN
      IY1MXS=IY1MAX
      IY2MNS=IY2MIN
      IY2MXS=IY2MAX
      IX1MNS=IX1MIN
      IX1MXS=IX1MAX
      IX2MNS=IX2MIN
      IX2MXS=IX2MAX
C
      GY1MIN=FY1MNZ
      GY1MAX=FY1MXZ
      GY2MIN=GY1MIN
      GY2MAX=GY1MAX
      GX1MIN=FX1MNZ
      GX1MAX=FX1MXZ
      GX2MIN=GX1MIN
      GX2MAX=GX1MAX
      IY1MIN='FIXE'
      IY1MAX='FIXE'
      IY2MIN='FIXE'
      IY2MAX='FIXE'
      IX1MIN='FIXE'
      IX1MAX='FIXE'
      IX2MIN='FIXE'
      IX2MAX='FIXE'
      IX1TSW='OFF'
      IX1ZSW='OFF'
      IX2TSW='OFF'
      IX2ZSW='OFF'
      IY1TSW='OFF'
      IY1ZSW='OFF'
      IY2TSW='OFF'
      IY2ZSW='OFF'
C
      IF(ICASPL.EQ.'PREG' .OR. ICASPL.EQ.'PRES' .OR.
     1   ICASPL.EQ.'PLEV')THEN
         NUMARG=2
         ICOM='PLOT'
         ICOM2='    '
         IHARG(1)='YPLO'
         IHARG2(1)='T   '
         IHARG(2)='XPLO'
         IHARG2(2)='T   '
      ENDIF
C
      IF(ISPMFI.EQ.'LOES')THEN
        ICOM='LOWE'
        ICOM2='SS  '
        CALL DPLOW(ALOWFR,ALOWDG,
     1             TEMP,TEMP2,XTEMP1,XTEMP2,MAXNXT,
     1             IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
      ELSEIF(ISPMFI.EQ.'LINE')THEN
        ICOM='FIT '
        ICOM2='    '
        ICASAN='FIT'
        CALL DPFIT(ICAPSW,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1             IFOUND,IERROR)
      ELSEIF(ISPMFI.EQ.'QUAD')THEN
        ISHIFT=1
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1              IBUGG2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ICOM='QUAD'
        ICOM2='RATI'
        IHARG(1)='FIT '
        IHARG2(1)='    '
        ICASAN='FIT'
        CALL DPFIT(ICAPSW,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,ISUBRO,
     1             IFOUND,IERROR)
      ELSEIF(ISPMFI.EQ.'SMOO')THEN
        ICOM='SMOO'
        ICOM2='TH  '
        ICASAN='SMOO'
        CALL DPSMOO(IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
      ENDIF
C
      ICOM='PLOT'
      ICOM2='    '
      ISHIFT=1
      IF(ISHIFT.GT.0)THEN
        CALL SHIFTR(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ELSEIF(ISHIFT.LT.0)THEN
        CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1            IBUGG2,IERROR)
      ENDIF
      IF(ISPMTA.EQ.'OFF')THEN
        ITEMP=2
      ELSE
        IWRITE='OFF'
        CALL MAXIM(TAGPLO,NPLOTP,IWRITE,XMAX,IBUGG3,IERROR)
        ITEMP=1+INT(XMAX)
        IF(ITEMP.LT.1.OR.ITEMP.GT.100)ITEMP=2
      ENDIF
      ICHAPA(1)=ICHAP2(ITEMP)
      ILINPA(1)=ILINP2(ITEMP)
      ILINCO(1)=ILI2CO(ITEMP)
      PLINTH(1)=PLI2TH(ITEMP)
      ICHAPO(1)=ICH2PO(ITEMP)
      ICHAFO(1)=ICH2FO(ITEMP)
      ICHACA(1)=ICH2CA(ITEMP)
      ICHAJU(1)=ICH2JU(ITEMP)
      ICHADI(1)=ICH2DI(ITEMP)
      ICHAFI(1)=ICH2FI(ITEMP)
      ICHACO(1)=ICH2CO(ITEMP)
      PCHAHE(1)=PCH2HE(ITEMP)
      PCHAWI(1)=PCH2WI(ITEMP)
      PCHAVG(1)=PCH2VG(ITEMP)
      PCHAHG(1)=PCH2HG(ITEMP)
      PCHAHO(1)=PCH2HO(ITEMP)
      PCHAVO(1)=PCH2VO(ITEMP)
      ACHAAN(1)=ACH2AN(ITEMP)
      IF(ICASPL.EQ.'PREG' .OR. ICASPL.EQ.'PRES' .OR.
     1   ICASPL.EQ.'PLEV')THEN
        NUMARG=3
        ICOM='LET '
        ICOM2='    '
        IHARG(1)='XTEM'
        IHARG2(1)='P   '
        IHARG(2)='=   '
        IHARG2(2)='    '
        IHARG(3)='XPLO'
        IHARG2(3)='T   '
        IANS(1)='L   '
        IANS(2)='E   '
        IANS(3)='T   '
        IANS(4)='    '
        IANS(5)='X   '
        IANS(6)='T   '
        IANS(7)='E   '
        IANS(8)='M   '
        IANS(9)='P   '
        IANS(10)='    '
        IANS(11)='=   '
        IANS(12)='    '
        IANS(13)='X   '
        IANS(14)='P   '
        IANS(15)='L   '
        IANS(16)='O   '
        IANS(17)='T   '
        IWIDTH=17
        CALL DPLET(IANGLU,ISEED,IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,
     1             TEMP,TEMP2,XTEMP1,XTEMP2,MAXNXT,
     1             IFTEXP,IFTORD,
     1             ROOTAC,OPTACC,IOPTME,IOPTHE,
     1             ISUBRO,IFOUND,IERROR)
C
        IF(IERROR.EQ.'YES')GOTO9000
        ICOM='PLOT'
        ICOM2='    '
        IHARG(1)='PRED'
        IHARG2(1)='    '
        IHARG(2)='VS  '
        IHARG2(2)='    '
        IHARG(3)='XTEM'
        IHARG2(3)='P   '
      ELSE
        IHARG(1)='PRED'
        IHARG2(1)='    '
        IHARG(2)='VS  '
        IHARG2(2)='    '
        IHARG(3)=IVARN1(ICOL)
        IHARG2(3)=IVARN2(ICOL)
      ENDIF
      CALL DPPLOT(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1            IANGLU,MAXNPP,
     1            IBUGG2,IBUGG3,IBUGCO,IBUGEV,IBUGQ,IFOUND,IERROR)
      ICASPL=ICASP2
C
C
C               **************************************************
C               **   STEP 25--                                  **
C               **   PLOT THE CURRENT PLOT                      **
C               **************************************************
C
      ICONT=IDCONT(1)
      NUMHPP=IDNHPP(1)
      IMPARG=2
      CALL DPGRAP(Y,X,X3D,D,N,NPLOTP,ICASPL,ICONT,NUMHPP,
     1            XMATN,YMATN,XMITN,YMITN,
     1            ISQUAR,
     1            IVGMSW,IHGMSW,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,
     1            IVSTAR,IVSTOP,IFUNC,NUMCHF,IREPCH,
     1            YPLOT,XPLOT,X2PLOT,TAGPLO,
     1            IMPSW,IMPNR,IMPNC,IMPCO,
     1            IMPARG,
     1            PMXMIN,PMXMAX,PMYMIN,PMYMAX,
     1            MAXCOL,
     1            DSIZE,DSYMB,DCOLOR,DFILL,
     1            ICAPSW,
     1            IBUGUG,IBUGU2,IBUGU3,IBUGU4,ISUBRO,
     1            IERROR)
      IF(IERROR.EQ.'NO')IAND1=IAND2
      IERROR='NO'
C
      GX1MIN=GX1MNS
      GX1MAX=GX1MXS
      GX2MIN=GX2MNS
      GX2MAX=GX2MXS
      GY1MIN=GY1MNS
      GY1MAX=GY1MXS
      GY2MIN=GY2MNS
      GY2MAX=GY2MXS
      IX1MIN=IX1MNS
      IX1MAX=IX1MXS
      IX2MIN=IX2MNS
      IX2MAX=IX2MXS
      IY1MIN=IY1MNS
      IY1MAX=IY1MXS
      IY2MIN=IY2MNS
      IY2MAX=IY2MXS
C
      NUMARG=NUMART
      ICOM=ICOMT
      ICOM2=ICOM2T
      DO900I=1,NUMARG
        IHARG(I)=ITHARG(I)
        IHARG2(I)=ITHAR2(I)
        IARG(I)=ITARG(I)
        ARG(I)=TARG(I)
        IARGT(I)=ITARGT(I)
  900 CONTINUE
      DO902I=1,MAXSTR
        IANS(I)=IANST(I)
  902 CONTINUE
      IWIDTH=IWIDT
      DO905I=1,MAXSUB
        ISUBSW(I)=ISU2SW(I)
  905 CONTINUE
      DO910I=1,100
        ILINCO(I)=ILI2CO(I)
        PLINTH(I)=PLI2TH(I)
        ICHAPO(I)=ICH2PO(I)
        ICHAFO(I)=ICH2FO(I)
        ICHACA(I)=ICH2CA(I)
        ICHAJU(I)=ICH2JU(I)
        ICHADI(I)=ICH2DI(I)
        ICHAFI(I)=ICH2FI(I)
        ICHACO(I)=ICH2CO(I)
        PCHAHE(I)=PCH2HE(I)
        PCHAWI(I)=PCH2WI(I)
        PCHAVG(I)=PCH2VG(I)
        PCHAHG(I)=PCH2HG(I)
        PCHAHO(I)=PCH2HO(I)
        PCHAVO(I)=PCH2VO(I)
        ACHAAN(I)=ACH2AN(I)
  910 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SPM2')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPM2--')
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPM3(ICASPL,IOUNI5,
     1IROW,ICOL,
     1PX2LD2,NPLOTP,
     1IFORSW,
     1ISPX2L,ISPX2P,ISPX2S,
     1IHRIGH,IHRIG2,IHWUSE,
     1ISUBN1,ISUBN2,MESSAG,
     1IBUGG2,ISUBRO,IERROR)
C
C     PURPOSE--UTILTY ROUTINE FOR SCATTER PLOT MATRIX.  GENERATE
C              AN X2LABEL BASED ON CORRELATION, EFFECT SIZE, OR
C              NUMBER OF DEFECTIVES.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/11
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--NOVEMBERR 1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOHK.INC'
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 ICASPL
C
      CHARACTER*4 IFORSW
      CHARACTER*4 IWRITE
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISPX2L
      CHARACTER*16 ISPX2P
      CHARACTER*16 ISPX2S
C
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHWUSE
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 MESSAG
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-------------------------------------------------
C
CCCCC IF(ISUBRO.EQ.'SPM3')THEN
CCCCC ENDIF
C               ***************************************
C               **  STEP 1--                         **
C               ***************************************
C
      IERROR='NO'
      IF(ISPX2L.EQ.'OFF ')GOTO9000
      IF(ISPX2L.EQ.'NONE')GOTO9000
      IF(ISPX2L.EQ.'BLAN')GOTO9000
C
      ALOWH=0.0
      ACORR=0.0
      NACC=0
      NREJ=0
C
      IHRIGH='ALOW'
      IHRIG2='HIGH'
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'NO')ALOWH=VALUE(ILOCP)
C
      IHRIGH='PLOT'
      IHRIG2='CORR'
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'NO')ACORR=VALUE(ILOCP)
C
      IHRIGH='NACC'
      IHRIG2='EPT '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'NO')NACC=INT(VALUE(ILOCP)+0.5)
C
      IHRIGH='NREJ'
      IHRIG2='ECT '
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1             IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1             ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IERROR='NO'
C
      NUMDIG=-1
      IF(IFORSW.EQ.'0')NUMDIG=0
      IF(IFORSW.EQ.'1')NUMDIG=1
      IF(IFORSW.EQ.'2')NUMDIG=2
      IF(IFORSW.EQ.'3')NUMDIG=3
      IF(IFORSW.EQ.'4')NUMDIG=4
      IF(IFORSW.EQ.'5')NUMDIG=5
      IF(IFORSW.EQ.'6')NUMDIG=6
      IF(IFORSW.EQ.'7')NUMDIG=7
      IF(IFORSW.EQ.'8')NUMDIG=8
      IF(IFORSW.EQ.'9')NUMDIG=9
      IF(IFORSW.EQ.'10')NUMDIG=10
C
      IF(ISPX2L.EQ.'CORR'.OR.ISPX2L.EQ.'PCOR')THEN
        IWRITE='OFF'
        IF(ISPX2P.EQ.'DEFAULT')THEN
          IX2LTE(1)='C'
          IX2LTE(2)='O'
          IX2LTE(3)='R'
          IX2LTE(4)='R'
          IX2LTE(5)=' '
          IX2LTE(6)='='
          IX2LTE(7)=' '
          NCX2LA=7
        ELSEIF(ISPX2P.EQ.' ')THEN
          NCX2LA=0
        ELSE
          DO110I=16,1,-1
            IF(ISPX2P(I:I).NE.' ')THEN
              NCX2LA=I
              DO120J=1,NCX2LA
                IX2LTE(J)(1:1)=ISPX2P(J:J)
  120         CONTINUE
              GOTO129
            ENDIF
  110     CONTINUE
  129     CONTINUE
        ENDIF
        CONST=0.5
        IF(ACORR.LT.0.0)CONST=-0.5
        IF(ISPX2L.EQ.'PCOR')ACORR=100.0*ACORR
        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(G15.7)')ACORR
        NDEF=3
        IF(ISPX2L.EQ.'PCOR')NDEF=1
        IF(NUMDIG.LT.0)THEN
          ICORR=INT(ACORR*10**NDEF + CONST)
          ACORR=REAL(ICORR)/(10**NDEF)
        ELSE
          ICORR=INT(ACORR*10**NUMDIG + CONST)
          ACORR=REAL(ICORR)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(ICORR,ACORR,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        IF(ISPX2S.EQ.'DEFAULT')THEN
          IF(ISPX2L.EQ.'PCOR')THEN
            NCX2LA=NCX2LA+1
            IX2LTE(NCX2LA)='%'
          ENDIF
        ELSEIF(ISPX2S.NE.' ')THEN
          DO210I=16,1,-1
            IF(ISPX2S(I:I).NE.' ')THEN
              NTEMP=I
              DO220J=1,NTEMP
                NCX2LA=NCX2LA+1
                IX2LTE(NCX2LA)(1:1)=ISPX2S(J:J)
  220         CONTINUE
              GOTO229
            ENDIF
  210     CONTINUE
  229     CONTINUE
        ENDIF
        CONST=0.5
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
      ELSEIF(ISPX2L.EQ.'PACC')THEN
        IF(ISPX2P.EQ.'DEFAULT')THEN
          NCX2LA=0
        ELSEIF(ISPX2P.EQ.' ')THEN
          NCX2LA=0
        ELSE
          DO310I=16,1,-1
            IF(ISPX2P(I:I).NE.' ')THEN
              NCX2LA=I
              DO320J=1,NCX2LA
                IX2LTE(J)(1:1)=ISPX2P(J:J)
  320         CONTINUE
              GOTO329
            ENDIF
  310     CONTINUE
  329     CONTINUE
        ENDIF
        CONST=0.5
        AV=REAL(NACC)/REAL(NACC+NREJ)
        AV=100.0*AV
        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(G15.7)')AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        IF(ISPX2S.EQ.'DEFAULT')THEN
          CONTINUE
        ELSEIF(ISPX2P.NE.' ')THEN
          DO360I=16,1,-1
            IF(ISPX2S(I:I).NE.' ')THEN
              NTEMP=I
              DO370J=1,NTEMP
                NCX2LA=NCX2LA+1
                IX2LTE(NCX2LA)(1:1)=ISPX2P(J:J)
  370         CONTINUE
              GOTO379
            ENDIF
  360     CONTINUE
  379     CONTINUE
        ENDIF
        CONST=0.5
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
C
      ELSEIF(ISPX2L.EQ.'NACC')THEN
        IF(ISPX2P.EQ.'DEFAULT')THEN
          NCX2LA=0
        ELSEIF(ISPX2P.EQ.' ')THEN
          NCX2LA=0
        ELSE
          DO410I=16,1,-1
            IF(ISPX2P(I:I).NE.' ')THEN
              NCX2LA=I
              DO420J=1,NCX2LA
                IX2LTE(J)(1:1)=ISPX2P(J:J)
  420         CONTINUE
              GOTO429
            ENDIF
  410     CONTINUE
  429     CONTINUE
        ENDIF
        CONST=0.5
        AV=REAL(NACC)
        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(G15.7)')AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        IF(ISPX2S.EQ.'DEFAULT')THEN
          CONTINUE
        ELSEIF(ISPX2P.NE.' ')THEN
          DO460I=16,1,-1
            IF(ISPX2S(I:I).NE.' ')THEN
              NTEMP=I
              DO470J=1,NTEMP
                NCX2LA=NCX2LA+1
                IX2LTE(NCX2LA)(1:1)=ISPX2P(J:J)
  470         CONTINUE
              GOTO479
            ENDIF
  460     CONTINUE
  479     CONTINUE
        ENDIF
        CONST=0.5
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
C
      ELSEIF(ISPX2L.EQ.'AT  ')THEN
        IF(ISPX2P.EQ.'DEFAULT')THEN
          NCX2LA=0
        ELSEIF(ISPX2P.EQ.' ')THEN
          NCX2LA=0
        ELSE
          DO810I=16,1,-1
            IF(ISPX2P(I:I).NE.' ')THEN
              NCX2LA=I
              DO820J=1,NCX2LA
                IX2LTE(J)(1:1)=ISPX2P(J:J)
  820         CONTINUE
              GOTO829
            ENDIF
  810     CONTINUE
  829     CONTINUE
        ENDIF
        CONST=0.5
        AV=REAL(NACC)
        AV1=AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        NCX2LA=NCX2LA+1
        IX2LTE(NCX2LA)(1:1)='/'
        AV=REAL(NACC+NREJ)
        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(2G15.7)')AV1,AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        IF(ISPX2S.EQ.'DEFAULT')THEN
          CONTINUE
        ELSEIF(ISPX2P.NE.' ')THEN
          DO860I=16,1,-1
            IF(ISPX2S(I:I).NE.' ')THEN
              NTEMP=I
              DO870J=1,NTEMP
                NCX2LA=NCX2LA+1
                IX2LTE(NCX2LA)(1:1)=ISPX2P(J:J)
  870         CONTINUE
              GOTO879
            ENDIF
  860     CONTINUE
  879     CONTINUE
        ENDIF
        CONST=0.5
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
C
      ELSEIF(ISPX2L.EQ.'ATP ')THEN
        IF(ISPX2P.EQ.'DEFAULT')THEN
          NCX2LA=0
        ELSEIF(ISPX2P.EQ.' ')THEN
          NCX2LA=0
        ELSE
          DO710I=16,1,-1
            IF(ISPX2P(I:I).NE.' ')THEN
              NCX2LA=I
              DO720J=1,NCX2LA
                IX2LTE(J)(1:1)=ISPX2P(J:J)
  720         CONTINUE
              GOTO729
            ENDIF
  710     CONTINUE
  729     CONTINUE
        ENDIF
        CONST=0.5
        AV=REAL(NACC)
        AV1=AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        NCX2LA=NCX2LA+1
        IX2LTE(NCX2LA)(1:1)='/'
        AV=REAL(NACC+NREJ)
        AV2=AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        NCX2LA=NCX2LA+1
        IX2LTE(NCX2LA)(1:1)=' '
        NCX2LA=NCX2LA+1
        IX2LTE(NCX2LA)(1:1)='='
        NCX2LA=NCX2LA+1
        IX2LTE(NCX2LA)(1:1)=' '
        AV=REAL(NACC)/REAL(NACC+NREJ)
        AV=100.0*AV
        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(3G15.7)')AV1,AV2,AV
        IF(AV.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AV*10**NUMDIG + CONST)
          AV=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AV,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        IF(ISPX2S.EQ.'DEFAULT')THEN
          CONTINUE
        ELSEIF(ISPX2P.NE.' ')THEN
          DO760I=16,1,-1
            IF(ISPX2S(I:I).NE.' ')THEN
              NTEMP=I
              DO770J=1,NTEMP
                NCX2LA=NCX2LA+1
                IX2LTE(NCX2LA)(1:1)=ISPX2P(J:J)
  770         CONTINUE
              GOTO779
            ENDIF
  760     CONTINUE
  779     CONTINUE
        ENDIF
        CONST=0.5
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
C
      ELSEIF(ISPX2L.EQ.'EFFE')THEN
        IF(ISPX2P.EQ.'DEFAULT')THEN
          IX2LTE(1)='E'
          IX2LTE(2)='F'
          IX2LTE(3)='F'
          IX2LTE(4)='E'
          IX2LTE(5)='C'
          IX2LTE(6)='T'
          IX2LTE(7)=' '
          IX2LTE(8)='='
          IX2LTE(9)=' '
          NCX2LA=9
        ELSEIF(ISPX2P.EQ.' ')THEN
          NCX2LA=0
        ELSE
          DO610I=16,1,-1
            IF(ISPX2P(I:I).NE.' ')THEN
              NCX2LA=I
              DO620J=1,NCX2LA
                IX2LTE(J)(1:1)=ISPX2P(J:J)
  620         CONTINUE
              GOTO629
            ENDIF
  610     CONTINUE
  629     CONTINUE
        ENDIF
        CONST=0.5
        AVAL=ALOWH
        IF(IOUNI5.GT.0)WRITE(IOUNI5,'(G15.7)')AVAL
        IF(AVAL.LT.0.0)CONST=-0.5
        IF(NUMDIG.GE.0)THEN
          IVAL=INT(AVAL*10**NUMDIG + CONST)
          AVAL=REAL(IVAL)/(10**NUMDIG)
        ENDIF
        NCX2LA=NCX2LA+1
        CALL DPCONH(IVAL,AVAL,IX2LTE(NCX2LA),NH,IBUGG2,IERROR)
        NCX2LA=NCX2LA+NH
        IF(ISPX2S.EQ.'DEFAULT')THEN
          CONTINUE
        ELSEIF(ISPX2P.NE.' ')THEN
          DO660I=16,1,-1
            IF(ISPX2S(I:I).NE.' ')THEN
              NTEMP=I
              DO670J=1,NTEMP
                NCX2LA=NCX2LA+1
                IX2LTE(NCX2LA)(1:1)=ISPX2P(J:J)
  670         CONTINUE
              GOTO679
            ENDIF
  660     CONTINUE
  679     CONTINUE
        ENDIF
        CONST=0.5
        PX2LDS=-((PYMAX-PYMIN)-PX2LD2)
C
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SPM3')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPM3--')
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPM4(ICASPL,IOPTN,IDX,IDY,
     1ISUBNU,
     1ISUBSW,
     1ASUBXL,ASUBXU,ASUBYL,ASUBYU,
     1ISUBN9,
     1ISUBSZ,
     1ASBXL2,ASBXU2,ASBYL2,ASBYU2,
     1PSPXSL,PSPXSU,PSPYSL,PSPYSU,
     1IBUGG2,ISUBRO,IERROR)
C
C     PURPOSE--UTILTY ROUTINE FOR SCATTER PLOT MATRIX.  SET SUBREGION
C              LIMITS (IF SPECIFIED BY USER).
C              IOPTN = 1  - SAVE CURENT SETTINGS
C              IOPTN = 2  - RESTORE CURENT SETTINGS
C              IOPTN = 3  - SET SUBREGION LIMITS FOR GIVEN Y, X
C                           PAIR OF VARIABLES.  NOTE IF LIMIT SET TO
C                           CPUMIN OR CPUMAX, THEN NOTHING SET.
C                           ALSO, MATRIX PLOTS ONLY RESET FIRST
C                           SUBREGION (OTHERS ARE LEFT AS IS)
C              IDX   = SETTING OF PSPXSL, PSPXSU TO USE
C              IDY   = SETTING OF PSPYSL, PSPYSU TO USE
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/12
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--DECEMBER  1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES---------------
C
      CHARACTER*4 IBUGG2
      CHARACTER*4 ICASPL
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBSW
      CHARACTER*4 ISUBSZ
C
      DIMENSION ISUBSW(*)
      DIMENSION ASUBXL(*)
      DIMENSION ASUBXU(*)
      DIMENSION ASUBYL(*)
      DIMENSION ASUBYU(*)
      DIMENSION PSPXSL(*)
      DIMENSION PSPXSU(*)
      DIMENSION PSPYSL(*)
      DIMENSION PSPYSU(*)
C
C-----COMMON VARIABLES (GENERAL)----------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-------------------------------------------------
C
CCCCC IF(ISUBRO.EQ.'SPM4')THEN
CCCCC ENDIF
C               ***************************************
C               **  STEP 1--SAVE INITIAL SETTINGS    **
C               ***************************************
C
      IF(IOPTN.EQ.1)THEN
        ISUBSZ=ISUBSW(1)
        ASBXL2=ASUBXL(1)
        ASBXU2=ASUBXU(1)
        ASBYL2=ASUBYL(1)
        ASBYU2=ASUBYU(1)
        ISUBN9=ISUBNU
      ELSEIF(IOPTN.EQ.2)THEN
        ISUBSW(1)=ISUBSZ
        ASUBXL(1)=ASBXL2
        ASUBXU(1)=ASBXU2
        ASUBYL(1)=ASBYL2
        ASUBYU(1)=ASBYU2
        ISUBNU=ISUBN9
      ELSEIF(IOPTN.EQ.3)THEN
        IF(PSPXSL(IDX).NE.CPUMIN .AND. PSPXSU(IDX).NE.CPUMIN)THEN
          ISUBSW(1)='ON'
          IF(ISUBNU.EQ.0)ISUBNU=1
          ASUBXL(1)=PSPXSL(IDX)
          ASUBXU(1)=PSPXSU(IDX)
        ENDIF
        IF(PSPYSL(IDY).NE.CPUMIN .AND. PSPYSU(IDY).NE.CPUMIN)THEN
          ISUBSW(1)='ON'
          IF(ISUBNU.EQ.0)ISUBNU=1
          ASUBYL(1)=PSPYSL(IDY)
          ASUBYU(1)=PSPYSU(IDY)
        ENDIF
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'SPM4')GOTO9090
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPM4--')
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPPA(IHARG,IHARG2,NUMARG,IDEFSL,MAXSPI,ISPILI,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPSPPA(IHARG,NUMARG,IDEFSL,MAXSPI,ISPILI,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE LINE PATTERNS.
C              THESE ARE LOCATED IN THE VECTOR ISPILI(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSL
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ISPILI (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --AUGUST    1995.  DASH2 BUG
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      CHARACTER*4 IHARG2
      CHARACTER*4 IDEFSL
      CHARACTER*4 ISPILI
C
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD1
      CHARACTER*4 IHOLD2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION ISPILI(*)
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='DPSP'
      ISUBN2='PA  '
C
      NUMSPI=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 DPSPPA--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSL
   55 FORMAT('IDEFSL = ',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)ISPILI(1)
   70 FORMAT('ISPILI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ISPILI(I)
   76 FORMAT('I,ISPILI(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
CCCCC IF(IHARG(1).EQ.'ALL')IHOLD1=IHARG(2)
CCCCC IF(IHARG(1).EQ.'ALL')GOTO1300
CCCCC IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(1)
CCCCC IF(IHARG(2).EQ.'ALL')GOTO1300
CCCCC APRIL 1996.  CHANGE IHOLD TO IHOLD1 BELOW
      IF(IHARG(1).EQ.'ALL')THEN
        IHOLD1=IHARG(2)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(2).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      IF(IHARG(2).EQ.'ALL')THEN
        IHOLD1=IHARG(1)
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(1).EQ.'2')IHOLD1='DA2'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(1).EQ.'3')IHOLD1='DA3'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(1).EQ.'4')IHOLD1='DA4'
        IF(IHOLD1.EQ.'DASH'.AND.IHARG2(1).EQ.'5')IHOLD1='DA5'
        GOTO1300
      ENDIF
      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
      NUMSPI=1
      ISPILI(1)='    '
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      J=I
      IHOLD1=IHARG(J)
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'2')IHOLD1='DA2'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'3')IHOLD1='DA3'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'4')IHOLD1='DA4'
      IF(IHOLD1.EQ.'DASH'.AND.IHARG2(J).EQ.'5')IHOLD1='DA5'
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSL
      ISPILI(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,ISPILI(I)
 1276 FORMAT('SPIKE ',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
      NUMSPI=MAXSPI
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='SOLI'
      IF(IHOLD1.EQ.'OFF')IHOLD2='    '
      IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSL
      IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSL
      DO1315I=1,NUMSPI
      ISPILI(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)ISPILI(I)
 1316 FORMAT('ALL SPIKES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPPA--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSL
 9015 FORMAT('IDEFSL = ',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)ISPILI(1)
 9030 FORMAT('ISPILI(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ISPILI(I)
 9036 FORMAT('I,ISPILI(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPSM(X,N,XS,ICHANG,IBUGG3,IERROR)
C
C     PURPOSE--THIS SUBROUTINE TAKES THE DATA IN THE VECTOR X,
C              DETERMINES THE VARIOUS MESAS,
C              AND APPLIES A 3-TERM MEDIAN SMOOTH TO THE DATA
C              BETWEEN EACH MESA.
C     OUTPUT ARGUMENTS--XS     = THE SINGLE PRECISION VECTOR
C                                CONTAINING SMOOTHED VALUES.
C                     --ICHANG = THE CHARACTER VARIABLE
C                                CONTAINING EITHER YES OR NO
C                                DEPENDING ON WHETHER OR NOT THE
C                                SMOOTHED DATA IS CHANGED OR NOT
C                                FROM THE ORIGINAL DATA.
C     OUTPUT--THE COMPUTED SINGLE PRECISION VECTOR
C             OF SMOOTHED VALUES.
C     NOTE--THE VECTOR X REMAINS UNCHANGED.
C     ASSUMPTION--THE VECTOR X HAS AT LEAST 3 VALUES.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--MCNEIL, INTERACTIVE DATA ANALYSIS
C                 1977, PAGE 146
C                 (= SOURCE OF ALGORITHM).
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     VERSION NUMBER--83.6
C     ORIGINAL VERSION--JULY      1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICHANG
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION XS(*)
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
      IERROR='NO'
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSPSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3
   52 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N
   53 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,X(I)
   56 FORMAT('I,X(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               *********************************************
C               **  SPLIT THE DATA AT EACH MESA            **
C               **  AND THEN APPLY A 3-TERM MEDIAN SMOOTH  **
C               **  TO THE SUBSET OF THE DATA              **
C               **  BETWEEN EACH MESA.                     **
C               *********************************************
C
C               ****************************************
C               **  STEP 1--                          **
C               **  COPY THE DATA FROM X(.) TO XS(.)  **
C               ****************************************
C
      DO1100I=1,N
      XS(I)=X(I)
 1100 CONTINUE
C
C               ********************************
C               **  STEP 2--                  **
C               **  SEARCH FOR A MESA IN THE  **
C               **  FIRST 3 OBSERVATIONS      **
C               ********************************
C
      IF(X(2).NE.X(3))GOTO1290
      IF(X(1).LE.X(2).AND.X(3).LE.X(4))GOTO1290
      IF(X(1).GE.X(2).AND.X(3).GE.X(4))GOTO1290
      XS(2)=X(1)
      ARG1=X(3)
      ARG2=X(4)
      ARG3=3*X(4)-2*X(5)
      CALL DPMED3(ARG1,ARG2,ARG3,XMED3,IBUGG3,IERROR)
      XS(3)=XMED3
 1290 CONTINUE
C
C               ***********************************
C               **  STEP 3--                     **
C               **  SEARCH FOR MESAS             **
C               **  IN THE MIDDLE OF THE SERIES  **
C               ***********************************
C
      NM2=N-2
      IF(3.GT.NM2)GOTO1390
      DO1300I=3,NM2
C
      IM2=I-2
      IM1=I-1
      IP1=I+1
      IP2=I+2
      IP3=I+3
C
      IF(X(I).NE.X(IP1))GOTO1300
      IF(X(IM1).LE.X(I).AND.X(IP1).LE.X(IP2))GOTO1300
      IF(X(IM1).GE.X(I).AND.X(IP1).GE.X(IP2))GOTO1300
C
      ARG1=X(I)
      ARG2=X(IM1)
      ARG3=3*X(IM1)-2*X(IM2)
      CALL DPMED3(ARG1,ARG2,ARG3,XMED3,IBUGG3,IERROR)
      XS(I)=XMED3
C
      ARG1=X(IP1)
      ARG2=X(IP2)
      ARG3=3*X(IP2)-2*X(IP3)
      CALL DPMED3(ARG1,ARG2,ARG3,XMED3,IBUGG3,IERROR)
      XS(IP1)=XMED3
C
 1300 CONTINUE
 1390 CONTINUE
C
C               ********************************
C               **  STEP 4--                  **
C               **  SEARCH FOR A MESA IN THE  **
C               **  LAST  3 OBSERVATIONS      **
C               ********************************
C
      NM1=N-1
      NM2=N-2
      NM3=N-3
      NM4=N-4
      IF(X(NM1).NE.X(NM2))GOTO1490
      IF(X(N).LE.X(NM1).AND.X(NM2).LE.X(NM3))GOTO1490
      IF(X(N).GE.X(NM1).AND.X(NM2).GE.X(NM3))GOTO1490
      XS(NM1)=X(N)
      ARG1=X(NM2)
      ARG2=X(NM3)
      ARG3=3*X(NM3)-2*X(NM4)
      CALL DPMED3(ARG1,ARG2,ARG3,XMED3,IBUGG3,IERROR)
      XS(NM2)=XMED3
 1490 CONTINUE
C               *********************************************
C               **  STEP 5--                               **
C               **  CHECK TO SEE IF A CHANGE HAS OCCURRED  **
C               **  BETWEEN THE RAW DATA AND               **
C               **  THE SPLIT & SMOOTHED DATA.             **
C               *********************************************
C
      ICHANG='NO'
      DO1500I=1,N
      IF(XS(I).NE.X(I))GOTO1510
 1500 CONTINUE
      GOTO1590
 1510 CONTINUE
      ICHANG='YES'
 1590 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 DPSPSM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3
 9012 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICHANG
 9013 FORMAT('ICHANG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N
 9014 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,X(I),XS(I)
 9016 FORMAT('I,X(I),XS(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPSW(IHARG,NUMARG,IDEFSS,MAXSPI,ISPISW,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE SWITCHES.
C              THESE ARE LOCATED IN THE VECTOR ISPISW(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG
C                     --IDEFSS
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--ISPISW (A CHARACTER VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFSS
      CHARACTER*4 ISPISW
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 ISPISW(*)
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='DPSP'
      ISUBN2='SW  '
C
      NUMSPI=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 DPSPSW--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSS
   55 FORMAT('IDEFSS = ',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)ISPISW(1)
   70 FORMAT('ISPISW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,ISPISW(I)
   76 FORMAT('I,ISPISW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   90 CONTINUE
C
C               **************************************
C               **  STEP 1--                        **
C               **  BRANCH TO THE APPROPRIATE CASE  **
C               **************************************
C
      ISTEPN='1'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1100
      IF(NUMARG.EQ.1)GOTO1110
      IF(NUMARG.EQ.2)GOTO1120
      GOTO1130
C
 1100 CONTINUE
      GOTO1200
C
 1110 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1='OFF'
      IF(IHARG(1).EQ.'ALL')GOTO1300
      GOTO1200
C
 1120 CONTINUE
      IF(IHARG(1).EQ.'ALL')IHOLD1=IHARG(2)
      IF(IHARG(1).EQ.'ALL')GOTO1300
      IF(IHARG(2).EQ.'ALL')IHOLD1=IHARG(1)
      IF(IHARG(2).EQ.'ALL')GOTO1300
      GOTO1200
C
 1130 CONTINUE
      GOTO1200
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  TREAT THE INDIVIDUAL SPECIFICATIONS CASE  **
C               *************************************************
C
 1200 CONTINUE
      ISTEPN='2'
      IF(IBUGP2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO1210
      GOTO1220
C
 1210 CONTINUE
      NUMSPI=1
      ISPISW(1)='ON'
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      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=IDEFSS
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSS
      ISPISW(I)=IHOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,ISPISW(I)
 1276 FORMAT('SPIKE ',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
      NUMSPI=MAXSPI
      IHOLD2=IHOLD1
      IF(IHOLD1.EQ.'ON')IHOLD2='ON'
      IF(IHOLD1.EQ.'OFF')IHOLD2='OFF'
CCCCC IF(IHOLD1.EQ.'AUTO')IHOLD2=IDEFSS
CCCCC IF(IHOLD1.EQ.'DEFA')IHOLD2=IDEFSS
      DO1315I=1,NUMSPI
      ISPISW(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)ISPISW(I)
 1316 FORMAT('ALL SPIKES HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPSW--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)IDEFSS
 9015 FORMAT('IDEFSS = ',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)ISPISW(1)
 9030 FORMAT('ISPISW(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,ISPISW(I)
 9036 FORMAT('I,ISPISW(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSPTH(IHARG,IARGT,ARG,NUMARG,PDEFST,MAXSPI,PSPITH,
     1IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE SPIKE THICKNESSES.
C              THESE ARE LOCATED IN THE VECTOR PSPITH(.).
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG
C                     --NUMARG
C                     --PDEFST
C                     --MAXSPI
C                     --IBUGP2 ('ON' OR 'OFF' )
C     OUTPUT ARGUMENTS--PSPITH (A FLOATING POINT VECTOR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1983.
C     UPDATED         --JANUARY   1989.  ERROR IN FORMAT STATEMENT (ALAN)
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 PSPITH(*)
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='DPSP'
      ISUBN2='TH  '
C
      NUMSPI=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 DPSPTH--')
      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)MAXSPI,NUMSPI
   53 FORMAT('MAXSPI,NUMSPI = ',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)PDEFST
   55 FORMAT('PDEFST = ',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)PSPITH(1)
   70 FORMAT('PSPITH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO75I=1,10
      WRITE(ICOUT,76)I,PSPITH(I)
   76 FORMAT('I,PSPITH(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=PDEFST
      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
      NUMSPI=1
      PSPITH(1)=PDEFST
      GOTO1270
C
 1220 CONTINUE
      NUMSPI=NUMARG-1
      IF(NUMSPI.GT.MAXSPI)NUMSPI=MAXSPI
      DO1225I=1,NUMSPI
      J=I+1
      IHOLD1=IHARG(J)
      HOLD1=ARG(J)
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFST
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFST
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFST
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFST
      PSPITH(I)=HOLD2
 1225 CONTINUE
      GOTO1270
C
 1270 CONTINUE
      IF(IFEEDB.EQ.'OFF')GOTO1279
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      DO1278I=1,NUMSPI
      WRITE(ICOUT,1276)I,PSPITH(I)
 1276 FORMAT('SPIKE 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
      NUMSPI=MAXSPI
      HOLD2=HOLD1
      IF(IHOLD1.EQ.'ON')HOLD2=PDEFST
      IF(IHOLD1.EQ.'OFF')HOLD2=PDEFST
      IF(IHOLD1.EQ.'AUTO')HOLD2=PDEFST
      IF(IHOLD1.EQ.'DEFA')HOLD2=PDEFST
      DO1315I=1,NUMSPI
      PSPITH(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)PSPITH(I)
 1316 FORMAT('ALL SPIKE THICKNESSES HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1319 CONTINUE
      IFOUND='YES'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSPTH--')
      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)MAXSPI,NUMSPI
 9013 FORMAT('MAXSPI,NUMSPI = ',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)PDEFST
 9015 FORMAT('PDEFST = ',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)PSPITH(1)
 9030 FORMAT('PSPITH(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,10
      WRITE(ICOUT,9036)I,PSPITH(I)
 9036 FORMAT('I,PSPITH(I) = ',I8,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSQUE(PX,PY,NP,
     1PXMIN,PXMAX,PYMIN,PYMAX)
C
C     PURPOSE--SCAN EACH VALUE OF PX(.) AND
C              COMPARE IT TO (PXMIN,PXMAX).
C              IF ONLY SLIGHTLY SMALLER THAN PXMIN,
C              THEN CHANGE PX(I) TO PXMAX.
C              IF ONLY SLIGHTLY LARGER THAN PXMAX,
C              THEN CHANGE PX(I) TO PXMAX.
C              SIMILARLY, SCAN EACH VALUE OF PY(.) AND
C              COMPARE IT TO (PYMIN,PYMAX).
C              IF ONLY SLIGHTLY SMALLER THAN PYMIN,
C              THEN CHANGE PY(I) TO PYMAX.
C              IF ONLY SLIGHTLY LARGER THAN PYMAX,
C              THEN CHANGE PY(I) TO PYMAX.
C     NOTE--THIS SUBROUTINE COUNTERACTS INCORRECT
C           COORDINATE CALCULATIONS FOR P WHICH ARE
C           INCORRECT DUE TO ROUNDOFF ERROR
C           AND SQUEEZES THEM BACK TO THEIR PROPER VALUE.
C     DANGER--PX(.) AND PY(.) SERVE AS BOTH INPUT AND
C             OUTPUT ARGUMENTS IN THIS SUBROUTINE.
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-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--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C--------------------------------------------------------
C
      DIMENSION PX(*)
      DIMENSION PY(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SQUE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSQUE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)PXMIN,PXMAX,PYMIN,PYMAX
   52 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NP
   54 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NP
      DELXMN=PXMIN-PX(I)
      DELXMX=PX(I)-PXMAX
      DELYMN=PYMIN-PY(I)
      DELYMX=PY(I)-PYMAX
      WRITE(ICOUT,56)I,PX(I),PY(I)
   56 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)DELXMN,DELXMX,DELYMN,DELYMN
   57 FORMAT('DELXMN,DELXMX,DELYMN,DELYMN = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************************
C               **  STEP 1--                                   **
C               **  CHECK TO SEE IF PX(.) NEAR PXMIN OR PXMAX  **
C               *************************************************
C
      IF(NP.LE.0)GOTO1190
      DO1100I=1,NP
C
      IF(PX(I).LT.PXMIN)GOTO1110
      IF(PX(I).GT.PXMAX)GOTO1120
      GOTO1100
C
 1110 CONTINUE
      DELMIN=PXMIN-PX(I)
      IF(DELMIN.LE.0.0001)PX(I)=PXMIN
      GOTO1100
C
 1120 CONTINUE
      DELMAX=PX(I)-PXMAX
      IF(DELMAX.LE.0.0001)PX(I)=PXMAX
      GOTO1100
C
 1100 CONTINUE
 1190 CONTINUE
C
C               *************************************************
C               **  STEP 2--                                   **
C               **  CHECK TO SEE IF PY(.) NEAR PYMIN OR PYMAX  **
C               *************************************************
C
      IF(NP.LE.0)GOTO1290
      DO1200I=1,NP
C
      IF(PY(I).LT.PYMIN)GOTO1210
      IF(PY(I).GT.PYMAX)GOTO1220
      GOTO1200
C
 1210 CONTINUE
      DELMIN=PYMIN-PY(I)
      IF(DELMIN.LE.0.0001)PY(I)=PYMIN
      GOTO1200
C
 1220 CONTINUE
      DELMAX=PY(I)-PYMAX
      IF(DELMAX.LE.0.0001)PY(I)=PYMAX
      GOTO1200
C
 1200 CONTINUE
 1290 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SQUE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSQUE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)PXMIN,PXMAX,PYMIN,PYMAX
 9012 FORMAT('PXMIN,PXMAX,PYMIN,PYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      DELXMN=PXMIN-PX(I)
      DELXMX=PX(I)-PXMAX
      DELYMN=PYMIN-PY(I)
      DELYMX=PY(I)-PYMAX
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)DELXMN,DELXMX,DELYMN,DELYMN
 9017 FORMAT('DELXMN,DELXMX,DELYMN,DELYMN = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSTAC(ICASL8,ILOCV,
     1IFOUNZ,IBEGIN,IEND,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1,
     1TEMP,TEMP2,XTEMP1,XTEMP2,XTEMP3,MAXNXT,
CCCCC JULY 2002.  ADD ISEED FOR HODHES-LEHMAN
     1ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--TREAT THE TYPE 8 LET CASE--
C              COMPUTE ELEMENTARY STATISTICS (MOSTLY).
C                      LET A = NUMBER X
C                      LET A = SIZE X
C                      LET A = COUNT X
C
C                      LET A = SUM X
C                      LET A = PRODUCT X
C                      LET A = INTEGRAL X
C                      LET A = RATIO X1 X2
C
C                      LET A = MIDRANGE X
C                      LET A = MEAN X
C                      LET A = AVERAGE X
C                      LET A = MIDMEAN X
C                      LET A = MEDIAN X
C                      LET A = TRIMMED MEAN X
C                      LET A = WINDSORIZED MEAN X
C                      LET A = STANDARD DEVIATION X
C                      LET A = VARIANCE X
C                      LET A = COEFFICIENT OF VARIATION X
C                      LET A = RELATIVE STANDARD DEVIATION X
C                      LET A = RELATIVE VARIANCE X
C                      LET A = AVERAGE ABSOLUTE DEVIATION X
C                      LET A = RANGE X
C                      LET A = MINIMUM X
C                      LET A = MIN X
C                      LET A = MAXIMUM X
C                      LET A = MAX X
C                      LET A = EXTREME X
C                      LET A = STANDARDIZED THIRD CENTRAL MOMENT X
C                      LET A = SKEWNESS X
C                      LET A = STANDARDIZED FOURTH CENTRAL MOMENT X
C                      LET A = KURTOSIS X
C                      LET A = AUTOCORRELATION X
C                      LET A = COVARIANCE X Y
C                      LET A = CORRELATION X Y
C                      LET A = RANK CORRELATION X Y
C                      LET A = KENDELLS TAU X Y
C                      LET A = COMOVEMENT X Y (LEIGH-PEARLMAN)
C                      LET A = RANK COMOVEMENT X Y
C                      LET A = STANDARD DEVIATION OF MEAN X
C                      LET A = VARIANCE OF MEAN X
C                      LET A = STANDARD DEVIATION OF THE MEAN X
C                      LET A = STANDARD DEVIATION MEAN X
C
C                      LET A = WEIGHTED MEAN X W
C                      LET A = WEIGHTED MEDIAN X W
C                      LET A = WEIGHTED STANDARD DEVIATION X W
C                      LET A = WEIGHTED VARIANCE X W
C                      LET A = WEIGHTED TRIMMED MEAN X W
C
C                      LET A = CP X
C                      LET A = CPL X
C                      LET A = CPU X
C                      LET A = CPK X
C                      LET A = CNPK X
C                      LET A = CPM X
C                      LET A = CC X
C                      LET A = PERCENT DEFECTIVE X
C                      LET A = EXPECTED LOSS X
C
C                      LET A = NORMAL PPCC X
C
C                      LET A = LINEAR INTERCEPT Y X
C                      LET A = LINEAR SLOPE Y X
C                      LET A = LINEAR RESSD Y X
C                      LET A = LINEAR CORRELATION Y X
C                      LET A = REPEATABILITY SD Y X
C                      LET A = REPRODUCABILITY SD Y X
C
C                      LET A = (TAGUCHI) SN- X
C                      LET A = (TAGUCHI) SN0 X
C                      LET A = (TAGUCHI) SN+ X
C                      LET A = (TAGUCHI) SN00 X
C
C                      LET A = MEDIAN ABSOLUTE DEVIATION X
C                      LET A = MAD X
C                      LET A = SN X
C                      LET A = QN X
C                      LET A = 95 PERCENTILE X
C
C                      LET A = GEOMETRIC MEAN X W
C                      LET A = GEOMETRIC STANDARD DEVIATION X W
C
C                      LET A = COMMON DIGITS X
C                      LET A = NUMBER OF COMMON DIGITS X
C
C                      LET A = INTERQUARTILE RANGE X
C
C                      LET A = BIWEIGHT LOCATION X
C                      LET A = BIWEIGHT SCALE X
C
C                      LET A = WINSORIZED VARIANCE X
C                      LET A = WINSORIZED SD X
C                      LET A = WINSORIZED COVARIANCE X Y
C                      LET A = WINSORIZED CORRELATION X Y
C                      LET A = PERCENTAGE BEND MIDVARIANCE X
C                      LET A = PERCENTAGE BEND CORRELATION X1 X2
C                      LET A = HODGES LEHMAN X
C                      LET A = BIWEIGHT MIDVARIANCE X
C                      LET A = BIWEIGHT MIDCOVARIANCE X Y
C                      LET A = BIWEIGHT MIDCORRELATION X Y
C                      LET A = TRIMMED MEAN STANDARD ERROR X
C                      LET A = ... QUANTILE X
C                      LET A = ... QUANTILE STANDARD ERROR X
C
C              FOLLOWING STATISTICS COMPUTE DIFFERENCE IN
C              STATISTIC FOR TWO RESPONSE VARIABLES (USED FOR
C              LOCATION AND SCALE STATISTICS):
C
C              LOCATION:
C                      LET A = DIFFERENCE OF MEANS X1 X2
C                      LET A = DIFFERENCE OF MIDMEANS X1 X2
C                      LET A = DIFFERENCE OF MEDIANS X1 X2
C                      LET A = DIFFERENCE OF TRIMMED MEANS X1 X2
C                      LET A = DIFFERENCE OF WINSORIZED MEANS X1 X2
C                      LET A = DIFFERENCE OF GEOMETRIC MEANS X1 X2
C                      LET A = DIFFERENCE OF HARMONIC MEANS X1 X2
C                      LET A = DIFFERENCE OF HODGES-LEHMAN X1 X2
C                      LET A = DIFFERENCE OF BIWEIGHT LOCATION X1 X2
C
C              SCALE:
C                      LET A = DIFFERENCE OF STANDARD DEVIATIONS X1 X2
C                      LET A = DIFFERENCE OF VARIANCES X1 X2
C                      LET A = DIFFERENCE OF AAD X1 X2
C                      LET A = DIFFERENCE OF MAD X1 X2
C                      LET A = DIFFERENCE OF SN X1 X2
C                      LET A = DIFFERENCE OF QN X1 X2
C                      LET A = DIFFERENCE OF INTERQUARTILE RANGE X1 X2
C                      LET A = DIFFERENCE OF WINSORIZED SD X1 X2
C                      LET A = DIFFERENCE OF WINSORIZED VARIANCE X1 X2
C                      LET A = DIFFERENCE OF BIWEIGHT MIDVARIANCE X1 X2
C                      LET A = DIFFERENCE OF BIWEIGHT SCALE X1 X2
C                      LET A = DIFFERENCE OF PERCENTAGE BEND X1 X2
C                      LET A = DIFFERENCE OF GEOMETRIC SD X1 X2
C                      LET A = DIFFERENCE OF RANGE X1 X2
C                      LET A = DIFFERENCE OF MIDRANGE X1 X2
C                      LET A = DIFFERENCE OF QUANTILE X1 X2
C                      LET A = DIFFERENCE OF SKEWNESS X1 X2
C                      LET A = DIFFERENCE OF KURTOSIS X1 X2
C                      LET A = DIFFERENCE OF RELATIVE SD X1 X2
C                      LET A = DIFFERENCE OF SD OF MEAN X1 X2
C                      LET A = DIFFERENCE OF RELATIVE VARIANCE X1 X2
C                      LET A = DIFFERENCE OF VARIANCE OF THE MEAN X1 X2
C                      LET A = DIFFERENCE OF MINIMUM X1 X2
C                      LET A = DIFFERENCE OF MAXIMUM X1 X2
C                      LET A = DIFFERENCE OF EXTREMES X1 X2
C                      LET A = DIFFERENCE OF COEFFICENT OF VARI X1 X2
C                      LET A = DIFFERENCE OF COUNTS X1 X2
C                      LET A = DIFFERENCE OF SUM X1 X2
C
C     NOTE--THIS SUBROUTINE OPERATES ON A VECTOR
C           AND PRODUCES A PARAMETER (= A SCALAR);
C           THIS IS TO BE CONTRASTED WITH DPLET7 WHICH
C           OPERATES ON A VECTOR
C           BUT PRODUCES A VECTOR.
C     NOTE-INPUT WILL NECESSARILY BE A VECTOR (OR 2 VECTORS).
C          OUTPUT WILL NECESSARILY BE A SCALAR--
C               1) PARAMETER, OR
C               2) ELEMENT OF A VECTOR.
C          THE STATISTICS CAN BE CALCULATED ON A FULL VARIABLE
C          OR ON A PARTIAL VARIABLE.
C     EXAMPLE--LET A    = MEAN X                      (A FULL VARIABLE)
C            --LET Y(4) = MEAN X                      (A FULL VARIABLE)
C            --LET A    = MEAN X   SUBSET 2 3 5       (A PARTIAL VAR.)
C            --LET Y(4) = MEAN X   SUBSET 2 3 5       (A PARTIAL VAR.)
C            --LET A    = MEAN X   FOR I = 1 2 10     (A PARTIAL VAR.)
C            --LET Y(4) = MEAN X   FOR I = 1 2 10     (A PARTIAL VAR.)
C            --LET A    = CORRELATION X Y              (A FULL VARIABLE
C            --LET Y(4) = CORRELATION X Y              (A FULL VARIABLE
C            --LET A    = CORRELATION X Y  SUBSET 2 3 5     (A PARTIAL
C            --LET Y(4) = CORRELATION X Y  SUBSET 2 3 5     (A PARTIAL
C            --LET A    = CORRELATION X Y  FOR I = 1 2 10   (A PARTIAL
C            --LET Y(4) = CORRELATION X Y  FOR I = 1 2 10   (A PARTIAL
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION (AS A PART OF DPLET)--DECEMBER 1977.
C     UPDATED         --MAY       1982.
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MARCH 1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --APRIL     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --JUNE      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --NOVEMBER  1981.
C     UPDATED         --NOVEMBER  1987.  (EXIT OUT IF ERROR)
C     UPDATED         --AUGUST    1988.  (WEIGHTED MEAN, MEDIAN, SD, VARIANCE)
C     UPDATED         --DECEMBER  1988.  LET Y(K) = MEAN X INSIDE LOOP
C     UPDATED         --JANUARY   1989.  TRY TO REUSE A PARAM. AS A VAR.
C     UPDATED         --FEBRUARY  1989.  AVERAGE ABSOLUTE DEVIATION (ALAN)
C     UPDATED         --APRIL     1990.  EXTREME
C     UPDATED         --SEPTEMBER 1990.  CP, CPK, % DEF, EXP. LOSS
C     UPDATED         --AUGUST    1991.  COMOVEMENT
C     UPDATED         --FEBRUARY  1994.  CHANGE ICASL8: RSD => RESD
C     UPDATED         --FEBRUARY  1994.  CHANGE ICASL8: SDM => SDME
C     UPDATED         --FEBRUARY  1994.  RELATIVE VARIANCE
C     UPDATED         --FEBRUARY  1994.  VARIANCE OF THE MEAN
C     UPDATED         --FEBRUARY  1994.  NORMAL PPCC
C     UPDATED         --FEBRUARY  1994.  TAGUCHI SN- SN0 SN+ SN00
C     UPDATED         --NOVEMBER  1994.  DISTINGUISH RELATIVE SD AND
C                                        COEF OF VARIATION CASES.
C     UPDATED         --MARCH     1995.  MAD
C     UPDATED         --NOVEMBER  1998.  <VALUE> PERCENTILE
C     UPDATED         --NOVEMBER  1998.  CPM, CC
C     UPDATED         --MARCH     1999.  CNPK
C     UPDATED         --MARCH     1999.  GEOMETRIC MEAN
C     UPDATED         --MARCH     1999.  GEOMETRIC STANDARD DEVIATION
C     UPDATED         --APRIL     2001.  ARGUMENT LIST TO CP, CPK, CPM
C     UPDATED         --APRIL     2001.  CPL, CPU
C     UPDATED         --AUGUST    2001.  COMMON DIGITS
C     UPDATED         --AUGUST    2001.  NUMBER OF COMMON DIGITS
C     UPDATED         --SEPTEMBER 2001.  IQ RANGE
C     UPDATED         --NOVEMBER  2001.  BIWEIGHT LOCATION
C     UPDATED         --NOVEMBER  2001.  BIWEIGHT SCALE
C     UPDATED         --JULY      2002.  WINSORIZED VARIANCE
C     UPDATED         --JULY      2002.  WINSORIZED SD
C     UPDATED         --JULY      2002.  WINSORIZED COVARIANCE
C     UPDATED         --JULY      2002.  WINSORIZED CORRELATION
C     UPDATED         --JULY      2002.  HODGES LEHMAN
C     UPDATED         --JULY      2002.  PERCENTAGE BEND MIDVARIANCE
C     UPDATED         --JULY      2002.  PERCENTAGE BEND CORRELATION
C     UPDATED         --JULY      2002.  BIWEIGHT MIDVARIANCE
C     UPDATED         --JULY      2002.  BIWEIGHT MIDCOVARIANCE
C     UPDATED         --JULY      2002.  BIWEIGHT MIDCORRELATION
C     UPDATED         --JULY      2002.  TRIMMED MEAN STANDARD ERROR
C     UPDATED         --JULY      2002.  QUANTILE STANDARD ERROR
C     UPDATED         --JULY      2002.  QUANTILE
C     UPDATED         --MARCH     2003.  ADD 32 "DIFFERENCE OF"
C                                        STATISTICS
C     UPDATED         --APRIL     2003.  ADD SN AND QN (AND DIFFERENCE
C                                        OF).  REQUIRED ADDITIONAL
C                                        SCRATCH ARRAYS.
C     UPDATED         --MAY       2003.  ADD WEIGHTED TRIMMED MEAN
C     UPDATED         --DECEMBER  2003.  BUG IN INTEGRAL (DETERMINE
C                                        WHETHER 1 OR 2 VARIABLES
C                                        SPECIFIED)
C     UPDATED         --OCTOBER   2004.  KENDELLS TAU
C     UPDATED         --FEBRUARY  2005.  REPEATABILITY SD
C     UPDATED         --FEBRUARY  2005.  REPRODUCABILITY SD
C     UPDATED         --SEPTEMBER 2005.  RATIO
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      EXTERNAL SUM
      EXTERNAL RANGE
C
      CHARACTER*4 ICASL8
      CHARACTER*4 IFOUNZ
      CHARACTER*4 ITYPE
      CHARACTER*4 IHOL
      CHARACTER*4 IHOL2
      CHARACTER*4 IERRO1
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 NEWNAM
      CHARACTER*4 NEWCOL
      CHARACTER*4 ICASEL
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IWRITE
      CHARACTER*4 IHARG3
      CHARACTER*4 IHARG4
      CHARACTER*4 IHARG5
      CHARACTER*4 IHARG6
      CHARACTER*4 ILEFT
      CHARACTER*4 ILEFT2
      CHARACTER*4 ISUBSF
      CHARACTER*4 IFORF
      CHARACTER*4 IARG4T
      CHARACTER*4 IARG4F
      CHARACTER*4 IHSET
      CHARACTER*4 IHSET2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFLAGD
C
C---------------------------------------------------------------------
C
      DIMENSION IFOUNZ(*)
      DIMENSION IBEGIN(*)
      DIMENSION IEND(*)
      DIMENSION ITYPE(*)
      DIMENSION IHOL(*)
      DIMENSION IHOL2(*)
      DIMENSION INT1(*)
      DIMENSION FLOAT1(*)
      DIMENSION IERRO1(*)
C
      DIMENSION TEMP(*)
      DIMENSION TEMP2(*)
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
      DIMENSION XTEMP3(*)
C
      DIMENSION ITEMP1(*)
      DIMENSION ITEMP2(*)
      DIMENSION ITEMP3(*)
      DIMENSION ITEMP4(*)
      DIMENSION ITEMP5(*)
      DIMENSION ITEMP6(*)
C
C---------------------------------------------------------------------
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
      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
      ISUBN1='DPST'
      ISUBN2='AC  '
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
      ICOLL=0
      ICOL2=0
      NIRIG2=0
      ILOCSV=0
CCCCC FEBRUARY 1998.  ADD FOLLOWING LINE.  CAUSED A PROBLEM IN
CCCCC SOME CASES (RS_6000 COMPILED WITH f2c)
      NIOLD=0
C
      ICASEL='UNKN'
C
C               **********************************************************
C               **  TREAT THE SUBCASE OF CALCULATING CERTAIN            **
C               **  ELEMENTARY STATISTICS (MEAN, SD, ETC.)              **
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 DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA3,IBUGQ
   52 FORMAT('IBUGA3,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASL8,ILOCV
   53 FORMAT('ICASL8,ILOCV = ',A4,2X,I8)
      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
      ISUBRO='UNKN'
      IFLAGD='OFF'
      IF(ICASL8.EQ.'DMEA')IFLAGD='ON'
      IF(ICASL8.EQ.'DMDM')IFLAGD='ON'
      IF(ICASL8.EQ.'DMED')IFLAGD='ON'
      IF(ICASL8.EQ.'DTRM')IFLAGD='ON'
      IF(ICASL8.EQ.'DWNM')IFLAGD='ON'
      IF(ICASL8.EQ.'DGEO')IFLAGD='ON'
      IF(ICASL8.EQ.'DHAR')IFLAGD='ON'
      IF(ICASL8.EQ.'DHDL')IFLAGD='ON'
      IF(ICASL8.EQ.'DBIW')IFLAGD='ON'
      IF(ICASL8.EQ.'DSD ')IFLAGD='ON'
      IF(ICASL8.EQ.'DVAR')IFLAGD='ON'
      IF(ICASL8.EQ.'DAAD')IFLAGD='ON'
      IF(ICASL8.EQ.'DMAD')IFLAGD='ON'
      IF(ICASL8.EQ.'DIQR')IFLAGD='ON'
      IF(ICASL8.EQ.'DWSD')IFLAGD='ON'
      IF(ICASL8.EQ.'DWVA')IFLAGD='ON'
      IF(ICASL8.EQ.'DBIM')IFLAGD='ON'
      IF(ICASL8.EQ.'DBIS')IFLAGD='ON'
      IF(ICASL8.EQ.'DPBN')IFLAGD='ON'
      IF(ICASL8.EQ.'DGSD')IFLAGD='ON'
      IF(ICASL8.EQ.'DRAN')IFLAGD='ON'
      IF(ICASL8.EQ.'DMDR')IFLAGD='ON'
      IF(ICASL8.EQ.'DQUA')IFLAGD='ON'
      IF(ICASL8.EQ.'DSKE')IFLAGD='ON'
      IF(ICASL8.EQ.'DKUR')IFLAGD='ON'
      IF(ICASL8.EQ.'DRSD')IFLAGD='ON'
      IF(ICASL8.EQ.'DSDM')IFLAGD='ON'
      IF(ICASL8.EQ.'DRVA')IFLAGD='ON'
      IF(ICASL8.EQ.'DVAM')IFLAGD='ON'
      IF(ICASL8.EQ.'DMIN')IFLAGD='ON'
      IF(ICASL8.EQ.'DMAX')IFLAGD='ON'
      IF(ICASL8.EQ.'DEXT')IFLAGD='ON'
      IF(ICASL8.EQ.'DCVA')IFLAGD='ON'
      IF(ICASL8.EQ.'DCOU')IFLAGD='ON'
      IF(ICASL8.EQ.'DSUM')IFLAGD='ON'
      IF(ICASL8.EQ.'DSN')IFLAGD='ON'
      IF(ICASL8.EQ.'DQN')IFLAGD='ON'
C
C               ****************************************************************
C               **  STEP 2--                                                   *
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='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC CALL DPTYP8(IANS,IWIDTH,IHNAME,IHNAM2,NUMNAM,MAXNAM,IBUGA3,
CCCCC1                  IFOUNZ,ITYPE,IHOL,IHOL2,INT1,FLOAT1,IERRO1)
      ILEFT=IHOL(2)
      ILEFT2=IHOL2(2)
      DO200I=1,NUMNAM
      I2=I
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO215
      IF(ILEFT.EQ.IHNAME(I).AND.ILEFT2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO210
  200 CONTINUE
      NEWNAM='YES'
      ILISTL=NUMNAM+1
      IF(ILISTL.GT.MAXNAM)GOTO220
      GOTO230
C
  220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,221)
  221 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,222)
  222 FORMAT('      THE NUMBER OF VARIABLE AND/OR PARAMETER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,223)MAXNAM
  223 FORMAT('      NAMES HAS JUST EXCEEDED THE MAX ALLOWABLE ',
     1I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,224)
  224 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,225)
  225 FORMAT('      ENTER      STATUS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,226)
  226 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,227)
  227 FORMAT('      AND THEN REDEFINE (REUSE) SOME OF THE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,228)
  228 FORMAT('      ALREADY-USED NAMES')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  230 CONTINUE
      IARG4F=IFOUNZ(4)
      ISUBSF=IFOUNZ(11)
      IFORF=IFOUNZ(21)
      IF(IARG4F.EQ.'NO')GOTO290
      NIOLD=0
      ICOLL=NUMCOL+1
      IF(ICOLL.GT.MAXCOL)GOTO240
      MAXNI=0
      DO235I=1,12
      IF(IUSE(I).EQ.'V')GOTO236
      GOTO235
  236 CONTINUE
      IF(IN(I).GT.MAXNI)MAXNI=IN(I)
  235 CONTINUE
      IF(MAXNI.EQ.0)MAXNI=MAXN
      GOTO290
C
  240 CONTINUE
      WRITE(ICOUT,241)
  241 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,242)
  242 FORMAT('      THE NUMBER OF DATA COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,243)MAXCOL
  243 FORMAT('      HAS JUST EXCEEDED THE MAX ALLOWABLE ',I8,'  .')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,244)
  244 FORMAT('      SUGGESTED ACTION--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,245)
  245 FORMAT('      ENTER      STATUS VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,246)
  246 FORMAT('      TO FIND OUT THE FULL LIST OF USED COLUMNS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,247)
  247 FORMAT('      AND THEN OVERWRITE SOME COLUMNS.   EXAMPLE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,248)
  248 FORMAT('      IF (E.G.)   LET Y(3) = MEAN X          FAILED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,249)
  249 FORMAT('      THEN ONE MIGHT ENTER     NAME Y 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,250)
  250 FORMAT('      (THEREBY EQUATING THE NAME Y WITH COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,251)
  251 FORMAT('      FOLLOWED BY              LET Y(3) = MEAN X ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,252)
  252 FORMAT('      (WHICH WILL ACTUALLY OVERWRITE ROW 3 ',
     1'OF COLUMN 7')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,253)
  253 FORMAT('      WITH THE CALCULATED MEAN OF VARIABLE X)')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  215 CONTINUE
      ILISTL=I2
CCCCC THE FOLLOWING LINE WAS COMMENTED OUT (JANUARY 1989)
CCCCC AND REPLACED BY THE SUCCEEDING 12 LINES (JANUARY 1989)
CCCCC TO FIX PROBLEM OF REUSING A PARAMETER AS A VARIABLE  (JANUARY 1989)
CCCCC GOTO290
      IF(IFOUNZ(4).EQ.'NO')GOTO290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,216)
  216 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,217)IHOL(2),IHOL2(2)
  217 FORMAT('      AN ATTEMPT WAS MADE TO USE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,218)
  218 FORMAT('      AS A VARIABLE, EVEN THOUGH IT ALREADY EXISTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,219)
  219 FORMAT('      AS A PARAMETER.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  210 CONTINUE
      ILISTL=I2
      ICOLL=IVALUE(ILISTL)
      NIOLD=IN(ILISTL)
  290 CONTINUE
C
C               ****************************************************************
C               **  STEP 3--                                                   *
C               **  EXAMINE THE RIGHT-HAND SIDE--                              *
C               **  HAS THE VARIABLE OR COLUMN ON THE RIGHT                    *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     IRIGHT    IS THE NAME OF THE VARIABLE        *
C               **  ON THE RIGHT.                                              *
C               **  NOTE THAT     ILISTR    IS THE LINE IN THE TABLE           *
C               **  OF THE VARIABLE OR COLUMN ON THE RIGHT.                    *
C               **  NOTE THAT     ICOLR    IS THE DATA COLUMN (1 TO 12)        *
C               **  FOR THE VARIABLE OR COLUMN ON THE RIGHT.                   *
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ********************************************
C               **  STEP 4--                              **
C               **  BRANCH BETWEEN 1-VARIABLE STATISTICS  **
C               **  (E.G., MEAN, SD, MIN, ETC.)           **
C               **  AND 2-VARIABLE STATISTICS             **
C               **  (CORRELATION AND RANK CORRELATION).   **
C               ********************************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVIN=1
      IF(ICASL8.EQ.'COVA')GOTO2000
      IF(ICASL8.EQ.'CORR')GOTO2000
CCCCC THE FOLLOWING LINE WAS ADDED    AUGUST 1991    JJF
      IF(ICASL8.EQ.'COMO')GOTO2000
      IF(ICASL8.EQ.'RACV')GOTO2000
      IF(ICASL8.EQ.'RACR')GOTO2000
CCCCC THE FOLLOWING LINE WAS ADDED    AUGUST 1991    JJF
      IF(ICASL8.EQ.'RACM')GOTO2000
      IF(ICASL8.EQ.'LIIN')GOTO2000
      IF(ICASL8.EQ.'LISL')GOTO2000
      IF(ICASL8.EQ.'LIRE')GOTO2000
      IF(ICASL8.EQ.'LICO')GOTO2000
      IF(ICASL8.EQ.'KTAU')GOTO2000
      IF(ICASL8.EQ.'REPE')GOTO2000
      IF(ICASL8.EQ.'REPR')GOTO2000
      IF(ICASL8.EQ.'WICV')GOTO2000
      IF(ICASL8.EQ.'WICR')GOTO2000
      IF(ICASL8.EQ.'BIMC')GOTO2000
      IF(ICASL8.EQ.'BICR')GOTO2000
      IF(ICASL8.EQ.'PBCR')GOTO2000
      IF(ICASL8.EQ.'WEME')GOTO500
      IF(ICASL8.EQ.'WEMD')GOTO500
      IF(ICASL8.EQ.'WESD')GOTO500
      IF(ICASL8.EQ.'WEVA')GOTO500
      IF(ICASL8.EQ.'WETM')GOTO500
      IF(ICASL8.EQ.'INTE')GOTO500
      IF(ICASL8.EQ.'RATI')GOTO500
      IF(IFLAGD.EQ.'ON')GOTO500
      GOTO1000
C
  500 CONTINUE
      NUMVIN=1
      ILOCVP=ILOCV+1
      IF(ILOCVP.GT.NUMARG)GOTO1000
      IHARG5=IHARG(ILOCVP)
      IHARG6=IHARG2(ILOCVP)
      IF(IHARG5.EQ.'SUBS'.AND.IHARG6.EQ.'ET  ')GOTO1000
      IF(IHARG5.EQ.'EXCE'.AND.IHARG6.EQ.'PT  ')GOTO1000
      IF(IHARG5.EQ.'FOR '.AND.IHARG6.EQ.'    ')GOTO1000
      NUMVIN=2
      GOTO2000
C
C               ***************************************
C               **  STEP 5--                         **
C               **  TREAT THE 1-VARIABLE STATISTICS  **
C               ***************************************
C
 1000 CONTINUE
C
      ISTEPN='5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=1
C
 1100 CONTINUE
      IH=IHARG(ILOCV)
      IH2=IHARG2(ILOCV)
      DO1110I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1190
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1150
 1110 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE SPECIFIED ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1115)
 1115 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1116)
 1116 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1117)(IANS(I),I=1,IWIDTH)
 1117 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1150 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      THE SPECIFIED ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)
 1156 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1157)
 1157 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1158)
 1158 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1159)(IANS(I),I=1,IWIDTH)
 1159 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 1190 CONTINUE
      ILISTR=I2
      ICOLR=IVALUE(ILISTR)
      NIRIGH=IN(ILISTR)
      GOTO700
C
C               ************************************************
C               **  STEP 6.2--                                **
C               **  TREAT THE 2 VARIABLE CASE.                **
C               **  CHECK THE VALIDITY OF THE FIRST ARGUMENT  **
C               ************************************************
C
 2000 CONTINUE
C
      ISTEPN='6.2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=2
C
      IHARG3=IHARG(ILOCV)
      IHARG4=IHARG2(ILOCV)
      DO2210I=1,NUMNAM
      I2=I
      IF(IHARG3.EQ.IHNAME(I).AND.IHARG4.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2290
      IF(IHARG3.EQ.IHNAME(I).AND.IHARG4.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO2219
 2210 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE SPECIFIED FIRST  ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)
 2216 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2217)(IANS(I),I=1,IWIDTH)
 2217 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2219 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2221)
 2221 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2222)
 2222 FORMAT('      THE SPECIFIED FIRST  ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2223)
 2223 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2224)
 2224 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2225)
 2225 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2226)
 2226 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2227)
 2227 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2228)
 2228 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2229)(IANS(I),I=1,IWIDTH)
 2229 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2290 CONTINUE
C
      ILISTR=I2
      ICOLR=IVALUE(ILISTR)
      NIRIGH=IN(ILISTR)
C
C               *****************************************************
C               **  STEP 6.3--                                     **
C               **  CHECK THE VALIDITY OF THE SECOND ARGUMENT      **
C               *****************************************************
C
 2300 CONTINUE
C
      ISTEPN='6.3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ILOCVP=ILOCV+1
      IF(ILOCVP.LE.NUMARG)GOTO2309
C
      WRITE(ICOUT,2301)
 2301 FORMAT('***** ERROR IN DPSTAC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2302)
 2302 FORMAT('      NO SECOND VARIABLE NAME OR COLUMN NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2303)
 2303 FORMAT('      WAS GIVEN AFTER THE STATISTIC ',
     1'CALCULATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2304)
 2304 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2305)(IANS(I),I=1,IWIDTH)
 2305 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2309 CONTINUE
C
      IHARG5=IHARG(ILOCVP)
      IHARG6=IHARG2(ILOCVP)
      DO2310I=1,NUMNAM
      I2=I
      IF(IHARG5.EQ.IHNAME(I).AND.IHARG6.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2390
      IF(IHARG5.EQ.IHNAME(I).AND.IHARG6.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO2319
 2310 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2311)
 2311 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2312)
 2312 FORMAT('      THE SPECIFIED SECOND ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2313)
 2313 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2314)
 2314 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2315)
 2315 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2316)
 2316 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2317)(IANS(I),I=1,IWIDTH)
 2317 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2319 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2321)
 2321 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2322)
 2322 FORMAT('      THE SPECIFIED SECOND ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2323)
 2323 FORMAT('      (VARIABLE NAME OR COLUMN NUMBER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2324)
 2324 FORMAT('      ON THE RIGHT OF THE = SIGN')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2325)
 2325 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2326)
 2326 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2327)
 2327 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2328)
 2328 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2329)(IANS(I),I=1,IWIDTH)
 2329 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2390 CONTINUE
C
      ILIST2=I2
      ICOL2=IVALUE(ILIST2)
      NIRIG2=IN(ILIST2)
C
C               ******************************************************
C               **  STEP 6.4--                                      **
C               **  CHECK THAT THE 2 VARIABLES HAVE THE SAME        **
C               **  NUMBER OF ELEMENTS.                             **
C               ******************************************************
C
      ISTEPN='6.4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NIRIG2.EQ.NIRIGH)GOTO2490
      IF(IFLAGD.EQ.'ON')GOTO2490
C
      WRITE(ICOUT,2411)
 2411 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2412)
 2412 FORMAT('      FOR A 2-VARIABLE STATISTIC CALCULATION,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2413)
 2413 FORMAT('      THE NUMBER OF OBSERVATIONS IN EACH VARIABLE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2414)
 2414 FORMAT('      MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2415)
 2415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2416)IHARG3,IHARG4,NIRIGH
 2416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2417)IHARG5,IHARG6,NIRIG2
 2417 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2418)
 2418 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2419)(IANS(I),I=1,IWIDTH)
 2419 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
 2490 CONTINUE
C
C               *******************************
C               **  STEP 7--                 **
C               **  DETERMINE THE SUBCASE    **
C               **  AND BRANCH ACCORDINGLY.  **
C               *******************************
C
  700 CONTINUE
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IARG4F=IFOUNZ(4)
      IARG4T=ITYPE(4)
C
      ICASEL='UNKN'
      IF(IARG4F.EQ.'NO')ICASEL='PARA'
      IF(IARG4F.EQ.'YES'.AND.IARG4T.EQ.'NUMB')ICASEL='ELEM'
CCCCC THE FOLLOWING LINE WAS REPLACED                   (DECEMBER 1988)
CCCCC BY THE SUCCEEDING LINE                            (DECEMBER 1988)
CCCCC TO ALLOW    LET X(K) = MEAN ETC.  INSIDE LOOP     (DECEMBER 1988)
CCCCC IF(IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD')ICASEL='VAR'
      IF(IARG4F.EQ.'YES'.AND.IARG4T.EQ.'WORD')ICASEL='ELEM'
      IF(ICASEL.EQ.'UNKN'.OR.ICASEL.EQ.'VAR')GOTO710
      GOTO729
C
  710 CONTINUE
      WRITE(ICOUT,711)
  711 FORMAT('***** ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,712)
  712 FORMAT('      UNKNOWN VARIABLE/PARAMETER EXPRESSION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,713)
  713 FORMAT('      TO THE LEFT OF THE EQUAL SIGN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,718)
  718 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,719)(IANS(I),I=1,IWIDTH)
  719 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
  729 CONTINUE
C
      ICASEQ='UNKN'
      IMIN=ILOCV+1
      IF(IMIN.GT.NUMARG)GOTO741
      DO740I=IMIN,NUMARG
      IF(IHARG(I).EQ.'SUBS'.AND.IHARG2(I).EQ.'ET  ')GOTO742
      IF(IHARG(I).EQ.'EXCE'.AND.IHARG2(I).EQ.'PT  ')GOTO742
      IF(IHARG(I).EQ.'FOR '.AND.IHARG2(I).EQ.'    ')GOTO743
  740 CONTINUE
  741 CONTINUE
      ICASEQ='FULL'
      GOTO749
  742 CONTINUE
      ICASEQ='SUBS'
      GOTO749
  743 CONTINUE
      ICASEQ='FOR'
      GOTO749
  749 CONTINUE
      IF(ICASEQ.EQ.'UNKN')GOTO750
C
      IF(ICASEQ.EQ.'FULL')GOTO8000
      IF(ICASEQ.EQ.'SUBS')GOTO9000
      IF(ICASEQ.EQ.'FOR')GOTO10000
C
  750 CONTINUE
      WRITE(ICOUT,751)
  751 FORMAT('***** INTERNAL ERROR IN DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,752)
  752 FORMAT('      UNKNOWN QUALIFIER TYPE FOR LET COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,758)
  758 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,759)(IANS(I),I=1,IWIDTH)
  759 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
C               ************************************************
C               **  STEP 8--                                  **
C               **  TREAT THE FULL VARIABLE CASE.             **
C               **  EXAMPLE--LET Y = SORT(X)                  **
C               **         --LET Y(I) = SORT(X)               **
C               **  JUMP TO STEP NUMBER 11 BELOW              **
C               **  FOR THE ACTUAL STATISTICAL CALCULATION,   **
C               **  FOR THE LIST UPDATING, AND                **
C               **  FOR SOME INFORMATIVE PRINTING.            **
C               ************************************************
C
 8000 CONTINUE
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NIOLD=NIRIGH
      IF(NUMVAR.GE.2.AND.NIRIG2.GT.NIOLD)NIOLD=NIRIG2
      NINEW=NIOLD
      DO8100I=1,NINEW
      ISUB(I)=1
 8100 CONTINUE
      GOTO11000
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  TREAT THE PARTIAL VARIABLE SUBSET CASE.                    *
C               **  EXAMPLE--LET Y = SORT(X)    SUBSET 2 3 5                   *
C               **         --LET Y(I) = SORT(X) SUBSET 2 3 5                   *
C               **  JUMP TO STEP NUMBER 11 BELOW                               *
C               **  FOR THE ACTUAL STATISTICAL CALCULATION,                    *
C               **  FOR THE LIST UPDATING, AND                                 *
C               **  FOR SOME INFORMATIVE PRINTING.                             *
C               ****************************************************************
C
 9000 CONTINUE
      ISTEPN='9'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMVAR.EQ.1)ILOCSV=ILOCV+2
      IF(NUMVAR.EQ.2)ILOCSV=ILOCV+3
      IHSET=IHARG(ILOCSV)
      IHSET2=IHARG2(ILOCSV)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHSET,IHSET2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO19000
      NIOLD=IN(ILOC)
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
CCCCC NINEW=NS
      NINEW=NIOLD
      GOTO11000
C
C               ****************************************************************
C               **  STEP 10--                                                  *
C               **  TREAT THE PARTIAL VARIABLE FOR CASE.                       *
C               **  EXAMPLE--LET Y = SORT(X)    FOR I = 1 2 10                 *
C               **         --LET Y(I) = SORT(X) FOR I = 1 2 10                 *
C               **  JUMP TO STEP NUMBER 11 BELOW                               *
C               **  FOR THE ACTUAL STATISTICAL CALCULATION,                    *
C               **  FOR THE LIST UPDATING, AND                                 *
C              **  FOR SOME INFORMATIVE PRINTING.                             *
C               ****************************************************************
C
10000 CONTINUE
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPFOR(NIOLD,NINEW,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NIFOR=NINEW
      GOTO11000
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE                        **
C               **  ACTUAL STATISTICAL CALCULATION,      ZZ
C               **  THE LIST UPDATING, AND               **
C               **  GENERATE THE INFORMATIVE PRINTING    **
C               **  FOR STEP NUMBERS 7, 8, AND 9 ABOVE.  **
C               *******************************************
C
11000 CONTINUE
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NS2=0
      NS3=0
CCCCC NINEW=NIRIGH
CCCCC IMAX=NINEW
CCCCC IF(ICASEQ.EQ.'FOR'.AND.IMAX.GT.NIFOR)IMAX=NIFOR
CCCCC DO11100I=1,IMAX
      DO11100I=1,NINEW
      IF(ISUB(I).EQ.0)GOTO11100
      IF(I.GT.NIRIGH)GOTO11105
      NS2=NS2+1
C
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)TEMP(NS2)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)TEMP(NS2)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)TEMP(NS2)=RES(I)
      IF(ICOLR.EQ.MAXCP3)TEMP(NS2)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)TEMP(NS2)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)TEMP(NS2)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)TEMP(NS2)=TAGPLO(I)
      IF(NUMVAR.LE.1)GOTO11100
C
11105 CONTINUE
      IF(I.GT.NIRIG2)GOTO11100
      IF(NUMVAR.LE.1)GOTO11100
      NS3=NS3+1
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)TEMP2(NS3)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)TEMP2(NS3)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)TEMP2(NS3)=RES(I)
      IF(ICOL2.EQ.MAXCP3)TEMP2(NS3)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)TEMP2(NS3)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)TEMP2(NS3)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)TEMP2(NS3)=TAGPLO(I)
C
11100 CONTINUE
C
      IWRITE='ON'
      IF(IPRINT.EQ.'OFF')IWRITE='OFF'
      IF(IFEEDB.EQ.'OFF')IWRITE='OFF'
C
CCCCC MARCH 2003: CALL CMPSTA TO COMPUTE THE STATISTIC.
C
      CALL CMPSTA(
     1     TEMP,TEMP2,XTEMP1,XTEMP2,XTEMP3,
     1     MAXNXT,NS2,NS3,NUMVAR,ICASL8,
     1     ISEED,ITEMP1,ITEMP2,ITEMP3,ITEMP4,ITEMP5,ITEMP6,
     1     IQUAME,IQUASE,
     1     RIGHT,
     1     ISUBRO,IBUGA3,IERROR)
C
      GOTO11900
C
11900 CONTINUE
      IFOUND='YES'
      IF(IERROR.EQ.'YES')GOTO19000
      IF(ICASEL.EQ.'PARA')GOTO15000
      IF(ICASEL.EQ.'ELEM')GOTO16000
C
C               *****************************************************
C               **  STEP 15--                                      **
C               **  TREAT THE PARAMETER CASE.                      **
C               **  EXAMPLE--LET A = MEAN X                        **
C               **           WHERE A WAS PREVIOUSLY UNDEFINED      **
C               **           OR WHERE A WAS PREVIOUSLY A PARAMETER.**
C               **  CARRY OUT THE LIST UPDATING  AND               **
C               **  GENERATE THE INFORMATIVE PRINTING.             **
C               **  THEN EXIT.                                     **
C               *****************************************************
C
15000 CONTINUE
      ISTEPN='15'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILISTL)=ILEFT
      IHNAM2(ILISTL)=ILEFT2
      IUSE(ILISTL)='P'
      VALUE(ILISTL)=RIGHT
C     ***** THE FOLLOWING LINE WAS ADDED 7/83 *****
      IVALUE(ILISTL)=VALUE(ILISTL)+0.5
      IN(ILISTL)=1
      IF(NEWNAM.EQ.'YES')NUMNAM=NUMNAM+1
C
      IF(IPRINT.EQ.'OFF')GOTO15119
      IF(IFEEDB.EQ.'OFF')GOTO15119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,15111)ILEFT,ILEFT2,RIGHT
15111 FORMAT('THE COMPUTED VALUE OF THE CONSTANT ',
     1A4,A4,'      = ',E15.8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
15119 CONTINUE
      GOTO19000
C
C               *********************************************
C               **  STEP 16--                              **
C               **  TREAT THE ELEMENT SPECIFICATION CASE.  **
C               **  EXAMPLE--LET Y(4)=MEAN X               **
C              **  ALSO, CARRY OUT THE LIST UPDATING AND  **
C               **  GENERATE THE INFORMATIVE PRINTING.     **
C               *********************************************
C
16000 CONTINUE
      ISTEPN='16'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IARGL=INT1(4)
      IF(1.LE.IARGL.AND.IARGL.LE.MAXN)GOTO16100
      WRITE(ICOUT,16001)
16001 FORMAT('***** ERROR IN DPSTAC')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16002)IARGL,ILEFT
16002 FORMAT('      THE SPECIFIED ROW (',I8,') OF VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16003)RIGHT
16003 FORMAT('      (THAT WAS TO BE SET = ',E15.7,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16004)
16004 FORMAT('      WAS LESS THAN 1 OR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16005)MAXN
16005 FORMAT('      GREATER THAN THE MAX ALLOWABLE ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO19000
C
16100 CONTINUE
CCCCC THE FOLLOWING 2 LINES WERE ADDED     (DECEMBER 1988)
CCCCC TO FIX PROBLEM OF LET Y(K) = MEAN X  (DECEMBER 1988)
CCCCC INSIDE A LOOP                        (DECEMBER 1988)
      IF(NEWNAM.EQ.'NO')NIOLD=IN(ILISTL)
      IF(NEWNAM.EQ.'YES')NIOLD=1
      NINEW=NIOLD
      IF(IARGL.GT.NINEW)NINEW=IARGL
      NS2=1
C
      IJ=MAXN*(ICOLL-1)+IARGL
      IF(ICOLL.LE.MAXCOL)V(IJ)=RIGHT
      IF(ICOLL.EQ.MAXCP1)PRED(IARGL)=RIGHT
      IF(ICOLL.EQ.MAXCP2)RES(IARGL)=RIGHT
      IF(ICOLL.EQ.MAXCP3)YPLOT(IARGL)=RIGHT
      IF(ICOLL.EQ.MAXCP4)XPLOT(IARGL)=RIGHT
      IF(ICOLL.EQ.MAXCP5)X2PLOT(IARGL)=RIGHT
      IF(ICOLL.EQ.MAXCP6)TAGPLO(IARGL)=RIGHT
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
      DO16200J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOLL)GOTO16205
      GOTO16200
16205 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOLL
      VALUE(J4)=ICOLL
      IN(J4)=NINEW
16200 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO16119
      IF(IFEEDB.EQ.'OFF')GOTO16119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,16111)ILEFT,ILEFT2,IARGL,RIGHT
16111 FORMAT('THE COMPUTED VALUE OF ',
     1A4,A4,'(',I6,')      = ',E15.8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
16119 CONTINUE
      GOTO19000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
19000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO19090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19011)
19011 FORMAT('***** AT THE END       OF DPSTAC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19012)IFOUND,IERROR
19012 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,9014)ICASL8,ILOCV,IWRITE,IFLAGD
 9014 FORMAT('ICASL8,ILOCV,IWRITE,IFLAGD = ',A4,2X,I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19015)NS2,NS3
19015 FORMAT('NS2,NS3 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,19017)ICASEL,RIGHT
19017 FORMAT('ICASEL,RIGHT = ',A4,E15.7)
      CALL DPWRST('XXX','BUG ')
19090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSTAR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A STAR PLOT--
C              A MULTIVARIATE TECHNICQUE WHICH PLOTS A SEQUENCE
C              OF RADIAL SPOKES AT EQUAL ANGLES AROUND A CIRCLE.
C              EACH RADIAL SPOKE REPRESENTS A SEPARATE VARIABLE.
C              THE LENGTH OF EACH RADIAL SPOKE IS PROPORTIONAL
C              TO THE RELATIVE SIZE OF THE RESPONSE.
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--88/2
C     ORIGINAL VERSION--FEBRUARY  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 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
CCCCC CHARACTER*4 IH
CCCCC CHARACTER*4 IH2
CCCCC CHARACTER*4 IERRO2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
CCCCC CHARACTER*4 IHHOR
CCCCC CHARACTER*4 IHHOR2
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Z1(MAXOBV)
      DIMENSION Z2(MAXOBV)
      DIMENSION Z3(MAXOBV)
      DIMENSION YSUB(MAXOBV)
      DIMENSION YFULL(MAXOBV)
      DIMENSION XTEMP(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Z1(1))
      EQUIVALENCE (GARBAG(IGARB2),Z2(1))
      EQUIVALENCE (GARBAG(IGARB3),Z3(1))
      EQUIVALENCE (GARBAG(IGARB4),YSUB(1))
      EQUIVALENCE (GARBAG(IGARB5),YFULL(1))
      EQUIVALENCE (GARBAG(IGARB6),XTEMP(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='DPST'
      ISUBN2='AR  '
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 STAR PLOT CASE  **
C               ***********************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'STAR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSTAR--')
      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.'STAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='STAR'
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO111
      GOTO119
C
  111 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO119
C
  119 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'.OR.ISUBRO.EQ.'STAR')
     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 11--                          **
C               **  FOR A STAR PLOT,                **
C               **  WE MUST HAVE A SUBSET OR FOR       **
C               **  SO AS TO INDICATE EXACTLY WHICH    **
C               **  CAR, ETC. THE SINGLE STAR PLOT  **
C               **  WILL BE FORMED FOR.                **
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.'STAR')
     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
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)
 1181 FORMAT('***** ERROR IN DPSTAR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1182)
 1182 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1183)
 1183 FORMAT('      NUMARG LESS THAN 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1184)
 1184 FORMAT('      POSSIBLE CAUSE--AN OMITTED (BUT NEEDED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1185)
 1185 FORMAT('      SUBSET/EXCEPT/FOR QUALIIFICATION')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)
 1186 FORMAT('      AT THE END OF THE STAR PLOT COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1187)
 1187 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1188)(IANS(I),I=1,IWIDTH)
 1188 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1190 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'STAR')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               **************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'STAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.GE.1)GOTO1290
C
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPSTAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      TO BE INCLUDED AS COMPONENTS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      IN A STAR PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)
 1215 FORMAT('      MUST BE 1 OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)
 1217 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1218)(IANS(I),I=1,IWIDTH)
 1218 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      RETURN
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.'STAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1300I=1,NUMVAR
C
      IHRIGH=IHARG(I)
      IHRIG2=IHARG2(I)
      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
C
      NRIGHT=IN(ILOCV)
      IF(NRIGHT.GE.MINN2)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPSTAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1312)
 1312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1321)
 1321 FORMAT('      (FOR WHICH A STAR PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1325)
 1325 FORMAT('      WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1326)MINN2
 1326 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1327)
 1327 FORMAT('      SUCH WAS 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)WRITE(ICOUT,1329)(IANS(J),J=1,IWIDTH)
 1329 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1390 CONTINUE
C
 1300 CONTINUE
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.'STAR')
     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.'STAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2200K=1,NUMVAR
      IHRIGH=IHARG(K)
      IHRIG2=IHARG2(K)
C
      DO2210I=1,NUMNAM
      I2=I
      IF(IHRIGH.EQ.IHNAME(I).AND.IHRIG2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2219
 2210 CONTINUE
      WRITE(ICOUT,2211)
 2211 FORMAT('***** INTERNAL ERROR IN DPSTAR AT POINT 2210--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE VARIABLE ',I4,I4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      NOT NOW FOUND IN INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      ALTHOUGH ALREADY 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)WRITE(ICOUT,2216)(IANS(I),I=1,IWIDTH)
 2216 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      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
      DO2240I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO2240
      J=J+1
      IJ=MAXN*(ICOLR-1)+I
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'STAR')
     1WRITE(ICOUT,2241)I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX
 2241 FORMAT('I,J,MAXN,ICOLR,IJ,NRIGHT,NQ,IMAX = ',8I8)
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'STAR')
     1CALL DPWRST('XXX','BUG ')
      IF(ICOLR.LE.MAXCOL)YSUB(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)YSUB(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)YSUB(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)YSUB(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)YSUB(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)YSUB(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)YSUB(J)=TAGPLO(I)
 2240 CONTINUE
      NLOCAL=J
      NSUB=NLOCAL
C
      J=0
      IMAX=NRIGHT
      DO2250I=1,IMAX
      J=J+1
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)YFULL(J)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)YFULL(J)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)YFULL(J)=RES(I)
      IF(ICOLR.EQ.MAXCP3)YFULL(J)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)YFULL(J)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)YFULL(J)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)YFULL(J)=TAGPLO(I)
 2250 CONTINUE
      NFULL=J
C
      IWRITE='OFF'
      CALL MEDIAN(YSUB,NSUB,IWRITE,XTEMP,MAXN,XMED,IBUGG3,IERROR)
      CALL MINIM(YFULL,NFULL,IWRITE,XMIN,IBUGG3,IERROR)
      CALL MAXIM(YFULL,NFULL,IWRITE,XMAX,IBUGG3,IERROR)
      Z1(K)=XMED
      Z2(K)=XMIN
      Z3(K)=XMAX
C
 2200 CONTINUE
      NZ=NUMVAR
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(.) 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'.OR.ISUBRO.EQ.'STAR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPSTA2(Z1,Z2,Z3,NZ,ICASPL,
     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.'STAR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSTAR--')
      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,YSUB(I)
 9023 FORMAT('I,YSUB(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
      WRITE(ICOUT,9031)NFULL
 9031 FORMAT('NFULL = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NFULL.LE.0)GOTO9034
      DO9032I=1,NFULL
      WRITE(ICOUT,9033)I,YFULL(I)
 9033 FORMAT('I,YFULL(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
 9034 CONTINUE
      WRITE(ICOUT,9041)NZ
 9041 FORMAT('NZ = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO9044
      DO9042I=1,NZ
      WRITE(ICOUT,9043)I,Z1(I),Z2(I),Z3(I)
 9043 FORMAT('I,Z1(I),Z2(I),Z3(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9042 CONTINUE
 9044 CONTINUE
      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 DPSTAT(
     1IFOUND,IERROR)
C
C     PURPOSE--WRITE OUT A STATUS LISTING OF PARAMETERS,
C              VARIABLES, AND PLOT SPECIFICATIONS.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--DECEMBER  1977.
C     UPDATED         --APRIL     1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --DECEMBER  1978.
C     UPDATED         --MARCH     1979.
C     UPDATED         --JULY      1979.
C     UPDATED         --NOVEMBER  1980.
C     UPDATED         --MARCH     1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --DECEMBER  1991. DIME, VARI, PARA, ETC. ARGS
C     UPDATED         --DECEMBER  1991. VARI/PARAM FORMAT STATEMENTS
C     UPDATED         --SEPTEMBER 1993. WRITE MESSAGE IF NO VAR.,
C                                       PAR. FUNC., ETC.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IJUNK
      CHARACTER*4 IJUNK2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IJUNK(100)
      DIMENSION IJUNK2(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCODB.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOF2.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPST'
      ISUBN2='AT  '
C
      IFOUND='NO'
      IERROR='NO'
C
      NI=0
      NUMELE=0
      KMAX=0
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 DPSTAT--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGS2
   53 FORMAT('IBUGS2 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IPR
   54 FORMAT('IPR = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NUMARG
   55 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)IHARG(1)
   56 FORMAT('IHARG(1) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NUMNAM
   61 FORMAT('NUMNAM   = ',I4)
      CALL DPWRST('XXX','BUG ')
      DO69I=1,NUMNAM
      WRITE(ICOUT,62)I,IHNAME(I),IHNAM2(I),IUSE(I)
   62 FORMAT('I,IHNAME,IHNAM2,IUSE   = ',I4,3(A4,1X))
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IN(I),IVALUE(I),IVALU2(I)
   63 FORMAT('IN,IVALUE,IVALU2  = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IVSTAR(I),IVSTOP(I),VALUE(I)
   64 FORMAT('IVSTAR,IVSTOP,VALUE     = ',2I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   69 CONTINUE
   90 CONTINUE
C
C               *****************************
C               **  TREAT THE STATUS CASE  **
C               *****************************
C
      IFOUND='YES'
C
C               *********************************************
C               **  STEP 10--                               **
C               **  PRINT OUT DETAILED STATUS INFORMATION  **
C               *********************************************
C
C               ****************************************
C               **  STEP 11--                         **
C               **  TREAT THE MACHINE CONSTANTS CASE  **
C               ****************************************
C
      IF(IHARG(1).EQ.'MACH')GOTO1100
      IF(IHARG(1).EQ.'COMP')GOTO1100
      IF(IHARG(1).EQ.'SITE')GOTO1100
      IF(IHARG(1).EQ.'HOST')GOTO1100
      GOTO1190
C
 1100 CONTINUE
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('STATUS OF MACHINE CONSTANTS--')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)IHOST1,IHOST2
 1112 FORMAT('IHOST1,IHOST2  (HOST) = ',A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1113)IHMOD1,IHMOD2
 1113 FORMAT('IHMOD1,IHMOD2 (MODEL) = ',A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1114)IOPSY1,IOPSY2
 1114 FORMAT('IOPSY1,IOPSY2 (OPERATING SYSTEM) = ',A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1115)ICOMPI
 1115 FORMAT('ICOMPI        (COMPILER) = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1116)ISITE
 1116 FORMAT('ISITE         (SITE) = ',A4)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1123)IPR,IRD,CPUMIN,CPUMAX
 1123 FORMAT('IPR,IRD,CPUMIN,CPUMAX = ',2I6,2E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1124)NUMBPC,NUMCPW,NUMBPW
 1124 FORMAT('NUMBPC,NUMCPW,NUMBPW = ',3I6)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO1130I=1,16
      IF(NUMBPW.LT.32)WRITE(ICOUT,1131)I,I1MACH(I)
 1131 FORMAT('I,I1MACH(I) = ',I8,2X,I8)
      IF(NUMBPW.LT.32)CALL DPWRST('XXX','WRIT')
      IF(NUMBPW.EQ.32)WRITE(ICOUT,1132)I,I1MACH(I)
 1132 FORMAT('I,I1MACH(I) = ',I8,2X,I11)
      IF(NUMBPW.EQ.32)CALL DPWRST('XXX','WRIT')
      IF(NUMBPW.EQ.36)WRITE(ICOUT,1133)I,I1MACH(I)
 1133 FORMAT('I,I1MACH(I) = ',I8,2X,I12)
      IF(NUMBPW.EQ.36)CALL DPWRST('XXX','WRIT')
      IF(NUMBPW.EQ.48)WRITE(ICOUT,1134)I,I1MACH(I)
 1134 FORMAT('I,I1MACH(I) = ',I8,2X,I16)
      IF(NUMBPW.EQ.48)CALL DPWRST('XXX','WRIT')
      IF(NUMBPW.GE.60)WRITE(ICOUT,1135)I,I1MACH(I)
 1135 FORMAT('I,I1MACH(I) = ',I8,2X,I20)
      IF(NUMBPW.GE.60)CALL DPWRST('XXX','WRIT')
      IF(NUMBPW.GT.32.AND.NUMBPW.NE.36.AND.
     1   NUMBPW.NE.48.AND.NUMBPW.NE.60)WRITE(ICOUT,1136)I,I1MACH(I)
 1136 FORMAT('I,I1MACH(I) = ',I8,2X,I8)
      IF(NUMBPW.GT.32.AND.NUMBPW.NE.36.AND.
     1   NUMBPW.NE.48.AND.NUMBPW.NE.60)CALL DPWRST('XXX','WRIT')
 1130 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO1140I=1,5
      WRITE(ICOUT,1141)I,R1MACH(I)
 1141 FORMAT('I,R1MACH(I)  = ',I8,2X,E15.7)
      CALL DPWRST('XXX','WRIT')
 1140 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO1150I=1,5
      WRITE(ICOUT,1151)I,D1MACH(I)
 1151 FORMAT('I,D1MACH(I)  = ',I8,2X,D15.7)
      CALL DPWRST('XXX','WRIT')
 1150 CONTINUE
      GOTO9000
C
 1190 CONTINUE
C
C               ***************************
C               **  STEP 12--            **
C               **  TREAT THE FILE CASE  **
C               ***************************
C
      IF(IHARG(1).EQ.'FILE')GOTO1200
      IF(IHARG(1).EQ.'I/O')GOTO1200
      GOTO1290
C
 1200 CONTINUE
      ISTEPN='12'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('STATUS OF FILES--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1253)IPR,IRD,CPUMIN,CPUMAX
 1253 FORMAT('IPR,IRD,CPUMIN,CPUMAX = ',2I6,2E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1254)NUMBPC,NUMCPW,NUMBPW
 1254 FORMAT('NUMBPC,NUMCPW,NUMBPW = ',3I6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1261)IMESNU,IMESST,IMESNA
 1261 FORMAT('IMESNU,IMESST,IMESNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1262)INEWNU,INEWST,INEWNA
 1262 FORMAT('INEWNU,INEWST,INEWNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1263)IMAINU,IMAIST,IMAINA
 1263 FORMAT('IMAINU,IMAIST,IMAINA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1264)IHELNU,IHELST,IHELNA
 1264 FORMAT('IHELNU,IHELST,IHELNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1265)IBUGNU,IBUGST,IBUGNA
 1265 FORMAT('IBUGNU,IBUGST,IBUGNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1266)IQUENU,IQUEST,IQUENA
 1266 FORMAT('IQUENU,IQUEST,IQUENA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1267)ISYSNU,ISYSST,ISYSNA
 1267 FORMAT('ISYSNU,ISYSST,ISYSNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1268)ILOGNU,ILOGST,ILOGNA
 1268 FORMAT('ILOGNU,ILOGST,ILOGNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1271)IREANU,IREAST,IREANA
 1271 FORMAT('IREANU,IREAST,IREANA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1272)IWRINU,IWRIST,IWRINA
 1272 FORMAT('IWRINU,IWRIST,IWRINA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1273)ISAVNU,ISAVST,ISAVNA
 1273 FORMAT('ISAVNU,ISAVST,ISAVNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1274)ICRENU,ICREST,ICRENA
 1274 FORMAT('ICRENU,ICREST,ICRENA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,1275)IMACNU,IMACST,IMACNA
C1275 FORMAT('IMACNU,IMACST,IMACNA = ',I8,2X,A12,2X,A80)
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1276)ISCRNU,ISCRST,ISCRNA
 1276 FORMAT('ISCRNU,ISCRST,ISCRNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1277)IDATNU,IDATST,IDATNA
 1277 FORMAT('IDATNU,IDATST,IDATNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1278)IPL1NU,IPL1ST,IPL1NA
 1278 FORMAT('IPL1NU,IPL1ST,IPL1NA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1279)IPL2NU,IPL2ST,IPL2NA
 1279 FORMAT('IPL2NU,IPL2ST,IPL2NA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1280)IPRONU,IPROST,IPRONA
 1280 FORMAT('IPRONU,IPROST,IPRONA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1281)ICONNU,ICONST,ICONNA
 1281 FORMAT('ICONNU,ICONST,ICONNA = ',I8,2X,A12,2X,A80)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
C
 1290 CONTINUE
C
C               *****************************
C               **  STEP 21--              **
C               **  TREAT THE ARROWS CASE  **
C               *****************************
C
      IF(IHARG(1).EQ.'ARRO')GOTO2100
      GOTO2190
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2111)
 2111 FORMAT('STATUS OF ARROWS--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2112)NUMARR
 2112 FORMAT('       NUMBER OF ARROWS = ',I8)
      CALL DPWRST('XXX','WRIT')
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(NUMARR.LE.0)GOTO2180
      IF(NUMARR.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,2105)
 2105    FORMAT('NO ARROWS DEFINED')
         CALL DPWRST('XXX','WRIT')
         GOTO2180
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2115I=1,NUMARR
      IF(PARRXC(I,1).LT.0.0.OR.PARRXC(I,1).GT.100.0)GOTO2115
      IF(PARRYC(I,1).LT.0.0.OR.PARRYC(I,1).GT.100.0)GOTO2115
      IF(PARRXC(I,2).LT.0.0.OR.PARRXC(I,2).GT.100.0)GOTO2115
      IF(PARRYC(I,2).LT.0.0.OR.PARRYC(I,2).GT.100.0)GOTO2115
      WRITE(ICOUT,2116)I,PARRXC(I,1),PARRYC(I,1),PARRXC(I,2),PARRYC(I,2)
 2116 FORMAT('       ARROW   ',I8,' COORDINATES       --',4F10.4)
      CALL DPWRST('XXX','WRIT')
 2115 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2125I=1,NUMARR
      WRITE(ICOUT,2126)I,IARRCO(I)
 2126 FORMAT('       ARROW   ',I8,' COLOR             --',A4)
      CALL DPWRST('XXX','WRIT')
 2125 CONTINUE
C
 2180 CONTINUE
      GOTO9000
C
 2190 CONTINUE
C
C               *******************************
C               **  STEP 22--                **
C               **  TREAT THE SEGMENTS CASE  **
C               *******************************
C
      IF(IHARG(1).EQ.'SEGM')GOTO2200
      GOTO2290
C
 2200 CONTINUE
      ISTEPN='22'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2211)
 2211 FORMAT('STATUS OF SEGMENTS--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2212)NUMSEG
 2212 FORMAT('       NUMBER OF SEGMENTS = ',I8)
      CALL DPWRST('XXX','WRIT')
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(NUMSEG.LE.0)GOTO2280
      IF(NUMSEG.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,2205)
 2205    FORMAT('NO SEGMENTS DEFINED')
         CALL DPWRST('XXX','WRIT')
         GOTO2280
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2215I=1,NUMSEG
      IF(PSEGXC(I,1).LT.0.0.OR.PSEGXC(I,1).GT.100.0)GOTO2215
      IF(PSEGYC(I,1).LT.0.0.OR.PSEGYC(I,1).GT.100.0)GOTO2215
      IF(PSEGXC(I,2).LT.0.0.OR.PSEGXC(I,2).GT.100.0)GOTO2215
      IF(PSEGYC(I,2).LT.0.0.OR.PSEGYC(I,2).GT.100.0)GOTO2215
      WRITE(ICOUT,2216)I,PSEGXC(I,1),PSEGYC(I,1),PSEGXC(I,2),PSEGYC(I,2)
 2216 FORMAT('       SEGMENT ',I8,' COORDINATES       --',4F10.4)
      CALL DPWRST('XXX','WRIT')
 2215 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2225I=1,NUMSEG
      WRITE(ICOUT,2226)I,ISEGCO(I)
 2226 FORMAT('       SEGMENT ',I8,' COLOR             --',A4)
      CALL DPWRST('XXX','WRIT')
 2225 CONTINUE
C
 2280 CONTINUE
      GOTO9000
C
 2290 CONTINUE
C
C               ******************************
C               **  STEP 23--               **
C               **  TREAT THE LEGENDS CASE  **
C               ******************************
C
      IF(IHARG(1).EQ.'LEGE')GOTO2300
      GOTO2390
C
 2300 CONTINUE
      ISTEPN='23'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2311)
 2311 FORMAT('STATUS OF LEGENDS--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2312)NUMLEG
 2312 FORMAT('       NUMBER OF LEGENDS = ',I8)
      CALL DPWRST('XXX','WRIT')
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(NUMLEG.LE.0)GOTO2380
      IF(NUMLEG.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,2305)
 2305    FORMAT('NO LEGENDS DEFINED')
         CALL DPWRST('XXX','WRIT')
         GOTO2380
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2315I=1,NUMLEG
      JMIN=ILEGST(I)
      JMAX=ILEGSP(I)
      WRITE(ICOUT,2316)I,(ILEGTE(J),J=JMIN,JMAX)
 2316 FORMAT('       LEGEND  ',I8,'--',100A1)
      CALL DPWRST('XXX','WRIT')
 2315 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2325I=1,NUMLEG
      IF(PLEGXC(I).LT.0.0.OR.PLEGXC(I).GT.100.0)GOTO2325
      IF(PLEGYC(I).LT.0.0.OR.PLEGYC(I).GT.100.0)GOTO2325
      WRITE(ICOUT,2326)I,PLEGXC(I),PLEGYC(I)
 2326 FORMAT('       LEGEND  ',I8,' COORDINATES       --',2F10.4)
      CALL DPWRST('XXX','WRIT')
 2325 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2335I=1,NUMLEG
      WRITE(ICOUT,2336)I,ILEGCO(I)
 2336 FORMAT('       LEGEND  ',I8,' COLOR             --',A4)
      CALL DPWRST('XXX','WRIT')
 2335 CONTINUE
C
 2380 CONTINUE
      GOTO9000
C
 2390 CONTINUE
C
C               ****************************
C               **  STEP 24--             **
C               **  TREAT THE BOXES CASE  **
C               ****************************
C
      IF(IHARG(1).EQ.'BOXE')GOTO2400
      IF(IHARG(1).EQ.'BOX')GOTO2400
      GOTO2490
C
 2400 CONTINUE
      ISTEPN='24'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2411)
 2411 FORMAT('STATUS OF BOXES--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,2412)NUMBOX
 2412 FORMAT('       NUMBER OF BOXES = ',I8)
      CALL DPWRST('XXX','WRIT')
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(NUMBOX.LE.0)GOTO2480
      IF(NUMBOX.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,2405)
 2405    FORMAT('NO BOXES DEFINED')
         CALL DPWRST('XXX','WRIT')
         GOTO2480
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2415I=1,NUMBOX
      IF(PBOXXC(I,1).LT.0.0.OR.PBOXXC(I,1).GT.100.0)GOTO2415
      IF(PBOXYC(I,1).LT.0.0.OR.PBOXYC(I,1).GT.100.0)GOTO2415
      IF(PBOXXC(I,2).LT.0.0.OR.PBOXXC(I,2).GT.100.0)GOTO2415
      IF(PBOXYC(I,2).LT.0.0.OR.PBOXYC(I,2).GT.100.0)GOTO2415
      WRITE(ICOUT,2416)I,PBOXXC(I,1),PBOXYC(I,1),PBOXXC(I,2),PBOXYC(I,2)
 2416 FORMAT('       BOX     ',I8,' CORNER COORDINATES--',4F10.4)
      CALL DPWRST('XXX','WRIT')
 2415 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO2425I=1,NUMBOX
      WRITE(ICOUT,2426)I,IBOPCO(I)
 2426 FORMAT('       BOX     ',I8,' COLOR             --',A4)
      CALL DPWRST('XXX','WRIT')
 2425 CONTINUE
C
 2480 CONTINUE
      GOTO9000
C
 2490 CONTINUE
C
C               ****************************
C               **  STEP 31--             **
C               **  TREAT THE SPIKE CASE  **
C               ****************************
C
      IF(IHARG(1).EQ.'SPIK')GOTO3100
CCCCC THE FOLLOWING LINE WAS ADDED   JULY 1993
      IF(IHARG(1).EQ.'S   ')GOTO3100
      GOTO3190
C
 3100 CONTINUE
      ISTEPN='31'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3111)
 3111 FORMAT('STATUS OF SPIKE SETTINGS--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3112)
 3112 FORMAT('   SET       SPIKE     SPIKE     SPIKE     SPIKE  ',
     1'    SPIKE  ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3113)
 3113 FORMAT('  INDEX     SWITCH     LINE      COLOR   THICKNESS',
     1'    BASE   ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IMAX=10
CCCCC IF(NUMSET.GT.IMAX)IMAX=NUMSET
      DO3120I=1,IMAX
      WRITE(ICOUT,3121)I,ISPISW(I),ISPILI(I),ISPICO(I),PSPITH(I),
     1ASPIBA(I)
 3121 FORMAT(I5,8X,A4,6X,A4,6X,A4,6X,F7.3,3X,E15.7)
      CALL DPWRST('XXX','WRIT')
 3120 CONTINUE
      WRITE(ICOUT,3122)IDEFSS,IDEFSL,IDEFSC,PDEFST,ADEFSB
 3122 FORMAT('DEFAULT',6X,A4,6X,A4,6X,A4,6X,F7.3,3X,E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
 3190 CONTINUE
C
C               ****************************
C               **  STEP 32--             **
C               **  TREAT THE BAR   CASE  **
C               ****************************
C
      IF(IHARG(1).EQ.'BAR ')GOTO3200
CCCCC THE FOLLOWING LINE WAS ADDED   SEPTEMBER 1993
      IF(IHARG(1).EQ.'BARS')GOTO3200
CCCCC THE FOLLOWING LINE WAS ADDED   JULY 1993
      IF(IHARG(1).EQ.'B   ')GOTO3200
      GOTO3290
C
 3200 CONTINUE
      ISTEPN='32'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3211)
 3211 FORMAT('STATUS OF BAR SETTINGS--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3212)
 3212 FORMAT('   SET       BAR       BAR       BAR       BAR   ',
     1'        BAR   ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3213)
 3213 FORMAT('  INDEX     SWITCH     FILL   DIMENSION  PATTERN',
     1'         BASE ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IMAX=10
CCCCC IF(NUMSET.GT.IMAX)IMAX=NUMSET
      DO3220I=1,IMAX
      WRITE(ICOUT,3221)I,IBARSW(I),IBAFSW(I),IBARTY(I),IBAPTY(I),
     1ABARBA(I)
 3221 FORMAT(I5,8X,A4,6X,A4,6X,A4,6X,A4,6X,E15.7)
      CALL DPWRST('XXX','WRIT')
 3220 CONTINUE
      WRITE(ICOUT,3222)IDEBSW,IDEBFS,IDEBTY,IDEBPT,ADEBBA
 3222 FORMAT('DEFAULT',6X,A4,6X,A4,6X,A4,6X,A4,6X,E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
 3290 CONTINUE
C
C               *************************************
C               **  STEP 70--                      **
C               **  TREAT THE GENERAL STATUS CASE  **
C               *************************************
C
C               *****************************
C               **  STEP 70.1--            **
C               **  PRINT OUT A            **
C               **  STORAGE SUMMARY TABLE  **
C               *****************************
C
  100 CONTINUE
C
      ISTEPN='70.1'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED     DECEMBER 1991
      IF(NUMARG.LE.0)GOTO109
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'DIME')GOTO109
CCCCC THE FOLLOWING LINE WAS ADDED   JULY 1993
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'D   ')GOTO109
      GOTO149
  109 CONTINUE
C
      NUMN=0
      DO110I=1,NUMNAM
      IF(IHNAME(I).EQ.'PRED')GOTO110
      IF(IHNAME(I).EQ.'RES')GOTO110
      IF(IHNAME(I).EQ.'YPLO')GOTO110
      IF(IHNAME(I).EQ.'XPLO')GOTO110
      IF(IHNAME(I).EQ.'X2PL')GOTO110
      IF(IHNAME(I).EQ.'TAGP')GOTO110
      IF(IUSE(I).EQ.'V')NI=IN(I)
      IF(NI.GT.NUMN)NUMN=NI
  110 CONTINUE
C
      NUMNK=MAXN*NUMCOL
      IDELCO=MAXCOL-NUMCOL
      IDELN=MAXN-NUMN
      IDELNK=MAXNK-NUMNK
      IDELCF=MAXCHF-NUMCHF
      IDELNA=MAXNAM-NUMNAM
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)
  131 FORMAT('****************************************************')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,132)
  132 FORMAT('*               STORAGE INFORMATION                *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,133)
  133 FORMAT('* NUMBER OF ...      * MAXIMUM * UNUSED  *   USED  *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,141)MAXCOL,IDELCO,NUMCOL
  141 FORMAT('* VARIABLES (COLUMNS)*',I7,'  *',I7,'  *',I7,'  *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,142)MAXN,IDELN,NUMN
  142 FORMAT('* OBS PER VARIABLE   *',I7,'  *',I7,'  *',I7,'  *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,143)MAXNK,IDELNK,NUMNK
  143 FORMAT('* OBS (TOTAL)        *',I7,'  *',I7,'  *',I7,'  *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,144)MAXCHF,IDELCF,NUMCHF
  144 FORMAT('* FUNC CHAR (TOTAL)  *',I7,'  *',I7,'  *',I7,'  *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,145)MAXNAM,IDELNA,NUMNAM
  145 FORMAT('* VAR/PAR/FUNC NAMES *',I7,'  *',I7,'  *',I7,'  *')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,131)
      CALL DPWRST('XXX','WRIT')
CCCCC THE FOLLOWING LINE WAS ADDED    DECEMBER 1991
  149 CONTINUE
C
C               *******************************
C               **  STEP 70.2--              **
C               **  PRINT OUT PLOT LINE,     **
C               **  PLOT CHARACTER, AND      **
C               **  PLOT LIMITS INFORMATION  **
C               *******************************
C
      ISTEPN='70.2'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED     DECEMBER 1991
      IF(NUMARG.LE.0)GOTO209
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'CHAR')GOTO209
CCCCC THE FOLLOWING LINE WAS ADDED   JULY 1993
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'C   ')GOTO209
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'LINE')GOTO209
CCCCC THE FOLLOWING LINE WAS ADDED   JULY 1993
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'L   ')GOTO209
      GOTO239
  209 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,211)
  211 FORMAT('   SET       PLOT      PLOT      PLOT      PLOT   ',
     1'    PLOT  ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,212)
  212 FORMAT('  INDEX      LINE      LINE    CHARACTER CHARACTER',
     1' CHARACTER')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,213)
  213 FORMAT('             TYPE      COLOR     TYPE      COLOR  ',
     1'    SIZE  ')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IMAX=10
CCCCC IF(NUMSET.GT.IMAX)IMAX=NUMSET
      DO220I=1,IMAX
      WRITE(ICOUT,221)I,ILINPA(I),ILINCO(I),ICHAPA(I),ICHACO(I),
     1PCHAHE(I)
  221 FORMAT(I5,8X,A4,6X,A4,6X,A4,6X,A4,4X,F7.3)
      CALL DPWRST('XXX','WRIT')
  220 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,231)FX1MIN
  231 FORMAT('X-AXIS PLOT MINIMUM = ',E15.8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,232)FX1MAX
  232 FORMAT('X-AXIS PLOT MAXIMUM = ',E15.8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,233)FY1MIN
  233 FORMAT('Y-AXIS PLOT MINIMUM = ',E15.8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,234)FY1MAX
  234 FORMAT('Y-AXIS PLOT MAXIMUM = ',E15.8)
      CALL DPWRST('XXX','WRIT')
CCCCC THE FOLLOWING LINE WAS INSERTED    DECEMBER 1991
  239 CONTINUE
C
C               ***************************************
C               **  STEP 70.3--                      **
C               **  PRINT OUT VARIABLES INFORMATION  **
C               ***************************************
C
      ISTEPN='70.3'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO379
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'VARI')GOTO379
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'VAR ')GOTO379
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'V   ')GOTO379
      GOTO399
  379 CONTINUE
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(NUMCOL.LE.0)GOTO399
      IF(NUMCOL.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,355)
  355    FORMAT('NO VARIABLES  (= VECTORS) DEFINED')
         CALL DPWRST('XXX','WRIT')
         GOTO399
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      DO390I=1,NUMCOL
      NJUNK=0
      DO391J=1,NUMNAM
      IF(I.EQ.IVALUE(J).AND.IUSE(J).EQ.'V')GOTO395
      GOTO391
  395 CONTINUE
      NJUNK=NJUNK+1
      IJUNK(NJUNK)=IHNAME(J)
      IJUNK2(NJUNK)=IHNAM2(J)
      NUMELE=IN(J)
  391 CONTINUE
      IF(NJUNK.GE.1)WRITE(ICOUT,397)I,NUMELE,
     1(IJUNK(K),IJUNK2(K),K=1,NJUNK)
CCCCC THE FOLLOWING 2 LINES WERE CHANGED   DECEMBER 1991
CC397 FORMAT('VARIABLE  ',I6,' (WITH ',I8,' ELEMENTS) ',
CCCCC1'HAS THE FOLLOWING NAMES:   ',10A4)
  397 FORMAT('VARIABLE ',I5,' (',I8,' ELEMENTS) ',
     1'IS: ',10A4)
      IF(NJUNK.GE.1)CALL DPWRST('XXX','WRIT')
  390 CONTINUE
  399 CONTINUE
C
CCCCC THE FOLLOWING SECTION WAS CHANGED    SEPTEMBER 1993
C               ****************************
C               **  STEP 70.4--           **
C               **  PRINT OUT PARAMETERS  **
C               ****************************
C
      ISTEPN='70.4'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO429
      IF(NUMARG.LE.1)THEN
         IF(IHARG(1).EQ.'PARA')GOTO429
         IF(IHARG(1).EQ.'PAR ')GOTO429
         IF(IHARG(1).EQ.'P   ')GOTO429
      ENDIF
      GOTO490
  429 CONTINUE
C
      NUMPAR=0
      IF(NUMNAM.LE.0)GOTO480
C
      DO430J=1,NUMNAM
         IF(IUSE(J).EQ.'P')THEN
            NUMPAR=NUMPAR+1
            IF(NUMPAR.LE.1)THEN
               WRITE(ICOUT,999)
               CALL DPWRST('XXX','WRIT')
               WRITE(ICOUT,999)
               CALL DPWRST('XXX','WRIT')
            ENDIF
            WRITE(ICOUT,436)IHNAME(J),IHNAM2(J),VALUE(J)
            CALL DPWRST('XXX','WRIT')
  436       FORMAT('PARAMETER ',2A4,'  HAS THE VALUE:   ',E15.7)
         ENDIF
  430 CONTINUE
C
  480 CONTINUE
      IF(NUMPAR.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,481)
  481    FORMAT('NO PARAMETERS (= SCALARS) DEFINED')
         CALL DPWRST('XXX','WRIT')
      ENDIF
C
  490 CONTINUE
C
C
CCCCC THE FOLLOWING SECTION WAS CHANGED    SEPTEMBER 1993
C               ****************************
C               **  STEP 70.5--           **
C               **  PRINT OUT FUNCTIONS   **
C               ****************************
C
      ISTEPN='70.5'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.0)GOTO529
      IF(NUMARG.LE.1)THEN
         IF(IHARG(1).EQ.'FUNC')GOTO529
         IF(IHARG(1).EQ.'FUN ')GOTO529
         IF(IHARG(1).EQ.'F   ')GOTO529
      ENDIF
      GOTO590
  529 CONTINUE
C
      NUMFUN=0
      IF(NUMNAM.LE.0)GOTO580
C
      DO530J=1,NUMNAM
         IF(IUSE(J).EQ.'F')THEN
            NUMFUN=NUMFUN+1
            IF(NUMFUN.LE.1)THEN
               WRITE(ICOUT,999)
               CALL DPWRST('XXX','WRIT')
               WRITE(ICOUT,999)
               CALL DPWRST('XXX','WRIT')
            ENDIF
            IMIN=IVSTAR(J)
            IMAX=IVSTOP(J)
            IDEL=IMAX-IMIN+1
            NUMLIN=((IDEL-1)/100)+1
C
            IF(NUMLIN.LE.0)GOTO530
            DO540KLINE=1,NUMLIN
               IF(KLINE.EQ.1)THEN
                  KMIN=IMIN
                  KMAX=KMIN+100-1
                  IF(KMAX.GT.IMAX)KMAX=IMAX
                  WRITE(ICOUT,552)IHNAME(J),IHNAM2(J),
     1            (IFUNC(K),K=KMIN,KMAX)
  552             FORMAT('FUNCTION  ',2A4,'--',100A1)
                  CALL DPWRST('XXX','WRIT')
               ENDIF
C
               IF(KLINE.GE.2)THEN
                  KMIN=KMAX+1
                  KMAX=KMIN+100-1
                  IF(KMAX.GT.IMAX)KMAX=IMAX
                  WRITE(ICOUT,562)(IFUNC(K),K=KMIN,KMAX)
  562             FORMAT(18X,100A1)
                  CALL DPWRST('XXX','WRIT')
               ENDIF
  540       CONTINUE
C
         ENDIF
  530 CONTINUE
C
  580 CONTINUE
      IF(NUMFUN.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,581)
  581    FORMAT('NO FUNCTIONS (= STRINGS) DEFINED')
         CALL DPWRST('XXX','WRIT')
      ENDIF
C
  590 CONTINUE
C
C               ***************************************
C               **  STEP 70.6--                     **
C               **  PRINT OUT MATRIX    INFORMATION  **
C               ***************************************
C
      ISTEPN='70.6'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED     DECEMBER 1991
      IF(NUMARG.LE.0)GOTO629
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MATR')GOTO629
CCCCC THE FOLLOWING LINE WAS ADDED   JULY 1993
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'M   ')GOTO629
      GOTO639
  629 CONTINUE
C
CCCCC THE FOLLOWING LINE WAS CHANGED    SEPTEMBER 1993
CCCCC IF(NUMNAM.LE.0)GOTO619
      IF(NUMNAM.LE.0)THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','WRIT')
         WRITE(ICOUT,605)
  605    FORMAT('NO MATRICES               DEFINED')
         CALL DPWRST('XXX','WRIT')
         GOTO619
      ENDIF
C
      IPASS=0
      DO610J=1,NUMNAM
      IF(IUSE(J).EQ.'M')GOTO615
      GOTO610
C
  615 CONTINUE
      IPASS=IPASS+1
      IF(IPASS.EQ.1)WRITE(ICOUT,999)
      IF(IPASS.EQ.1)CALL DPWRST('XXX','WRIT')
      IF(IPASS.EQ.1)WRITE(ICOUT,999)
      IF(IPASS.EQ.1)CALL DPWRST('XXX','WRIT')
      NR1=IN(J)
      NC1=IVALU2(J)-IVALUE(J)+1
      WRITE(ICOUT,616)IHNAME(J),IHNAM2(J),NR1,NC1,IVALUE(J)
  616 FORMAT('MATRIX ',2A4,' HAS ',I8,' ROWS AND ',I8,' COLUMNS ',
     1'(AND STARTS IN COLUMN ',I8,')')
      CALL DPWRST('XXX','WRIT')
  610 CONTINUE
  619 CONTINUE
  639 CONTINUE
C
C               **************************
C               **  STEP 70.7--         **
C               **  PRINT OUT THE LAST  **
C               **  MODEL FITTED        **
C               **************************
C
      ISTEPN='70.7'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC THE FOLLOWING 4 LINES WERE ADDED     DECEMBER 1991
      IF(NUMARG.LE.0)GOTO729
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'MODE')GOTO729
      GOTO749
  729 CONTINUE
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IF(NUMCHM.EQ.0)WRITE(ICOUT,731)
  731 FORMAT('MODEL--NO MODEL YET DEFINED')
      IF(NUMCHM.EQ.0)CALL DPWRST('XXX','WRIT')
      IF(NUMCHM.EQ.0)GOTO749
      DO740I=1,20
      I2=I
      IF(MODEL(I).NE.' ')GOTO748
  740 CONTINUE
  748 CONTINUE
      WRITE(ICOUT,741)(MODEL(I),I=I2,NUMCHM)
  741 FORMAT('MODEL--',120A1)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
  749 CONTINUE
C
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('AT THE END       OF DPSTAT--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9013)IBUGS2,IFOUND,IERROR
 9013 FORMAT('IBUGS2,IFOUND,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSTA2(Z1,Z2,Z3,NZ,ICASPL,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A STAR PLOT
C              (USEFUL FOR MULTIVARIATE ANALYSIS).
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--88/2
C     ORIGINAL VERSION--JANUARY   1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Z1(*)
      DIMENSION Z2(*)
      DIMENSION Z3(*)
C
      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='DPST'
      ISUBN2='A2  '
C
      IERROR='NO'
C
      TWOPI=2.0*3.1415926
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(NZ.GE.1)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPSTA2--')
      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)NZ
   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(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'STA2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPSTA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,NZ,N2,NPLOTV
   72 FORMAT('ICASPL,NZ,N2,NPLOTV = ',A4,2X,3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO83
      DO81I=1,NZ
      WRITE(ICOUT,82)I,Z1(I),Z2(I),Z3(I)
   82 FORMAT('I,Z1(I),Z2(I),Z3(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
   83 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      ANZ=NZ
C
      J=0
      K=1
      DO1100I=1,NZ
      AI=I
      ANUM=Z1(I)-Z2(I)
      ADEN=Z3(I)-Z2(I)
      P=0.0
      IF(ADEN.GT.0.0)P=ANUM/ADEN
      THETA=((AI-1.0)/ANZ)*TWOPI
      J=J+1
      Y2(J)=P*SIN(THETA)
      X2(J)=P*COS(THETA)
      D2(J)=K
 1100 CONTINUE
      J=J+1
      Y2(J)=Y2(1)
      X2(J)=X2(1)
      D2(J)=D2(1)
C
      DO1200I=1,NZ
      AI=I
      THETA=((AI-1.0)/ANZ)*TWOPI
      J=J+1
      K=K+1
      Y2(J)=0.0
      X2(J)=0.0
      D2(J)=K
      J=J+1
      Y2(J)=SIN(THETA)
      X2(J)=COS(THETA)
      D2(J)=K
 1200 CONTINUE
C
      N2=J
      NPLOTV=3
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'STA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSTA2--')
      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,9013)N2,J,K
 9013 FORMAT('N2,J,K = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO9023
      DO9021I=1,NZ
      WRITE(ICOUT,9022)I,Z1(I),Z2(I),Z3(I)
 9022 FORMAT('I,Z1(I),Z2(I),Z3(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
 9021 CONTINUE
 9023 CONTINUE
      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
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSTE2(Y,W,N,YS,MAXN,IBUGG3,IERROR)
C
C     PURPOSE--FORM A STEM AND LEAF DIAGRAM
C     OUTPUT--A STEM AND LEAF DIAGRAM
C             OF SMOOTHED VALUES.
C     NOTE--THE VECTOR Y REMAINS UNCHANGED.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--MCNEIL, INTERACTIVE DATA ANALYSIS
C                 1977, PAGE 23
C                 (= SOURCE OF ALGORITHM).
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     VERSION NUMBER--83.6
C     ORIGINAL VERSION--JULY      1983.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*1 IA
      CHARACTER*1 M
      CHARACTER*1 IOUT
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION W(*)
      DIMENSION YS(*)
C
      DIMENSION IOUT(132)
      DIMENSION IA(20)
      DIMENSION M(4)
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---------------------------------------------------------------------
C
      DATA IA(1)/'0'/
      DATA IA(2)/'1'/
      DATA IA(3)/'2'/
      DATA IA(4)/'3'/
      DATA IA(5)/'4'/
      DATA IA(6)/'5'/
      DATA IA(7)/'6'/
      DATA IA(8)/'7'/
      DATA IA(9)/'8'/
      DATA IA(10)/'9'/
      DATA IA(11)/'0'/
      DATA IA(12)/'1'/
      DATA IA(13)/'2'/
      DATA IA(14)/'3'/
      DATA IA(15)/'4'/
      DATA IA(16)/'5'/
      DATA IA(17)/'6'/
      DATA IA(18)/'7'/
      DATA IA(19)/'8'/
      DATA IA(20)/'9'/
C
      DATA M(1)/'-'/
      DATA M(2)/' '/
      DATA M(3)/':'/
      DATA M(4)/'+'/
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      IWIDTH=50
      SCALE=1.0
      EPS=0.00000001
C
      IF(IBUGG3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3
   52 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)N
   53 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I)
   56 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ************************************
C               **  FORM A STEM-AND-LEAF DIAGRAM  **
C               ************************************
C
      IF(N.GE.1)GOTO190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,111)
  111 FORMAT('***** ERROR IN DPSTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,112)
  112 FORMAT('     NUMBER OF OBSERVATIONS IS NON-POSITIVE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,113)N
  113 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  190 CONTINUE
C
C
C               *********************
C               **  STEP 1--       **
C               **  SORT THE DATA  **
C               *********************
C
      CALL SORT(Y,N,YS)
C
C     STEP 2--
C     DEFINE C
C
      RANGE=YS(N)-YS(1)
      R=EPS+RANGE/SCALE
C
      C=10.0**(11-INT(ALOG10(R)+10.0))
      ARG1=INT(R*C/25.0)
      ARG2=0
      MAX=ARG1
      IF(ARG2.GT.ARG1)MAX=ARG2
C
      ARG1=2
      ARG2=MAX
      MM=ARG1
      IF(ARG2.LT.ARG1)MM=ARG2
C
      K=3*MM+2-150/(N+50)
      IPROD=(K-1)*(K-2)*(K-5)
      IF(IPROD.EQ.0)C=C*10
C
C     STEP 3--
C     DEFINE MU
C
      MU=10
      IPROD=K*(K-4)*(K-8)
      IF(IPROD.EQ.0)MU=5
      IPROD=(K-1)*(K-5)*(K-6)
      IF(IPROD.EQ.0)MU=20
C
      I=1
      IF(YS(1).GE.0)I=2
      I2=1
      TERM=INT(YS(I2)*C/MU)+I-2
      D=MU*TERM/10.0
C
C               *****************************************
C               **  STEP XX--                          **
C               **  SET UP A LOOP IN WHICH             **
C               **  EACH ITERATION OF THE LOOP         **
C               **  WILL FORM A NEW LINE (ROW) OF THE  **
C               **  STEM AND LEAF DIAGRAM              **
C               *****************************************
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 1000 CONTINUE
C
C               ***************************************************************
C               **  STEP XX--                                                **
C               **  FORM THE NEXT OUTPUT LINE OF THE STEM AND LEAF DIAGRAM.  **
C               **  FILL THE OUTPUT LINE WITH BLANKS.                        **
C               ***************************************************************
C
      DO1100K=1,IWIDTH
      IOUT(K)=' '
 1100 CONTINUE
C
      IF(I.EQ.2.OR.D.LE.0)GOTO1290
      I=2
      D=D-MU/10.0
 1290 CONTINUE
C
      ICOL=0
 1300 CONTINUE
      ICOL=ICOL+1
      TERM1=YS(I2)*C-10*INT(D)
      IY=INT(0.5+ABS(TERM1))
      IF(YS(I2)*C-10*D.GE.0.5+(MU-1)*(I-1))GOTO1390
      IF(ICOL.LE.IWIDTH)IOUT(ICOL)=IA(1+IY)
      I2=I2+1
      IF(I2.GT.N)GOTO1390
      GOTO1300
 1390 CONTINUE
C
      ID=MOD(IABS(INT(D)),100)
      K1=1+ID/10
      K2=1+ID-10*(K1-1)
      IF(ICOL.LE.IWIDTH+1)GOTO1490
      IOUT(IWIDTH-2)='+'
      IOUT(IWIDTH-1)=IA(1+(ICOL-IWIDTH+2)/10)
      IOUT(IWIDTH)=IA(ICOL-IWIDTH+3-10*((ICOL-IWIDTH+2)/10))
 1490 CONTINUE
C
C               **********************************************
C               **  STEP XX--                               **
C               **  WRITE OUT THE OUTPUT LINE FOR THIS ROW  **
C               **********************************************
C
      K=IWIDTH
      IF(ICOL.LT.IWIDTH)K=ICOL
      WRITE(ICOUT,1510)M(I),IA(K1),IA(K2),M(2),M(3),M(2),
     1(IOUT(ICOL),ICOL=1,K)
 1510 FORMAT(132A1)
      CALL DPWRST('XXX','BUG ')
C
C               *****************************************************
C               **  STEP XX--                                      **
C               **  JUMP BACK TO THE BEGINNING OF THE LOOP         **
C               **  TO WORK ON THE NEXT LINE (ROW) OF THE DIAGRAM  **
C               *****************************************************
C
      IF(I2.GT.N)GOTO9000
      D=D+MU/10.0
      GOTO1000
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 DPSTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG3
 9012 FORMAT('IBUGG3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N
 9014 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N
      WRITE(ICOUT,9016)I,Y(I),YS(I)
 9016 FORMAT('I,Y(I),YS(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPSTEM(IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--GENERATE A STEM AND LEAF DIAGRAM.
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--83/7
C     ORIGINAL VERSION--JULY      1983.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION TEMP(MAXOBV)
C
      DIMENSION W(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),W(1))
      EQUIVALENCE (GARBAG(IGARB2),TEMP(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPSU'
      ISUBN2='MM  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXV2=1
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ************************************
C               **  TREAT THE STEM AND LEAF CASE  **
C               ************************************
C
      IF(IBUGA2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPSTEM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 1--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************
C               **  STEP 2--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'PLOT')GOTO111
      IF(NUMARG.GE.1.AND.
     1IHARG(1).EQ.'DIAG'.AND.IHARG2(1).EQ.'RAM')GOTO111
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'AND'.AND.
     1IHARG(2).EQ.'PLOT')GOTO112
      IF(NUMARG.GE.2.AND.
     1IHARG(2).EQ.'AND'.AND.
     1IHARG(2).EQ.'DIAG'.AND.IHARG2(2).EQ.'RAM')GOTO112
C
      IF(NUMARG.GE.2.AND.
     1IHARG(1).EQ.'LEAF'.AND.
     1IHARG(2).EQ.'PLOT')GOTO112
      IF(NUMARG.GE.2.AND.
     1IHARG(2).EQ.'LEAF'.AND.
     1IHARG(2).EQ.'DIAG'.AND.IHARG2(2).EQ.'RAM')GOTO112
C
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'AND'.AND.
     1IHARG(2).EQ.'LEAF'.AND.
     1IHARG(3).EQ.'PLOT')GOTO113
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'AND'.AND.
     1IHARG(2).EQ.'LEAF'.AND.
     1IHARG(3).EQ.'DIAG'.AND.IHARG2(3).EQ.'RAM')GOTO113
      IF(NUMARG.GE.3.AND.
     1IHARG(1).EQ.'AND'.AND.
     1IHARG(2).EQ.'LEAF')GOTO112
C
      IFOUND='YES'
      GOTO190
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
  113 CONTINUE
      ILASTC=3
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO180
C
  180 CONTINUE
      IFOUND='YES'
      GOTO190
C
  190 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(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPSTEM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A STEM AND LEAF DIAGRAM ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               *********************************************
C               **  STEP 5--                               **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)     **
C               **  WHICH WILL HOLD THE RESPONSE VARIABLE. **
C               **  FORM THIS VARIABLE BY                  **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE   **
C               **  (FULL, SUBSET, OR FOR).                **
C               *********************************************
C
      ISTEPN='5'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO510
      IF(ICASEQ.EQ.'SUBS')GOTO520
      IF(ICASEQ.EQ.'FOR')GOTO530
C
  510 CONTINUE
      DO515I=1,NLEFT
      ISUB(I)=1
  515 CONTINUE
      NQ=NLEFT
      GOTO550
C
  520 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO550
C
  530 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO550
C
  550 CONTINUE
      IF(NQ.GE.MINN2)GOTO560
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPSTEM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)IHLEFT,IHLEF2
  553 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      (FOR WHICH A STEM AND LEAF DIAGRAM ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      IS TO BE GENERATED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)MINN2
  556 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,559)(IANS(I),I=1,IWIDTH)
  559 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  560 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO570I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO570
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(ICOLL.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
  570 CONTINUE
      NS=J
C
C               ****************************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPSTE2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ****************************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1110I=1,NS
      W(I)=1.0
 1110 CONTINUE
C
C               *********************************
C               **  STEP 9--                   **
C               **  FORM THE STEM AND LEAF DIAGRAM.  **
C               *********************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** FROM DPSTEM, AS WE ARE ABOUT TO CALL DPSTE2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)NLEFT,MAXN,NS
 1212 FORMAT('NLEFT,MAXN,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      DO1215I=1,NS
      WRITE(ICOUT,1216)I,Y(I),W(I)
 1216 FORMAT('I,Y(I),W(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 1215 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,1231)IBUGA3
 1231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 1290 CONTINUE
C
      CALL DPSTE2(Y,W,NS,TEMP,MAXN,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPSTEM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
