      SUBROUTINE DP2CHS(Y1,Y2,X1,X2,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE A 2-SAMPLE CHI-SQUARE TEST
C              THAT 2 SAMPLES ARE FROM THE SAME DISTRIBUTION
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--98/12
C     ORIGINAL VERSION--DECEMBER  1998.
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
C                                       BINNING ALGORITHMS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IHR2GH
      CHARACTER*4 IHR2G2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION ZX1(MAXOBV)
      DIMENSION ZX2(MAXOBV)
      DIMENSION ZY1(MAXOBV)
      DIMENSION ZY2(MAXOBV)
      DIMENSION XTEMP(MAXOBV)
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),ZY1(1))
      EQUIVALENCE (GARBAG(IGARB2),ZY2(1))
      EQUIVALENCE (GARBAG(IGARB3),ZX1(1))
      EQUIVALENCE (GARBAG(IGARB4),ZX2(1))
      EQUIVALENCE (GARBAG(IGARB5),XTEMP(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.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
      IERROR='NO'
C
      ISUBN1='DP2C'
      ISUBN2='CH  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=3
      MINN2=3
C
      ICOLR=0
C
C               ******************************************
C               **  TREAT THE CHI-SQUARE 2 SAMPLE CASE  **
C               ******************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DP2CHS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL
   52 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  RECOGNIZE THE FOLLOWING FORMS FOR THE COMMAND:
C     CHI SQUARE 2 SAMPLE TEST Y1 Y2
C     CHISQUARE 2 SAMPLE TEST Y1 Y2
C     CHI SQUARE TWO SAMPLE TEST Y1 Y2
C     CHISQUARE TWO SAMPLE TEST Y1 Y2
C     2 SAMPLE CHI SQUARE TEST Y1 Y2
C     2 SAMPLE CHISQUARE TEST Y1 Y2
C     TWO SAMPLE CHI SQUARE TEST Y1 Y2
C     TWO SAMPLE CHISQUARE TEST Y1 Y2
C  THE WORD TEST IS OPTIONAL.  IN ADDITION, FOR PRE-BINNED DATA,
C  THERE CAN BE AN X VARIABLE AT THE END.
C
      IF(ICOM.EQ.'CHI')THEN
        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SQUA'.AND.
     1     IHARG(2).EQ.'2'.AND.IHARG(3).EQ.'SAMP')THEN
           ISHIFT=3
           GOTO112
        ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'SQUA'.AND.
     1     IHARG(2).EQ.'TWO'.AND.IHARG(3).EQ.'SAMP')THEN
           ISHIFT=3
           GOTO112
        ENDIF
      ELSEIF(ICOM.EQ.'CHIS')THEN
        IF(NUMARG.GE.2.AND.IHARG(1).EQ.'2'.AND.IHARG(2).EQ.'SAMP')THEN
           ISHIFT=2
           GOTO112
        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'TWO'.AND.
     1     IHARG(2).EQ.'SAMP')THEN
           ISHIFT=2
           GOTO112
        ENDIF
      ELSEIF(ICOM.EQ.'2'.OR.ICOM.EQ.'TWO')THEN
        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SAMP'.AND.
     1     IHARG(2).EQ.'CHI'.AND.IHARG(3).EQ.'SQUA')THEN
           ISHIFT=3
           GOTO112
        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'SAMP'.AND.
     1     IHARG(2).EQ.'CHIS')THEN
           ISHIFT=2
           GOTO112
        ENDIF
      ENDIF
C
C ----------NO MATCH FOUND----------
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ICASPL='2CHS'
      CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
      IF(IHARG(1).EQ.'TEST')THEN
        ISHIFT=1
        CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ENDIF
      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'.OR.ISUBRO.EQ.'2CHS')
     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 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')CALL DPWRST('XXX','BUG ')
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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DP2CHS--')
      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 CHI-SQUARE 2 SAMPLE TEST WAS TO ',
     1'HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE ',
     1'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)THEN
        WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
  318   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
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='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DP2CHS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2CHS')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  CHECK FOR REQUIRED SECOND ARGUMENT AND          **
C               **  OPTIONAL THIRD ARGUMENT.                        **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATSW='RAW'
      IF(NUMV2.EQ.2)IDATSW='RAW'
      IF(NUMV2.EQ.2)GOTO509
      IF(NUMV2.EQ.3)IDATSW='FREQ'
      IF(NUMV2.EQ.3)GOTO509
      GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
C
      IF(NUMV2.GT.2)GOTO519
      GOTO570
C
  519 CONTINUE
      IHR2GH=IHARG(3)
      IHR2G2=IHARG2(3)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHR2GH,IHR2G2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOL3=IVALUE(ILOCV)
      NRIGH2=IN(ILOCV)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1WRITE(ICOUT,521)IHR2GH,IHR2G2,ICOL3,NRIGH2
  521 FORMAT('IHR2GH,IHR2G2,ICOL3,NRIGH2 = ',A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')CALL DPWRST('XXX','BUG ')
  530 CONTINUE
C
      GOTO570
C
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DP2CHS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A CHI-SQUARE 2 SAMPLE TEST, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES MUST BE EITHER 2 OR 3  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,564)(IANS(I),I=1,MIN(IWIDTH,80))
  564   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  570 CONTINUE
      IF(NUMV2.NE.3)GOTO590
      IF((NLEFT.NE.NRIGHT).OR.(NLEFT.NE.NRIGH2))THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,571)
  571 FORMAT('***** ERROR IN DP2CHS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,572)
  572 FORMAT('      FOR A CHI-SQUARE 2 SAMPLE TEST, WHEN HAVE 3 ',
     1'VARIABLES SPECIFIED')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,579)
  579 FORMAT('      THE NUMBER OF ELEMENTS IN THE 3 VARIABLES MUST ',
     1'BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,582)
  582 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,584)IHLEFT,IHLEF2,NLEFT
  584 FORMAT('      THE FIRST VARIABLE, ',A4,A4,',  HAS ',I8,
     1' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,586)IHRIGH,IHRIG2,NRIGHT
  586 FORMAT('      THE SECOND VARIABLE, ',A4,A4,',  HAS ',I8,
     1' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,588)IHR2GH,IHR2G2,NRIGH2
  588 FORMAT('      THE THIRD VARIABLE, ',A4,A4,',  HAS ',I8,
     1' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,589)
  589 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,592)(IANS(I),I=1,MIN(80,IWIDTH))
  592   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
      ENDIF
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMAX=MAX(NLEFT,NRIGHT)
      IF(NUMV2.EQ.3)IMAX=MAX(IMAX,NRIGH2)
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,IMAX
      ISUB(I)=1
  615 CONTINUE
      NQ=IMAX
      GOTO650
C
  620 CONTINUE
      NIOLD=IMAX
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=IMAX
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IF(NQ.LT.NLEFT)IMAX=NQ
      N1=0
      N2=0
      N3=0
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IF(NUMV2.GE.1.AND.I.LE.NLEFT)THEN
        N1=N1+1
        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)
      ENDIF
C
      IF(NUMV2.GE.2.AND.I.LE.NRIGHT)THEN
        N2=N2+1
        IJ=MAXN*(ICOLR-1)+I
        IF(ICOLR.LE.MAXCOL)Y2(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)Y2(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)Y2(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)Y2(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)Y2(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)Y2(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)Y2(J)=TAGPLO(I)
      ENDIF
C
      IF(NUMV2.GE.3.AND.I.LE.NRIGH2)THEN
        N3=N3+1
        IJ=MAXN*(ICOL3-1)+I
        IF(ICOL3.LE.MAXCOL)X1(J)=V(IJ)
        IF(ICOL3.EQ.MAXCP1)X1(J)=PRED(I)
        IF(ICOL3.EQ.MAXCP2)X1(J)=RES(I)
        IF(ICOL3.EQ.MAXCP3)X1(J)=YPLOT(I)
        IF(ICOL3.EQ.MAXCP4)X1(J)=XPLOT(I)
        IF(ICOL3.EQ.MAXCP5)X1(J)=X2PLOT(I)
        IF(ICOL3.EQ.MAXCP6)X1(J)=TAGPLO(I)
      ENDIF
C
  660 CONTINUE
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  COMPUTE THE CHI-SQUARE 2 SAMPLE                **
C               **  TEST                                           **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2CHS')GOTO5190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)
 5111 FORMAT('***** FROM THE MIDDLE  OF DP2CHS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)ICASPL,NUMV2,N1,N2,N3,IDATSW
 5112 FORMAT('ICASPL,NUMV2,N1,N2,N3,IDATSW = ',A4,I8,2X,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO5116I=1,N1
      WRITE(ICOUT,5117)I,Y1(I),Y2(I),X1(I)
 5117 FORMAT('I,Y1(I),Y2(I),X1(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 5116 CONTINUE
 5190 CONTINUE
C
      CLWID=CLWIDT(1)
      XSTART=CLLIMI(1)
      XSTOP=CLLIMI(2)
C
      CALL DP2CH2(Y1,Y2,X1,X2,N1,N2,N3,ICASPL,IDATSW,IRHSTG,
     1CLWID,XSTART,XSTOP,
     1XTEMP,IHSTCW,MAXOBV,
     1STATVA,STATCD,STATNU,CUTU90,CUTU95,CUTU99,
     1ZY1,ZY2,ZX1,ZX2,NFREQ,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 7--                         **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2CHS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPCH'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='NU  '
      VALUE0=STATNU
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='STAT'
      IH2='CDF '
      VALUE0=STATCD
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2CHS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DP2CHS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NFREQ,ICASPL
 9013 FORMAT('NFREQ,ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DP2CH2(Y1,Y2,X1,X2,N1,N2,N3,ICASPL,IDATSW,IRHSTG,
     1CLWID,XSTART,XSTOP,
     1XTEMP,IHSTCW,MAXOBV,
     1STATVA,STATCD,STATNU,CUTH90,CUTH95,CUTH99,
     1ZY1,ZY2,ZX1,ZX2,M2,IBUGA3,IERROR)
C
C     PURPOSE--COMPUTE A 2-SAMPLE CHI-SQUARE TEST
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--98/11
C     ORIGINAL VERSION--DECEMBER  1998.
C     UPDATED         --MARCH     2006. SUPPORT FOR DIFFERENT DEFAULT
C                                       BINNING ALGORITHMS
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IDATSW
      CHARACTER*4 IRHSTG
      CHARACTER*4 IHSTCW
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IWRIT2
C
      CHARACTER*4 IRELAT
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DTEMP1
      DOUBLE PRECISION DTEMP2
      DOUBLE PRECISION DTEMP3
      DOUBLE PRECISION DFACT1
      DOUBLE PRECISION DFACT2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION X1(*)
      DIMENSION X2(*)
      DIMENSION ZY1(*)
      DIMENSION ZY2(*)
      DIMENSION ZX1(*)
      DIMENSION ZX2(*)
      DIMENSION XTEMP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C
      ISUBN1='DP2C'
      ISUBN2='H2  '
C
      IRELAT='OFF'
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      NMIN=MIN(N1,N2)
      IF(IDATSW.EQ.'FREQ')NMIN=MIN(NMIN,N3)
C
      IF(NMIN.LT.2)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN DP2CH2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS FOR EACH VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)
   33   FORMAT('      MUST BE AT LEAST 1;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)N1
   34   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,35)N2
   35   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 2 = ',I6)
        CALL DPWRST('XXX','BUG ')
        IF(IDATSW.EQ.'FREQ')THEN
        WRITE(ICOUT,36)N3
   36   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 3 = ',I6)
        CALL DPWRST('XXX','BUG ')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IBUGA3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DP2CH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,IDATSW,N1,N2,N3
   72 FORMAT('ICASPL,IDATSW,N1,N2,N3 = ',A4,2X,A4,2X,4I8)
      CALL DPWRST('XXX','BUG ')
      DO85I=1,N1
      WRITE(ICOUT,86)I,Y1(I),Y2(I),X1(I),X2(I)
   86 FORMAT('I,Y1(I),Y2(I),X1(I),X2(I) = ',I8,4E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   80 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  IF DATA NOT ALREADY BINNED, THEN**
C               **  BIN THE DATA                    **
C               **************************************
C
      IF(IDATSW.EQ.'RAW')THEN
        CLWID2=CLWID
        DXSTAR=XSTART
        DXSTOP=XSTOP
        IF(CLWID.NE.CPUMIN.AND.XSTART.NE.CPUMIN.AND.
     1    XSTOP.NE.CPUMAX)GOTO200
          IWRIT2='OFF'
          CALL MEAN(Y1,N1,IWRIT2,YMEAN1,IBUGA3,IERROR)
          CALL SD(Y1,N1,IWRIT2,YSD1,IBUGA3,IERROR)
          CALL MEAN(Y2,N2,IWRIT2,YMEAN2,IBUGA3,IERROR)
          CALL SD(Y2,N2,IWRIT2,YSD2,IBUGA3,IERROR)
          IF(CLWID.EQ.CPUMIN)THEN
            DCLWID=MIN(0.3*YSD1,0.3*YSD2)
          ENDIF
          IF(XSTART.EQ.CPUMIN)THEN
            DXSTAR=MIN(YMEAN1-6.0*YSD1,YMEAN2-6.0*YSD2)
          ENDIF
          IF(XSTOP.EQ.CPUMAX)THEN
            DXSTOP=MIN(YMEAN1+6.0*YSD1,YMEAN2+6.0*YSD2)
          ENDIF
  200   CONTINUE
C
        AN1=REAL(N1)
        CALL DPBIN(Y1,N1,IRELAT,DCLWID,DXSTAR,DXSTOP,IRHSTG,
     1             XTEMP,MAXOBV,IHSTCW,
     1             ZY1,ZX1,M2,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL SORTC(ZX1,ZY1,M2,ZX1,ZY1)
        AN2=REAL(N2)
        CALL DPBIN(Y2,N2,IRELAT,DCLWID,DXSTAR,DXSTOP,IRHSTG,
     1             XTEMP,MAXOBV,IHSTCW,
     1             ZY2,ZX2,M2,IBUGA3,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        CALL SORTC(ZX2,ZY2,M2,ZX2,ZY2)
      ELSEIF(IDATSW.EQ.'FREQ')THEN
        AN1=0.0
        AN2=0.0
        DO1009I=1,N1
          AN1=AN1+Y1(I)
          AN2=AN2+Y2(I)
          ZY1(I)=Y1(I)
          ZY2(I)=Y2(I)
          ZX1(I)=X1(I)
          ZX2(I)=X1(I)
 1009   CONTINUE
        CALL SORTC(ZX1,ZY1,M2,ZX2,ZY1)
        CALL SORTC(ZX1,ZY2,M2,ZX1,ZY2)
        M2=N1
      ENDIF
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  COMPUTE CHI-SQUARE TEST STATISTIC **
C               **  EXPECTED                          **
C               ****************************************
C
 1100 CONTINUE
C
      DSUM1=0.0D0
      DFACT1=DBLE(SQRT(AN2/AN1))
      DFACT2=DBLE(SQRT(AN1/AN2))
      NCELLS=0
      DO1199I=1,M2
        IF(ZY1(I).EQ.0.0 .AND. ZY2(I).EQ.0.0)GOTO1199
        NCELLS=NCELLS+1
        DTEMP1=DBLE(ZY1(I))
        DTEMP2=DBLE(ZY2(I))
        DTEMP3=(DFACT1*DTEMP1 - DFACT2*DTEMP2)**2/(DTEMP1+DTEMP2)
        DSUM1=DSUM1 + DTEMP3
 1199 CONTINUE
C
      STAT=REAL(DSUM1)
      IDF=NCELLS
      IF(N1.EQ.N2)IDF=IDF-1
C
      CALL CHSCDF(STAT,IDF,CDF)
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      STATVA=STAT
      STATCD=CDF
      STATNU=IDF
      CALL CHSPPF(.90,IDF,CUTH90)
      CALL CHSPPF(.95,IDF,CUTH95)
      CALL CHSPPF(.99,IDF,CUTH99)
C
      IF(STATVA.LE.CUTH90)ICONC1='ACCEPT'
      IF(STATVA.LE.CUTH95)ICONC2='ACCEPT'
      IF(STATVA.LE.CUTH99)ICONC3='ACCEPT'
C
C               *******************************
C               **   STEP 32--               **
C               **   WRITE OUT EVERYTHING    **
C               **   FOR A CHI-SQUARED TEST  **
C               *******************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3211)
 3211 FORMAT(
     1'                  CHI-SQUARED TWO SAMPLE TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3212)
 3212 FORMAT(
     1'NULL HYPOTHESIS H0:      TWO SAMPLES COME FROM THE SAME ',
     1'(UNSPECIFIED)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3213)
 3213 FORMAT(
     1'                         DISTRIBUTION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3214)
 3214 FORMAT(
     1'ALTERNATE HYPOTHESIS HA: TWO SAMPLES COME FROM DIFFERENT ',
     1'DISTRIBUTIONS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,3220)
 3220 FORMAT('SAMPLE:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3221)INT(AN1+0.1)
 3221 FORMAT(3X,'NUMBER OF OBSERVATIONS FOR SAMPLE 1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3222)INT(AN2+0.1)
 3222 FORMAT(3X,'NUMBER OF OBSERVATIONS FOR SAMPLE 2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3223)NCELLS
 3223 FORMAT(3X,'NUMBER OF NON-EMPTY CELLS           = ',I8)
      CALL DPWRST('XXX','WRIT')
      IF(IDATSW.EQ.'RAW')THEN
      WRITE(ICOUT,3224)DCLWID
 3224 FORMAT(3X,'CLASS WIDTH FOR BINS                = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3225)DXSTAR
 3225 FORMAT(3X,'CLASS LOWER FOR BINS                = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3226)DXSTOP
 3226 FORMAT(3X,'CLASS UPPER FOR BINS                = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,3240)
 3240 FORMAT('TEST:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3242)STAT
 3242 FORMAT('CHI-SQUARED TEST STATISTIC     = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3243)IDF
 3243 FORMAT(3X,'DEGREES OF FREEDOM          = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3244)CDF
 3244 FORMAT(3X,'CHI-SQUARED CDF VALUE       = ',F11.6)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE(ICOUT,3251)
C3251 FORMAT('ALPHA = 0.10')
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3253)
 3253 FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3255)CUTH90,ICONC1
 3255 FORMAT('           10%',5X,F10.5,15X,A6,' H0')
      CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE(ICOUT,3261)
C3261 FORMAT('ALPHA = 0.05')
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,3263)
C3263 FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3265)CUTH95,ICONC2
 3265 FORMAT('            5%',5X,F10.5,15X,A6,' H0')
      CALL DPWRST('XXX','WRIT')
C
CCCCC
C3271 FORMAT('ALPHA = 0.01')
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,3273)
C3273 FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3275)CUTH99,ICONC3
 3275 FORMAT('            1%',5X,F10.5,15X,A6,' H0')
      CALL DPWRST('XXX','WRIT')
C
 3290 CONTINUE
      GOTO9000
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 DP2CH2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,IDATSW,M2,IERROR
 9012 FORMAT('ICASPL,IDATSW,M2,IERROR = ',A4,2X,A4,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)N1
 9014 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,M2
      WRITE(ICOUT,9021)I,ZY1(I),ZY2(I),ZX1(I),ZX2(I)
 9021 FORMAT('I,ZY1(I),ZY2(I),ZX1(I),ZX2(I) = ',I8,4E15.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DP1KST(Y1,YOBS,YEXP,MAXNXT,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE A KOLMOGOROV-SMIRNOV GOODNESS OF FIT ANALYSIS
C              FOR ONE OF THE FOLLOWING DISTRIBUTIONS--
C              1 ) UNIFORM
C              2 ) NORMAL
C              3 ) LOGISTIC
C              4 ) DOUBLE EXPONENTIAL
C              5 ) CAUCHY
C              6 ) TUKEY LAMBDA
C              7 ) LOGNORMAL
C              8 ) HALFNORMAL
C              9 ) T
C              10) CHI-SQUARE
C              11) F
C              12) EXPONENTIAL
C              13) GAMMA
C              14) BETA
C              15) WEIBULL---MIN & MAX
C              16) EXTREME VALUE TYPE 1 (GUMBEL)--MIN & MAX
C              17) EXTREME VALUE TYPE 2 (FRECHET)--MIN & MAX
C              18) PARETO
C              19) NEGATIVE BINOMIAL
C              20) SEMI-CIRCULAR
C              21) TRIANGULAR
C              22) INVERSE GAUUSIAN
C              23) WALD
C              24) RECIPROCAL INVERSE GAUUSIAN
C              25) FAILURE TIME
C              26) GENERALIZED PARETO
C              27) NON-CENTRAL T
C              28) NON-CENTRAL F
C              29) NON-CENTRAL KOLMOGOROV-SMIRNOV
C              30) NON-CENTRAL BETA
C              31) DOUBLY NON-CENTRAL T
C              32) DOUBLY NON-CENTRAL F
C              33) VON-MISES
C              34) POWER NORMAL
C              35) POWER LOGNORMAL
C              36) COSINE
C              37) ALPHA
C              38) POWER FUNCTION
C              39) CHI
C              40) LOG LOGISTIC
C              41) GENERALIZED GAMMA
C              42) ANGLIT
C              43) ARCSIN
C              44) FOLDED NORMAL
C              45) TRUNCATED NORMAL
C              46) LOG GAMMA
C              47) HYPERBOLIC SECANT
C              48) GOMPERTZ
C              49) PARETO SECOND KIND
C              50) DOUBLE WEIBULL
C              51) WRAPPED-UP CAUCHY
C              52) EXPONENTIATED WEIBULL
C              53) TRUNCATED EXPONENTIAL
C              54) GENERALIZED LOGISTIC
C              55) EXPONENTIAL POWER
C              56) DOUBLE GAMMA
C              57) MIELKE'S BETA-KAPPA
C              58) FOLDED CAUCHY
C              59) BETA BINOMIAL
C              60) BETA PASCAL
C              61) GENERALIZED EXPONENTIAL
C              62) RECIPROCAL
C              63) NORMAL MIXTURE
C              64) INVERTED GAMMA
C              65) INVERTED WEIBULL
C              66) LOG DOUBLE EXPONENTIAL
C              67) GENERALIZED TUKEY-LAMBDA
C              68) JOHNSON SU
C              69) JOHNSON SB
C              70) GEOMETRIC EXTREME EXPONENTIAL
C              71) TWO-SIDE POWER
C              72) BIWEIBULL
C              73) LANDAU
C              74) ERROR
C              75) TRAPEZOID
C              76) GENERALIZED TRAPEZOID
C              77) FOLDED T
C              78) SLASH
C              79) SKEWED NORMAL
C              80) SKEWED T
C              81) INVERTED BETA
C              82) GOMPERTZ-MAKEHAM
C              83) GENERALIZED INVERSE GAUSSIAN
C              84) GENERALIZED F
C              85) G-H
C              86) LOG-SKEW-NORMAL
C              87) LOG-SKEW-T
C              88) HALF-LOGISTIC
C              89) GENERALIZED HALF-LOGISTIC
C              90) SKEWED DOUBLE EXPONENTIAL
C              91) ASYMMETRIC DOUBLE EXPONENTIAL
C              92) MAXWELL
C              93) RAYLEIGH
C              94) GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL
C              95) MCLEISH
C              96) BESSEL I FUNCTION
C              97) BESSEL K FUNCTION (NOT WORKING YET)
C              98) GENERALIZED MCLEISH
C              99) HYPERBOLIC (NOT WORKING YET)
C             100) GENERALIZED LOGISTIC TYPE 5
C             101) GENERALIZED LOGISTIC TYPE 2
C             102) GENERALIZED LOGISTIC TYPE 3
C             104) GENERALIZED LOGISTIC TYPE 4
C             105) WAKEBY
C             106) BETA-NORMAL
C             107) ASYMMETRIC LOG DOUBLE EXPONENTIAL
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--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C     UPDATED         --OCTOBER   2001.
C     UPDATED         --NOVEMBER  2001. GEOMETRIC EXTREME EXPONENTIAL
C     UPDATED         --MAY       2002. TWO-SIDED POWER
C     UPDATED         --MAY       2002. BIWEIBULL
C     UPDATED         --APRIL     2003. LANDAU
C     UPDATED         --MAY       2003. ERROR (=EXPONENTIAL POWER)
C     UPDATED         --JUNE      2003. TRAPEZOID
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML AND LATEX
C     UPDATED         --NOVEMBER  2003. FOLDED T
C     UPDATED         --DECEMBER  2003. MU PARAMETER FOR INVERSE
C                                       GAUSSIAN, RECIPROCAL INVERSE
C                                       GAUSSIAN
C     UPDATED         --DECEMBER  2003. SLASH, SKEW NORMAL,
C                                       SKEW T, INVERTED BETA,
C                                       GOMPERTZ-MAKEHAM, G-H
C     UPDATED         --MARCH     2004. LOG-SKEW-NORMAL
C     UPDATED         --MARCH     2004. LOG-SKEW-T
C     UPDATED         --JUNE      2004. SKEW-DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. MAXWELL, RAYLEIGH
C     UPDATED         --AUGUST    2004. GENERALIZED INVERSE GAUSSIAN
C     UPDATED         --AUGUST    2004. GENERALIZED ASYMMETRIC LAPLACE
C     UPDATED         --AUGUST    2004. MCLEISH
C     UPDATED         --AUGUST    2004. BESSEL I-FUNCTION
C     UPDATED         --AUGUST    2004. BESSEL K-FUNCTION
C     UPDATED         --SEPTEMBER 2004. GENERALIZED MCLEISH
C     UPDATED         --SEPTEMBER 2004. HYPERBOLIC
C     UPDATED         --OCTOBER   2004. SUPPORT FOR CENSORED DATA
C     UPDATED         --DECEMBER  2004. CLARIFY SHAPE PARAMETERS FOR
C                                       PARETO PARETO SECOND KIND
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. WAKEBY
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION FOR
C                                       GENERALIZED TUKEY-LAMBDA
C     UPDATED         --MARCH     2006. BETA-NORMAL
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 2
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 3
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 4
C     UPDATED         --MARCH     2006. ASYMMETRIC LOG DOUBLE
C                                       EXPONENTIAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IDATSW
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 IWRIT2
      CHARACTER*4 LOWLTY
      CHARACTER*4 UPPLTY
      CHARACTER*4 ICENSO
      CHARACTER*30 IDIST
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      REAL KSLOC
      REAL KSSCAL
C
      REAL LOC2
C
      PARAMETER (NUMCHS=200)
      CHARACTER*4 INAME(NUMCHS,4)
      CHARACTER*4 INCASE(NUMCHS)
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION YOBS(*)
      DIMENSION YEXP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOF2.INC'
C
      DIMENSION CENSOR(MAXOBV)
      DIMENSION XTEMP1(MAXOBV)
C
      EQUIVALENCE (CENSOR(1),GARBAG(IGARB1))
      EQUIVALENCE (XTEMP1(1),GARBAG(IGARB2))
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  AUGUST 1998.  MAKE SEARCH TABLE DRIVEN
C
      DATA INCASE(1)/'UNPP'/
      DATA (INAME(1,J),J=1,4)/'UNIF','    ','    ','    '/
      DATA INCASE(2)/'UNPP'/
      DATA (INAME(2,J),J=1,4)/'RECT','    ','    ','    '/
      DATA INCASE(3)/'NMPP'/
      DATA (INAME(3,J),J=1,4)/'NORM','MIXT','    ','    '/
      DATA INCASE(4)/'NMPP'/
      DATA (INAME(4,J),J=1,4)/'GAUS','MIXT','    ','    '/
      DATA INCASE(5)/'NOPP'/
      DATA (INAME(5,J),J=1,4)/'NORM','    ','    ','    '/
      DATA INCASE(6)/'NOPP'/
      DATA (INAME(6,J),J=1,4)/'GAUS','    ','    ','    '/
      DATA INCASE(7)/'LOPP'/
      DATA (INAME(7,J),J=1,4)/'LOGI','    ','    ','    '/
      DATA INCASE(8)/'DEPP'/
      DATA (INAME(8,J),J=1,4)/'DOUB','EXPO','    ','    '/
      DATA INCASE(9)/'DEPP'/
      DATA (INAME(9,J),J=1,4)/'LAPL','    ','    ','    '/
      DATA INCASE(10)/'CAPP'/
      DATA (INAME(10,J),J=1,4)/'CAUC','    ','    ','    '/
      DATA INCASE(11)/'LAPP'/
      DATA (INAME(11,J),J=1,4)/'TUKE','LAMB','    ','    '/
      DATA INCASE(12)/'LAPP'/
      DATA (INAME(12,J),J=1,4)/'TUKE','    ','    ','    '/
      DATA INCASE(13)/'LAPP'/
      DATA (INAME(13,J),J=1,4)/'LAMB','    ','    ','    '/
      DATA INCASE(14)/'LNPP'/
      DATA (INAME(14,J),J=1,4)/'LOG ','NORM','    ','    '/
      DATA INCASE(15)/'LNPP'/
      DATA (INAME(15,J),J=1,4)/'LOGN','    ','    ','    '/
      DATA INCASE(16)/'HNPP'/
      DATA (INAME(16,J),J=1,4)/'HALF','NORM','    ','    '/
      DATA INCASE(17)/'HNPP'/
      DATA (INAME(17,J),J=1,4)/'HALF','    ','    ','    '/
      DATA INCASE(18)/'TPP'/
      DATA (INAME(18,J),J=1,4)/'T   ','    ','    ','    '/
      DATA INCASE(19)/'TPP'/
      DATA (INAME(19,J),J=1,4)/'STUD','T   ','    ','    '/
      DATA INCASE(20)/'CSPP'/
      DATA (INAME(20,J),J=1,4)/'CHIS','    ','    ','    '/
      DATA INCASE(21)/'CSPP'/
      DATA (INAME(21,J),J=1,4)/'CHI ','SQUA','    ','    '/
      DATA INCASE(22)/'FPP'/
      DATA (INAME(22,J),J=1,4)/'F   ','    ','    ','    '/
      DATA INCASE(23)/'FPP'/
      DATA (INAME(23,J),J=1,4)/'SNED','F   ','    ','    '/
      DATA INCASE(24)/'EXPP'/
      DATA (INAME(24,J),J=1,4)/'EXPO','    ','    ','    '/
      DATA INCASE(25)/'EXPP'/
      DATA (INAME(25,J),J=1,4)/'NEGA','EXPO','    ','    '/
      DATA INCASE(26)/'GAPP'/
      DATA (INAME(26,J),J=1,4)/'GAMM','    ','    ','    '/
      DATA INCASE(27)/'BNPP'/
      DATA (INAME(27,J),J=1,4)/'BETA','NORM','    ','    '/
      DATA INCASE(28)/'WEPP'/
      DATA (INAME(28,J),J=1,4)/'WEIB','    ','    ','    '/
      DATA INCASE(29)/'E1PP'/
      DATA (INAME(29,J),J=1,4)/'EXTR','VALU','TYPE','1   '/
      DATA INCASE(30)/'E1PP'/
      DATA (INAME(30,J),J=1,4)/'EXTR','VALU','TYPE','I   '/
      DATA INCASE(31)/'E1PP'/
      DATA (INAME(31,J),J=1,4)/'EV1 ','    ','    ','    '/
      DATA INCASE(32)/'E1PP'/
      DATA (INAME(32,J),J=1,4)/'EVI ','    ','    ','    '/
      DATA INCASE(33)/'E1PP'/
      DATA (INAME(33,J),J=1,4)/'GUMB','    ','    ','    '/
      DATA INCASE(34)/'E2PP'/
      DATA (INAME(34,J),J=1,4)/'EXTR','VALU','TYPE','2   '/
      DATA INCASE(35)/'E2PP'/
      DATA (INAME(35,J),J=1,4)/'EXTR','VALU','TYPE','II  '/
      DATA INCASE(36)/'E2PP'/
      DATA (INAME(36,J),J=1,4)/'EVII','    ','    ','    '/
      DATA INCASE(37)/'E2PP'/
      DATA (INAME(37,J),J=1,4)/'EV2 ','    ','    ','    '/
      DATA INCASE(38)/'E2PP'/
      DATA (INAME(38,J),J=1,4)/'FREC','    ','    ','    '/
      DATA INCASE(39)/'PAPP'/
      DATA (INAME(39,J),J=1,4)/'PARE','    ','    ','    '/
      DATA INCASE(40)/'BIPP'/
CCCCC DATA (INAME(40,J),J=1,4)/'BINO','    ','    ','    '/
      DATA (INAME(40,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(41)/'GEPP'/
CCCCC DATA (INAME(41,J),J=1,4)/'GEOM','    ','    ','    '/
      DATA (INAME(41,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(42)/'POPP'/
CCCCC DATA (INAME(42,J),J=1,4)/'POIS','    ','    ','    '/
      DATA (INAME(42,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(43)/'NBPP'/
CCCCC DATA (INAME(43,J),J=1,4)/'NEGA','BINO','    ','    '/
      DATA (INAME(43,J),J=1,4)/'NEGA','BINO','    ','    '/
      DATA INCASE(44)/'SEPP'/
      DATA (INAME(44,J),J=1,4)/'SEMI','CIRC','    ','    '/
      DATA INCASE(45)/'SEPP'/
      DATA (INAME(45,J),J=1,4)/'SEMI','    ','    ','    '/
      DATA INCASE(46)/'TRPP'/
      DATA (INAME(46,J),J=1,4)/'TRIA','    ','    ','    '/
      DATA INCASE(47)/'IGPP'/
      DATA (INAME(47,J),J=1,4)/'INVE','GAUS','    ','    '/
      DATA INCASE(48)/'IGPP'/
      DATA (INAME(48,J),J=1,4)/'IG  ','    ','    ','    '/
      DATA INCASE(49)/'WAPP'/
      DATA (INAME(49,J),J=1,4)/'WALD','    ','    ','    '/
      DATA INCASE(50)/'RIPP'/
      DATA (INAME(50,J),J=1,4)/'RIG ','    ','    ','    '/
      DATA INCASE(51)/'RIPP'/
      DATA (INAME(51,J),J=1,4)/'TWEE','    ','    ','    '/
      DATA INCASE(52)/'RIPP'/
      DATA (INAME(52,J),J=1,4)/'RECI','INVE','GAUS','    '/
      DATA INCASE(53)/'FLPP'/
      DATA (INAME(53,J),J=1,4)/'FATI','LIFE','    ','    '/
      DATA INCASE(54)/'FLPP'/
      DATA (INAME(54,J),J=1,4)/'FL  ','    ','    ','    '/
      DATA INCASE(55)/'FLPP'/
      DATA (INAME(55,J),J=1,4)/'BIRN','SAUN','    ','    '/
      DATA INCASE(56)/'FLPP'/
      DATA (INAME(56,J),J=1,4)/'SAUN','BIRN','    ','    '/
      DATA INCASE(57)/'GPPP'/
      DATA (INAME(57,J),J=1,4)/'GENE','PARE','    ','    '/
      DATA INCASE(58)/'GPPP'/
      DATA (INAME(58,J),J=1,4)/'GEP ','    ','    ','    '/
      DATA INCASE(59)/'GPPP'/
      DATA (INAME(59,J),J=1,4)/'GP  ','    ','    ','    '/
      DATA INCASE(60)/'DUPP'/
CCCCC DATA (INAME(60,J),J=1,4)/'DISC','UNIF','    ','    '/
      DATA (INAME(60,J),J=1,4)/'DISC','UNIF','    ','    '/
      DATA INCASE(61)/'NTPP'/
      DATA (INAME(61,J),J=1,4)/'NONC','T   ','    ','    '/
      DATA INCASE(62)/'NTPP'/
      DATA (INAME(62,J),J=1,4)/'NON-','T   ','    ','    '/
      DATA INCASE(63)/'NTPP'/
      DATA (INAME(63,J),J=1,4)/'NON ','CENT','T   ','    '/
      DATA INCASE(64)/'NFPP'/
      DATA (INAME(64,J),J=1,4)/'NONC','F   ','    ','    '/
      DATA INCASE(65)/'NFPP'/
      DATA (INAME(65,J),J=1,4)/'NON-','F   ','    ','    '/
      DATA INCASE(66)/'NFPP'/
      DATA (INAME(66,J),J=1,4)/'NON ','CENT','F   ','    '/
      DATA INCASE(67)/'NCBP'/
      DATA (INAME(67,J),J=1,4)/'NONC','BETA','    ','    '/
      DATA INCASE(68)/'NCBP'/
      DATA (INAME(68,J),J=1,4)/'NON-','BETA','    ','    '/
      DATA INCASE(69)/'NCBP'/
      DATA (INAME(69,J),J=1,4)/'NON ','CENT','BETA','    '/
      DATA INCASE(70)/'NCPP'/
      DATA (INAME(70,J),J=1,4)/'NON ','CENT','CHIS','    '/
      DATA INCASE(71)/'NCPP'/
      DATA (INAME(71,J),J=1,4)/'NON ','CENT','CHI-','    '/
      DATA INCASE(72)/'NCPP'/
      DATA (INAME(72,J),J=1,4)/'NONC','CHI ','SQUA','    '/
      DATA INCASE(73)/'NCPP'/
      DATA (INAME(73,J),J=1,4)/'NON-','CHI ','SQUA','    '/
      DATA INCASE(74)/'NCPP'/
      DATA (INAME(74,J),J=1,4)/'NONC','CHI-','    ','    '/
      DATA INCASE(75)/'NCPP'/
      DATA (INAME(75,J),J=1,4)/'NON-','CHI-','    ','    '/
      DATA INCASE(76)/'NCPP'/
      DATA (INAME(76,J),J=1,4)/'NONC','CHIS','    ','    '/
      DATA INCASE(77)/'NCPP'/
      DATA (INAME(77,J),J=1,4)/'NON-','CHIS','CHIS','    '/
      DATA INCASE(78)/'DNCF'/
      DATA (INAME(78,J),J=1,4)/'DOUB','NONC','F   ','    '/
      DATA INCASE(79)/'DNCF'/
      DATA (INAME(79,J),J=1,4)/'DOUB','NON-','F   ','    '/
      DATA INCASE(80)/'DNCT'/
      DATA (INAME(80,J),J=1,4)/'DOUB','NONC','T   ','    '/
      DATA INCASE(81)/'DNCT'/
      DATA (INAME(81,J),J=1,4)/'DOUB','NON-','T   ','    '/
      DATA INCASE(82)/'HYPP'/
CCCCC DATA (INAME(82,J),J=1,4)/'HYPE','    ','    ','    '/
      DATA (INAME(82,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(83)/'HYPP'/
CCCCC DATA (INAME(83,J),J=1,4)/'HYPE','GEO ','    ','    '/
      DATA (INAME(83,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(84)/'VMPP'/
      DATA (INAME(84,J),J=1,4)/'VON ','MISE','    ','    '/
      DATA INCASE(85)/'VMPP'/
      DATA (INAME(85,J),J=1,4)/'VONM','    ','    ','    '/
      DATA INCASE(86)/'VMPP'/
      DATA (INAME(86,J),J=1,4)/'VON-','    ','    ','    '/
      DATA INCASE(87)/'PNPP'/
      DATA (INAME(87,J),J=1,4)/'POWE','NORM','    ','    '/
      DATA INCASE(88)/'PLPP'/
      DATA (INAME(88,J),J=1,4)/'POWE','LOGN','    ','    '/
      DATA INCASE(89)/'PLPP'/
      DATA (INAME(89,J),J=1,4)/'POWE','LGNO','    ','    '/
      DATA INCASE(90)/'PLPP'/
      DATA (INAME(90,J),J=1,4)/'POWE','LOG-','    ','    '/
      DATA INCASE(91)/'COPP'/
      DATA (INAME(91,J),J=1,4)/'COSI','    ','    ','    '/
      DATA INCASE(92)/'ALPP'/
      DATA (INAME(92,J),J=1,4)/'ALPH','    ','    ','    '/
      DATA INCASE(93)/'PEPP'/
      DATA (INAME(93,J),J=1,4)/'POWE','EXPO','    ','    '/
      DATA INCASE(94)/'PFPP'/
      DATA (INAME(94,J),J=1,4)/'POWE','FUNC','    ','    '/
      DATA INCASE(95)/'CHPP'/
      DATA (INAME(95,J),J=1,4)/'CHI ','    ','    ','    '/
      DATA INCASE(96)/'DLPP'/
CCCCC DATA (INAME(96,J),J=1,4)/'LOGA','SERI','    ','    '/
      DATA (INAME(96,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(97)/'LLPP'/
      DATA (INAME(97,J),J=1,4)/'LOG ','LOGI','    ','    '/
      DATA INCASE(98)/'LLPP'/
      DATA (INAME(98,J),J=1,4)/'LOG-','LOGI','    ','    '/
      DATA INCASE(99)/'LLPP'/
      DATA (INAME(99,J),J=1,4)/'LOGL','    ','    ','    '/
      DATA INCASE(100)/'GGPP'/
      DATA (INAME(100,J),J=1,4)/'GENE','GAMM','    ','    '/
      DATA INCASE(101)/'GIPP'/
      DATA (INAME(101,J),J=1,4)/'INVE','GAMM','    ','    '/
      DATA INCASE(102)/'WRPP'/
CCCCC DATA (INAME(102,J),J=1,4)/'WARI','    ','    ','    '/
      DATA (INAME(102,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(103)/'WRPP'/
CCCCC DATA (INAME(103,J),J=1,4)/'YULE','    ','    ','    '/
      DATA (INAME(103,J),J=1,4)/'    ','    ','    ','    '/
      DATA INCASE(104)/'ANPP'/
      DATA (INAME(104,J),J=1,4)/'ANGL','    ','    ','    '/
      DATA INCASE(105)/'ARPP'/
      DATA (INAME(105,J),J=1,4)/'ARSE','    ','    ','    '/
      DATA INCASE(106)/'FNPP'/
      DATA (INAME(106,J),J=1,4)/'FOLD','NORM','    ','    '/
      DATA INCASE(107)/'TNPP'/
      DATA (INAME(107,J),J=1,4)/'TRUN','NORM','    ','    '/
      DATA INCASE(108)/'LGPP'/
      DATA (INAME(108,J),J=1,4)/'LOG ','GAMM','    ','    '/
      DATA INCASE(109)/'HSPP'/
      DATA (INAME(109,J),J=1,4)/'HYPE','SECA','    ','    '/
      DATA INCASE(110)/'GOPP'/
      DATA (INAME(110,J),J=1,4)/'GOMP','    ','    ','    '/
      DATA INCASE(111)/'HLPP'/
      DATA (INAME(111,J),J=1,4)/'HALF','LOGI','    ','    '/
      DATA INCASE(112)/'GVPP'/
      DATA (INAME(112,J),J=1,4)/'GENE','EXTR','VALU','    '/
      DATA INCASE(113)/'GVPP'/
      DATA (INAME(113,J),J=1,4)/'GEV ','    ','    ','    '/
      DATA INCASE(114)/'HCPP'/
      DATA (INAME(114,J),J=1,4)/'HALF','CAUC','    ','    '/
      DATA INCASE(115)/'P2PP'/
      DATA (INAME(115,J),J=1,4)/'PARE','SECO','KIND','    '/
      DATA INCASE(116)/'P2PP'/
      DATA (INAME(116,J),J=1,4)/'PARE','TYPE','2   ','    '/
      DATA INCASE(117)/'P2PP'/
      DATA (INAME(117,J),J=1,4)/'PARE','TYPE','II  ','    '/
      DATA INCASE(118)/'DWPP'/
      DATA (INAME(118,J),J=1,4)/'DOUB','WEIB','    ','    '/
      DATA INCASE(119)/'EWPP'/
      DATA (INAME(119,J),J=1,4)/'EXPO','WEIB','    ','    '/
      DATA INCASE(120)/'TEPP'/
      DATA (INAME(120,J),J=1,4)/'TRUN','EXPO','    ','    '/
      DATA INCASE(121)/'WCPP'/
      DATA (INAME(121,J),J=1,4)/'WRAP','CAUC','    ','    '/
      DATA INCASE(122)/'WKPP'/
      DATA (INAME(122,J),J=1,4)/'WAKE','    ','    ','    '/
      DATA INCASE(123)/'PEPP'/
      DATA (INAME(123,J),J=1,4)/'EXPO','POWE','    ','    '/
      DATA INCASE(124)/'DGPP'/
      DATA (INAME(124,J),J=1,4)/'DOUB','GAMM','    ','    '/
      DATA INCASE(125)/'KAPP'/
      DATA (INAME(125,J),J=1,4)/'BETA','KAPP','    ','    '/
      DATA INCASE(126)/'KAPP'/
      DATA (INAME(126,J),J=1,4)/'MIEL','BETA','KAPP','    '/
      DATA INCASE(127)/'FCPP'/
      DATA (INAME(127,J),J=1,4)/'FOLD','CAUC','    ','    '/
      DATA INCASE(128)/'BBPP'/
      DATA (INAME(128,J),J=1,4)/'BETA','BINO','    ','    '/
      DATA INCASE(129)/'BRPP'/
      DATA (INAME(129,J),J=1,4)/'BRAD','    ','    ','    '/
      DATA INCASE(130)/'GXPP'/
      DATA (INAME(130,J),J=1,4)/'GENE','EXPO','    ','    '/
      DATA INCASE(131)/'REPP'/
      DATA (INAME(131,J),J=1,4)/'RECI','    ','    ','    '/
      DATA INCASE(132)/'IWPP'/
      DATA (INAME(132,J),J=1,4)/'INVE','WEIB','    ','    '/
      DATA INCASE(133)/'LXPP'/
      DATA (INAME(133,J),J=1,4)/'LOG ','DOUB','EXPO','    '/
      DATA INCASE(134)/'LDPP'/
      DATA (INAME(134,J),J=1,4)/'GENE','TUKE','LAMB','    '/
      DATA INCASE(135)/'JBPP'/
      DATA (INAME(135,J),J=1,4)/'JOHN','SB  ','    ','    '/
      DATA INCASE(136)/'JUPP'/
      DATA (INAME(136,J),J=1,4)/'JOHN','SU  ','    ','    '/
      DATA INCASE(137)/'EEPP'/
      DATA (INAME(137,J),J=1,4)/'GEOM','EXTR','EXPO','    '/
      DATA INCASE(138)/'TSPP'/
      DATA (INAME(138,J),J=1,4)/'TWO ','SIDE','POWE','    '/
      DATA INCASE(139)/'BWPP'/
      DATA (INAME(139,J),J=1,4)/'BIWE','    ','    ','    '/
      DATA INCASE(140)/'BWPP'/
      DATA (INAME(140,J),J=1,4)/'BI  ','WEIB','    ','    '/
      DATA INCASE(141)/'LUPP'/
      DATA (INAME(141,J),J=1,4)/'LAND','    ','    ','    '/
      DATA INCASE(142)/'ERPP'/
      DATA (INAME(142,J),J=1,4)/'ERRO','    ','    ','    '/
      DATA INCASE(143)/'ERPP'/
      DATA (INAME(143,J),J=1,4)/'SUBB','    ','    ','    '/
      DATA INCASE(144)/'PFPP'/
      DATA (INAME(144,J),J=1,4)/'POWE','    ','    ','    '/
      DATA INCASE(145)/'TZPP'/
      DATA (INAME(145,J),J=1,4)/'TRAP','    ','    ','    '/
      DATA INCASE(146)/'GTPP'/
      DATA (INAME(146,J),J=1,4)/'GENE','TRAP','    ','    '/
      DATA INCASE(147)/'FTPP'/
      DATA (INAME(147,J),J=1,4)/'FOLD','T   ','    ','    '/
      DATA INCASE(148)/'SNPP'/
      DATA (INAME(148,J),J=1,4)/'SKEW','NORM','    ','    '/
      DATA INCASE(149)/'STPP'/
      DATA (INAME(149,J),J=1,4)/'SKEW','T   ','    ','    '/
      DATA INCASE(150)/'SLPP'/
      DATA (INAME(150,J),J=1,4)/'SLAS','    ','    ','    '/
      DATA INCASE(151)/'IBPP'/
      DATA (INAME(151,J),J=1,4)/'INVE','BETA','    ','    '/
      DATA INCASE(152)/'GMPP'/
      DATA (INAME(152,J),J=1,4)/'GOMP','MAKE','    ','    '/
      DATA INCASE(153)/'GIGP'/
      DATA (INAME(153,J),J=1,4)/'GENE','INVE','GAUS','    '/
      DATA INCASE(154)/'GFPP'/
      DATA (INAME(154,J),J=1,4)/'GENE','F   ','    ','    '/
      DATA INCASE(155)/'GHPP'/
      DATA (INAME(155,J),J=1,4)/'G-H ','    ','    ','    '/
      DATA INCASE(156)/'GHPP'/
      DATA (INAME(156,J),J=1,4)/'GH  ','    ','    ','    '/
      DATA INCASE(157)/'GHPP'/
      DATA (INAME(157,J),J=1,4)/'G   ','H   ','    ','    '/
      DATA INCASE(158)/'GHPP'/
      DATA (INAME(158,J),J=1,4)/'G   ','AND ','H   ','    '/
      DATA INCASE(159)/'LZPP'/
      DATA (INAME(159,J),J=1,4)/'LOG ','SKEW','NORM','    '/
      DATA INCASE(160)/'LTPP'/
      DATA (INAME(160,J),J=1,4)/'LOG ','SKEW','T   ','    '/
      DATA INCASE(161)/'GZPP'/
      DATA (INAME(161,J),J=1,4)/'GENE','HALF','LOGI','    '/
      DATA INCASE(162)/'ASPP'/
      DATA (INAME(162,J),J=1,4)/'ARCS','    ','    ','    '/
      DATA INCASE(163)/'PZPP'/
CCCCC DATA (INAME(163,J),J=1,4)/'POLY','    ','    ','    '/
      DATA INCASE(164)/'SDPP'/
      DATA (INAME(164,J),J=1,4)/'SKEW','DOUB','EXPO','    '/
      DATA INCASE(165)/'SDPP'/
      DATA (INAME(165,J),J=1,4)/'SKEW','LAPL','    ','    '/
      DATA INCASE(166)/'ADPP'/
      DATA (INAME(166,J),J=1,4)/'ASYM','DOUB','EXPO','    '/
      DATA INCASE(167)/'ADPP'/
      DATA (INAME(167,J),J=1,4)/'ASYM','LAPL','    ','    '/
      DATA INCASE(168)/'MXPP'/
      DATA (INAME(168,J),J=1,4)/'MAXW','    ','    ','    '/
      DATA INCASE(169)/'RAPP'/
      DATA (INAME(169,J),J=1,4)/'RAYL','    ','    ','    '/
      DATA INCASE(170)/'GALP'/
      DATA (INAME(170,J),J=1,4)/'GENE','ASYM','DOUB','EXPO'/
      DATA INCASE(171)/'GALP'/
      DATA (INAME(171,J),J=1,4)/'GENE','ASYM','LAPL','    '/
      DATA INCASE(172)/'MCPP'/
      DATA (INAME(172,J),J=1,4)/'MCLE','    ','    ','    '/
      DATA INCASE(173)/'BEIP'/
      DATA (INAME(173,J),J=1,4)/'BESS','I   ','FUNC','    '/
      DATA INCASE(174)/'BEIP'/
      DATA (INAME(174,J),J=1,4)/'BESS','I   ','    ','    '/
      DATA INCASE(175)/'BEKP'/
      DATA (INAME(175,J),J=1,4)/'BESS','K   ','FUNC','    '/
      DATA INCASE(176)/'BEKP'/
      DATA (INAME(176,J),J=1,4)/'BESS','K   ','    ','    '/
      DATA INCASE(177)/'GMCP'/
      DATA (INAME(177,J),J=1,4)/'GENE','MCLE','    ','    '/
      DATA INCASE(178)/'G5PP'/
      DATA (INAME(178,J),J=1,4)/'GENE','LOGI','TYPE','5   '/
      DATA INCASE(179)/'G5PP'/
      DATA (INAME(179,J),J=1,4)/'GENE','LOGI','TYPE','V   '/
      DATA INCASE(180)/'G5PP'/
      DATA (INAME(180,J),J=1,4)/'GENE','LOGI','HOSK','    '/
      DATA INCASE(181)/'G5PP'/
      DATA (INAME(181,J),J=1,4)/'HOSK','GENE','LOGI','    '/
      DATA INCASE(182)/'G5PP'/
      DATA (INAME(182,J),J=1,4)/'TYPE','5   ','GENE','LOGI'/
      DATA INCASE(183)/'G5PP'/
      DATA (INAME(183,J),J=1,4)/'TYPE','V   ','GENE','LOGI'/
      DATA INCASE(184)/'G2PP'/
      DATA (INAME(184,J),J=1,4)/'GENE','LOGI','TYPE','2   '/
      DATA INCASE(185)/'G2PP'/
      DATA (INAME(185,J),J=1,4)/'GENE','LOGI','TYPE','II  '/
      DATA INCASE(186)/'G2PP'/
      DATA (INAME(186,J),J=1,4)/'TYPE','2   ','GENE','LOGI'/
      DATA INCASE(187)/'G2PP'/
      DATA (INAME(187,J),J=1,4)/'TYPE','II  ','GENE','LOGI'/
      DATA INCASE(188)/'G3PP'/
      DATA (INAME(188,J),J=1,4)/'GENE','LOGI','TYPE','3   '/
      DATA INCASE(189)/'G3PP'/
      DATA (INAME(189,J),J=1,4)/'GENE','LOGI','TYPE','III '/
      DATA INCASE(190)/'G3PP'/
      DATA (INAME(190,J),J=1,4)/'TYPE','3   ','GENE','LOGI'/
      DATA INCASE(191)/'G3PP'/
      DATA (INAME(191,J),J=1,4)/'TYPE','III ','GENE','LOGI'/
      DATA INCASE(192)/'G4PP'/
      DATA (INAME(192,J),J=1,4)/'GENE','LOGI','TYPE','4   '/
      DATA INCASE(193)/'G4PP'/
      DATA (INAME(193,J),J=1,4)/'GENE','LOGI','TYPE','IV  '/
      DATA INCASE(194)/'G4PP'/
      DATA (INAME(194,J),J=1,4)/'TYPE','4   ','GENE','LOGI'/
      DATA INCASE(195)/'G4PP'/
      DATA (INAME(195,J),J=1,4)/'TYPE','IV  ','GENE','LOGI'/
      DATA INCASE(196)/'GLPP'/
      DATA (INAME(196,J),J=1,4)/'GENE','LOGI','    ','    '/
      DATA INCASE(197)/'BEPP'/
      DATA (INAME(197,J),J=1,4)/'BETA','    ','    ','    '/
      DATA INCASE(198)/'LXPP'/
      DATA (INAME(198,J),J=1,4)/'LOG ','LAPL','    ','    '/
      DATA INCASE(199)/'AXPP'/
      DATA (INAME(199,J),J=1,4)/'ASYM','LOG ','DOUB','EXPO'/
      DATA INCASE(200)/'AXPP'/
      DATA (INAME(200,J),J=1,4)/'ASYM','LOG ','LAPL','    '/
C
C-----START POINT---------------------------------------------
C
      IERROR='NO'
      IDIST=' '
C
      ISUBN1='DP1K'
      ISUBN2='ST  '
      ICENSO='OFF'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=3
C
      ICOLR=0
C
C               *******************************************************
C               **  TREAT THE KOLMOGOROV-SMIRNOV GOODNESS OF FIT CASE *
C               *******************************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,51)
   51   FORMAT('***** AT THE BEGINNING OF DP1KST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,52)ICASPL
   52   FORMAT('ICASPL = ',A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53   FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
 
      DO100I=1,NUMCHS
        IROW=I
        IF(INAME(I,1).NE.ICOM)GOTO100
        DO102J=1,4
          IF(INAME(I,J).NE.'    ')GOTO102
          ITEMP=J-1
          GOTO104
  102   CONTINUE
        ITEMP=4
  104   CONTINUE
        ILASTC=0
        IF(ITEMP.GT.1)THEN
          DO108J=2,ITEMP
            IF(INAME(I,J).NE.IHARG(J-1))GOTO100
  108     CONTINUE
          ILASTC=ITEMP-1
        ENDIF
        I1=ILASTC+1
        I2=ILASTC+2
        I3=ILASTC+3
        I4=ILASTC+4
        I5=ILASTC+5
        I6=ILASTC+6
C
        IF(IHARG(I1).EQ.'CENS')THEN
          ICENSO='ON'
          ISHIFT=1
          CALL SHIFTL(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG,
     1                IBUGA2,IERROR)
        ENDIF
C
        IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND.
     1     IHARG(I3).EQ.'GOOD'.AND.IHARG(I4).EQ.'OF  '.AND.
     1     IHARG(I5).EQ.'FIT '.AND.IHARG(I6).EQ.'TEST')THEN
           ILASTC=I6
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND.
     1     IHARG(I3).EQ.'GOOD'.AND.IHARG(I4).EQ.'OF  '.AND.
     1     IHARG(I5).EQ.'FIT ')THEN
           ILASTC=I5
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'GOOD'.AND.
     1     IHARG(I3).EQ.'OF  '.AND.IHARG(I4).EQ.'FIT '.AND.
     1     IHARG(I5).EQ.'TEST')THEN
           ILASTC=I5
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'GOOD'.AND.
     1     IHARG(I3).EQ.'OF  '.AND.IHARG(I4).EQ.'FIT ')THEN
           ILASTC=I4
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'SMIR'.AND.
     1     IHARG(I3).EQ.'TEST')THEN
           ILASTC=I3
           GOTO112
        END IF
        IF(IHARG(I1).EQ.'KOLM'.AND.IHARG(I2).EQ.'TEST')THEN
           ILASTC=I2
           GOTO112
        END IF
C
CCCCC   ICASPL='    '
CCCCC   IFOUND='NO'
CCCCC   GOTO9000
  100 CONTINUE
C
C ----------NO MATCH FOUND----------
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ICASPL=INCASE(IROW)
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      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'.OR.ISUBRO.EQ.'1KST')
     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 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     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(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'ON')THEN
        WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211   FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
        CALL DPWRST('XXX','BUG ')
      ENDIF
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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,311)
  311   FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
        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 KOLMOGOROV-SMIRNOV GOODNESS OF FIT ',
     1         'TEST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,314)MINN2
  314   FORMAT('      WAS TO HAVE BEEN PERFORMED MUST BE ',I8,' OR ',
     1         '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)THEN
          WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
  318     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ********************************************
C               **  STEP 3B--                             **
C               **  CHECK THE VALIDITY OF ARGUMENT 2      **
C               **  IF ARGUMENT 2 NOT FOUND OR IS NOT A   **
C               **  VARIABLE, ASSUME UNCENSORED CASE.     **
C               ********************************************
C
      ISTEPN='3B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.2)THEN
        IHRIGH=IHARG(2)
        IHRIG2=IHARG2(2)
        IHWUSE='V'
        MESSAG='NO'
        CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
        IF(IERROR.EQ.'YES')THEN
          ICENSO='OFF'
        ELSE
          ICENSO='ON'
          ICOLR=IVALUE(ILOCV)
          NRIGHT=IN(ILOCV)
          IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN
            WRITE(ICOUT,321)IHRIGH,IHRIG2,ICOLR,NRIGHT
  321       FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,A4,I8,I8)
            CALL DPWRST('XXX','BUG ')
          ENDIF
        ENDIF
      ELSE
        ICENSO='OFF'
      ENDIF
C
C               *******************************************************
C               **  STEP 4B-                                         **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NRIGHT)
C               **  FOR THE SECOND RESPONSE VARIABLE IS POSITIVE.    **
C               *******************************************************
C
      ISTEPN='4B'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICENSO.EQ.'ON' .AND. NRIGHT.LT.MINN2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,361)
  361   FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,362)IHRIGH,IHRIG2
  362   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1         'IN VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,363)
  363   FORMAT('      FOR WHICH A KOLMOGOROV-SMIRNOV GOODNESS OF FIT ',
     1         'TEST')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,364)MINN2
  364   FORMAT('      WAS TO HAVE BEEN PERFORMED MUST BE ',I8,' OR ',
     1         'LARGER;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,366)
  366   FORMAT('      SUCH WAS NOT THE CASE HERE.')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,367)
  367   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,368)(IANS(I),I=1,MIN(80,IWIDTH))
  368     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(ICENSO.EQ.'ON' .AND. NRIGHT.NE.NLEFT)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,371)
  371   FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,372)IHLEFT,IHLEF2
  372   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1         'IN VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,373)IHRIGH,IHRIG2
  373   FORMAT('      DOES NOT MATCH')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,374)IHRIGH,IHRIG2
  374   FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1         'IN VARIABLE ',A4,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,377)
  377   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,378)(IANS(I),I=1,MIN(80,IWIDTH))
  378     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 5--                           **
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='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF ',
     1       'FIT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487   FORMAT('      ',80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN
        WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491   FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  IF THERE ARE MORE THAN TWO RESPONSE VARIABLES,  **
C               **  THIS IS AN ERROR CONDITION.                     **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IDATSW='RAW'
C
      IF(NUMV2.GT.MAXV2)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,551)
  551   FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,552)
  552   FORMAT('      FOR A ... KOLMOGOROV-SMIRNOV GOODNESS OF FIT ',
     1         'TEST, ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,558)
  558   FORMAT('      THE NUMBER OF VARIABLES MUST BE EITHER ONE OR ')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,560)
  560   FORMAT('      TWO;  SUCH WAS NOT THE CASE HERE;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,561)NUMV2
  561   FORMAT('      THE SPECIFIED NUMBER OF VARIABLES WAS ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,563)
  563   FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
        CALL DPWRST('XXX','BUG ')
        IF(IWIDTH.GE.1)THEN
          WRITE(ICOUT,564)(IANS(I),I=1,MIN(IWIDTH,80))
  564     FORMAT(80A1)
          CALL DPWRST('XXX','BUG ')
        ENDIF
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,NLEFT
      ISUB(I)=1
  615 CONTINUE
      NQ=NLEFT
      GOTO650
C
  620 CONTINUE
      NIOLD=NLEFT
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=NLEFT
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO660I=1,IMAX
        IF(ISUB(I).EQ.0)GOTO660
        J=J+1
C
        IJ=MAXN*(ICOLL-1)+I
        IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
        IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
        IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
        IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
        IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
        IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
        IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
        IF(NUMV2.LE.1)GOTO660
C
        IJ=MAXN*(ICOLR-1)+I
        IF(ICOLR.LE.MAXCOL)CENSOR(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)CENSOR(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)CENSOR(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)CENSOR(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)CENSOR(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)CENSOR(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)CENSOR(J)=TAGPLO(I)
C
  660 CONTINUE
      NLOCAL=J
C
CCCCC OCTOBER 2004.  FOR CENSORED CASE, CHECK THAT CENSOR VARIABLE
CCCCC                CONTAINS TWO DISTINCT VALUES, SET TO 1 AND 0.
C
      IF(ICENSO.EQ.'ON'.AND.NUMV2.EQ.2)THEN
        IWRIT2='OFF'
        CALL DISTIN(CENSOR,NLOCAL,IWRIT2,XTEMP1,NDIST,IBUGA2,IERROR)
        IF(NDIST.EQ.1)THEN
          DO1102I=1,NLOCAL
            CENSOR(I)=1.0
 1102     CONTINUE
        ELSEIF(NDIST.EQ.2)THEN
          IF(XTEMP1(1).EQ.1.0 .OR. XTEMP1(2).EQ.1.0)THEN
            DO1103I=1,NLOCAL
              IF(CENSOR(I).NE.1.0)CENSOR(I)=0.0
 1103       CONTINUE
          ELSE
            ATEMP1=MIN(XTEMP1(1),XTEMP1(2))
            ATEMP2=MAX(XTEMP1(1),XTEMP1(2))
            DO1108I=1,NLOCAL
              IF(CENSOR(I).EQ.ATEMP1)CENSOR(I)=1.0
              IF(CENSOR(I).EQ.ATEMP2)CENSOR(I)=0.0
 1108       CONTINUE
          ENDIF
        ELSE
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1104)
 1104     FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1105)IHRIGH,IHRIG2
 1105     FORMAT('      FOR CENSORED DATA, THE CENSORING VARIABLE (',
     1           A4,A4,')')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1106)
 1106     FORMAT('      SHOULD CONTAIN AT MOST TWO DISTINCT VALUES.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,1107)NDIST
 1107     FORMAT('      ',I8,' DISTINCT VALUES FOUND.')
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
      ENDIF
C
C               ***********************************************
C               **  STEP 8--                                 **
C               **  FOR THOSE DISTRIBUTIONS REQUIRING THEM,  **
C               **  DETERMINE IF THE ANALYST                 **
C               **  HAS SPECIFIED PARAMETER VALUES           **
C               ***********************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASPL.EQ.'LAPP')THEN
        IDIST='LAMBDA'
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TPP')THEN
        IDIST='T'
        IHP='NU  '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'CSPP')THEN
        IDIST='CHI-SQUARED'
        IHP='NU  '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FPP')THEN
        IDIST='F     '
        IHP='NU1 '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU1,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='NU2 '
        IHP2='    '
        CALL PARCHI(IHP,IHP2,IDIST,NU2,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GAPP')THEN
        IDIST='GAMMA'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BEPP')THEN
        IDIST='BETA'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BNPP')THEN
        IDIST='BETA-NORMAL'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WEPP')THEN
        IDIST='WEIBULL'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'E2PP')THEN
        IDIST='EXTREME VALUE TYPE 2'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PAPP')THEN
        IDIST='PARETO'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=1.0
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BIPP')THEN
        IDIST='BINOMIAL'
        IHP='N   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,N,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GEPP')THEN
        IDIST='GEOMETRIC'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'POPP')THEN
        IDIST='POISSON'
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NBPP')THEN
        IDIST='NEGATIVE BINOMIAL'
        IHP='K   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'IGPP')THEN
        IDIST='INVERSE GAUSSIAN'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='MU  '
        IHP2='    '
        IDIST='INVERSE GAUSSIAN'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AMU=1.0
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WAPP')THEN
        IDIST='WALD'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'RIPP')THEN
        IDIST='RECIRPOCAL INVERSE GAUSSIAN'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='MU  '
        IHP2='    '
        IDIST='RECIPROCAL INVERSE GAUSSIAN'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AMU=1.0
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FLPP')THEN
        IDIST='FATIGUE LIFE'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GPPP')THEN
        IDIST='GENERALIZED PARETO'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TRPP')THEN
        IDIST='TRIANGULAR'
        IHP='C   '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')THEN
          C=0.0
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DUPP')THEN
        IDIST='DISCRETE UNIFORM'
        IHP='N   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NDUN,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NCBP')THEN
        IDIST='NON-CENTRAL BETA'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NCPP')THEN
        IDIST='NON-CENTRAL CHI-SQUARE'
        IHP='NU  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NFPP')THEN
        IDIST='NON-CENTRAL F'
        IHP='NU1 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='NU2 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NTPP')THEN
        IDIST='NON-CENTRAL T'
        IHP='NU  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DNCF')THEN
        IDIST='DOUBLY NON-CENTRAL F'
        IHP='NU1 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='NU2 '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA2 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DNCT')THEN
        IDIST='DOUBLY NON-CENTRAL T'
        IHP='NU  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA2 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'HYPP')THEN
        IDIST='HYPERGEOMETRIC'
        IHP='M   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,MPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=MPAR
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NPAR,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='K   '
        IHP2='    '
        ILOWLM=1
        IUPPLM=MPAR
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,K,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'VMPP')THEN
        IDIST='VON MISES'
        IHP='B   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PNPP')THEN
        IDIST='POWER NORMAL'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PLPP')THEN
        IDIST='POWER LOG-NORMAL'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'ALPP')THEN
        IDIST='ALPHA'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LNPP')THEN
        IHP='SIGM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SIGMA=1.0
        ELSE
          SIGMA=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PFPP')THEN
        IDIST='POWER FUNCTION'
        IHP='C   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'CHPP')THEN
        IDIST='CHI'
        IHP='NU  '
        IHP2='    '
        IDIST='CHI'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DLPP')THEN
        IDIST='LOGARITMIC SERIES'
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LLPP')THEN
        IDIST='LOG-LOGISTIC'
        IHP='DELT'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,DELTA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GGPP')THEN
        IDIST='GENERALIZED GAMMA'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='C   '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IF(C.NE.0.0)GOTO4829
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4821)
 4821     FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4822)
 4822     FORMAT('      THE SPECIFIED SHAPE PARAMETER C')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4823)
 4823     FORMAT('      FOR THE GENERALIZED GAMMA DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4824)
 4824     FORMAT('      CANNOT BE EQUAL TO 0;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4825)
 4825     FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4826)C
 4826     FORMAT('      THE SPECIFIED VALUE OF C = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
 4829   CONTINUE
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WRPP')THEN
        IDIST='WARING'
        IHP='C   '
        IHP2='    '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=1.0
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        IF(A.LT.1.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4911)
 4911 FORMAT('***** ERROR IN KOLMOGOROV-SMIRNOV GOODNESS OF FIT--')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4912)
 4912 FORMAT('      THE SPECIFIED SHAPE PARAMETER A FOR THE WARING ',
     1'DISTRIBUTION')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4913)
 4913 FORMAT('      MUST BE GREATER THAN OR EQUAL TO 1 ')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4914)
 4914 FORMAT('      FOR THE KOLMOGOROV-SMIRNOV GOODNESS OF FIT;')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4915)
 4915 FORMAT('      SUCH WAS NOT THE CASE HERE.')
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,4916)A
 4916 FORMAT('      THE SPECIFIED VALUE OF A = ',E15.7)
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FNPP')THEN
        IDIST='FOLDED NORMAL'
        IHP='MU  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TNPP')THEN
        IDIST='TRUNCATED NORMAL'
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=-99.9
        ELSE
          A=VALUE(ILOCP)
        ENDIF
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          B=-99.9
        ELSE
          B=VALUE(ILOCP)
        ENDIF
C
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LGPP')THEN
        IDIST='LOG-GAMMA'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GOPP')THEN
        IDIST='GOMPERTZ'
        IHP='C   '
        IHP2='    '
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='B   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GVPP')THEN
        IDIST='GENERALIZED EXTREME VALUE'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GZPP')THEN
        IDIST='GENERALIZED HALF-LOGISTIC'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=5.0
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'P2PP')THEN
        IDIST='PARETO TYPE 2'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=1.0
        ELSE
          A=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DWPP')THEN
        IDIST='DOUBLE WEIBULL'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'WCPP')THEN
        IDIST='WRAPPED CAUCHY'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=1.
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'EWPP')THEN
        IDIST='EXPONENTIATED WEIBULL'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TEPP')THEN
        IDIST='TRUNCATED EXPONENTIAL'
        IHP='X0  '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,X0,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GLPP')THEN
        IDIST='GENERALIZED LOGISTIC'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G2PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 2'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G3PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 3'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G4PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 4'
        IHP='P   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='Q   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,Q,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'G5PP')THEN
        IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)'
C
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'WAKE')THEN
        IDIST='WAKEBY'
C
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='DELT'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,DELTA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'PEPP')THEN
        IDIST='EXPONENTIAL POWER'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'DGPP')THEN
        IDIST='DOUBLE GAMMA'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'KAPP')THEN
        IDIST='MIELKE BETA-KAPPA'
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='K   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'FCPP')THEN
        IDIST='FOLDED CAUCHY'
        IHP='M   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO '
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          AM=0.0
        ELSE
          AM=VALUE(ILOCP)
        ENDIF
C
        IHP='SD  '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1              IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1              ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES'.OR.VALUE(ILOCP).LE.0.0)THEN
          SD=1.0
        ELSE
          SD=VALUE(ILOCP)
        ENDIF
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BBPP')THEN
        IDIST='BETA-BINOMIAL'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ILOWLM=0
        IUPPLM=I1MACH(9)
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BRPP')THEN
        IDIST='BRADFORD'
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GXPP')THEN
        IDIST='GENERALIZED EXPONENTIAL'
        IHP='LAMB'
        IHP2='DA1 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA2 '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMB2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='S   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'REPP')THEN
        IDIST='RECIPROCAL'
        IHP='B   '
        IHP2='    '
        ALOWLM=1.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'NMPP')THEN
        IDIST='NORMAL MIXTURE'
        IHP='U1  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,U1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='U2  '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,U2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD1 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SD1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SD2 '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SD2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='P   '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,P,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'GIPP')THEN
        IDIST='INVERTED GAMMA'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'IWPP')THEN
        IDIST='INVERTED WEIBULL'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LXPP')THEN
        IDIST='LOG DOUBLE EXPONENTIAL'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'AXPP')THEN
        IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'JUPP')THEN
        IDIST='JOHNSON SU'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='ALPH'
        IHP2='A2  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'JBPP')THEN
        IDIST='JOHNSON SB'
        IHP='ALPH'
        IHP2='A1  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='ALPH'
        IHP2='A2  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALPHA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'LDPP')THEN
        IDIST='GENERALIZED TUKEY-LAMBDA'
        IHP='LAMB'
        IHP2='DA3 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALAMB3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA4 '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,
     1              ALAMB4,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
CCCCC   IWRITE='OFF'
CCCCC   ZSCALE=1.0
CCCCC   CALL GLDCHK(ALAMB3,ALAMB4,ALOWER,AUPPER,IFLAG,ISIGN,IWRITE)
CCCCC   IF(ISIGN.LT.0)ZSCALE=-1.0
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'EEPP')THEN
        IDIST='GEOMETRIC EXTREME EXPONENTIAL'
        IHP='GAMM'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TSPP')THEN
        IDIST='TWO-SIDED POWER'
        IHP='THET'
        IHP2='A   '
        ALOWLM=0.
        AUPPLM=1.0
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='N   '
        IHP2='    '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'BWPP')THEN
        IDIST='BIWEIBULL'
        IHP='SCAL'
        IHP2='E1  '
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SCALE1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='SCAL'
        IHP2='E2  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,SCALE2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='GAMM'
        IHP2='A1  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='GAMM'
        IHP2='A2  '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,GAMMA2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LOC2'
        IHP2='    '
        IDIST='BIWEIBULL'
        ALOWLM=0.
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,LOC2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'ERPP')THEN
        IDIST='ERROR'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=1.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
      IF(ICASPL.EQ.'TZPP')THEN
        IDIST='TRAPEZOID'
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        A=VALUE(ILOCP)
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        B=VALUE(ILOCP)
C
        IHP='C   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        C=VALUE(ILOCP)
C
        IHP='D   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DZ=VALUE(ILOCP)
C
        IF(A.GE.B .OR. B.GE.C .OR. C.GE.DZ)THEN
          WRITE(ICOUT,7312)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7313)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7314)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7316)A,B,C,DZ
          CALL DPWRST('XXX','BUG ')
          PDF=0.0
          GOTO9000
        ENDIF
 7312   FORMAT(
     1'***** FATAL ERROR--FOR THE TRAPEZOID DISTRIBUTION, THE FOUR')
 7313   FORMAT(
     1'      SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
 7314   FORMAT(
     1'         A < B < C < D')
 7316   FORMAT(
     1'      A, B, C, D = ',4E15.7)
C
      ENDIF
C
      IF(ICASPL.EQ.'GTPP')THEN
        IDIST='GENERALIZED TRAPEZOID'
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        A=VALUE(ILOCP)
C
        IHP='B   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        B=VALUE(ILOCP)
C
        IHP='C   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        C=VALUE(ILOCP)
C
        IHP='D   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='YES'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        DZ=VALUE(ILOCP)
C
        IHP='ALPH'
        IHP2='A   '
        IDIST='GENERALIZED TRAPEZOID'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU1 '
        IHP2='    '
        IDIST='GENERALIZED TRAPEZOID'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='NU3 '
        IHP2='    '
        IDIST='GENERALIZED TRAPEZOID'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ANU3,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IF(A.GE.B .OR. B.GE.C .OR. C.GE.DZ)THEN
          WRITE(ICOUT,7322)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7323)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7324)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,7326)A,B,C,DZ
          CALL DPWRST('XXX','BUG ')
          PDF=0.0
          GOTO9000
        ENDIF
 7322   FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALZIED TRAPEZOID DISTRIBUTION,')
 7323   FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
 7324   FORMAT(
     1'         A < B < C < D')
 7326   FORMAT(
     1'      A, B, C, D = ',4E15.7)
C
      ENDIF
C
      IF(ICASPL.EQ.'FTPP')THEN
        IDIST='FOLDED T'
        IHP='NU  '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'SNPP')THEN
        IDIST='SKEWED NORMAL'
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'STPP')THEN
        IDIST='SKEWED T'
        IHP='NU  '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'IBPP')THEN
        IDIST='INVERTED BETA'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='BETA'
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,BETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GMPP')THEN
        IF(IMAKDF.EQ.'DLMF')THEN
          IDIST='GOMPERTZ-MAKEHAM'
          IHP='XI  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,XI,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          IHP='LAMB'
          IHP2='DA  '
          CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          LOWLTY='>=  '
          IHP='THET'
          IHP2='A   '
          CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
        ELSEIF(IMAKDF.EQ.'MEEK')THEN
          IDIST='GOMPERTZ-MAKEHAM'
          IHP='GAMM'
          IHP2='A   '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,GAMMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          LOWLTY='>=  '
          IHP='LAMB'
          IHP2='DA  '
          CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          LOWLTY='>   '
          IHP='K   '
          IHP2='    '
          CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
        ELSE
          IDIST='GOMPERTZ-MAKEHAM'
          IHP='ETA '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>=  '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,ETA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>=  '
          UPPLTY='<=  '
          IHP='ZETA'
          IHP2='    '
          CALL PARCHR(IHP,IHP2,IDIST,ZETA,ALOWLM,AUPPLM,
     1                LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
        ENDIF
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GIGP')THEN
        IDIST='GENERALIZED INVERSE GAUSSIAN'
        IHP='CHI '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,CHI,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        IHP='LAMB'
        IHP2='DA  '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IHP='THET'
        IHP2='A   '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,THETA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GHPP')THEN
        IDIST='G-H'
        IHP='G   '
        IHP2='    '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>=   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,G,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        ALOWLM=0.0
        IHP='H   '
        IHP2='    '
        CALL PARCHR(IHP,IHP2,IDIST,H,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'LZPP')THEN
        IDIST='LOG SKEWED NORMAL'
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD  '
        IHP2='    '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,SD,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'LTPP')THEN
        IDIST='LOG SKEWED T'
        IHP='NU  '
        IHP2='    '
        ILOWLM=1
        IUPPLM=I1MACH(9)
        LOWLTY='>=  '
        UPPLTY='<=  '
        CALL PARCHI(IHP,IHP2,IDIST,NU,ILOWLM,IUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='SD  '
        IHP2='    '
        IDIST='LOG SKEWED T'
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,SD,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'SDPP')THEN
        IDIST='SKEWED DOUBLE EXPONENTIAL'
        IHP='LAMB'
        IHP2='DA  '
        ALOWLM=CPUMIN
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,ALAMBA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'ADPP')THEN
        IDIST='ASYMMETRIC DOUBLE EXPONENTIAL'
        IF(IADEDF.EQ.'K')THEN
          IHP='K   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ELSE
          IHP='MU  '
          IHP2='    '
          ALOWLM=CPUMIN
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ENDIF
      ENDIF
C
      IF(ICASPL.EQ.'MXPP')THEN
        IDIST='MAXWELL'
        IHP='SIGM'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,SIGMA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GALP')THEN
        IDIST='GENERALIZED ASYMMETRIC DOUBLE EXPONENTIAL'
        IF(IADEDF.EQ.'K')THEN
          IHP='K   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AK,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          IHP='TAU '
          IHP2='    '
          CALL PARCHR(IHP,IHP2,IDIST,TAU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ELSE
          IHP='MU  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<   '
          CALL PARCHR(IHP,IHP2,IDIST,AMU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
        ENDIF
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'MCPP')THEN
        IDIST='MCLEISH'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'GMCP')THEN
        IDIST='GENERALIZED MCLEISH'
        IHP='ALPH'
        IHP2='A   '
        ALOWLM=0.0
        AUPPLM=CPUMAX
        LOWLTY='>   '
        UPPLTY='<=  '
        CALL PARCHR(IHP,IHP2,IDIST,ALPHA,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
C
        IHP='A   '
        IHP2='    '
        ALOWLM=-1.0
        AUPPLM=1.0
        LOWLTY='>   '
        UPPLTY='<   '
        CALL PARCHR(IHP,IHP2,IDIST,A,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1              ISUBN1,ISUBN2,IERROR)
        IF(IERROR.EQ.'YES')GOTO9000
        GOTO4999
      ENDIF
C
      IF(ICASPL.EQ.'BEIP' .OR. ICASPL.EQ.'BEKP')THEN
        IDIST='BESSEL I-FUNCTION'
        IF(ICASPL.EQ.'BEKP')IDIST='BESSEL K-FUNCTION'
        IF(IBEIDF.EQ.'1')THEN
          IHP='SIGM'
          IHP2='A1SQ'
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,SD1,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='SIGM'
          IHP2='A2SQ'
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,SD2,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='NU  '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,ANU,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ELSE
          IHP='B   '
          IHP2='    '
          ALOWLM=0.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,B,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='C   '
          IHP2='    '
          ALOWLM=1.0
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,C,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
C
          IHP='M   '
          IHP2='    '
          ALOWLM=0.5
          AUPPLM=CPUMAX
          LOWLTY='>   '
          UPPLTY='<=  '
          CALL PARCHR(IHP,IHP2,IDIST,AM,ALOWLM,AUPPLM,LOWLTY,UPPLTY,
     1                ISUBN1,ISUBN2,IERROR)
          IF(IERROR.EQ.'YES')GOTO9000
          GOTO4999
        ENDIF
      ENDIF
C
 4999 CONTINUE
C
C  LOCATION AND SCALE FOR ALL DISTRIBUTIONS
C
      IHP='KSLO'
      IHP2='C   '
      IHWUSE='P'
      MESSAG='NO '
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        KSLOC=0.0
      ELSE
        KSLOC=VALUE(ILOCP)
      ENDIF
C
      IHP='KSSC'
      IHP2='ALE '
      IHWUSE='P'
      MESSAG='NO '
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1            IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1            ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')THEN
        AKSCAL=1.0
      ELSE
        AKSCAL=VALUE(ILOCP)
      ENDIF
      IF(AKSCAL.LE.0.0)AKSCAL=1.0
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  COMPUTE THE KOLMOGOROV-SMIRNOV GOODNESS OF FIT **
C               **  TEST                                           **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5111)
 5111   FORMAT('***** FROM THE MIDDLE OF DP1KST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5112)ICASPL,NUMV2,NLOCAL,IDATSW
 5112   FORMAT('ICASPL,NUMV2,NLOCAL,IDATSW = ',A4,I8,2X,I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5113)ALAMBA,NU,NU1,NU2
 5113   FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,5114)GAMMA,ALPHA,BETA,NPAR,P,K
 5114   FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8)
        CALL DPWRST('XXX','BUG ')
        DO5116I=1,NLOCAL
          WRITE(ICOUT,5117)I,Y1(I),CENSOR(I)
 5117     FORMAT('I,Y1(I) = ',I8,2E15.7)
          CALL DPWRST('XXX','BUG ')
 5116   CONTINUE
      ENDIF
C
      IWRIT2='ON'
C
      CALL DP1KS2(Y1,NLOCAL,ICASPL,
     1CENSOR,ICENSO,
     1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX,
     1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA,DELTA,A,AM,X0,
     1U1,SD1,U2,SD2,DZ,
     1ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCCC MAY 2002: ADD FOLLOWING LINE
     1SCALE1,GAMMA1,LOC2,SCALE2,GAMMA2,
     1AMU,XI,CHI,G,H,AK,SIGMA,
     1ETA,ZETA,TAU,Q,
     1KSLOC,AKSCAL,
     1STATVA,CUTU90,CUTU95,CUTU99,
     1ICAPSW,ICAPTY,
     1IWRIT2,IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1YOBS,YEXP,N2,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 7--                         **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'1KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DP1K'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'ON' .OR. ISUBRO.EQ.'1KST')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DP1KST--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9012)IFOUND,IERROR
 9012   FORMAT('IFOUND,IERROR = ',A4,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9013)NS,ICASPL
 9013   FORMAT('NS,ICASPL = ',I8,2X,A4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9014)ALAMBA,NU,NU1,NU2
 9014   FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9015)GAMMA,ALPHA,BETA,NPAR,P,K
 9015   FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9016)MINMAX
 9016   FORMAT('MINMAX = ',I8)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9017)ALPHA,BETA
 9017   FORMAT('ALPHA,BETA = ',2E15.7)
        CALL DPWRST('XXX','BUG ')
      ENDIF
C
      RETURN
      END
      SUBROUTINE DP1KS2(Y,N,ICASPL,
     1CENSOR,ICENSO,
     1ALAMBA,NU,NU1,NU2,GAMMA,ALPHA,BETA,NPAR,P,K,MINMAX,
     1ANU,ANU1,ANU2,NDUN,C,ALAMB1,ALAMB2,MPAR,B,SD,THETA,
     1DELTA,A,AM,X0,
     1U1,SD1,U2,SD2,DZ,
     1ALAMB3,ALAMB4,ALPHA1,ALPHA2,
CCCCC MAY 2002: ADD FOLLOWING LINE
     1ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,
     1AMU,XI,CHI,G,H,AK,SIGMA,
     1ETA,ZETA,TAU,Q,
     1KSLOC,KSSCAL,
     1STATVA,CDF1,CDF2,CDF3,
     1ICAPSW,ICAPTY,
     1IWRIT2,IADEDF,IGEPDF,IMAKDF,IBEIDF,
     1ILGADF,ISKNDF,IGLDDF,
     1Y2,X2,N2,IBUGA3,IERROR)
C
C     PURPOSE--COMPUTE A KOLMOGOROV-SMIRNOV GOODNESS OF FIT TEST
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--98/11
C     ORIGINAL VERSION--NOVEMBER  1998.
C     UPDATED         --OCTOBER   2001.
C     UPDATED         --NOVEMBER  2001. GEOMETRIC EXTREME EXPONENTIAL
C     UPDATED         --MAY       2002. TWO-SIDED POWER
C     UPDATED         --MAY       2002. BIWEIBULL
C     UPDATED         --APRIL     2003. LANDAU
C     UPDATED         --MAY       2003. ERROR (= EXPONENTIAL POWER)
C     UPDATED         --JUNE      2003. TRAPEZOID
C     UPDATED         --OCTOBER   2003. ADD SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --NOVEMBER  2003. FOLDED T
C     UPDATED         --DECEMBER  2003. SUPPORT FOR MU PARAMETER FOR
C                                       INVERSE GAUSSIAN
C     UPDATED         --DECEMBER  2003. SKEWED NORMAL, SKEWED T,
C                                       SLASH, INVERTED BETA,
C                                       GOMPERTZ-MAKEHAM, G-H
C     UPDATED         --MARCH     2004. LOG SKEWED NORMAL
C                                       LOG SKEWED T
C     UPDATED         --JUNE      2004. SKEWED DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. ASYMMETRIC DOUBLE EXPONENTIAL
C     UPDATED         --JUNE      2004. MAXWELL, RAYLEIGH
C     UPDATED         --JULY      2004. ALTERNATE DEFINITION FOR
C                                       GOMPERTZ-MAKEHAM
C     UPDATED         --AUGUST    2004. GENERALIZED ASYMMETRIC
C                                       DOUBLE EXPONENTIAL
C     UPDATED         --AUGUST    2004. MCLEISH
C     UPDATED         --AUGUST    2004. BESSEL I-FUNCTION
C     UPDATED         --SEPTEMBER 2004. GENERALIZED MCLEISH
C     UPDATED         --OCTOBER   2004. SUPPORT FOR CENSORED DATA
C                                       (BASE ON KAPLAN-MEIER EMPIRICAL
C                                       CDF)
C     UPDATED         --JULY      2005. CALL LIST TO LGACDF AND SNCDF
C     UPDATED         --FEBRUARY  2006. GENERALIZED LOGISTIC TYPE 5
C     UPDATED         --FEBRUARY  2006. WAKEBY
C     UPDATED         --FEBRUARY  2006. FMKL PARAMETERIZATION FOR
C                                       GENERALIZED TUKEY LAMBDA
C     UPDATED         --MARCH     2006. BETA-NORMAL
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 2
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 3
C     UPDATED         --MARCH     2006. GENERALIZED LOGISTIC TYPE 4
C     UPDATED         --MARCH     2006. ASYMMETRIC LOG DOUBLE
C                                       EXPONENTIAL
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      LOGICAL POINT
C
      CHARACTER*4 ICASPL
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IBUGA3
      CHARACTER*4 IWRITE
      CHARACTER*4 IWRIT2
      CHARACTER*4 ICENSO
      CHARACTER*4 IADEDF
      CHARACTER*4 IGEPDF
      CHARACTER*4 IMAKDF
      CHARACTER*4 IBEIDF
      CHARACTER*4 ILGADF
      CHARACTER*4 ISKNDF
      CHARACTER*4 IGLDDF
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IRELAT
      CHARACTER*1 IBASLC
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*50 IDIST
C
      REAL KSLOC
      REAL KSSCAL
C
      DOUBLE PRECISION DM
      DOUBLE PRECISION DTEMP1
      DOUBLE PRECISION DTEMP2
      DOUBLE PRECISION DOUT1
      DOUBLE PRECISION DN
      DOUBLE PRECISION DCURR
      DOUBLE PRECISION DCORR
      DOUBLE PRECISION DPROD
      DOUBLE PRECISION CDFGLO
      DOUBLE PRECISION CDFWAK
      DOUBLE PRECISION XPAR(5)
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION CENSOR(*)
C
      REAL CV90(40)
      REAL CV95(40)
      REAL CV99(40)
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
      DATA CV90/
     1 0.950,0.776,0.636,0.565,0.509,0.468,0.436,0.410,0.387,0.369,
     1 0.352,0.338,0.325,0.314,0.304,0.295,0.286,0.279,0.271,0.265,
     1 0.259,0.253,0.247,0.242,0.238,0.233,0.229,0.225,0.221,0.218,
     1 0.214,0.211,0.208,0.205,0.202,0.199,0.196,0.194,0.191,0.189/
      DATA CV95/
     1 0.975,0.842,0.708,0.624,0.563,0.519,0.483,0.454,0.430,0.409,
     1 0.391,0.375,0.361,0.349,0.338,0.327,0.318,0.309,0.301,0.294,
     1 0.287,0.281,0.275,0.269,0.264,0.259,0.254,0.250,0.246,0.242,
     1 0.238,0.234,0.231,0.227,0.224,0.221,0.218,0.215,0.213,0.210/
      DATA CV99/
     1 0.995,0.929,0.829,0.734,0.669,0.617,0.576,0.542,0.513,0.489,
     1 0.468,0.449,0.432,0.418,0.404,0.392,0.381,0.371,0.361,0.352,
     1 0.344,0.337,0.330,0.323,0.317,0.311,0.305,0.300,0.295,0.290,
     1 0.285,0.281,0.277,0.273,0.269,0.265,0.262,0.258,0.255,0.252/
C
C-----START POINT-----------------------------------------------------
C
C
      ISUBN1='DP1K'
      ISUBN2='S2  '
C
      IRELAT='OFF'
      IERROR='NO'
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 DP1KS2--')
      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 DP1KS2--')
      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=Y(1)
      DO60I=1,N
      IF(Y(I).NE.HOLD)GOTO69
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)
   61 FORMAT('***** ERROR IN DP1KS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)
   62 FORMAT('      ALL INPUT VERTICAL AXIS ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)HOLD
   63 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
   69 CONTINUE
C
      IF(IBUGA3.EQ.'OFF')GOTO80
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DP1KS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,N
   72 FORMAT('ICASPL,N, = ',A4,2X,2X,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)ALAMBA,NU,NU1,NU2
   73 FORMAT('ALAMBA,NU,NU1,NU2 = ',E15.7,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)GAMMA,ALPHA,BETA,NPAR,P,K
   74 FORMAT('GAMMA,ALPHA,BETA,NPAR,P,K = ',3E15.7,I8,E15.7,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,75)MINMAX
   75 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO80
      DO85I=1,N
      WRITE(ICOUT,86)I,Y(I),CENSOR(I)
   86 FORMAT('I,Y(I),CENSOR(I) = ',I8,3E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
   80 CONTINUE
C
C               **************************************
C               **  STEP 4--                        **
C               **  COMPUTE THE EMPIRICAL CDF       **
C               **  FUNCTION                        **
C               **************************************
C
C  FOR K-S TEST, ONLY UNBINNED DATA SUPPORTED.
C
      IF(ICENSO.EQ.'ON')THEN
        CALL SORTC(Y,CENSOR,N,Y,CENSOR)
        XMIN=Y(1)
        XMAX=Y(N)
        DN=DBLE(N)
        J=1
        X2(J)=0.0
        Y2(J)=1.0
        DPROD=1.0D0
        DCORR=(DN + 0.7D0)/(DN + 0.4D0)
        IR=0
        DO100I=1,N
          IF(ABS(CENSOR(I)).LT.0.5)GOTO100
          IR=IR+1
          J=J+1
          X2(J)=Y(I)
          Y2(J)=Y2(J-1)
          J=J+1
          DCURR=(DN - DBLE(I) + 0.7D0)/(DN - DBLE(I) + 1.7D0)
          DPROD=DPROD*DCURR
          X2(J)=Y(I)
          Y2(J)=REAL(DCORR*DPROD)
  100   CONTINUE
        N2=J
        J=0
        DO110I=N2,1,-1
          J=J+1
          CENSOR(J)=Y2(I)
  110   CONTINUE
        DO120I=1,N2
          Y2(I)=CENSOR(I)
  120   CONTINUE
      ELSE
        CALL SORT(Y,N,Y)
        XMIN=Y(1)
        XMAX=Y(N)
        J=1
        X2(J)=Y(1)
        Y2(J)=0.0
        J=2
        X2(J)=Y(1)
        Y2(J)=1.0/REAL(N)
        DO200I=2,N
          J=J+1
          X2(J)=Y(I)
          Y2(J)=REAL(I-1)/REAL(N)
          J=J+1
          X2(J)=Y(I)
          Y2(J)=REAL(I)/REAL(N)
  200   CONTINUE
        N2=J
      ENDIF
C
      IF(IBUGA3.EQ.'ON')THEN
        WRITE(ICOUT,281)ICENSO,N2
  281   FORMAT('ICENSO,N2 = ',A4,I8)
        CALL DPWRST('XXX','BUG ')
        DO285I=1,N2
          WRITE(ICOUT,286)I,Y2(I),X2(I)
  286     FORMAT('I,Y2(I),X2(I) = ',I8,2E12.5)
          CALL DPWRST('XXX','BUG ')
  285   CONTINUE
      ENDIF
C
C               ************************************************
C               **  STEP 4.1--                                **
C               **  COMPUTE KOLMOGOROV-SMIRNOV OBSERVED AND   **
C               **  EXPECTED                                  **
C               ************************************************
C
 1100 CONTINUE
C
      DM=0.0D0
      DO1199I=1,N2
C
        XL=X2(I)
C
      IF(ICASPL.EQ.'UNPP')GOTO1110
      IF(ICASPL.EQ.'NOPP')GOTO1120
      IF(ICASPL.EQ.'LOPP')GOTO1130
      IF(ICASPL.EQ.'DEPP')GOTO1140
      IF(ICASPL.EQ.'CAPP')GOTO1150
      IF(ICASPL.EQ.'LAPP')GOTO1160
      IF(ICASPL.EQ.'LNPP')GOTO1170
      IF(ICASPL.EQ.'HNPP')GOTO1180
      IF(ICASPL.EQ.'TPP')GOTO1190
      IF(ICASPL.EQ.'CSPP')GOTO1200
      IF(ICASPL.EQ.'FPP')GOTO1210
      IF(ICASPL.EQ.'EXPP')GOTO1220
      IF(ICASPL.EQ.'GAPP')GOTO1230
      IF(ICASPL.EQ.'BEPP')GOTO1240
      IF(ICASPL.EQ.'WEPP')GOTO1250
      IF(ICASPL.EQ.'E1PP')GOTO1260
      IF(ICASPL.EQ.'E2PP')GOTO1270
      IF(ICASPL.EQ.'PAPP')GOTO1280
      IF(ICASPL.EQ.'BIPP')GOTO1290
      IF(ICASPL.EQ.'GEPP')GOTO1300
      IF(ICASPL.EQ.'POPP')GOTO1310
      IF(ICASPL.EQ.'NBPP')GOTO1320
      IF(ICASPL.EQ.'SEPP')GOTO1330
      IF(ICASPL.EQ.'TRPP')GOTO1340
      IF(ICASPL.EQ.'IGPP')GOTO1350
      IF(ICASPL.EQ.'WAPP')GOTO1360
      IF(ICASPL.EQ.'RIPP')GOTO1370
      IF(ICASPL.EQ.'FLPP')GOTO1380
      IF(ICASPL.EQ.'GPPP')GOTO1390
      IF(ICASPL.EQ.'DUPP')GOTO1400
      IF(ICASPL.EQ.'NTPP')GOTO1410
      IF(ICASPL.EQ.'NYPP')GOTO1410
      IF(ICASPL.EQ.'NFPP')GOTO1420
      IF(ICASPL.EQ.'NCPP')GOTO1430
      IF(ICASPL.EQ.'NXPP')GOTO1430
      IF(ICASPL.EQ.'NCBP')GOTO1440
      IF(ICASPL.EQ.'DNCT')GOTO1450
      IF(ICASPL.EQ.'DNCF')GOTO1460
      IF(ICASPL.EQ.'HYPP')GOTO1470
      IF(ICASPL.EQ.'VMPP')GOTO1480
      IF(ICASPL.EQ.'PNPP')GOTO1490
      IF(ICASPL.EQ.'PLPP')GOTO1500
      IF(ICASPL.EQ.'ALPP')GOTO1510
      IF(ICASPL.EQ.'COPP')GOTO1520
      IF(ICASPL.EQ.'PFPP')GOTO1530
      IF(ICASPL.EQ.'CHPP')GOTO1540
      IF(ICASPL.EQ.'LSPP')GOTO1550
      IF(ICASPL.EQ.'LLPP')GOTO1560
      IF(ICASPL.EQ.'GGPP')GOTO1570
      IF(ICASPL.EQ.'WRPP')GOTO1580
      IF(ICASPL.EQ.'ANPP')GOTO1590
      IF(ICASPL.EQ.'ARPP')GOTO1600
      IF(ICASPL.EQ.'FNPP')GOTO1610
      IF(ICASPL.EQ.'TNPP')GOTO1620
      IF(ICASPL.EQ.'LGPP')GOTO1630
      IF(ICASPL.EQ.'HSPP')GOTO1640
      IF(ICASPL.EQ.'GOPP')GOTO1650
      IF(ICASPL.EQ.'HCPP')GOTO1660
      IF(ICASPL.EQ.'HLPP')THEN
        IDIST='HALF LOGISTIC'
        GAMMA=-1.0
        GOTO1670
      ENDIF
      IF(ICASPL.EQ.'GZPP')THEN
        IDIST='GENERALIZED HALF LOGISTIC'
        GOTO1670
      ENDIF
      IF(ICASPL.EQ.'GVPP')GOTO1680
      IF(ICASPL.EQ.'P2PP')GOTO1690
      IF(ICASPL.EQ.'DWPP')GOTO1700
      IF(ICASPL.EQ.'WCPP')GOTO1710
      IF(ICASPL.EQ.'EWPP')GOTO1720
      IF(ICASPL.EQ.'TEPP')GOTO1730
      IF(ICASPL.EQ.'TXPP')GOTO1730
      IF(ICASPL.EQ.'GLPP')GOTO1740
      IF(ICASPL.EQ.'PEPP')GOTO1750
      IF(ICASPL.EQ.'DGPP')GOTO1760
      IF(ICASPL.EQ.'KAPP')GOTO1770
      IF(ICASPL.EQ.'FCPP')GOTO1780
      IF(ICASPL.EQ.'BBPP')GOTO1790
      IF(ICASPL.EQ.'BRPP')GOTO1800
      IF(ICASPL.EQ.'GXPP')GOTO1810
      IF(ICASPL.EQ.'REPP')GOTO1820
      IF(ICASPL.EQ.'NMPP')GOTO1830
      IF(ICASPL.EQ.'GIPP')GOTO1840
      IF(ICASPL.EQ.'IWPP')GOTO1850
      IF(ICASPL.EQ.'LXPP')GOTO1860
      IF(ICASPL.EQ.'LDPP')GOTO1870
      IF(ICASPL.EQ.'JBPP')GOTO1880
      IF(ICASPL.EQ.'JUPP')GOTO1890
      IF(ICASPL.EQ.'EEPP')GOTO1900
      IF(ICASPL.EQ.'TSPP')GOTO1910
      IF(ICASPL.EQ.'BWPP')GOTO1920
      IF(ICASPL.EQ.'LUPP')GOTO1930
      IF(ICASPL.EQ.'ERPP')GOTO1940
      IF(ICASPL.EQ.'TZPP')GOTO1950
      IF(ICASPL.EQ.'GTPP')GOTO1960
      IF(ICASPL.EQ.'FTPP')GOTO1970
      IF(ICASPL.EQ.'SLPP')GOTO1980
      IF(ICASPL.EQ.'SNPP')GOTO1990
      IF(ICASPL.EQ.'STPP')GOTO2000
      IF(ICASPL.EQ.'IBPP')GOTO2010
      IF(ICASPL.EQ.'GMPP')GOTO2020
      IF(ICASPL.EQ.'GIGP')GOTO2030
      IF(ICASPL.EQ.'GFPP')GOTO2040
      IF(ICASPL.EQ.'GHPP')GOTO2050
      IF(ICASPL.EQ.'LZPP')GOTO2060
      IF(ICASPL.EQ.'LTPP')GOTO2070
      IF(ICASPL.EQ.'ASPP')GOTO2080
      IF(ICASPL.EQ.'SDPP')GOTO2090
      IF(ICASPL.EQ.'ADPP')GOTO2100
      IF(ICASPL.EQ.'MXPP')GOTO2110
      IF(ICASPL.EQ.'RAPP')GOTO2120
      IF(ICASPL.EQ.'GALP')GOTO2130
      IF(ICASPL.EQ.'MCPP')GOTO2140
      IF(ICASPL.EQ.'BEIP')GOTO2150
      IF(ICASPL.EQ.'BEKP')GOTO2160
      IF(ICASPL.EQ.'GMCP')GOTO2170
      IF(ICASPL.EQ.'G5PP')GOTO2180
      IF(ICASPL.EQ.'WKPP')GOTO2190
      IF(ICASPL.EQ.'BNPP')GOTO2200
      IF(ICASPL.EQ.'G2PP')GOTO2210
      IF(ICASPL.EQ.'G3PP')GOTO2220
      IF(ICASPL.EQ.'G4PP')GOTO2230
      IF(ICASPL.EQ.'AXPP')GOTO2240
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)
 1011 FORMAT('***** ERROR DP1KS2--UNKNOWN DISTRIBUTION')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1110 CONTINUE
      IDIST='UNIFORM'
      ZSCALE=KSSCAL-KSLOC
      XL=(XL-KSLOC)/ZSCALE
      CALL UNICDF(XL,XOUT1)
      GOTO2990
C
 1120 CONTINUE
      IDIST='NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL NORCDF(XL,XOUT1)
      GOTO2990
C
 1130 CONTINUE
      IDIST='LOGISTIC'
      XL=(XL-KSLOC)/KSSCAL
      CALL LOGCDF(XL,XOUT1)
      GOTO2990
C
 1140 CONTINUE
      IDIST='DOUBLE EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL DEXCDF(XL,XOUT1)
      GOTO2990
C
 1150 CONTINUE
      IDIST='CAUCHY'
      XL=(XL-KSLOC)/KSSCAL
      CALL CAUCDF(XL,XOUT1)
      GOTO2990
C
 1160 CONTINUE
      IDIST='TUKEY-LAMBDA'
      XL=(XL-KSLOC)/KSSCAL
      CALL LAMCDF(XL,ALAMBA,XOUT1)
      GOTO2990
C
 1170 CONTINUE
      IDIST='LOG-NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL LGNCDF(XL,SIGMA,XOUT1)
      GOTO2990
C
 1180 CONTINUE
      IDIST='HALF-NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL HFNCDF(XL,XOUT1)
      GOTO2990
C
 1190 CONTINUE
      IDIST='T'
      XL=(XL-KSLOC)/KSSCAL
      CALL TCDF(XL,NU,XOUT1)
      GOTO2990
C
 1200 CONTINUE
      IDIST='CHI-SQUARE'
      XL=(XL-KSLOC)/KSSCAL
      CALL CHSCDF(XL,NU,XOUT1)
      GOTO2990
C
 1210 CONTINUE
      IDIST='F'
      XL=(XL-KSLOC)/KSSCAL
      CALL FCDF(XL,NU1,NU2,XOUT1)
      GOTO2990
C
 1220 CONTINUE
      IDIST='EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL EXPCDF(XL,XOUT1)
      GOTO2990
C
 1230 CONTINUE
      IDIST='GAMMA'
      XL=(XL-KSLOC)/KSSCAL
      CALL GAMCDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1240 CONTINUE
      IDIST='BETA'
      ZSCALE=KSSCAL-KSLOC
      XL=(XL-KSLOC)/ZSCALE
      CALL BETCDF(XL,ALPHA,BETA,XOUT1)
      GOTO2990
C
 1250 CONTINUE
      IDIST='WEIBULL'
      XL=(XL-KSLOC)/KSSCAL
      CALL WEICDF(XL,GAMMA,MINMAX,XOUT1)
      GOTO2990
C
 1260 CONTINUE
      IDIST='EXTREME VALUE TYPE 1'
      XL=(XL-KSLOC)/KSSCAL
      CALL EV1CDF(XL,MINMAX,XOUT1)
      GOTO2990
C
 1270 CONTINUE
      IDIST='EXTREME VALUE TYPE 2'
      XL=(XL-KSLOC)/KSSCAL
      CALL EV2CDF(XL,GAMMA,MINMAX,XOUT1)
      GOTO2990
C
 1280 CONTINUE
      IDIST='PARETO'
      ZLOC=A
      IF(ZLOC.GT.XMIN)ZLOC=XMIN
      XL=(XL-KSLOC)/KSSCAL
      CALL PARCDF(XL,GAMMA,ZLOC,XOUT1)
      GOTO2990
C
 1290 CONTINUE
      IDIST='BINOMIAL'
      CALL BINCDF(XL,P,NPAR,XOUT1)
      GOTO2990
C
 1300 CONTINUE
      IDIST='GEOMETRIC'
      CALL GEOCDF(XL,P,XOUT1)
      GOTO2990
C
 1310 CONTINUE
      IDIST='POISSON'
      IF(ALAMBA.LE.60.0)THEN
        CALL POICDF(XL,ALAMBA,XOUT1)
      ELSE
        SQRTAL=SQRT(ALAMBA)
        CALL NORCDF(XL,XOUT1)
        XOUT1=ALAMBA+SQRTAL*XOUT1
      ENDIF
      GOTO2990
C
 1320 CONTINUE
      IDIST='NEGATIVE BINOMIAL'
      CALL NBCDF(XL,P,AK,XOUT1)
      GOTO2990
C
 1330 CONTINUE
      IDIST='SEMI-CIRCULAR'
      XL=(XL-KSLOC)/KSSCAL
      CALL SEMCDF(XL,XOUT1)
      GOTO2990
C
 1340 CONTINUE
      IDIST='TRIANGULAR'
      IF(KSLOC.EQ.0.0 .AND. KSSCAL.EQ.1.0)THEN
        ZLOWLM=-1.0
        ZUPPLM=1.0
      ELSE
        ZLOWLM=KSLOC
        ZUPPLM=KSSCAL
      ENDIF
      CALL TRICDF(XL,C,ZLOWLM,ZUPPLM,XOUT1)
      GOTO2990
C
 1350 CONTINUE
      IDIST='INVERSE GAUSSIAN'
      XL=(XL-KSLOC)/KSSCAL
      CALL IGCDF(XL,GAMMA,AMU,XOUT1)
      GOTO2990
C
 1360 CONTINUE
      IDIST='WALD'
      XL=(XL-KSLOC)/KSSCAL
      CALL WALCDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1370 CONTINUE
      IDIST='RECIPROCAL INVERSE GAUSSIAN'
      XL=(XL-KSLOC)/KSSCAL
      CALL RIGCDF(XL,GAMMA,AMU,XOUT1)
      GOTO2990
C
 1380 CONTINUE
      IDIST='FATIGUE LIFE'
      XL=(XL-KSLOC)/KSSCAL
      CALL FLCDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1390 CONTINUE
      IDIST='GENERALIZED PARETO'
      XL=(XL-KSLOC)/KSSCAL
      CALL GEPCDF(XL,GAMMA,MINMAX,IGEPDF,XOUT1)
      GOTO2990
C
 1400 CONTINUE
      IDIST='DISCRETE UNIFORM'
      CALL DISCDF(XL,NDUN,XOUT1)
      GOTO2990
C
 1410 CONTINUE
      IDIST='NON-CENTRAL T'
      XL=(XL-KSLOC)/KSSCAL
      CALL NCTCDF(XL,ANU,ALAMBA,XOUT1)
      GOTO2990
C
 1420 CONTINUE
      IDIST='NON-CENTRAL F'
      XL=(XL-KSLOC)/KSSCAL
      CALL NCFCDF(XL,ANU1,ANU2,ALAMBA,XOUT1)
      GOTO2990
C
 1430 CONTINUE
      IDIST='NON-CENTRAL KOLMOGOROV-SMIRNOV'
      XL=(XL-KSLOC)/KSSCAL
      CALL NCCCDF(XL,ANU,ALAMBA,XOUT1)
      GOTO2990
C
 1440 CONTINUE
      IDIST='NON-CENTRAL BETA'
      XL=(XL-KSLOC)/KSSCAL
      CALL NCBCDF(XL,ALPHA,BETA,ALAMBA,XOUT1)
      GOTO2990
C
 1450 CONTINUE
      IDIST='DOUBLY NON-CENTRAL T'
      XL=(XL-KSLOC)/KSSCAL
      CALL DNTCDF(XL,ANU,ALAMB1,ALAMB2,XOUT1)
      GOTO2990
C
 1460 CONTINUE
      IDIST='DOUBLY NON-CENTRAL F'
      XL=(XL-KSLOC)/KSSCAL
      CALL DNFCDF(XL,ANU1,ANU2,ALAMB1,ALAMB2,XOUT1)
      GOTO2990
C
 1470 CONTINUE
      IDIST='HYPERGEOMETRIC'
      POINT=.FALSE.
      CALL HYPCDF(XL,K,NPAR,MPAR,POINT,XOUT1)
      GOTO2990
C
 1480 CONTINUE
      IDIST='VON MISES'
      XL=(XL-KSLOC)/KSSCAL
      CALL VONCDF(XL,B,XOUT1)
      GOTO2990
C
 1490 CONTINUE
      IDIST='POWER NORMAL'
      XL=(XL-KSLOC)/KSSCAL
CCCCC CALL PNRCDF(XL,P,SD,XOUT1)
      CALL PNRCDF(XL,P,XOUT1)
      GOTO2990
C
 1500 CONTINUE
      IDIST='POWER LOG-NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL PLNCDF(XL,P,SD,XOUT1)
      GOTO2990
C
 1510 CONTINUE
      IDIST='ALPHA'
      XL=(XL-KSLOC)/KSSCAL
      CALL ALPCDF(XL,ALPHA,BETA,XOUT1)
      GOTO2990
C
 1520 CONTINUE
      IDIST='COSINE'
      XL=(XL-KSLOC)/KSSCAL
      CALL COSCDF(XL,XOUT1)
      GOTO2990
C
 1530 CONTINUE
      IDIST='POWER'
      XL=(XL-KSLOC)/KSSCAL
      CALL POWCDF(XL,C,XOUT1)
      GOTO2990
C
 1540 CONTINUE
      IDIST='CHI'
      XL=(XL-KSLOC)/KSSCAL
      CALL CHCDF(XL,ANU,XOUT1)
      GOTO2990
C
 1550 CONTINUE
      IDIST='LOGARITHMIC SERIES'
      CALL DLGCDF(XL,THETA,XOUT1)
      GOTO2990
C
 1560 CONTINUE
      IDIST='LOG LOGISTIC'
      XL=(XL-KSLOC)/KSSCAL
      CALL LLGCDF(XL,DELTA,XOUT1)
      GOTO2990
C
 1570 CONTINUE
      IDIST='GENERALIZED GAMMA'
      XL=(XL-KSLOC)/KSSCAL
      CALL GGDCDF(XL,ALPHA,C,XOUT1)
      GOTO2990
C
 1580 CONTINUE
      IDIST='WARING'
      CALL WARCDF(XL,C,A,XOUT1,'NOTR')
      GOTO2990
C
 1590 CONTINUE
      IDIST='ANGLIT'
      XL=(XL-KSLOC)/KSSCAL
      CALL ANGCDF(XL,XOUT1)
      GOTO2990
C
 1600 CONTINUE
      IDIST='ARCSINE'
      XL=(XL-KSLOC)/KSSCAL
      CALL ARSCDF(XL,XOUT1)
      GOTO2990
C
 1610 CONTINUE
      IDIST='FOLDED NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL FNRCDF(XL,AM,SD,XOUT1)
      GOTO2990
C
 1620 CONTINUE
      IDIST='TRUNCATED NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL TNRCDF(XL,A,B,AM,SD,XOUT1)
      GOTO2990
C
 1630 CONTINUE
      IDIST='LOG GAMMA'
      XL=(XL-KSLOC)/KSSCAL
      CALL LGACDF(XL,GAMMA,ILGADF,XOUT1)
      GOTO2990
C
 1640 CONTINUE
      IDIST='HYPERBOLIC SECANT'
      XL=(XL-KSLOC)/KSSCAL
      CALL HSECDF(XL,XOUT1)
      GOTO2990
C
 1650 CONTINUE
      IDIST='GOMPERTZ'
      XL=(XL-KSLOC)/KSSCAL
      CALL GOMCDF(XL,C,B,XOUT1)
      GOTO2990
C
 1660 CONTINUE
      IDIST='HALF CAUCHY'
      XL=(XL-KSLOC)/KSSCAL
      CALL HFCCDF(XL,XOUT1)
      GOTO2990
C
 1670 CONTINUE
      IDIST='HALF LOGISTIC'
      XL=(XL-KSLOC)/KSSCAL
      CALL HFLCDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1680 CONTINUE
      IDIST='GENERALIZED EXTREME VALUE'
      XL=(XL-KSLOC)/KSSCAL
      CALL GEVCDF(XL,GAMMA,MINMAX,XOUT1)
      GOTO2990
C
 1690 CONTINUE
      IDIST='PARETO OF THE SECOND KIND'
      ZLOC=A
      IF(ZLOC.LE.XMIN)ZLOC=A
      XL=(XL-KSLOC)/KSSCAL
c     write(18,*)'a,gamma,xmin,zloc=',a,gamma,xmin,zloc
c     write(18,*)'xl,ksloc,kssca=',xl,ksloc,ksscal
      CALL PA2CDF(XL,GAMMA,ZLOC,XOUT1)
      GOTO2990
C
 1700 CONTINUE
      IDIST='DOUBLE WEIBULL'
      XL=(XL-KSLOC)/KSSCAL
      CALL DWECDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1710 CONTINUE
      IDIST='WRAPPED CAUCHY'
      ZLOC=1.0
      IF(KSLOC.NE.0.0)ZLOC=KSLOC
      XL=(XL-ZLOC)/KSSCAL
      CALL WCACDF(XL,P,XOUT1)
      GOTO2990
C
 1720 CONTINUE
      IDIST='EXPONENTIATED WEIBULL'
      XL=(XL-KSLOC)/KSSCAL
      IARG1=1
      CALL EWECDF(XL,GAMMA,THETA,IARG1,XOUT1)
      CALL EWECDF(XU,GAMMA,THETA,IARG1,XOUT2)
      GOTO2990
C
 1730 CONTINUE
      IDIST='TRUNCATED EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL TNECDF(XL,X0,AM,SD,XOUT1)
      GOTO2990
C
 1740 CONTINUE
      IDIST='GENERALIZED LOGISTIC'
      XL=(XL-KSLOC)/KSSCAL
      CALL GLOCDF(XL,ALPHA,XOUT1)
      GOTO2990
C
 1750 CONTINUE
      IDIST='POWER EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL PEXCDF(XL,ALPHA,BETA,XOUT1)
      GOTO2990
C
 1760 CONTINUE
      IDIST='DOUBLE GAMMA'
      XL=(XL-KSLOC)/KSSCAL
      CALL DGACDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1770 CONTINUE
      IDIST='MEILKE BETA-KAPPA'
      XL=(XL-KSLOC)/KSSCAL
      CALL KAPCDF(XL,ANU,BETA,THETA,XOUT1)
      GOTO2990
C
 1780 CONTINUE
      IDIST='FOLDED CAUCHY'
      XL=(XL-KSLOC)/KSSCAL
      CALL FCACDF(XL,AM,SD,XOUT1)
      GOTO2990
C
 1790 CONTINUE
      IDIST='BETA BINOMIAL'
      CALL BBNCDF(XL,ALPHA,BETA,NU,XOUT1)
      GOTO2990
C
 1800 CONTINUE
      IDIST='BRADFORD'
      XL=(XL-KSLOC)/KSSCAL
      CALL BRACDF(XL,BETA,XOUT1)
      GOTO2990
C
 1810 CONTINUE
      IDIST='GENERALIZED EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL GEXCDF(XL,ALAMB1,ALAMB2,GAMMA,XOUT1)
      GOTO2990
C
 1820 CONTINUE
      IDIST='RECIPROCAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL RECCDF(XL,B,XOUT1)
      GOTO2990
C
 1830 CONTINUE
      IDIST='MIXTURE OF 2 NORMALS'
      XL=(XL-KSLOC)/KSSCAL
      CALL NMXCDF(XL,U1,SD1,U2,SD2,P,XOUT1)
      GOTO2990
C
 1840 CONTINUE
      IDIST='INVERTED GAMMA'
      XL=(XL-KSLOC)/KSSCAL
      CALL IGACDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1850 CONTINUE
      IDIST='INVERTED WEIBULL'
      XL=(XL-KSLOC)/KSSCAL
      CALL IWECDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1860 CONTINUE
      IDIST='LOG DOUBLE EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL LDECDF(XL,ALPHA,XOUT1)
      GOTO2990
C
 1870 CONTINUE
      IDIST='GENERALIZED TUKEY-LAMBDA'
      XL=(XL-KSLOC)/KSSCAL
      CALL GLDCDF(DBLE(XL),DBLE(ALAMB3),DBLE(ALAMB4),
     1            DOUT1,IGLDDF,IWRITE)
      XOUT1=REAL(DOUT1)
      GOTO2990
C
 1880 CONTINUE
      IDIST='JOHNSON SB'
      XL=(XL-KSLOC)/KSSCAL
      CALL JSBCDF(XL,ALPHA1,ALPHA2,XOUT1)
      GOTO2990
C
 1890 CONTINUE
      IDIST='JOHNSON SU'
      XL=(XL-KSLOC)/KSSCAL
      CALL JSUCDF(XL,ALPHA1,ALPHA2,XOUT1)
      GOTO2990
C
 1900 CONTINUE
      IDIST='GEOMETRIC EXTREME EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL GEECDF(XL,GAMMA,XOUT1)
      GOTO2990
C
 1910 CONTINUE
      IDIST='TWO-SIDED POWER'
      XL=(XL-KSLOC)/KSSCAL
      CALL TSPCDF(XL,THETA,ANU,XOUT1)
      GOTO2990
C
 1920 CONTINUE
      IDIST='BIWEIBULL'
      XL=(XL-KSLOC)/KSSCAL
      CALL BWECDF(XL,ASCAL1,GAMMA1,ALOC2,ASCAL2,GAMMA2,XOUT1,DTEMP1)
      GOTO2990
C
 1930 CONTINUE
      IDIST='LANDAU'
      XL=(XL-KSLOC)/KSSCAL
      DTEMP1=LANCDF(DBLE(XL))
      XOUT1=REAL(DTEMP1)
      GOTO2990
C
 1940 CONTINUE
      IDIST='ERROR (= EXPONENTIAL POWER)'
      XL=(XL-KSLOC)/KSSCAL
      CALL ERRCDF(XL,ALPHA,XOUT1)
      GOTO2990
C
 1950 CONTINUE
      IDIST='TRAPEZOID'
      XL=(XL-KSLOC)/KSSCAL
      CALL TRACDF(XL,A,B,C,DZ,XOUT1)
      GOTO2990
C
 1960 CONTINUE
      IDIST='GENERALIZED TRAPEZOID'
      XL=(XL-KSLOC)/KSSCAL
      CALL GTRCDF(XL,A,B,C,DZ,ANU1,ANU3,ALPHA,XOUT1)
      GOTO2990
C
 1970 CONTINUE
      IDIST='FOLDED T'
      XL=(XL-KSLOC)/KSSCAL
      CALL FTCDF(XL,NU,XOUT1)
      GOTO2990
C
 1980 CONTINUE
      IDIST='SLASH'
      XL=(XL-KSLOC)/KSSCAL
      CALL SLACDF(XL,XOUT1)
      GOTO2990
C
 1990 CONTINUE
      IDIST='SKEWED NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL SNCDF(XL,ALAMBA,ISKNDF,XOUT1)
      GOTO2990
C
 2000 CONTINUE
      IDIST='SKEWED T'
      XL=(XL-KSLOC)/KSSCAL
      CALL STCDF(XL,NU,ALAMBA,XOUT1)
      GOTO2990
C
 2010 CONTINUE
      IDIST='INVERTED BETA'
      XL=(XL-KSLOC)/KSSCAL
      CALL IBCDF(XL,ALPHA,BETA,XOUT1)
      GOTO2990
C
 2020 CONTINUE
      IDIST='GOMPERTZ-MAKEHAM'
      XL=(XL-KSLOC)/KSSCAL
      IF(IMAKDF.EQ.'DLMF')THEN
        CALL MAKCDF(XL,XI,ALAMB,THETA,XOUT1)
      ELSEIF(IMAKDF.EQ.'MEEK')THEN
        XI=GAMMA/AK
        THETA=ALAMB/GAMMA
        ALAMB=AK
        CALL MAKCDF(XL,XI,ALAMB,THETA,XOUT1)
      ELSEIF(IMAKDF.EQ.'REPA')THEN
        CALL MA2CDF(XL,ZETA,ETA,XOUT1)
      ENDIF
      GOTO2990
C
 2030 CONTINUE
      IDIST='GENERALIZED INVERSE GAUSIAN'
      XL=(XL-KSLOC)/KSSCAL
      CALL GIGCDF(DBLE(XL),DBLE(CHI),DBLE(ALAMBA),DBLE(THETA),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2040 CONTINUE
      IDIST='GENERALIZED F'
      XL=(XL-KSLOC)/KSSCAL
CCCCC CALL GFCDF(XL,ALPHA,BETA,XOUT1)
      GOTO2990
C
 2050 CONTINUE
      IDIST='G-H'
      XL=(XL-KSLOC)/KSSCAL
      CALL GHCDF(XL,G,H,XOUT1)
      GOTO2990
C
 2060 CONTINUE
      IDIST='LOG SKEWED NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL LSNCDF(XL,ALAMBA,SD,XOUT1)
      GOTO2990
C
 2070 CONTINUE
      IDIST='LOG SKEWED T'
      XL=(XL-KSLOC)/KSSCAL
      CALL LSTCDF(XL,NU,ALAMBA,SD,XOUT1)
      GOTO2990
C
 2080 CONTINUE
      IDIST='ARCSIN'
      XL=(XL-KSLOC)/KSSCAL
      CALL ARSCDF(XL,XOUT1)
      GOTO2990
C
 2090 CONTINUE
      IDIST='SKEWED DOUBLE EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL SDECDF(XL,ALAMBA,XOUT1)
      GOTO2990
C
 2100 CONTINUE
      IDIST='ASYMMETRIC DOUBLE EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      IF(IADEDF.EQ.'K')THEN
        CALL ADECDF(XL,AK,IADEDF,XOUT1)
      ELSE
        CALL ADECDF(XL,AMU,IADEDF,XOUT1)
      ENDIF
      GOTO2990
C
 2110 CONTINUE
      IDIST='MAXWELL'
      XL=(XL-KSLOC)/KSSCAL
      CALL MAXCDF(XL,SIGMA,XOUT1)
      GOTO2990
C
 2120 CONTINUE
      IDIST='RAYLEIGH'
      XL=(XL-KSLOC)/KSSCAL
      CALL RAYCDF(XL,XOUT1)
      GOTO2990
C
 2130 CONTINUE
      IDIST='GENERALIZED ASYMMETRIC LAPLACE'
      XL=(XL-KSLOC)/KSSCAL
      CALL GALCDF(DBLE(XL),DBLE(AK),DBLE(TAU),IADEDF,DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2140 CONTINUE
      IDIST='MCLEISH'
      XL=(XL-KSLOC)/KSSCAL
      CALL MCLCDF(DBLE(XL),DBLE(ALPHA),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2150 CONTINUE
      IDIST='BESSEL I-FUNCTION'
      XL=(XL-KSLOC)/KSSCAL
      IF(IBEIDF.EQ.'1')THEN
        CALL BEICDF(DBLE(XL),DBLE(SD1),DBLE(SD2),DBLE(ANU),IBEIDF,
     1              DOUT1)
      ELSE
        CALL BEICDF(DBLE(XL),DBLE(B),DBLE(C),DBLE(AM),IBEIDF,
     1              DOUT1)
      ENDIF
      XOUT1=DOUT1
      GOTO2990
C
 2160 CONTINUE
      IDIST='BESSEL K-FUNCTION'
      XL=(XL-KSLOC)/KSSCAL
CCCCC CALL BEKCDF(DBLE(XL),DBLE(SD1),DBLE(SD2),DBLE(ANU),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2170 CONTINUE
      IDIST='GENERALIZED MCLEISH'
      XL=(XL-KSLOC)/KSSCAL
      CALL GMCCDF(DBLE(XL),DBLE(ALPHA),DBLE(A),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2180 CONTINUE
      IDIST='GENERALIZED LOGISTIC TYPE 5 (HOSKING)'
      XL=(XL-KSLOC)/KSSCAL
      XPAR(1)=DBLE(KSLOC)
      XPAR(2)=DBLE(KSSCAL)
      XPAR(3)=DBLE(ALPHA)
      DOUT1=CDFGLO(DBLE(XL),XPAR)
      XOUT1=DOUT1
      GOTO2990
C
 2190 CONTINUE
      IDIST='WAKEBY'
      XL=(XL-KSLOC)/KSSCAL
      XPAR(1)=DBLE(KSLOC)
      XPAR(2)=DBLE(KSSCAL)
      XPAR(3)=DBLE(BETA)
      XPAR(4)=DBLE(GAMMA)
      XPAR(5)=DBLE(DELTA)
      DOUT1=CDFWAK(DBLE(XL),XPAR)
      XOUT1=DOUT1
      GOTO2990
C
 2200 CONTINUE
      IDIST='BETA-NORMAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL BNOCDF(DBLE(XL),DBLE(ALPHA),DBLE(BETA),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2210 CONTINUE
      IDIST='GENERALIZED LOGISTIC TYPE 2'
      XL=(XL-KSLOC)/KSSCAL
      CALL GL2CDF(DBLE(XL),DBLE(ALPHA),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2220 CONTINUE
      IDIST='GENERALIZED LOGISTIC TYPE 3'
      XL=(XL-KSLOC)/KSSCAL
      CALL GL3CDF(DBLE(XL),DBLE(ALPHA),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2230 CONTINUE
      IDIST='GENERALIZED LOGISTIC TYPE 4'
      XL=(XL-KSLOC)/KSSCAL
      CALL GL4CDF(DBLE(XL),DBLE(P),DBLE(Q),DOUT1)
      XOUT1=DOUT1
      GOTO2990
C
 2240 CONTINUE
      IDIST='ASYMMETRIC LOG DOUBLE EXPONENTIAL'
      XL=(XL-KSLOC)/KSSCAL
      CALL ALDCDF(DBLE(XL),DBLE(ALPHA),DBLE(BETA),DOUT1)
      XOUT1=REAL(DOUT1)
      GOTO2990
C
 2990 CONTINUE
C
      DTEMP1=DBLE(Y2(I))
      DTEMP2=DBLE(XOUT1)
      DM=MAX(DABS(DTEMP1-DTEMP2),DM)
C
 1199 CONTINUE
C
      STAT=REAL(DM)
      AN=REAL(N)
C
C  COMPUTE CRITICAL VALUES FOR 0.90, 0.95, AND 0.99.
C  USE FUNCTION FOR N <=100, USE APPROXIMATION FOR N > 100.
C
C  NOTE: 12/2003.  REPLACE FOLLOWING WITH VALUES IN CONOVER
C        TABLE ("PRACTICAL NONPARAMETRIC STATISTICS", THIRD
C        EDITION, W. J. CONOVER, WILEY, 1999, TABLE A13 P. 547).
C
CCCCC IF(N.LE.5)THEN
CCCCC   CDF1=0.51
CCCCC   CDF2=0.56
CCCCC   CDF3=0.67
CCCCC ELSEIF(N.LE.10)THEN
CCCCC   CDF1=0.37
CCCCC   CDF2=0.41
CCCCC   CDF3=0.49
CCCCC ELSEIF(N.LE.15)THEN
CCCCC   CDF1=0.30
CCCCC   CDF2=0.34
CCCCC   CDF3=0.40
CCCCC ELSEIF(N.LE.20)THEN
CCCCC   CDF1=0.26
CCCCC   CDF2=0.29
CCCCC   CDF3=0.36
CCCCC ELSEIF(N.LE.25)THEN
CCCCC   CDF1=0.24
CCCCC   CDF2=0.27
CCCCC   CDF3=0.32
CCCCC ELSEIF(N.LE.30)THEN
CCCCC   CDF1=0.22
CCCCC   CDF2=0.24
CCCCC   CDF3=0.29
CCCCC ELSEIF(N.LE.35)THEN
CCCCC   CDF1=0.20
CCCCC   CDF2=0.23
CCCCC   CDF3=0.27
CCCCC ELSEIF(N.LE.40)THEN
CCCCC   CDF1=0.19
CCCCC   CDF2=0.21
CCCCC   CDF3=0.25
CCCCC ELSEIF(N.LE.45)THEN
CCCCC   CDF1=0.18
CCCCC   CDF2=0.20
CCCCC   CDF3=0.24
CCCCC ELSEIF(N.LE.50)THEN
CCCCC   CDF1=0.17
CCCCC   CDF2=0.19
CCCCC   CDF3=0.23
      IF(N.LE.40)THEN
        CDF1=CV90(N)
        CDF2=CV95(N)
        CDF3=CV99(N)
      ELSE
        CDF1=1.22/SQRT(REAL(N))
        CDF2=1.36/SQRT(REAL(N))
        CDF3=1.63/SQRT(REAL(N))
        AFACT=SQRT(AN + SQRT(AN/10.))
        CDF1B=1.22/AFACT
        CDF2B=1.36/AFACT
        CDF3B=1.63/AFACT
      ENDIF
CCCCC I'M NOT ABOUT THIS PKS2 ROUTINE FOR RETRIEVING THE EXACT K-S
CCCCC CDF FOR A GIVEN VALUE OF D
CCCCC IF(N.LE.100)THEN
CCCCC   CDFA=PKS2(N,STAT)
CCCCC   print *,'cdfa=',cdfa
CCCCC   CDFA=PKS2(N,SQRT(REAL(N))*STAT)
CCCCC   print *,'cdfb=',cdfb
CCCCC   CDFC=PKS(N,STAT)
CCCCC   print *,'cdfc=',cdfc
CCCCC   CDFD=PKS(N,SQRT(REAL(N))*STAT)
CCCCC   print *,'cdfa,cdfb,cdfc,cdfd=',cdfa,cdfb,cdfc,cdfd
CCCCC ENDIF
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(N.LE.40)THEN
        IF(STAT.LE.CDF1)ICONC1='ACCEPT'
        IF(STAT.LE.CDF2)ICONC2='ACCEPT'
        IF(STAT.LE.CDF3)ICONC3='ACCEPT'
      ELSE
        IF(STAT.LE.CDF1B)ICONC1='ACCEPT'
        IF(STAT.LE.CDF2B)ICONC2='ACCEPT'
        IF(STAT.LE.CDF3B)ICONC3='ACCEPT'
      ENDIF
C
      STATVA=STAT
      STATCD=CDF2B
C
      IF(IWRIT2.EQ.'OFF')GOTO9000
C
C               **************************************
C               **   STEP 32--                      **
C               **   WRITE OUT EVERYTHING           **
C               **   FOR A KOLMOGOROV-SMIRNOV TEST  **
C               **************************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5113)
 5113   FORMAT('   <CAPTION ALIGN=CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5115)
 5115   FORMAT('      <B>KOLMOGOROV-SMIRNOV GOODNESS-OF-FIT TEST</B>')
        CALL DPWRST('XXX','WRIT')
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,5117)
 5117     FORMAT('      (Censored Case, Critical Values May Not Be ',
     1           'Accurate)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5119)
 5119   FORMAT('   </CAPTION>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5141)
 5141   FORMAT('         Null Hypothesis H<SUB>0</SUB>:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)
 5151   FORMAT('         Distribution Fits the Data')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5142)
 5142   FORMAT('         Alternate Hypothesis H<SUB>a</SUB>:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5152)
 5152   FORMAT('         Distribution Does Not Fit the Data')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5143)
 5143   FORMAT('         Distribution:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5153)IDIST
 5153   FORMAT('         ',A50)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
 5121   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5144)
 5144   FORMAT('         Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('      </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)N
 5154   FORMAT('         ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
C
        IF(ICENSO.EQ.'ON')THEN
C
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5123)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5244)
 5244     FORMAT('         Number of Uncensored Observations:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5126)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5154)IR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,5121)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5123)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5344)
 5344     FORMAT('         Number of Censored Observations:')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5126)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5154)N-IR
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5127)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5128)
          CALL DPWRST('XXX','WRIT')
C
        ENDIF
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5145)
 5145   FORMAT('         Kolmogorov-Smirnov Test Statistic:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5155)STAT
 5155   FORMAT('         ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
 5991   FORMAT('</TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5993)
 5993   FORMAT('</UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5995)
 5995   FORMAT('<BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5307)
 5307   FORMAT('<UL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5311)
 5311   FORMAT('<TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
 5321   FORMAT('   <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
 5323   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5341)
 5341   FORMAT('         Alpha<br>Level')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
 5329   FORMAT('      </TH>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5351)
 5351   FORMAT('         Cutoff')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5353)
 5353   FORMAT('         Conclusion')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5329)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
 5328   FORMAT('   </TR>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5313)
 5313   FORMAT('   <TD COLSPAN=3>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5319)
 5319   FORMAT('      <HR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
 5327   FORMAT('      </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
 5440   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5441)
 5441   FORMAT('         10%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        IF(N.LE.40)THEN
          WRITE(ICOUT,5442)CDF1
 5442     FORMAT('         ',F7.3)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5742)CDF1,CDF1B
 5742     FORMAT('         ',F7.3,'*, <BR>',F7.3,'**')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5443)ICONC1
 5443   FORMAT('         ',A6,' H<SUB>0</SUB>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5541)
 5541   FORMAT('          5%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        IF(N.LE.40)THEN
          WRITE(ICOUT,5442)CDF2
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5742)CDF2,CDF2B
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5443)ICONC2
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5641)
 5641   FORMAT('          1%')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        IF(N.LE.40)THEN
          WRITE(ICOUT,5442)CDF3
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,5742)CDF3,CDF3B
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5440)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5443)ICONC3
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5327)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5328)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5991)
        CALL DPWRST('XXX','WRIT')
        IF(N.GT.40)THEN
          WRITE(ICOUT,5995)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5980)
 5980     FORMAT('* - Standard Large Sample Approximation (C/SQRT(N))')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5995)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5982)
 5982     FORMAT('** - More Accurate Large Sample Approximation ',
     1           '( C/SQRT(N + SQRT(N/10)) )')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,5995)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5993)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5499)
 5499   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
CCCCC OCTOBER 2003: ADD LATEX SUPPORT.
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001 FORMAT('{',A1,'bf KOLMOGOROV-SMIRNOV GOODNESS-OF-FIT TEST}')
88001 FORMAT('{(Censored Case, Critical Values May Not Be Accurate)}')
 8002 FORMAT(A1,A1)
 8003 FORMAT(A1,'end{table}')
 8007 FORMAT(A1,'begin{center}')
 8009 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8010 FORMAT(A1,'end{center}')
 8012 FORMAT(A1,'end{verbatim}')
 8013 FORMAT(A1,'begin{table}')
 8014 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
 8016 FORMAT(5X,'} ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8013)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,88001)IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8020 FORMAT(5X,A1,'begin{tabular} {lr}')
 8021 FORMAT(5X,'Null Hypothesis $H_0$: & Distribution Fits the Data',
     1       2X,A1,A1)
 8022 FORMAT(5X,'Alternate Hypothesis $H_a$: & Distribution Does Not ',
     1       'Fit the Data',2X,A1,A1)
 8023 FORMAT(5X,'Distribution: & ',A50,2X,A1,A1)
 8024 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
 8025 FORMAT(5X,'Kolmogorov-Smirnov Test Statistic & ',G15.7,2X,A1,A1)
 8026 FORMAT(5X,'Number of Uncensored Observations: & ',I8,2X,A1,A1)
 8027 FORMAT(5X,'Number of Censored Observations: & ',I8,2X,A1,A1)
 8030 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8021)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8022)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8023)IDIST,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8024)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,8026)IR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8027)N-IR,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8025)STAT,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8040 FORMAT(5X,A1,'begin{tabular} {rrr}')
 8041 FORMAT(5X,'Alpha Level & Cutoff & Conclusion',2X,A1,A1,
     1       2x,A1,'hline')
 8042 FORMAT(5X,'10',A1,'% & ',F7.3,' & ',A6,' $H_0$',2X,A1,A1)
 8043 FORMAT(5X,'5',A1,'% & ',F7.3,' & ',A6,' $H_0$',2X,A1,A1)
 8044 FORMAT(5X,'1',A1,'% & ',F7.3,' & ',A6,' $H_0$',2X,A1,A1)
 8045 FORMAT(5X,'10',A1,'% & ',F7.3,'* & ',A6,' $H_0$',2X,A1,A1)
 8046 FORMAT(5X,'5',A1,'% & ',F7.3,'* & ',A6,' $H_0$',2X,A1,A1)
 8047 FORMAT(5X,'1',A1,'% & ',F7.3,'* & ',A6,' $H_0$',2X,A1,A1)
 8048 FORMAT(5X,'  & ',F7.3,'** & ',2X,A1,A1)
 8049 FORMAT(A1,'end{table}')
 8050 FORMAT(A1,'end{tabular}')
 8072 FORMAT(5X,'* - Standard Large Sample Approximation ',
     1       '$C/',A1,'sqrt{n}$')
 8074 FORMAT(5X,'* - More Accurate Large Sample Approximation ',
     1       '$C/',A1,'sqrt{n + ',A1,'{n/10}}$')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(N.LE.40)THEN
          WRITE(ICOUT,8042)IBASLC,CDF1,ICONC1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8043)IBASLC,CDF2,ICONC2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8044)IBASLC,CDF3,ICONC3,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8045)IBASLC,CDF1,ICONC1,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8048)CDF1B,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8046)IBASLC,CDF2,ICONC2,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8048)CDF2B,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8047)IBASLC,CDF3,ICONC3,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8048)CDF3B,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8010)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        IF(N.GT.40)THEN
          WRITE(ICOUT,8072)IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8074)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8014)IBASLC,IBASLC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
 8092   FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C  JUST A PLACEHOLDER FOR NOW.
C
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3211)
 3211   FORMAT(
     1  '                  KOLMOGOROV-SMIRNOV GOODNESS-OF-FIT TEST')
        CALL DPWRST('XXX','WRIT')
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,3217)
 3217     FORMAT('                  (CENSORED CASE, CRITICAL VALUES ',
     1           'MAY NOT BE ACCURATE)')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3212)
 3212   FORMAT(
     1  'NULL HYPOTHESIS H0:      DISTRIBUTION FITS THE DATA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13212)
13212   FORMAT(
     1  'ALTERNATE HYPOTHESIS HA: DISTRIBUTION DOES NOT FIT THE DATA')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3213)IDIST
 3213   FORMAT(
     1  'DISTRIBUTION:            ',A50)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3221)N
 3221   FORMAT(3X,'NUMBER OF OBSERVATIONS              = ',I8)
        CALL DPWRST('XXX','WRIT')
        IF(ICENSO.EQ.'ON')THEN
          WRITE(ICOUT,3223)IR
 3223     FORMAT(3X,'NUMBER OF UNCENSORED OBSERVATIONS   = ',I8)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3225)N-IR
 3225     FORMAT(3X,'NUMBER OF CENSORED OBSERVATIONS     = ',I8)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3240)
 3240   FORMAT('TEST:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,3242)STAT
 3242   FORMAT('KOLMOGOROV-SMIRNOV TEST STATISTIC      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,3253)
 3253   FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
        CALL DPWRST('XXX','WRIT')
        IF(N.LE.40)THEN
          WRITE(ICOUT,3255)CDF1,ICONC1
 3255     FORMAT('           10%',5X,F7.3,15X,A6,' H0')
          CALL DPWRST('XXX','WRIT')
C
   
          WRITE(ICOUT,3265)CDF2,ICONC2
 3265     FORMAT('            5%',5X,F7.3,15X,A6,' H0')
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,3275)CDF3,ICONC3
 3275     FORMAT('            1%',5X,F7.3,15X,A6,' H0')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,3355)CDF1,ICONC1
 3355     FORMAT('           10%',5X,F7.3,'*',14X,A6,' H0')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3356)CDF1B
 3356     FORMAT('              ',5X,F7.3,'**')
          CALL DPWRST('XXX','WRIT')
C
   
          WRITE(ICOUT,3365)CDF2,ICONC2
 3365     FORMAT('            5%',5X,F7.3,'*',14X,A6,' H0')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3356)CDF2B
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,3375)CDF3,ICONC3
 3375     FORMAT('            1%',5X,F7.3,'*',14X,A6,' H0')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3356)CDF3B
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        IF(N.GT.40)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3385)
 3385     FORMAT(3X,' *  - STANDARD LARGE SAMPLE ',
     1           'APPROXIMATION  ( C/SQRT(N) )')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,3388)
 3388     FORMAT(3X,'** - MORE ACCURATE LARGE SAMPLE ',
     1           'APPROXIMATION  ( C/SQRT(N + SQRT(N/10)) )')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
      GOTO9000
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 DP1KS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,N2,IERROR
 9012 FORMAT('ICASPL,N2,IERROR = ',A4,2X,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE ADDED   MAY 1993
      WRITE(ICOUT,9015)MINMAX
 9015 FORMAT('MINMAX = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,N2
      WRITE(ICOUT,9021)I,Y2(I),X2(I)
 9021 FORMAT('I,Y2(I),X2(I), = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DP2KST(Y1,Y2,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE A 2-SAMPLE KOLMOGOROV-SMIRNOV TEST
C              THAT 2 SAMPLES ARE FROM THE SAME DISTRIBUTION
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--98/12
C     ORIGINAL VERSION--DECEMBER  1998.
C     UPDATED         --JULY      2001. FIXED ALGORITM
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IERRO4
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
C
C-----COMMON----------------------------------------------------------
C
      REAL YCOMB(2*MAXOBV)
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOHO.INC'
      INCLUDE 'DPCOMC.INC'
      INCLUDE 'DPCOF2.INC'
C
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),YCOMB(1))
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='DP2K'
      ISUBN2='ST  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=3
      MINN2=3
C
      ICOLR=0
C
C               ******************************************
C               **  TREAT THE KOLMOGOROV-SMIRNOV 2 SAMPLE CASE  **
C               ******************************************
C
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')THEN
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DP2KST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL
   52 FORMAT('ICASPL = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGA2,IBUGA3,IBUGQ
   53 FORMAT('IBUGA2,IBUGA3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      ENDIF
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  RECOGNIZE THE FOLLOWING FORMS FOR THE COMMAND:
C     KOLMOGOROV SMIRNOV 2 SAMPLE TEST Y1 Y2
C     KOLMOGOROV SMIRNOV TWO SAMPLE TEST Y1 Y2
C     2 SAMPLE KOLMOGOROV SMIRNOV TEST Y1 Y2
C     TWO SAMPLE KOLMOGOROV SMIRNOV TEST Y1 Y2
C  THE WORD TEST IS OPTIONAL.
C
      IF(ICOM.EQ.'KOLM')THEN
        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SMIR'.AND.
     1     IHARG(2).EQ.'2'.AND.IHARG(3).EQ.'SAMP')THEN
           ISHIFT=3
           GOTO112
        ELSEIF(NUMARG.GE.3.AND.IHARG(1).EQ.'SMIR'.AND.
     1     IHARG(2).EQ.'TWO'.AND.IHARG(3).EQ.'SAMP')THEN
           ISHIFT=3
           GOTO112
        ENDIF
      ELSEIF(ICOM.EQ.'2'.OR.ICOM.EQ.'TWO')THEN
        IF(NUMARG.GE.3.AND.IHARG(1).EQ.'SAMP'.AND.
     1     IHARG(2).EQ.'KOLM'.AND.IHARG(3).EQ.'SMIR')THEN
           ISHIFT=3
           GOTO112
        ELSEIF(NUMARG.GE.2.AND.IHARG(1).EQ.'SAMP'.AND.
     1     IHARG(2).EQ.'KOLM')THEN
           ISHIFT=2
           GOTO112
        ENDIF
      ENDIF
C
C ----------NO MATCH FOUND----------
C
      ICASPL='    '
      IFOUND='NO'
      GOTO9000
C
  112 CONTINUE
      ICASPL='2KST'
      CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      IFOUND='YES'
      IF(IHARG(1).EQ.'TEST')THEN
        ISHIFT=1
        CALL ADJUST(ISHIFT,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      ENDIF
      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'.OR.ISUBRO.EQ.'2KST')
     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 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1WRITE(ICOUT,211)IHLEFT,IHLEF2,ICOLL,NLEFT
  211 FORMAT('IHLEFT,IHLEF2,ICOLL,NLEFT = ',A4,A4,I8,I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')CALL DPWRST('XXX','BUG ')
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(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DP2KST--')
      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 KOLMOGOROV-SMIRNOV 2 SAMPLE TEST ',
     1'WAS TO HAVE BEEN FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER; SUCH WAS NOT THE ',
     1'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)THEN
        WRITE(ICOUT,318)(IANS(I),I=1,MIN(80,IWIDTH))
  318   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
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='5'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO480
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO490
C
  480 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,481)
  481 FORMAT('***** INTERNAL ERROR IN DP2KST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,482)
  482 FORMAT('      AT BRANCH POINT 481--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,483)
  483 FORMAT('      NUMARG LESS THAN 1 EVEN THOUGH')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,484)
  484 FORMAT('      NUMARG HAD PREVIOUSLY PASSED THIS TEST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,485)NUMARG
  485 FORMAT('      ONCE ALREADY.  VALUE OF NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,486)
  486 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,487)(IANS(I),I=1,IWIDTH)
  487 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  490 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2KST')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ,ICASEQ
  491 FORMAT('NUMARG,ILOCQ,ICASEQ = ',I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ******************************************************
C               **  STEP 6--                                        **
C               **  CHECK FOR REQUIRED SECOND ARGUMENT              **
C               ******************************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMV2=ILOCQ-1
      IF(NUMV2.NE.2)GOTO550
C
  509 CONTINUE
      IHRIGH=IHARG(2)
      IHRIG2=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHRIGH,IHRIG2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLR=IVALUE(ILOCV)
      NRIGHT=IN(ILOCV)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1WRITE(ICOUT,511)IHRIGH,IHRIG2,ICOLR,NRIGHT
  511 FORMAT('IHRIGH,IHRIG2,ICOLR,NRIGHT = ',A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')CALL DPWRST('XXX','BUG ')
  510 CONTINUE
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DP2KST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR A KOLMOGOROV-SMIRNOV 2 SAMPLE TEST, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,558)
  558 FORMAT('      THE NUMBER OF VARIABLES MUST BE EXACTLY 2;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,560)
  560 FORMAT('      SUCH WAS NOT THE CASE HERE; THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)NUMV2
  562 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)THEN
        WRITE(ICOUT,564)(IANS(I),I=1,MIN(IWIDTH,80))
  564   FORMAT(80A1)
        CALL DPWRST('XXX','BUG ')
      ENDIF
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  (BASED ON THE QUALIFIER)           **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               **  AND CARRY OUT THE PLOTS.           **
C               *****************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IMAX=MAX(NLEFT,NRIGHT)
      IF(ICASEQ.EQ.'FULL')GOTO610
      IF(ICASEQ.EQ.'SUBS')GOTO620
      IF(ICASEQ.EQ.'FOR')GOTO630
C
  610 CONTINUE
      DO615I=1,IMAX
      ISUB(I)=1
  615 CONTINUE
      NQ=IMAX
      GOTO650
C
  620 CONTINUE
      NIOLD=IMAX
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO650
C
  630 CONTINUE
      NIOLD=IMAX
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO650
C
  650 CONTINUE
      J=0
      IF(NQ.LT.NLEFT)IMAX=NQ
      N1=0
      N2=0
      N3=0
      DO660I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO660
      J=J+1
C
      IF(I.LE.NLEFT)THEN
        N1=N1+1
        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)
      ENDIF
C
      IF(I.LE.NRIGHT)THEN
        N2=N2+1
        IJ=MAXN*(ICOLR-1)+I
        IF(ICOLR.LE.MAXCOL)Y2(J)=V(IJ)
        IF(ICOLR.EQ.MAXCP1)Y2(J)=PRED(I)
        IF(ICOLR.EQ.MAXCP2)Y2(J)=RES(I)
        IF(ICOLR.EQ.MAXCP3)Y2(J)=YPLOT(I)
        IF(ICOLR.EQ.MAXCP4)Y2(J)=XPLOT(I)
        IF(ICOLR.EQ.MAXCP5)Y2(J)=X2PLOT(I)
        IF(ICOLR.EQ.MAXCP6)Y2(J)=TAGPLO(I)
      ENDIF
C
  660 CONTINUE
C
C               *****************************************************
C               **  STEP 9--                                       **
C               **  COMPUTE THE KOLMOGOROV-SMIRNOV 2 SAMPLE        **
C               **  TEST                                           **
C               *****************************************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2KST')GOTO5190
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5111)
 5111 FORMAT('***** FROM THE MIDDLE  OF DP2KST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5112)ICASPL,NUMV2,N1,N2,N3
 5112 FORMAT('ICASPL,NUMV2,N1,N2,N3= ',A4,I8,2X,3I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO5116I=1,N1
      WRITE(ICOUT,5117)I,Y1(I),Y2(I)
 5117 FORMAT('I,Y1(I),Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5116 CONTINUE
 5190 CONTINUE
C
      CALL DP2KS2(Y1,Y2,N1,N2,YCOMB,
     1STATVA,STATCD,CUTU90,CUTU95,CUTU99,
     1ISUBRO,IBUGA3,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 7--                         **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='7'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'2KST')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DP2K'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
CCCCC IH='STAT'
CCCCC IH2='CDF '
CCCCC VALUE0=STATCD
CCCCC CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
CCCCC1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
CCCCC1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP90'
      VALUE0=CUTU90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP95'
      VALUE0=CUTU95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTU'
      IH2='PP99'
      VALUE0=CUTU99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'2KST')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DP2KST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)ICASPL
 9013 FORMAT('ICASPL = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DP2KS2(Y1,Y2,N1,N2,YCOMB,
     1STATVA,STATCD,CUTU90,CUTU95,CUTU99,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--COMPUTE A 2-SAMPLE KOLMOGOROV-SMIRNOV TEST
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--98/11
C     ORIGINAL VERSION--DECEMBER  1998.
C     UPDATED         --JULY      2001. FIX ALGORITHM
C     UPDATED         --DECEMBER  2003. BASE CRITICAL VALUES ON
C                                       CONOVER TABLES
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION YCOMB(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C
      ISUBN1='DP2K'
      ISUBN2='S2  '
C
      IERROR='NO'
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      NMIN=MIN(N1,N2)
      NTOT=N1+N2
C
      IF(NMIN.LT.2)THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,31)
   31   FORMAT('***** ERROR IN DP2KS2--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,32)
   32   FORMAT('      THE NUMBER OF OBSERVATIONS FOR EACH VARIABLE')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)
   33   FORMAT('      MUST BE AT LEAST 2;')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,34)N1
   34   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 1 = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,35)N2
   35   FORMAT('      THE NUMBER OF OBSERVATIONS FOR VARIABLE 2 = ',I6)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'2KS2')THEN
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DP2KS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)N1,N2
   72 FORMAT('N1,N2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO85I=1,N1
      WRITE(ICOUT,86)I,Y1(I),Y2(I)
   86 FORMAT('I,Y1(I),Y2(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   85 CONTINUE
      ENDIF
C
C               **************************************
C               **  STEP 4--                        **
C               **  COMPUTE THE EMPIRICAL CDF       **
C               **  FUNCTIONS                       **
C               **************************************
C
C  FOR K-S TEST, ONLY UNBINNED DATA SUPPORTED.
C
      DO210I=1,N1
        YCOMB(I)=Y1(I)
  210 CONTINUE
      DO220I=1,N2
        YCOMB(I+N1)=Y2(I)
  220 CONTINUE
C
      CALL SORT(YCOMB,NTOT,YCOMB)
      CALL SORT(Y1,N1,Y1)
      CALL SORT(Y2,N2,Y2)
      AN1=REAL(N1)
      AN2=REAL(N2)
      ANTOT=REAL(NTOT)
C
      D=0.0
C
      DO910I=1,NTOT
        IFREQ=0
        DO920J=1,N1
          IF(Y1(J).LE.YCOMB(I))THEN
            IFREQ=IFREQ+1
          ELSE
            GOTO929
          ENDIF
  920   CONTINUE
  929   CONTINUE
        ZY1=REAL(IFREQ)/AN1
        IFREQ=0
        DO930J=1,N2
          IF(Y2(J).LE.YCOMB(I))THEN
            IFREQ=IFREQ+1
          ELSE
            GOTO939
          ENDIF
  930   CONTINUE
  939   CONTINUE
        ZY2=REAL(IFREQ)/AN2
        D=MAX(D,ABS(ZY1-ZY2))
        IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'2KS2')THEN
          WRITE(ICOUT,942)I,ZY1,ZY2,D
  942     FORMAT('I,ZY1,ZY2,D = ',I5,4G15.7)
          CALL DPWRST('XXX','BUG ')
        ENDIF
  910 CONTINUE
C
C               ****************************************
C               **  STEP 4.1--                        **
C               **  COMPUTE KOLMOGOROV-SMIRNOV TEST STATISTIC **
C               **  EXPECTED                          **
C               ****************************************
C
 1100 CONTINUE
C
      STAT=D
CCCCC NTEMP=INT(SQRT(AN1*AN2/(AN1+AN2)))
CCCCC CDF=PKS2(NTEMP,STAT)
C
C  COMPUTE CRITICAL VALUES FOR 0.90, 0.95, AND 0.99.
C  USE FUNCTION FOR N <=100, USE APPROXIMATION FOR N > 100.
C
C  12/2003: BASE CRITICAL VALUES ON CONOVER TABLES.
C
CCCCC IF(NTEMP.LE.5)THEN
CCCCC   CDF1=0.51
CCCCC   CDF2=0.56
CCCCC   CDF3=0.67
CCCCC ELSEIF(NTEMP.LE.10)THEN
CCCCC   CDF1=0.37
CCCCC   CDF2=0.41
CCCCC   CDF3=0.49
CCCCC ELSEIF(NTEMP.LE.15)THEN
CCCCC   CDF1=0.30
CCCCC   CDF2=0.34
CCCCC   CDF3=0.40
CCCCC ELSEIF(NTEMP.LE.20)THEN
CCCCC   CDF1=0.26
CCCCC   CDF2=0.29
CCCCC   CDF3=0.36
CCCCC ELSEIF(NTEMP.LE.25)THEN
CCCCC   CDF1=0.24
CCCCC   CDF2=0.27
CCCCC   CDF3=0.32
CCCCC ELSEIF(NTEMP.LE.30)THEN
CCCCC   CDF1=0.22
CCCCC   CDF2=0.24
CCCCC   CDF3=0.29
CCCCC ELSEIF(NTEMP.LE.35)THEN
CCCCC   CDF1=0.20
CCCCC   CDF2=0.23
CCCCC   CDF3=0.27
CCCCC ELSEIF(NTEMP.LE.40)THEN
CCCCC   CDF1=0.19
CCCCC   CDF2=0.21
CCCCC   CDF3=0.25
CCCCC ELSEIF(NTEMP.LE.45)THEN
CCCCC   CDF1=0.18
CCCCC   CDF2=0.20
CCCCC   CDF3=0.24
CCCCC ELSEIF(NTEMP.LE.50)THEN
CCCCC   CDF1=0.17
CCCCC   CDF2=0.19
CCCCC   CDF3=0.23
CCCCC ELSE
CCCCC   CDF1=1.22/SQRT(REAL(NTEMP))
CCCCC   CDF2=1.36/SQRT(REAL(NTEMP))
CCCCC   CDF3=1.63/SQRT(REAL(NTEMP))
CCCCC ENDIF
CCCCC I'M NOT SURE ABOUT THIS PKS2 ROUTINE FOR RETRIEVING THE EXACT K-S
CCCCC CDF FOR A GIVEN VALUE OF D
CCCCC IF(NTEMP.LE.100)THEN
CCCCC   CDFA=PKS2(NTEMP,STAT)
CCCCC   print *,'cdfa=',cdfa
CCCCC   CDFA=PKS2(NTEMP,SQRT(REAL(NTEMP))*STAT)
CCCCC   print *,'cdfb=',cdfb
CCCCC   CDFC=PKS(NTEMP,STAT)
CCCCC   print *,'cdfc=',cdfc
CCCCC   CDFD=PKS(NTEMP,SQRT(REAL(NTEMP))*STAT)
CCCCC   print *,'cdfa,cdfb,cdfc,cdfd=',cdfa,cdfb,cdfc,cdfd
CCCCC ENDIF
C
      IF(N1.EQ.N2)THEN
        IF(N1.EQ.3)THEN
          CDF1=2./3.
          CDF2=1.0
          CDF3=1.0
        ELSEIF(N1.EQ.4)THEN
          CDF1=3./4.
          CDF2=3./4.
          CDF3=1.0
        ELSEIF(N1.EQ.5)THEN
          CDF1=3./5.
          CDF2=4./5.
          CDF3=4./5.
        ELSEIF(N1.EQ.6)THEN
          CDF1=4./6.
          CDF2=4./6.
          CDF3=5./6.
        ELSEIF(N1.EQ.7)THEN
          CDF1=4./7.
          CDF2=5./7.
          CDF3=5./7.
        ELSEIF(N1.EQ.8)THEN
          CDF1=4./8.
          CDF2=5./8.
          CDF3=6./8.
        ELSEIF(N1.EQ.9)THEN
          CDF1=5./9.
          CDF2=5./9.
          CDF3=6./9.
        ELSEIF(N1.EQ.10)THEN
          CDF1=5./10.
          CDF2=6./10.
          CDF3=7./10.
        ELSEIF(N1.EQ.11)THEN
          CDF1=5./11.
          CDF2=6./11.
          CDF3=7./11.
        ELSEIF(N1.EQ.12)THEN
          CDF1=5./12.
          CDF2=6./12.
          CDF3=7./12.
        ELSEIF(N1.EQ.13)THEN
          CDF1=6./13.
          CDF2=6./13.
          CDF3=8./13.
        ELSEIF(N1.EQ.14)THEN
          CDF1=6./14.
          CDF2=7./14.
          CDF3=8./14.
        ELSEIF(N1.EQ.15)THEN
          CDF1=6./15.
          CDF2=7./15.
          CDF3=8./15.
        ELSEIF(N1.EQ.16)THEN
          CDF1=6./16.
          CDF2=7./16.
          CDF3=9./16.
        ELSEIF(N1.EQ.17)THEN
          CDF1=7./17.
          CDF2=7./17.
          CDF3=9./17.
        ELSEIF(N1.EQ.18)THEN
          CDF1=7./18.
          CDF2=8./18.
          CDF3=9./18.
        ELSEIF(N1.EQ.19)THEN
          CDF1=7./19.
          CDF2=8./19.
          CDF3=9./19.
        ELSEIF(N1.EQ.20)THEN
          CDF1=7./20.
          CDF2=8./20.
          CDF3=10./20.
        ELSEIF(N1.EQ.21)THEN
          CDF1=7./21.
          CDF2=8./21.
          CDF3=10./21.
        ELSEIF(N1.EQ.22)THEN
          CDF1=8./22.
          CDF2=8./22.
          CDF3=10./22.
        ELSEIF(N1.EQ.22)THEN
          CDF1=8./22.
          CDF2=8./22.
          CDF3=10./22.
        ELSEIF(N1.EQ.23)THEN
          CDF1=8./23.
          CDF2=9./23.
          CDF3=10./23.
        ELSEIF(N1.EQ.24)THEN
          CDF1=8./24.
          CDF2=9./24.
          CDF3=11./24.
        ELSEIF(N1.EQ.25)THEN
          CDF1=8./25.
          CDF2=9./25.
          CDF3=11./25.
        ELSEIF(N1.EQ.26)THEN
          CDF1=8./26.
          CDF2=9./26.
          CDF3=11./26.
        ELSEIF(N1.EQ.27)THEN
          CDF1=8./27.
          CDF2=9./27.
          CDF3=11./27.
        ELSEIF(N1.EQ.28)THEN
          CDF1=9./28.
          CDF2=10./28.
          CDF3=12./28.
        ELSEIF(N1.EQ.29)THEN
          CDF1=9./29.
          CDF2=10./29.
          CDF3=12./29.
        ELSEIF(N1.EQ.30)THEN
          CDF1=9./30.
          CDF2=10./30.
          CDF3=12./30.
        ELSEIF(N1.EQ.31)THEN
          CDF1=9./31.
          CDF2=10./31.
          CDF3=12./31.
        ELSEIF(N1.EQ.32)THEN
          CDF1=9./32.
          CDF2=10./32.
          CDF3=12./32.
        ELSEIF(N1.EQ.33)THEN
          CDF1=9./33.
          CDF2=11./33.
          CDF3=13./33.
        ELSEIF(N1.EQ.34)THEN
          CDF1=10./34.
          CDF2=11./34.
          CDF3=13./34.
        ELSEIF(N1.EQ.35)THEN
          CDF1=10./35.
          CDF2=11./35.
          CDF3=13./35.
        ELSEIF(N1.EQ.36)THEN
          CDF1=10./36.
          CDF2=11./36.
          CDF3=13./36.
        ELSEIF(N1.EQ.37)THEN
          CDF1=10./37.
          CDF2=11./37.
          CDF3=13./37.
        ELSEIF(N1.EQ.38)THEN
          CDF1=10./38.
          CDF2=11./38.
          CDF3=14./38.
        ELSEIF(N1.EQ.39)THEN
          CDF1=10./39.
          CDF2=11./39.
          CDF3=14./39.
        ELSEIF(N1.EQ.40)THEN
          CDF1=10./40.
          CDF2=12./40.
          CDF3=14./40.
        ELSE
          CDF1=1.73/SQRT(REAL(N1))
          CDF2=1.92/SQRT(REAL(N1))
          CDF3=2.30/SQRT(REAL(N1))
        ENDIF
      ELSEIF(N1.NE.N2)THEN
        N1T=MIN(N1,N2)
        N2T=MAX(N1,N2)
        IF(N1T.EQ.1)THEN
          IF(N2T.LE.10)THEN
            CDF1=1.
            CDF2=1.
            CDF3=1.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.2)THEN
          IF(N2T.LE.4)THEN
            CDF1=1.
            CDF2=1.
            CDF3=1.
          ELSEIF(N2T.EQ.5)THEN
            CDF1=4./5.
            CDF2=1.
            CDF3=1.
          ELSEIF(N2T.EQ.6)THEN
            CDF1=5./6.
            CDF2=1.
            CDF3=1.
          ELSEIF(N2T.EQ.7)THEN
            CDF1=6./7.
            CDF2=1.
            CDF3=1.
          ELSEIF(N2T.EQ.8)THEN
            CDF1=7./8.
            CDF2=7./8.
            CDF3=1.
          ELSEIF(N2T.EQ.9)THEN
            CDF1=8./9.
            CDF2=8./9.
            CDF3=1.
          ELSEIF(N2T.EQ.10)THEN
            CDF1=4./5.
            CDF2=9./10.
            CDF3=1.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.3)THEN
          IF(N2T.EQ.4)THEN
            CDF1=3./4.
            CDF2=1.
            CDF3=1.
          ELSEIF(N2T.EQ.5)THEN
            CDF1=4./5.
            CDF2=4./5.
            CDF3=1.
          ELSEIF(N2T.EQ.6)THEN
            CDF1=2./3.
            CDF2=5./6.
            CDF3=1.
          ELSEIF(N2T.EQ.7)THEN
            CDF1=5./7.
            CDF2=6./7.
            CDF3=6./7.
          ELSEIF(N2T.EQ.8)THEN
            CDF1=3./4.
            CDF2=3./4.
            CDF3=1.
          ELSEIF(N2T.EQ.9)THEN
            CDF1=2./3.
            CDF2=7./9.
            CDF3=8./9.
          ELSEIF(N2T.EQ.10)THEN
            CDF1=7./10.
            CDF2=4./5.
            CDF3=9./10.
          ELSEIF(N2T.EQ.11)THEN
            CDF1=(7./10. + 2./3.)/2.0
            CDF2=(4./5. + 3./4.)/2.0
            CDF3=(9./10. + 11./12.)/2.0
          ELSEIF(N2T.EQ.12)THEN
            CDF1=2./3.
            CDF2=3./4.
            CDF3=11./12.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.4)THEN
          IF(N2T.EQ.5)THEN
            CDF1=3./4.
            CDF2=4./5.
            CDF3=1.
          ELSEIF(N2T.EQ.6)THEN
            CDF1=2./3.
            CDF2=3./4.
            CDF3=5./6.
          ELSEIF(N2T.EQ.7)THEN
            CDF1=5./7.
            CDF2=6./7.
            CDF3=6./7.
          ELSEIF(N2T.EQ.8)THEN
            CDF1=5./8.
            CDF2=3./4.
            CDF3=7./8.
          ELSEIF(N2T.EQ.9)THEN
            CDF1=2./3.
            CDF2=3./4.
            CDF3=8./9.
          ELSEIF(N2T.EQ.10)THEN
            CDF1=13./20.
            CDF2=7./10.
            CDF3=4./5.
          ELSEIF(N2T.EQ.11)THEN
            CDF1=(13./20. + 2./3.)/2.0
            CDF2=(7./10. + 2./3.)/2.0
            CDF3=(4./5. + 5./6.)/2.0
          ELSEIF(N2T.EQ.12 .OR. N2T.EQ.13)THEN
            CDF1=2./3.
            CDF2=2./3.
            CDF3=5./6.
          ELSEIF(N2T.GE.14 .AND. N2T.LE.16)THEN
            CDF1=5./8.
            CDF2=11./16.
            CDF3=13./16.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.5)THEN
          IF(N2T.EQ.6)THEN
            CDF1=2./3.
            CDF2=2./3.
            CDF3=5./6.
          ELSEIF(N2T.EQ.7)THEN
            CDF1=23./35.
            CDF2=5./7.
            CDF3=6./7.
          ELSEIF(N2T.EQ.8)THEN
            CDF1=5./8.
            CDF2=27./40.
            CDF3=4./5.
          ELSEIF(N2T.EQ.9)THEN
            CDF1=3./5.
            CDF2=31./45.
            CDF3=4./5.
          ELSEIF(N2T.GE.10 .AND. N2T.LE.12)THEN
            CDF1=3./5.
            CDF2=7./10.
            CDF3=4./5.
          ELSEIF(N2T.GE.13 .AND. N2T.LE.17)THEN
            CDF1=3./5.
            CDF2=2./3.
            CDF3=11./15.
          ELSEIF(N2T.GE.18 .AND. N2T.LE.20)THEN
            CDF1=11./20.
            CDF2=3./5.
            CDF3=3./4.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.6)THEN
          IF(N2T.EQ.7)THEN
            CDF1=4./7.
            CDF2=29./42.
            CDF3=5./6.
          ELSEIF(N2T.EQ.8)THEN
            CDF1=7./12.
            CDF2=2./3.
            CDF3=3./4.
          ELSEIF(N2T.EQ.9)THEN
            CDF1=5./9.
            CDF2=2./3.
            CDF3=7./9.
          ELSEIF(N2T.EQ.10)THEN
            CDF1=17./30.
            CDF2=19./30.
            CDF3=11./15.
          ELSEIF(N2T.GE.11 .AND. N2T.LE.14)THEN
            CDF1=7./12.
            CDF2=7./12.
            CDF3=3./4.
          ELSEIF(N2T.GE.15 .AND. N2T.LE.20)THEN
            CDF1=5./9.
            CDF2=11./18.
            CDF3=13./18.
          ELSEIF(N2T.GE.21 .AND. N2T.LE.24)THEN
            CDF1=1./2.
            CDF2=7./12.
            CDF3=2./3.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.7)THEN
          IF(N2T.EQ.8)THEN
            CDF1=33./56.
            CDF2=5./8.
            CDF3=3./4.
          ELSEIF(N2T.EQ.9)THEN
            CDF1=5./9.
            CDF2=40./63.
            CDF3=47./63.
          ELSEIF(N2T.GE.10 .AND. N2T.LE.11)THEN
            CDF1=39./70.
            CDF2=43./70.
            CDF3=5./7.
          ELSEIF(N2T.GE.12 .AND. N2T.LE.20)THEN
            CDF1=1./2.
            CDF2=4./7.
            CDF3=5./7.
          ELSEIF(N2T.GE.21 .AND. N2T.LE.28)THEN
            CDF1=13./28.
            CDF2=15./28.
            CDF3=9./14.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.8)THEN
          IF(N2T.EQ.9)THEN
            CDF1=13./24.
            CDF2=5./8.
            CDF3=3./4.
          ELSEIF(N2T.EQ.10)THEN
            CDF1=21./40.
            CDF2=23./40.
            CDF3=7./10.
          ELSEIF(N2T.GE.11 .AND. N2T.LE.13)THEN
            CDF1=1./2.
            CDF2=7./12.
            CDF3=2./3.
          ELSEIF(N2T.GE.14 .AND. N2T.LE.23)THEN
            CDF1=1./2.
            CDF2=9./16.
            CDF3=5./8.
          ELSEIF(N2T.GE.24 .AND. N2T.LE.32)THEN
            CDF1=7./16.
            CDF2=1./2.
            CDF3=19./32.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.9)THEN
          IF(N2T.EQ.10)THEN
            CDF1=1./2.
            CDF2=26./45.
            CDF3=31./45.
          ELSEIF(N2T.GE.11 .AND. N2T.LE.13)THEN
            CDF1=1./2.
            CDF2=5./9.
            CDF3=2./3.
          ELSEIF(N2T.GE.14 .AND. N2T.LE.16)THEN
            CDF1=22./45.
            CDF2=8./15.
            CDF3=29./45.
          ELSEIF(N2T.GE.17 .AND. N2T.LE.26)THEN
            CDF1=4./9.
            CDF2=1./2.
            CDF3=11./18.
          ELSEIF(N2T.GE.27 .AND. N2T.LE.36)THEN
            CDF1=5./12.
            CDF2=17./36.
            CDF3=5./9.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.10)THEN
          IF(N2T.GE.11 .AND. N2T.LE.17)THEN
            CDF1=7./15.
            CDF2=1./2.
            CDF3=19./30.
          ELSEIF(N2T.GE.18 .AND. N2T.LE.29)THEN
            CDF1=9./20.
            CDF2=1./2.
            CDF3=3./5.
          ELSEIF(N2T.GE.30 .AND. N2T.LE.40)THEN
            CDF1=2./5.
            CDF2=9./20.
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.GE.11 .AND. N1T.LE.14)THEN
          IF(N2T.GE.12 .AND. N2T.LE.15)THEN
            CDF1=9./20.
            CDF2=1./2.
            CDF3=7./12.
          ELSEIF(N2T.GE.17 .AND. N2T.LE.18)THEN
            CDF1=7./16.
            CDF2=23./48.
            CDF3=7./12.
          ELSEIF(N2T.GE.19 .AND. N2T.LE.20)THEN
            CDF1=5./12.
            CDF2=7./15.
            CDF3=17./30.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.15)THEN
          IF(N2T.GE.16 .AND. N2T.LE.20)THEN
            CDF1=2./5.
            CDF2=13./30.
            CDF3=31./60.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSEIF(N1T.EQ.16)THEN
          IF(N2T.GE.17 .AND. N2T.LE.20)THEN
            CDF1=31./80.
            CDF2=17./40.
            CDF3=41./80.
          ELSE
            CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
            CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
            CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
          ENDIF
        ELSE
          CDF1=1.22*SQRT((AN1+AN2)/(AN1*AN2))
          CDF2=1.36*SQRT((AN1+AN2)/(AN1*AN2))
          CDF3=1.63*SQRT((AN1+AN2)/(AN1*AN2))
        ENDIF
      ENDIF
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
C
      IF(STAT.LE.CDF1)ICONC1='ACCEPT'
      IF(STAT.LE.CDF2)ICONC2='ACCEPT'
      IF(STAT.LE.CDF3)ICONC3='ACCEPT'
C
      STATVA=STAT
      STATCD=CDF2
      CUTU90=CDF1
      CUTU95=CDF2
      CUTU99=CDF3
C
C               *******************************
C               **   STEP 32--               **
C               **   WRITE OUT EVERYTHING    **
C               **   FOR A KOLMOGOROV-SMIRNOV TEST  **
C               *******************************
C
      ISTEPN='32'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3211)
 3211 FORMAT(
     1'                  KOLMOGOROV-SMIRNOV TWO SAMPLE TEST')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3212)
 3212 FORMAT(
     1'NULL HYPOTHESIS H0:      TWO SAMPLES COME FROM THE SAME ',
     1'(UNSPECIFIED)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3213)
 3213 FORMAT(
     1'DISTRIBUTION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3214)
 3214 FORMAT(
     1'ALTERNATE HYPOTHESIS HA: TWO SAMPLES COME FROM DIFFERENT ',
     1'DISTRIBUTIONS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,3220)
 3220 FORMAT('SAMPLE:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3221)INT(AN1+0.1)
 3221 FORMAT(3X,'NUMBER OF OBSERVATIONS FOR SAMPLE 1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3222)INT(AN2+0.1)
 3222 FORMAT(3X,'NUMBER OF OBSERVATIONS FOR SAMPLE 2 = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,3240)
 3240 FORMAT('TEST:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3242)STAT
 3242 FORMAT('KOLMOGOROV-SMIRNOV TEST STATISTIC     = ',G15.7)
      CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,3244)CDF
C3244 FORMAT(3X,'KOLMOGOROV-SMIRNOV CDF VALUE       = ',F11.6)
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE(ICOUT,3251)
C3251 FORMAT('ALPHA = 0.10')
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3253)
 3253 FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3255)CDF1,ICONC1
 3255 FORMAT('           10%',5X,F10.5,15X,A6,' H0')
      CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE(ICOUT,3261)
C3261 FORMAT('ALPHA = 0.05')
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,3263)
C3263 FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3265)CDF2,ICONC2
 3265 FORMAT('            5%',5X,F10.5,15X,A6,' H0')
      CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE(ICOUT,3271)
C3271 FORMAT('ALPHA = 0.01')
CCCCC CALL DPWRST('XXX','WRIT')
CCCCC WRITE(ICOUT,3273)
C3273 FORMAT('   ALPHA LEVEL         CUTOFF              CONCLUSION')
CCCCC CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,3275)CDF3,ICONC3
 3275 FORMAT('            1%',5X,F10.5,15X,A6,' H0')
      CALL DPWRST('XXX','WRIT')
C
 3290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'2KS2')THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,9011)
 9011   FORMAT('***** AT THE END       OF DP2KS2--')
        CALL DPWRST('XXX','BUG ')
 9020   CONTINUE
      ENDIF
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPABAS(XTEMP1,MAXNXT,
     1ICASAN,ICASDI,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE A AND B BASIS TOLERANCE LIMITS
C             FOR NORMAL, LOGNORMAL, WEIBULL, NON-PARAMETRIC CASES
C     EXAMPLE--B BASIS NORMAL TOLERANCE LIMITS Y
C     REFERENCE--MARK VANGEL
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--98/4
C     ORIGINAL VERSION--APRIL     1998.
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 ICASAN
      CHARACTER*4 ICASDI
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      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='DPGR'
      ISUBN2='UB  '
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
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               *************************************************
C               **  TREAT THE B(A) BASIS TOLERANCE LIMIT CASE  **
C               *************************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ABAS')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPABAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPABAS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR THE TOLERANCE LIMIT,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      THE ARGUMENT MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPABAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH THE TOLERANCE LIMIT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPABAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH THE TOLERANCE LIMITS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      ESTIMATES ARE TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************
C               **  STEP 52--                    **
C               **  CALCULATE THE TOLERANCE LIMIT**
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPABAS, AS WE ARE ABOUT TO CALL DPABA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPABA2(Y,NS1,
     1XTEMP1,MAXNXT,
     1ICASAN,ICASDI,
     1ABASIS,BBASIS,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPAB'
C
      IF(ICASAN.EQ.'ABAS')THEN
        IH='ABAS'
        IH2='IS  '
        VALUE0=ABASIS
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
      ENDIF
      IF(ICASAN.EQ.'BBAS')THEN
        IH='BBAS'
        IH2='IS  '
        VALUE0=BBASIS
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ABAS')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPABAS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPABA2(Y,N,
     1XTEMP,MAXNXT,
     1ICASAN,ICASDI,
     1ABASIS,BBASIS,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE B BASIS AND A BASIS
C              TOLERANCE LIMITS
C     EXAMPLE--B BASIS NORMAL TOLERANCE LIMITS Y
C     REFERENCE--XX
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--98/3
C     ORIGINAL VERSION--MARCH     1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASAN
      CHARACTER*4 ICASDI
      CHARACTER*4 IWRITE
      CHARACTER*20 ITYPE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
C
CCCCC DIMENSION NVAL(12)
CCCCC DIMENSION IVAL(12)
      DIMENSION NBBASN(107)
      DIMENSION NBBASR(107)
      DIMENSION NBBS2R(28)
      DIMENSION ABBS2K(28)
      DIMENSION NABASN(100)
      DIMENSION NABS2R(106)
      DIMENSION AABS2K(106)
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
CCCCC DATA NVAL/29,46,61,89,203,215,227,321,615,4005,4109,4213/
CCCCC DATA IVAL/ 1, 2, 3, 5, 14, 15, 16, 24, 50, 370, 380, 390/
C
CCCCC FOLLOWING TABLES FROM MIL-HANDBOOK 17.
C
      DATA (NBBASN(I),I=1,107)/
     1    28,   29,   46,   61,   76,   89,  103,  116,  129,  142,
     1   154,  167,  179,  191,  203,  215,  227,  239,  251,  263,
     1   275,  298,  321,  345,  368,  391,  413,  436,  459,  481,
     1   504,  526,  549,  571,  593,  615,  638,  660,  682,  704,
     1   726,  781,  836,  890,  945,  999, 1053, 1107, 1161, 1269,
     1  1376, 1483, 1590, 1696, 1803, 1909, 2015, 2120, 2226, 2331,
     1  2437, 2542, 2647, 2752, 2857, 2962, 3066, 3171, 3276, 3380,
     1  3484, 3589, 3693, 3797, 3901, 4005, 4109, 4213, 4317, 4421,
     1  4525, 4629, 4733, 4836, 4940, 5044, 5147, 5251, 5354, 5613,
     1  5871, 6130, 6388, 6645, 6903, 7161, 7418, 7727, 8036, 8344,
     1  8652, 8960, 9268, 9576, 9884,10191,10499/
      DATA (NBBASR(I),I=1,107)/
     1     0,    1,    2,    3,    4,    5,    6,    7,    8,    9,
     1    10,   11,   12,   13,   14,   15,   16,   17,   18,   19,
     1    20,   22,   24,   26,   28,   30,   32,   34,   36,   38,
     1    40,   42,   44,   46,   48,   50,   52,   54,   56,   58,
     1    60,   65,   70,   75,   80,   85,   90,   95,  100,  110,
     1   120,  130,  140,  150,  160,  170,  180,  190,  200,  210,
     1   220,  230,  240,  250,  260,  270,  280,  290,  300,  310,
     1   320,  330,  340,  350,  360,  370,  380,  390,  400,  410,
     1   420,  430,  440,  450,  460,  470,  480,  490,  500,  525,
     1   550,  575,  600,  625,  650,  675,  700,  730,  760,  790,
     1   820,  850,  880,  910,  940,  970, 1000/
      DATA (NBBS2R(I),I=1,28)/
     1  0,  2,  3,  4,  4,  5,  5,  6,  6,  6,  7,  7,  7,  8,  8,
     1  8,  8,  9,  9, 10, 10, 10, 11, 11, 11, 11, 11, 12/
      DATA (ABBS2K(I),I=1,28)/
     1  0., 35.177, 7.859, 4.505, 4.101, 3.064, 2.858, 2.382, 2.253,
     1  2.137, 1.897, 1.814, 1.738, 1.599, 1.540, 1.485, 1.434,
     1  1.354, 1.311, 1.253, 1.218, 1.184, 1.143, 1.114, 1.087,
     1  1.060, 1.035, 1.010/
      DATA (NABASN(I),I=1,100)/
     1   298,  299,  473,  628,  773,  913, 1049, 1182, 1312, 1441,
     1  1568, 1693, 1818, 1941, 2064, 2185, 2306, 2426, 2546, 2665,
     1  2784, 2902, 3020, 3137, 3254, 3371, 3487, 3603, 3719, 3834,
     1  3949, 4064, 4179, 4293, 4407, 4521, 4635, 4749, 4862, 4975,
     1  5088, 5201, 5314, 5427, 5539, 5651, 5764, 5876, 5988, 6099,
     1  6211, 6323, 6434, 6545, 6657, 6769, 6879, 6990, 7100, 7211,
     1  7322, 7432, 7543, 7653, 7763, 7874, 7984, 8094, 8204, 8314,
     1  8423, 8533, 8643, 8753, 8862, 8972, 9081, 9190, 9300, 9518,
     1  9627, 9736, 9854, 9954,10063,10172,10281,10390,10498,10607,
     1 10716,10824,10933,11041,11150,11258,11366,11475,11583,11691/
      DATA (NABS2R(I),I=1,106)/
     1     2,    3,    4,    5,    6,    7,    8,    9,
     1    10,   11,   12,   13,   14,   15,   16,   17,   18,   19,
     1    20,   21,   22,   23,   24,   25,   26,   27,   28,   29,
     1    30,   31,   32,   33,   34,   35,   36,   37,   38,   39,
     1    40,   41,   42,   43,   44,   45,   46,   47,   48,   49,
     1    50,   52,   54,   56,   58,   60,   62,   64,   66,   68,
     1    70,   72,   74,   76,   78,   80,   82,   84,   86,   88,
     1    90,   92,   94,   96,   98,  100,  105,  110,  115,  120,
     1   125,  130,  135,  140,  145,  150,  155,  160,  165,  170,
     1   175,  180,  185,  190,  195,  200,  205,  210,  215,  220,
     1   225,  230,  235,  240,  245,  250,  275,  299/
      DATA (AABS2K(I),I=1,106)/
     1 80.00380,16.91220, 9.49579, 6.89049, 5.57681, 4.78352, 4.25011,
     1  3.86502, 3.57267, 3.34227, 3.15540, 3.00033, 2.86924, 2.75672,
     1  2.65889, 2.57290, 2.49660, 2.42833, 2.36683, 2.31106, 2.26020,
     1  2.21359, 2.17067, 2.13100, 2.09419, 2.05991, 2.02790, 1.99791,
     1  1.96975, 1.94324, 1.91822, 1.89457, 1.87215, 1.85088, 1.83065,
     1  1.81139, 1.79301, 1.77546, 1.75868, 1.74260, 1.72718, 1.71239,
     1  1.69817, 1.68449, 1.67132, 1.65862, 1.64638, 1.63456, 1.62313,
     1  1.60139, 1.58101, 1.56184, 1.54377, 1.52670, 1.51053, 1.49520,
     1  1.48063, 1.46675, 1.45352, 1.44089, 1.42881, 1.41724, 1.40614,
     1  1.39549, 1.38525, 1.37541, 1.36592, 1.35678, 1.34796, 1.33944,
     1  1.33120, 1.32324, 1.31553, 1.30806, 1.29036, 1.27392, 1.25859,
     1  1.24425, 1.23080, 1.21814, 1.20620, 1.19491, 1.18421, 1.17406,
     1  1.16440, 1.15519, 1.14640, 1.13801, 1.12997, 1.12226, 1.11486,
     1  1.10776, 1.10092, 1.09434, 1.08799, 1.08187, 1.07595, 1.07024,
     1  1.06471, 1.05935, 1.05417, 1.04914, 1.04426, 1.03952, 1.01773,
     1  1.00000/
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPAB'
      ISUBN2='A2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ABA2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPABA2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPABA2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPABA2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPABA2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR TOLERANCE LIMITS    **
C               ******************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IERROR='NO'
C
      IWRITE='OFF'
      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
      NDF=N-1
      IF(ICASAN.EQ.'BBAS')THEN
        CALL NORPPF(0.9,Z)
      ELSE
        CALL NORPPF(0.99,Z)
      ENDIF
      ANC=SQRT(REAL(N))*Z
      SIG=0.95
      CALL NCTPPF(SIG,REAL(NDF),ANC,T10)
      T10=T10/SQRT(REAL(N))
C
      ABASIS=0.0
      BBASIS=0.0
      IF(ICASDI.EQ.'NORM')THEN
        ITYPE='NORMAL'
        BASIS=YMEAN-T10*YSD
      ELSEIF(ICASDI.EQ.'LOGN')THEN
        ITYPE='LOG-NORMAL'
        BASIS=EXP(YMEAN-T10*YSD)
      ELSEIF(ICASDI.EQ.'WEIB')THEN
        ITYPE='WEIBULL'
        IF(N.LE.9)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2011)
 2011     FORMAT(
     1    '***** ERROR: FOR THE WEIBULL TOLERANCE LIMIT, N MUST BE',
     1    'GREATER THAN 10.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2013)N
 2013     FORMAT(
     1    '      N IS EQUAL TO ',I6)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ELSEIF(N.EQ.10)THEN
          V10=6.710924
        ELSEIF(N.EQ.11)THEN
          V10=6.476953
        ELSEIF(N.EQ.12)THEN
          V10=6.286106
        ELSEIF(N.EQ.13)THEN
          V10=6.126751
        ELSEIF(N.EQ.14)THEN
          V10=5.991525
        ELSEIF(N.EQ.15)THEN
          V10=5.875097
        ELSE
          V10=3.803+EXP(1.79-0.516*ALOG(REAL(N))+5.1/REAL(N))
        ENDIF
        CALL WBLEST(Y,N,ALPHA,GAMMA,IERROR)
        P2=0.10
        IF(ICASAN.EQ.'ABAS')P2=0.10
        Q2=ALPHA*(-ALOG(1-P2))**(1/GAMMA)
        RLCB2=-V10/(GAMMA*SQRT(REAL(N)))
        BASIS=Q2*EXP(RLCB2)
      ELSEIF(ICASDI.EQ.'NONP')THEN
        ITYPE='NON-PARAMETRIC'
C
C APPROXIMATE THE INDICES FOR THE NONPARAMETRIC
C ESTIMATES OF THE ALLOWABLES, SECTION 7.7.8, MIL-HDBK-17.
C
        CALL SORT(Y,N,XTEMP)
        IF(ICASAN.EQ.'BBAS')THEN
          IF(N.LE.1.OR.N.GT.10499)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,3002)
 3002       FORMAT('***** ERROR: VALUE OF N FOR NON-PARAMETERIC ',
     1             'B BASIS VALUE OUTSIDE ALLOWABLE (2,10499) RANGE.')
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ELSEIF(N.LE.28)THEN
            ASMALL=XTEMP(1)
            ABIG=XTEMP(NBBS2R(N))
            IF(ASMALL.EQ.ABIG)THEN
              WRITE(ICOUT,999)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,3005)
 3005         FORMAT('***** ERROR: X(1) = X(R) FOR HANSON-KOOPMAN ',
     1               'CALCULATION.  NO B BASIS CALCULATED.')
              CALL DPWRST('XXX','WRIT')
              IERROR='YES'
              GOTO9000
            ENDIF
            AK=ABBS2K(N)
            BASIS=ABIG*(ASMALL/ABIG)**AK
          ELSEIF(N.LE.10499)THEN
            DO3010I=2,107
              IF(N.GE.NBBASN(I-1).AND.N.LT.NBBASN(I))THEN
                BASIS=XTEMP(NBBASR(I-1))
                GOTO3019
              ENDIF
 3010       CONTINUE
            BASIS=XTEMP(1000)
 3019       CONTINUE
          ENDIF
        ELSE
          IF(N.LE.1.OR.N.GT.11691)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,3102)
 3102       FORMAT('***** ERROR: VALUE OF N FOR NON-PARAMETERIC ',
     1             'A BASIS VALUE OUTSIDE ALLOWABLE (2,11691) RANGE.')
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ELSEIF(N.LE.298)THEN
            ASMALL=XTEMP(1)
            ABIG=XTEMP(N)
            DO3120I=2,106
              IF(N.GE.NABS2R(I-1).AND.N.LT.NABS2R(I))THEN
                AK=AABS2K(I-1)
                GOTO3129
              ENDIF
 3120       CONTINUE
            AK=1.0
 3129       CONTINUE
            BASIS=ABIG*(ASMALL/ABIG)**AK
          ELSEIF(N.LE.11691)THEN
            DO3110I=2,100
              IF(N.GE.NABASN(I-1).AND.N.LT.NABASN(I))THEN
                BASIS=XTEMP(I-1)
                GOTO3119
              ENDIF
 3110       CONTINUE
            BASIS=XTEMP(100)
 3119       CONTINUE
          ENDIF
        ENDIF
      ENDIF
      IF(ICASAN.EQ.'ABAS')ABASIS=BASIS
      IF(ICASAN.EQ.'BBAS')BBASIS=BASIS
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR TOLERANCE LIMITS      **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO4290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IF(ICASAN.EQ.'BBAS')THEN
        WRITE(ICOUT,4211)ITYPE
        CALL DPWRST('XXX','WRIT')
 4211 FORMAT(
     1'B-BASIS TOLERANCE LIMITS FOR THE ',A20,' DISTRIBUTION')
      ELSE
        WRITE(ICOUT,4216)ITYPE
        CALL DPWRST('XXX','WRIT')
      ENDIF
 4216 FORMAT(
     1'A-BASIS TOLERANCE LIMITS FOR THE ',A20,' DISTRIBUTION')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,4242)N
 4242 FORMAT(6X,'NUMBER OF OBSERVATIONS  = ',I8)
      CALL DPWRST('XXX','WRIT')
C
      IF(ICASDI.EQ.'WEIB')THEN
        WRITE(ICOUT,4343)GAMMA
 4343   FORMAT(6X,'SHAPE PARAMETER GAMMA   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4243)ALPHA
 4243   FORMAT(6X,'SCALE PARAMETER ALPHA   = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4244)V10
 4244   FORMAT(6X,'TOLERANCE LIMIT FACTOR  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICASDI.EQ.'NORM'.OR.ICASDI.EQ.'LOGN')THEN
        WRITE(ICOUT,4543)YMEAN
 4543   FORMAT(6X,'MEAN                    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4544)YSD
 4544   FORMAT(6X,'STANDARD DEVIATION      = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4545)NDF
 4545   FORMAT(6X,'DEGRESS OF FREEDOM      = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4546)T10
 4546   FORMAT(6X,'TOLERANCE LIMIT FACTOR  = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICASDI.EQ.'NPAR')THEN
        CONTINUE
      ENDIF
      IF(ICASAN.EQ.'BBAS')THEN
        WRITE(ICOUT,4643)BBASIS
 4643   FORMAT(6X,'B BASIS VALUE           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICASAN.EQ.'ABAS')THEN
        WRITE(ICOUT,4644)ABASIS
 4644   FORMAT(6X,'A BASIS VALUE           = ',G15.7)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      IF(ICASAN.EQ.'BBAS')THEN
        WRITE(ICOUT,4341)
 4341   FORMAT('THE BASIS VALUE WILL BE SAVED AS THE INTERNAL ',
     1         'PARAMETER BBASIS')
        CALL DPWRST('XXX','WRIT')
      ELSEIF(ICASAN.EQ.'ABAS')THEN
        WRITE(ICOUT,4342)
 4342   FORMAT('THE BASIS VALUE WILL BE SAVED AS THE INTERNAL ',
     1         'PARAMETER ABASIS')
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
 4290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ABA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPABA2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPACSA(XTEMP1,MAXNXT,
     1ICASAN,IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--COMPUTE ACCEPTANCE SAMPLING PLANS.  FOLLOWING ARE
C              CURRENTLY SUPPORTED:
C              1) BINOMIAL SINGLE SAMPLE
C              12 BINOMIAL DOUBLE SAMPLE
C     EXAMPLE--SINGLE SAMPLE P1 P2 ALPHA BETA
C            --DOUBLE SAMPLE P1 P2 ALPHA BETA
C     REFERENCE--XX
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--99/3
C     ORIGINAL VERSION--MARCH     1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASAN
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C---------------------------------------------------------------------
C
      DIMENSION XTEMP1(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOST.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='DPAC'
      ISUBN2='SA  '
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
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               *************************************************
C               **  TREAT THE SINGLE SAMPLE PLAN         CASE  **
C               *************************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ACSA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPACSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)NUMARG
   56 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO59I=1,NUMARG
      WRITE(ICOUT,57)I,IHARG(I),IHARG2(I),ARG(I)
   57 FORMAT('I,IHARG(I),IHARG2(I),ARG(I) = ',I5,A4,A4,G15.7)
   59 CONTINUE
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A PARAMETER.)      **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='P'
      MESSAG='YES'
C
      DO1100I=1,NUMNAM
        I2=I
        IF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'P')THEN
           P1=VALUE(I2)
           GOTO1199
        ELSEIF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'V')THEN
           GOTO1190
        ELSEIF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'M')THEN
           GOTO1190
        ENDIF
 1100 CONTINUE
      P1=ARG(1)
      GOTO1199
C
 1190 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1191)
 1191 FORMAT('***** ERROR IN DPACSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1192)
 1192 FORMAT('      FOR THE SINGLE SAMPLE ACCEPTANCE PLAN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1193)
 1193 FORMAT('      THE FIRST ARGUMENT MUST BE A PARAMETER OR SCALAR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1194)
 1194 FORMAT('      (AS OPPOSED TO A VARIABLE OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1195)
 1195 FORMAT('      ARGUMENT 1 WAS NOT A PARAMETER HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1196)
 1196 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1197)(IANS(I),I=1,MIN(IWIDTH,80))
 1197 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1199 CONTINUE
C
C               ****************************************
C               **  STEP 12--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHULD BE A PARAMETER.)      **
C               ****************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(2)
      IH12=IHARG2(2)
      IHWUSE='P'
      MESSAG='YES'
C
      DO1200I=1,NUMNAM
        I2=I
        IF(IH12.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'P')THEN
           P2=VALUE(I2)
           GOTO1299
        ELSEIF(IH12.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'V')THEN
           GOTO1290
        ELSEIF(IH12.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'M')THEN
           GOTO1290
        ENDIF
 1200 CONTINUE
      P2=ARG(2)
      GOTO1299
C
 1290 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1291)
 1291 FORMAT('***** ERROR IN DPACSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1292)
 1292 FORMAT('      FOR THE SINGLE SAMPLE ACCEPTANCE PLAN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1293)
 1293 FORMAT('      THE SECOND ARGUMENT MUST BE A PARAMETER OR SCALAR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1294)
 1294 FORMAT('      (AS OPPOSED TO A VARIABLE OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1295)
 1295 FORMAT('      ARGUMENT 2 WAS NOT A PARAMETER HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1296)
 1296 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1297)(IANS(I),I=1,MIN(IWIDTH,80))
 1297 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1299 CONTINUE
C
C               ****************************************
C               **  STEP 13--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  (THIS SHULD BE A PARAMETER.)      **
C               ****************************************
C
      ISTEPN='13'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(3)
      IH12=IHARG2(3)
      IHWUSE='P'
      MESSAG='YES'
C
      DO1300I=1,NUMNAM
        I2=I
        IF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'P')THEN
           ALPHA=VALUE(I2)
           GOTO1399
        ELSEIF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'V')THEN
           GOTO1390
        ELSEIF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'M')THEN
           GOTO1390
        ENDIF
 1300 CONTINUE
      ALPHA=ARG(3)
      GOTO1399
C
 1390 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1391)
 1391 FORMAT('***** ERROR IN DPACSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1392)
 1392 FORMAT('      FOR THE SINGLE SAMPLE ACCEPTANCE PLAN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1393)
 1393 FORMAT('      THE THIRD ARGUMENT MUST BE A PARAMETER OR SCALAR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1394)
 1394 FORMAT('      (AS OPPOSED TO A VARIABLE OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1395)
 1395 FORMAT('      ARGUMENT 3 WAS NOT A PARAMETER HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1396)
 1396 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1397)(IANS(I),I=1,MIN(IWIDTH,80))
 1397 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1399 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 4  **
C               **  (THIS SHULD BE A PARAMETER.)      **
C               ****************************************
C
      ISTEPN='14'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(4)
      IH12=IHARG2(4)
      IHWUSE='P'
      MESSAG='YES'
C
      DO1400I=1,NUMNAM
        I2=I
        IF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'P')THEN
           BETA=VALUE(I2)
           GOTO1499
        ELSEIF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'V')THEN
           GOTO1490
        ELSEIF(IH11.EQ.IHNAME(I).AND.IH12.EQ.IHNAM2(I).AND.
     1     IUSE(I).EQ.'M')THEN
           GOTO1490
        ENDIF
 1400 CONTINUE
      BETA=ARG(4)
      GOTO1499
C
 1490 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1491)
 1491 FORMAT('***** ERROR IN DPACSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1492)
 1492 FORMAT('      FOR THE SINGLE SAMPLE ACCEPTANCE PLAN.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1493)
 1493 FORMAT('      THE FOURTH ARGUMENT MUST BE A PARAMETER OR SCALAR')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1494)
 1494 FORMAT('      (AS OPPOSED TO A VARIABLE OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1495)
 1495 FORMAT('      ARGUMENT 4 WAS NOT A PARAMETER HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1496)
 1496 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1497)(IANS(I),I=1,MIN(IWIDTH,80))
 1497 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1499 CONTINUE
C
C               ***********************************
C               **  STEP 42--                    **
C               **  CHECK FOR PROPER VALUES FOR  **
C               **  INPUT PARAMETERS             **
C               ***********************************
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(P1.LE.0.0 .OR. P1.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4201)
 4201   FORMAT('***** ERROR FROM DPACSA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4203)
 4203   FORMAT('      THE VALUE OF THE FIRST PARAMETER (P1) MUST ',
     1         'BE IN THE INTERVAL (0,1).')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4205)P1
 4205   FORMAT('      P1 = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(P2.LE.0.0 .OR. P2.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4211)
 4211   FORMAT('***** ERROR FROM DPACSA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4213)
 4213   FORMAT('      THE VALUE OF THE SECOND PARAMETER (P2) MUST ',
     1         'BE IN THE INTERVAL (0,1).')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4215)P2
 4215   FORMAT('      P2 = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(ALPHA.LE.0.0 .OR. ALPHA.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4221)
 4221   FORMAT('***** ERROR FROM DPACSA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4223)
 4223   FORMAT('      THE VALUE OF THE SECOND PARAMETER (ALPHA) MUST ',
     1         'BE IN THE INTERVAL (0,1).')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4225)
 4225   FORMAT('      ALPHA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(BETA.LE.0.0 .OR. BETA.GE.1.0)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4231)
 4231   FORMAT('***** ERROR FROM DPACSA--')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4233)
 4233   FORMAT('      THE VALUE OF THE SECOND PARAMETER (BETA) MUST ',
     1         'BE IN THE INTERVAL (0,1).')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4235)BETA
 4235   FORMAT('      BETA = ',G15.7)
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
      IF(P1.GE.P2)THEN
        WRITE(ICOUT,4231)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4245)P1
 4245   FORMAT('      ACCEPTABLE QUALITY LEVEL, ',F10.5,' IS SET')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,4247)P2
 4247   FORMAT('      HIGHER THAN THE LOT PERCENT DEFECTIVE, ',F10.5,
     1         '.')
        CALL DPWRST('XXX','BUG ')
        IERROR='YES'
        GOTO9000
      ENDIF
C
C               ***********************************
C               **  STEP 52--                    **
C               **  COMPUTE THE ACCEPTANCE PLAN  **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPACSA, AS WE ARE ABOUT TO CALL SSNC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)P1,P2,ALPHA,BETA
 5212 FORMAT('P1,P2,ALPHA,BETA = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      IF(ICASAN.EQ.'SSNC')THEN
        IERROR='NO'
        CALL SSNC(P1,P2,ALPHA,BETA,N,IC,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
        ISTEPN='61'
        IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
        ISUBN0='ACSA'
C
        IH='SSN '
        IH2='    '
        VALUE0=REAL(N)
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
        IH='SSC '
        IH2='    '
        VALUE0=ALPHA
        CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1  IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1  IANS,IWIDTH,IBUGA3,IERROR)
C
      ENDIF
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ACSA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPACSA--')
      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,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IERROR
 9016 FORMAT('IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPADAR(XTEMP1,MAXNXT,ICASDI,
     1ICAPSW,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT ANDERSON-DARLING TEST FOR
C              NORMALITY (ALSO SUPPORT FOR EXPOENNTIAL,
C              EXTREME VALUE, WEIBULL, AND LOGISTIC DISTRIBUTIONS.
C     EXAMPLE--ANDERSON DARLING NORMAL TEST Y X
C            --ANDERSON DARLING WEIBULL TEST Y X
C     REFERENCE--ENCYLEPDIA OF STATISTICS, VOL. 1, PP. 81-85
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --OCTOBER   2003. SUPPORT FOR LOGISTIC
C     UPDATED         --NOVEMBER  2003. SUPPORT FOR UNIFORM (0,1)
C     UPDATED         --NOVEMBER  2003. SUPPORT FOR DOUBLE EXPONENTIAL
C     UPDATED         --APRIL     2004. SUPPORT FOR GENERALIZED PARETO
C     UPDATED         --DECEMBER  2004. SUPPORT FOR GAMMA
C     UPDATED         --FEBRUARY  2005. ADD DPCOS2.INC FOR MINMAX
C     UPDATED         --MAY       2005. SUPPORT FOR FRECHET
C                                       (MAXIMUM CASE)
C     UPDATED         --MAY       2005. SUPPORT FOR CAUCHY
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASDI
      CHARACTER*4 ICAPSW
C
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IH11
      CHARACTER*4 IH12
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
C-------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTAG(MAXOBV)
      DIMENSION QP(MAXOBV)
      DIMENSION XQPHAT(MAXOBV)
      DIMENSION XQPLCL(MAXOBV)
      DIMENSION XQPUCL(MAXOBV)
      DIMENSION XQPSE(MAXOBV)
C
C-----COMMON--------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCOSU.INC'
      INCLUDE 'DPCOS2.INC'
      INCLUDE 'DPCOST.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOZD.INC'
      INCLUDE 'DPCOZZ.INC'
C
      DOUBLE PRECISION DTEMP(MAXOBV)
      EQUIVALENCE (DGARBG(IDGAR1),DTEMP(1))
      EQUIVALENCE (GARBAG(IGARB1),XTAG(1))
      EQUIVALENCE (GARBAG(IGARB2),QP(1))
      EQUIVALENCE (GARBAG(IGARB3),XQPHAT(1))
      EQUIVALENCE (GARBAG(IGARB4),XQPLCL(1))
      EQUIVALENCE (GARBAG(IGARB5),XQPUCL(1))
      EQUIVALENCE (GARBAG(IGARB6),XQPSE(1))
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='DPAD'
      ISUBN2='AR  '
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
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************************
C               **  TREAT THE ANDERSON DARLING TEST CASE  **
C               ********************************************
C
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ADAR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPADAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPADAR--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR ANDERSON DARLING TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,MIN(IWIDTH,80))
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               *******************************************************
C               **  STEP 12--                                        **
C               **  IF ARGUMENT 1 IS A VARIABLE,                     **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1) **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                     **
C               *******************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPADAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH THE ANDERSON DARLING TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,MIN(80,IWIDTH))
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1. **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPADAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH THE ANDERSON DARLING TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,MIN(80,IWIDTH))
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 4.2 --                              **
C               **  CHECK FOR WEIBULL DISTRIBUTION           **
C               **  PARAMETER GAMMA                          **
C               ***********************************************
C
CCCCC   SEPTEMBER 2001.  FOR WEIBULL, CHECK TO SEE IF USER HAS
CCCCC   ENTERED VALUES FOR THE SHAPE AND SCALE PARAMETERS.  IF
CCCCC   NOT, DATAPLOT WILL COMPUTE THE MAXIMUM LIKELIHHOD ESTIMATES.
      IF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'FREC')THEN
        IHP='GAMM'
        IHP2='A   '
        IHWUSE='P'
CCCCC   MESSAG='YES'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          GAMMA=CPUMIN
        ELSE
          GAMMA=VALUE(ILOCP)
        ENDIF
        IHP='BETA'
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          BETA=CPUMIN
        ELSE
          BETA=VALUE(ILOCP)
        ENDIF
      ENDIF
C
C               ***********************************************
C               **  STEP 4.2 --                              **
C               **  CHECK FOR LOGISTIC  DISTRIBUTION         **
C               **  PARAMETERS ALPHA AND BETA                **
C               ***********************************************
C
CCCCC   OCTOBER 2003.  FOR LOGISTIC, CHECK TO SEE IF USER HAS
CCCCC   ENTERED VALUES FOR THE LOCATION AND SCALE PARAMETERS.  IF
CCCCC   NOT, DATAPLOT WILL COMPUTE THE MAXIMUM LIKELIHHOD ESTIMATES.
      IF(ICASDI.EQ.'LOGI')THEN
        IHP='ALPH'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          ALPHA=CPUMIN
        ELSE
          ALPHA=VALUE(ILOCP)
        ENDIF
        IHP='BETA'
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          BETA=CPUMIN
        ELSE
          BETA=VALUE(ILOCP)
        ENDIF
      ENDIF
C
C               **************************************************
C               **  STEP 4.3 --                                 **
C               **  CHECK FOR GENERALIZED PARETO  DISTRIBUTION  **
C               **  PARAMETERS GAMMA AND A                      **
C               **************************************************
C
CCCCC   APRIL 2004.  FOR GENERALIZED PARETO, CHECK TO SEE IF USER HAS
CCCCC   ENTERED VALUES FOR THE SHAPE AND SCALE PARAMETERS.  IF
CCCCC   NOT, DATAPLOT WILL COMPUTE THE MAXIMUM LIKELIHHOD ESTIMATES.
      IF(ICASDI.EQ.'GPAR')THEN
        IHP='GAMM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          GAMMA=CPUMIN
        ELSE
          GAMMA=VALUE(ILOCP)
        ENDIF
        IHP='A   '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          A=CPUMIN
        ELSE
          A=VALUE(ILOCP)
        ENDIF
      ENDIF
C
C               **************************************************
C               **  STEP 4.4 --                                 **
C               **  CHECK FOR GAMMA               DISTRIBUTION  **
C               **  PARAMETERS GAMMA AND SIGMA                  **
C               **************************************************
C
CCCCC   DECEMBER 2004.  FOR GAMMA, CHECK TO SEE IF USER HAS
CCCCC   ENTERED VALUES FOR THE SHAPE AND SCALE PARAMETERS.  IF
CCCCC   NOT, DATAPLOT WILL COMPUTE THE MAXIMUM LIKELIHHOD ESTIMATES.
      IF(ICASDI.EQ.'GAMM')THEN
        IHP='GAMM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          GAMMA=CPUMIN
        ELSE
          GAMMA=VALUE(ILOCP)
        ENDIF
        IHP='SIGM'
        IHP2='A   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          SIGMA=CPUMIN
        ELSE
          SIGMA=VALUE(ILOCP)
        ENDIF
      ENDIF
C
C               **************************************************
C               **  STEP 4.4 --                                 **
C               **  CHECK FOR GUMBEL              DISTRIBUTION  **
C               **  PARAMETERS ALOC  AND SDCALE                 **
C               **************************************************
C
CCCCC   FEBRUARY 2005.  FOR GUMBEL, CHECK TO SEE IF USER HAS
CCCCC   ENTERED VALUES FOR THE LOC AND SCALE PARAMETERS.  IF
CCCCC   NOT, DATAPLOT WILL COMPUTE THE MAXIMUM LIKELIHHOD ESTIMATES.
      IF(ICASDI.EQ.'EXTV')THEN
        IHP='LOC '
        IHP2='    '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          ALOC=CPUMIN
        ELSE
          ALOC=VALUE(ILOCP)
        ENDIF
        IHP='SCAL'
        IHP2='E   '
        IHWUSE='P'
        MESSAG='NO'
        CALL CHECKN(IHP,IHP2,IHWUSE,
     1  IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1  ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
        IF(IERROR.EQ.'YES')THEN
          SCALE=CPUMIN
        ELSE
          SCALE=VALUE(ILOCP)
        ENDIF
      ENDIF
C
C               ***********************************
C               **  STEP 52--                    **
C               **  DO THE ANDERSON DARLING TEST **
C               ***********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPADAR, AS WE ARE ABOUT TO CALL DPADA2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPADA2(Y,NS1,
     1XTEMP1,MAXNXT,ICASDI,MINMAX,GAMMA,BETA,ALPHA,A,SIGMA,
     1ALOC,SCALE,
     1STATVA,CUT90,CUT95,CUT975,CUT99,
     1XTAG,QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,
     1ICAPSW,ICAPTY,DTEMP,
     1IFREBC,
     1ISUBRO,IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 61--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='61'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ISUBN0='DPAN'
C
      IH='STAT'
      IH2='VAL '
      VALUE0=STATVA
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF90'
      VALUE0=CUT90
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF95'
      VALUE0=CUT95
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='F975'
      VALUE0=CUT975
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
C
      IH='CUTO'
      IH2='FF99'
      VALUE0=CUT99
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA3,IERROR)
 
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA2.EQ.'OFF'.AND.ISUBRO.NE.'ADAR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPADAR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPADA2(Y,N,
     1XTEMP,MAXNXT,ICASDI,MINMAX,GAMMA,BETA,ALPHA,A,SIGMA,
     1ALOC,SCALE,
     1STATVA,CUT90,CUT95,CUT975,CUT99,
     1TAG,QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,
     1ICAPSW,ICAPTY,DTEMP,
     1IFREBC,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT THE ANDERSON DARLING TEST
C              FOR EQUALITY TO A DISTRIBUTION
C     EXAMPLE--ANDERSON DARLING NORMALITY TEST Y
C     REFERENCE--ENCYLEPDIA OF STATISTICS, VOL. 1, PP. 81-85.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--97/9
C     ORIGINAL VERSION--SEPTEMBER 1997.
C     UPDATED         --OCTOBER   2001. COSMETIC FIXES IN
C                                       OUTPUT
C     UPDATED         --OCTOBER   2001. SOME FIXES FOR WEIBULL
C                                       REGARDING SHAPE PARAMETER
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C     UPDATED         --OCTOBER   2003. SUPPORT FOR LOGISTIC
C     UPDATED         --NOVEMBER  2003. SUPPORT FOR UNIFORM
C     UPDATED         --NOVEMBER  2003. SUPPORT FOR DOUBLE EXPONENTIAL
C     UPDATED         --APRIL     2004. SUPPORT FOR GENERALIZED PARETO
C     UPDATED         --DECEMBER  2004. SUPPORT FOR GAMMA
C     UPDATED         --FEBRUARY  2005. DOUBLE EXPONENTIAL: CHECK FOR
C                                       PRE-DEFINED LOCATION AND
C                                       SCALE PARAMETERS
C     UPDATED         --MAY       2005. SUPPRESS OUTPUT FROM
C                                       MAXIMUM LIKELIHOOD ROUTINES
C                                       FOR A FEW DISTRIBUTIONS
C     UPDATED         --MAY       2005. FRECHET (MAXIMUM)
C     UPDATED         --MAY       2005. CAUCHY (MAXIMUM)
C     UPDATED         --AUGUST    2005. GENERALIZED PARETO MLE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DSUM1
      DOUBLE PRECISION DSUM2
      DOUBLE PRECISION TOL
      DOUBLE PRECISION XPAR(2)
      DOUBLE PRECISION FVEC(2)
C
      REAL GPTABL(10,9)
      REAL GATABL(12,6)
      REAL CATABL(13,6)
C
      CHARACTER*4 ICASDI
      CHARACTER*20 IDIST
C
      CHARACTER*1 IBASLC
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*4 IGEPDF
      CHARACTER*4 IFREBC
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
      CHARACTER*4 IPRISV
C
      CHARACTER*6 ICONC1
      CHARACTER*6 ICONC2
      CHARACTER*6 ICONC3
      CHARACTER*6 ICONC4
C
      CHARACTER*4 ICENTY
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION XTEMP(*)
      DIMENSION TAG(*)
      DIMENSION QP(*)
      DIMENSION XQPHAT(*)
      DIMENSION XQPLCL(*)
      DIMENSION XQPUCL(*)
      DIMENSION XQPSE(*)
      DOUBLE PRECISION DTEMP(*)
C
      EXTERNAL GPAFUN
C
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*4 ISUBN0
C
      INCLUDE 'DPCOF2.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      DATA PI / 3.14159265358979 /
C
      DATA (GPTABL(1,J),J=1,8)/
     1 0.339, 0.471, 0.641, 0.771, 0.905, 1.086, 1.226, 1.559/
      DATA (GPTABL(2,J),J=1,8)/
     1 0.356, 0.499, 0.685, 0.830, 0.978, 1.180, 1.336, 1.707/
      DATA (GPTABL(3,J),J=1,8)/
     1 0.376, 0.534, 0.741, 0.903, 1.069, 1.296, 1.471, 1.893/
      DATA (GPTABL(4,J),J=1,8)/
     1 0.386, 0.550, 0.766, 0.935, 1.110, 1.348, 1.532, 1.966/
      DATA (GPTABL(5,J),J=1,8)/
     1 0.397, 0.569, 0.796, 0.974, 1.158, 1.409, 1.603, 2.064/
      DATA (GPTABL(6,J),J=1,8)/
     1 0.410, 0.591, 0.831, 1.020, 1.215, 1.481, 1.687, 2.176/
      DATA (GPTABL(7,J),J=1,8)/
     1 0.426, 0.617, 0.873, 1.074, 1.283, 1.567, 1.788, 2.314/
      DATA (GPTABL(8,J),J=1,8)/
     1 0.445, 0.649, 0.924, 1.140, 1.365, 1.672, 1.909, 2.475/
      DATA (GPTABL(9,J),J=1,8)/
     1 0.468, 0.688, 0.985, 1.221, 1.465, 1.799, 2.058, 2.674/
      DATA (GPTABL(10,J),J=1,8)/
     1 0.496, 0.735, 1.061, 1.321, 1.590, 1.958, 2.243, 2.922/
C
      DATA (GATABL(I,1),I=1,12)/
     1 0.486, 0.477, 0.475, 0.473, 0.472, 0.472, 0.471,
     1 0.471, 0.471, 0.470, 0.470, 0.470 /
      DATA (GATABL(I,2),I=1,12)/
     1 0.657, 0.643, 0.639, 0.637, 0.635, 0.635, 0.634,
     1 0.633, 0.633, 0.632, 0.632, 0.631 /
      DATA (GATABL(I,3),I=1,12)/
     1 0.786, 0.768, 0.762, 0.759, 0.758, 0.757, 0.755,
     1 0.754, 0.754, 0.754, 0.753, 0.752 /
      DATA (GATABL(I,4),I=1,12)/
     1 0.917, 0.894, 0.886, 0.883, 0.881, 0.880, 0.878,
     1 0.877, 0.876, 0.876, 0.875, 0.873 /
      DATA (GATABL(I,5),I=1,12)/
     1 1.092, 1.062, 1.052, 1.048, 1.045, 1.043, 1.041,
     1 0.040, 1.039, 1.038, 1.037, 1.035 /
      DATA (GATABL(I,6),I=1,12)/
     1 1.227, 1.190, 1.178, 1.173, 1.170, 1.168, 1.165,
     1 1.164, 1.163, 1.162, 1.161, 1.159 /
C
      DATA (CATABL(I,1),I=1,13)/
     1 0.835, 0.992, 1.04,  1.04,  1.02,  0.975, 0.914,
     1 0.875, 0.812, 0.774, 0.743, 0.689, 0.615 /
      DATA (CATABL(I,2),I=1,13)/
     1 1.14,  1.52,  1.63,  1.65,  1.61,  1.51,  1.40,
     1 1.30,  1.16,  1.08,  1.02,  0.927, 0.780 /
      DATA (CATABL(I,3),I=1,13)/
     1 1.40,  2.06,  2.27,  2.33,  2.28,  2.12,  1.94,
     1 1.76,  1.53,  1.41,  1.30,  1.14,  0.949 /
      DATA (CATABL(I,4),I=1,13)/
     1 1.77,  3.20,  3.77,  4.14,  4.25,  4.05,  3.57,
     1 3.09,  2.48,  2.14,  1.92,  1.52,  1.225 /
      DATA (CATABL(I,5),I=1,13)/
     1 2.00,  4.27,  5.58,  6.43,  7.20,  7.58,  6.91,
     1 5.86,  4.23,  3.37,  2.76,  2.05,  1.52  /
      DATA (CATABL(I,6),I=1,13)/
     1 2.16,  5.24,  7.50,  9.51, 11.50, 14.57, 14.96,
     113.80, 10.20,  7.49,  5.32,  3.30,  1.90  /
C
      ISUBN1='DPAD'
      ISUBN2='A2  '
C
      ICENTY='NULL'
      IERROR='NO'
C
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ADA2')THEN
        WRITE(ICOUT,999)
  999   FORMAT(1X)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,51)
   51   FORMAT('**** AT THE BEGINNING OF DPADA2--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,52)IBUGA3
   52   FORMAT('IBUGA3 = ',A4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,55)N
   55   FORMAT('N = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO56I=1,N
         WRITE(ICOUT,57)I,Y(I)
   57    FORMAT('I,Y(I) = ',I8,E15.7)
         CALL DPWRST('XXX','WRIT')
   56   CONTINUE
        WRITE(ICOUT,65)ICASDI
   65   FORMAT('ICASDI = ',A4)
        CALL DPWRST('XXX','WRIT')
      ENDIF
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ADA2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.1)THEN
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1111)
 1111   FORMAT('***** ERROR IN ANDERSON-DARLING TEST--')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1112)
 1112   FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE RESPONSE')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1113)
 1113   FORMAT('      VARIABLE IS LESS THAN OR EQUAL TO 1')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,1114)N
 1114   FORMAT('      SAMPLE SIZE = ',I8)
        CALL DPWRST('XXX','WRIT')
        IERROR='YES'
        GOTO9000
      ENDIF
C
      HOLD=Y(1)
      DO1135I=2,N
        IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('      THE RESPONSE VARIABLE HAS ALL ELEMENTS = ',
     1       E15.7)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               ******************************
C               **  STEP 41--               **
C               **  CARRY OUT CALCULATIONS  **
C               **  FOR ANDERSON DARLING    **
C               **  TEST                    **
C               ******************************
C
 2100 CONTINUE
C
      ISTEPN='21'
      IF(IBUGA3.EQ.'ON' .OR. ISUBRO.EQ.'ADA2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IWRITE='OFF'
      CALL SORT(Y,N,Y)
      IF(ICASDI.EQ.'LOGN' .OR.ICASDI.EQ.'WEIB' .OR.
     1   ICASDI.EQ.'GPAR' .OR. ICASDI.EQ.'GAMM' .OR.
     1   ICASDI.EQ.'FREC')THEN
        DO2105I=1,N
          IF(Y(I).LE.0.0)THEN
            IF(ICASDI.EQ.'GPAR')THEN
              IF(Y(I).EQ.0.0)GOTO2105
              WRITE(ICOUT,13107)
              CALL DPWRST('XXX','WRIT')
            ELSEIF(ICASDI.EQ.'LOGN')THEN
              WRITE(ICOUT,2107)
              CALL DPWRST('XXX','WRIT')
            ELSEIF(ICASDI.EQ.'GAMM')THEN
              WRITE(ICOUT,14107)
              CALL DPWRST('XXX','WRIT')
            ELSEIF(ICASDI.EQ.'FREC')THEN
              WRITE(ICOUT,15107)
              CALL DPWRST('XXX','WRIT')
            ELSE
              WRITE(ICOUT,12107)
              CALL DPWRST('XXX','WRIT')
            END IF
            WRITE(ICOUT,2108)
            CALL DPWRST('XXX','WRIT')
            IERROR='YES'
            GOTO9000
          ELSE
            IF(ICASDI.EQ.'LOGN')Y(I)=LOG(Y(I))
          ENDIF
 2105   CONTINUE
C  DECEMBER 2001.  CHANGE ALGORITHM FOR EV1 CASE.  DO
CCCCC ELSEIF(ICASDI.EQ.'EXTV')THEN
CCCCC    DO2102I=1,N
CCCCC      Y(I)=EXP(Y(I))
CCCCC      IF(Y(I).LE.1.0E-13)Y(I)=1.0E-13
C2102    CONTINUE
CCCCC NOVEMBER 2003. FOR UNIFORM (0,1), CHECK THAT DATA IS
CCCCC IN THE (0,1) INTERVAL.
      ELSEIF(ICASDI.EQ.'UNIF')THEN
         DO2122I=1,N
           IF(Y(I).LT.0.0 .OR. Y(I).GT.1.0)THEN
             WRITE(ICOUT,2127)
             CALL DPWRST('XXX','WRIT')
             WRITE(ICOUT,2128)
             CALL DPWRST('XXX','WRIT')
             IERROR='YES'
             GOTO9000
           ENDIF
 2122    CONTINUE
      ENDIF
 2107 FORMAT('***** ERROR FROM ANDERSON-DARLING LOGNORMAL ',
     1       'TEST.')
12107 FORMAT('***** ERROR FROM ANDERSON-DARLING WEIBULL ',
     1       'TEST.')
13107 FORMAT('***** ERROR FROM ANDERSON-DARLING GENERALIZED ',
     1       'PARETO TEST.')
14107 FORMAT('***** ERROR FROM ANDERSON-DARLING GAMMA TEST.')
15107 FORMAT('***** ERROR FROM ANDERSON-DARLING FRECHET (MAXIMUM) ',
     1       'TEST.')
 2108 FORMAT('      A NON-POSITIVE NUMBER WAS ENCOUNTERED.')
 2127 FORMAT('***** ERROR FROM ANDERSON-DARLING UNIFORM (0,1) ',
     1       'TEST.')
 2128 FORMAT('      A NUMBER OUTSIDE THE (0,1) INTERVAL WAS ',
     1       'ENCOUNTERED.')
C
      CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
      CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ADA2')THEN
        WRITE(ICOUT,2109)YMEAN,YSD
        CALL DPWRST('XXX','BUG')
      ENDIF
 2109 FORMAT('YMEAN,YSD=',2E15.7)
C
      IF(ICASDI.EQ.'NORM')THEN
        DO2200I=1,N
          Y(I)=(Y(I)-YMEAN)/YSD
          CALL NORCDF(Y(I),XTEMP(I))
 2200   CONTINUE
      ELSEIF(ICASDI.EQ.'LOGN')THEN
        DO2205I=1,N
          Y(I)=(Y(I)-YMEAN)/YSD
          CALL NORCDF(Y(I),XTEMP(I))
 2205   CONTINUE
      ELSEIF(ICASDI.EQ.'EXPO')THEN
        DO2210I=1,N
          Y(I)=Y(I)/YMEAN
          IF(Y(I).LE.0.0)THEN
            WRITE(ICOUT,2201)
 2201       FORMAT('***** ERROR FROM ANDERSON-DARLING EXPONENTIAL ',
     1             'TEST.')
            CALL DPWRST('XXX','BUG')
            WRITE(ICOUT,2203)
 2203       FORMAT('      A NON-POSITIVE NUMBER WAS ENCOUNTERED.')
            CALL DPWRST('XXX','BUG')
            IERROR='YES'
            GOTO9000
          ENDIF
          CALL EXPCDF(Y(I),XTEMP(I))
 2210   CONTINUE
      ELSEIF(ICASDI.EQ.'LOGI')THEN
        IF(ALPHA.EQ.CPUMIN.OR.BETA.EQ.CPUMIN.OR.BETA.LE.0.0)THEN
          CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
          CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
C
          IPRISV=IPRINT
          IPRINT='OFF'
          CALL DPMLLO(Y,N,
     1                XTEMP,MAXNXT,
     1                ALPHA,BETA,
     1                ICAPSW,ICAPTY,DTEMP,
     1                ISUBRO,IBUGA3,IERROR)
          IPRINT=IPRISV
        ENDIF
        DO2207I=1,N
          Y(I)=(Y(I)-ALPHA)/BETA
          CALL LOGCDF(Y(I),XTEMP(I))
 2207   CONTINUE
      ELSEIF(ICASDI.EQ.'WEIB')THEN
        IF(GAMMA.NE.CPUMIN.AND.BETA.NE.CPUMIN)THEN
          ALPHA=BETA
          BETA=GAMMA
        ELSE
          CALL WBLEST(Y,N,ALPHA,BETA,IERROR)
        ENDIF
        IF(IERROR.EQ.'YES')THEN
          WRITE(ICOUT,2235)
 2235     FORMAT('***** ERROR IN COMPUTING THE WEIBULL MAXIMUM ',
     1           'LIKELIHOOD ESTIMATES.')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ENDIF
        DO2230I=1,N
          Y(I)=(Y(I)/ALPHA)**BETA
          IF(Y(I).LE.0.0)THEN
            WRITE(ICOUT,2231)
 2231       FORMAT('***** ERROR FROM ANDERSON-DARLING WEIBULL ',
     1             'TEST.')
            CALL DPWRST('XXX','BUG')
            WRITE(ICOUT,2213)
 2213       FORMAT('      A NON-POSITIVE NUMBER WAS ENCOUNTERED.')
            CALL DPWRST('XXX','BUG')
            IERROR='YES'
            GOTO9000
          ENDIF
          XTEMP(I)=1.0-EXP(-Y(I))
          IF(XTEMP(I).LE.1.0E-13)XTEMP(I)=Y(I)
CCCCC     CALL WEICDF(Y(I),GAMMA,MINMAX,XTEMP(I))
 2230   CONTINUE
      ELSEIF(ICASDI.EQ.'EXTV')THEN
CCCCC   DECEMBER 2001.  I HAD THE ALGORITHM WRONG FOR
CCCCC   THE EV1 CASE.  WENT BACK TO STEPHENS ARTICLE AND
CCCCC   COMPUTED IT CORRECTLY.
CCCCC   CALL WBLEST(Y,N,ALPHA,BETA,IERROR)
        IF(ALOC.EQ.CPUMIN.OR.SCALE.EQ.CPUMIN.OR.SCALE.LE.0.0)THEN
          CALL EV1EST(Y,N,ALOC,ASCALE,LOC2,SCALE2,MINMAX,IERROR)
          IF(IERROR.EQ.'YES')THEN
            WRITE(ICOUT,2245)
 2245       FORMAT('***** ERROR IN COMPUTING THE EXTREME VALUE ',
     1           'MAXIMUM LIKELIHOOD ESTIMATES.')
            CALL DPWRST('XXX','WRIT')
            GOTO9000
          ENDIF
        ELSE
          ASCALE=SCALE
        ENDIF
        DO2240I=1,N
CCCCC     Y(I)=(Y(I)/ALPHA)**BETA
CCCCC     XTEMP(I)=1.0-EXP(-Y(I))
CCCCC     IF(XTEMP(I).LE.1.0E-13)XTEMP(I)=Y(I)
          YTEMP=(Y(I)-ALOC)/ASCALE
CCCCC     MINMX=2
          CALL EV1CDF(YTEMP,MINMAX,CDF)
          XTEMP(I)=CDF
 2240   CONTINUE
      ELSEIF(ICASDI.EQ.'UNIF')THEN
        IF(N.LT.5)THEN
          WRITE(ICOUT,2255)
 2255     FORMAT('***** FOR UNIFORM ANDERSON-DARLING TEST, ',
     1           'AT LEAST FIVE OBSERVATIONS REQUIRED.')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,2258)N
 2258     FORMAT('      THE SAMPLE SIZE IS ',I8)
          CALL DPWRST('XXX','WRIT')
          IERROR='YES'
          GOTO9000
        ENDIF
        DO2250I=1,N
          CALL UNICDF(Y(I),XTEMP(I))
 2250   CONTINUE
      ELSEIF(ICASDI.EQ.'GAMM')THEN
        IF(GAMMA.NE.CPUMIN.AND.BETA.NE.CPUMIN)THEN
          SCALE=BETA
          SHAPE=GAMMA
        ELSE
          CALL GAMEST(Y,N,SCALE,SHAPE,IERROR)
        ENDIF
        IF(IERROR.EQ.'YES')THEN
          WRITE(ICOUT,3235)
 3235     FORMAT('***** ERROR IN COMPUTING THE GAMMA MAXIMUM ',
     1           'LIKELIHOOD ESTIMATES.')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ENDIF
        DO3230I=1,N
          Y(I)=Y(I)/SCALE
          CALL GAMCDF(Y(I),SHAPE,XTEMP(I))
 3230   CONTINUE
      ELSEIF(ICASDI.EQ.'DEXP')THEN
C
        IPRISV=IPRINT
        IPRINT='OFF'
        CALL DPMLDE(Y,N,
     1              XTEMP,MAXNXT,
     1              ALOC,SCALE,ALOCSE,SCALSE,
     1              ICAPSW,ICAPTY,
     1              ISUBRO,IBUGA3,IERROR)
        IPRINT=IPRISV
        DO2261I=1,N
          Y(I)=(Y(I)-ALOC)/SCALE
          CALL DEXCDF(Y(I),XTEMP(I))
 2261   CONTINUE
C
      ELSEIF(ICASDI.EQ.'GPAR')THEN
        IF(GAMMA.EQ.CPUMIN.OR.A.EQ.CPUMIN.OR.A.LE.0.0)THEN
          CALL MEAN(Y,N,IWRITE,YMEAN,IBUGA3,IERROR)
          CALL SD(Y,N,IWRITE,YSD,IBUGA3,IERROR)
C
          IOUNI1=IST1NU
          IFILE1=IST1NA
          ISTAT1=IST1ST
          IFORM1=IST1FO
          IACCE1=IST1AC
          IPROT1=IST1PR
          ICURS1=IST1CS
          ISUBN0='ADA2'
          IERRF1='NO'
C
          IREWI1='ON'
          CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1                IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
          IF(IERRF1.EQ.'YES')GOTO9000
C
          IOUNI2=IST2NU
          IFILE2=IST2NA
          ISTAT2=IST2ST
          IFORM2=IST2FO
          IACCE2=IST2AC
          IPROT2=IST2PR
          ICURS2=IST2CS
          ISUBN0='MLWE'
          IERRF2='NO'
C
          IREWI2='ON'
          CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
          IF(IERRF2.EQ.'YES')GOTO9000
C
          IPRISV=IPRINT
          IPRINT='OFF'
C
CCCCC     AUGUST 2005: CALL LIST TO DPMLGP GREATLY EXPANDED.  EASIER TO
CCCCC                  JUST INCLUDE ML CODE INLINE.
C
CCCCC     CALL DPMLGP(Y,N,
CCCCC1                XTEMP,MAXNXT,
CCCCC1                GAMMMO,AMOM,GAMMML,AML,
CCCCC1                ICAPSW,ICAPTY,DTEMP,
CCCCC1                IGEPDF,IOUNI1,IOUNI2,
CCCCC1                ISUBRO,IBUGA3,IERROR)
C
          CALL MEAN(Y,N,IWRITE,XMEAN,IBUGA3,IERROR)
          CALL SD(Y,N,IWRITE,XSD,IBUGA3,IERROR)
          XVAR=XSD**2
C
          GAMMA1=0.5*(XMEAN*XMEAN/XVAR - 1.0)
          SCALE1=0.5*XMEAN*(XMEAN*XMEAN/XVAR + 1.0)
          XPAR(1)=DBLE(GAMMA1)
          XPAR(2)=DBLE(SCALE1)
C
          IOPT=2
          TOL=1.0D-6
          NVAR=2
          NPRINT=-1
          INFO=0
          LWA=MAXNXT
          CALL DNSQE(GPAFUN,JAC,IOPT,NVAR,XPAR,FVEC,TOL,NPRINT,INFO,
     1               DTEMP1,MAXNXT,Y,N)
C
          GAMMML=REAL(XPAR(1))
          AML=REAL(XPAR(2))
C
          IPRINT=IPRISV
CCCCC     GAMMML=GAMMMO
CCCCC     AML=AMOM
          IENDF1='OFF'
          IREWI1='ON'
          CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1                IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
          IF(IERRF1.EQ.'YES')GOTO9000
C
          IENDF2='OFF'
          IREWI2='ON'
          CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1                IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
          IF(IERRF1.EQ.'YES')GOTO9000
C
        ELSE
          GAMMML=GAMMA
          AML=A
        ENDIF
        IF(GAMMML.GT.0.0 .AND. IGEPDF.EQ.'JOHN')THEN
          DO2271I=1,N
            IF(Y(I).GT.AML/GAMMML)THEN
              WRITE(ICOUT,2273)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,2274)I
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,2275)GAMMML,AML
              CALL DPWRST('XXX','WRIT')
              IERROR='YES'
              GOTO9000
            ENDIF
 2271     CONTINUE
        ELSEIF(GAMMML.LT.0.0 .AND. IGEPDF.EQ.'SIMI')THEN
          DO22271I=1,N
            IF(Y(I).GT.-AML/GAMMML)THEN
              WRITE(ICOUT,22273)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,22274)I
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,22275)GAMMML,AML
              CALL DPWRST('XXX','WRIT')
              IERROR='YES'
              GOTO9000
            ENDIF
22271     CONTINUE
        ENDIF
 2273   FORMAT('***** FOR GENERALIZED PARETO ANDERSON-DARLING TEST--')
 2274   FORMAT('      ROW ',I8, ' IS GREATER THAN GAMMA/SCALE')
 2275   FORMAT('      GAMMA = ',G15.7,' AND SCALE = ',G15.7)
22273   FORMAT('***** FOR GENERALIZED PARETO ANDERSON-DARLING TEST--')
22274   FORMAT('      ROW ',I8, ' IS GREATER THAN -GAMMA/SCALE')
22275   FORMAT('      GAMMA = ',G15.7,' AND SCALE = ',G15.7)
C
        MINMXT=2
        IGEPDF='JOHN'
        DO2277I=1,N
          Y(I)=Y(I)/AML
          CALL GEPCDF(Y(I),GAMMML,MINMXT,IGEPDF,XTEMP(I))
 2277   CONTINUE
      ELSEIF(ICASDI.EQ.'FREC')THEN
        IF(GAMMA.NE.CPUMIN.AND.BETA.NE.CPUMIN)THEN
          ALPHA=BETA
          BETA=GAMMA
        ELSE
          IPRISV=IPRINT
          IPRINT='OFF'
          NUMV=1
          NPERC=0
          CALL DPMLFR(Y,TAG,N,
     1                XTEMP,DTEMP,MAXNXT,
     1                SCALE,SCALSE,GAMMA,GAMMSE,GAMMBC,GABCSE,
     1                COVSE,COBCSE,
     1                NUMV,ICENTY,TEND,
     1                ICAPSW,ICAPTY,IFREBC,
     1                QP,XQPHAT,XQPLCL,XQPUCL,XQPSE,NPERC,
     1                IOUNI1,IOUNI2,ALPHAP,
     1                ISUBRO,IBUGA3,IERROR)
          IPRINT=IPRISV
          ALPHA=SCALE
          BETA=GAMMA
        ENDIF
        IF(IERROR.EQ.'YES')THEN
          WRITE(ICOUT,2335)
 2335     FORMAT('***** ERROR IN COMPUTING THE FRECHET MAXIMUM ',
     1           'LIKELIHOOD ESTIMATES.')
          CALL DPWRST('XXX','WRIT')
          GOTO9000
        ENDIF
        MINMX2=2
        DO2330I=1,N
          Y(I)=Y(I)/ALPHA
          CALL EV2CDF(Y(I),GAMMA,MINMX2,XTEMP(I))
 2330   CONTINUE
      ELSEIF(ICASDI.EQ.'CAUC')THEN
C
C STEP 1: ESTIMATE LOCATION AND SCALE VIA SUMS OF WEIGHTED ORDER
C         STATISTICS.
C
        DSUM1=0.0D0
        DSUM2=0.0D0
        DO2410I=1,N
          TERM1=REAL(I)/REAL(N+1) - 0.5
          ANUM=SIN(4.0*PI*TERM1)
          ADENOM=REAL(N)*SIN(PI*TERM1)/COS(PI*TERM1)
          DSUM1=DSUM1 + DBLE(ANUM/ADENOM)*DBLE(Y(I))
          ANUM=8.0*SIN(PI*TERM1)/COS(PI*TERM1)
          TERM2=COS(PI*TERM1)
          IF(TERM2.NE.0.0)THEN
            TERM2=1.0/TERM2
          ELSE
            TERM2=1.0/0.0000001
          ENDIF
          ADENOM=REAL(N)*TERM2**4
          DSUM2=DSUM2 + DBLE(ANUM/ADENOM)*DBLE(Y(I))
 2410   CONTINUE
        ALOC=REAL(DSUM1)
        ASCALE=REAL(DSUM2)
C
        DO2461I=1,N
          Y(I)=(Y(I)-ALOC)/ASCALE
          CALL CAUCDF(Y(I),XTEMP(I))
 2461   CONTINUE
C
      ENDIF
C
      DSUM1=0.D0
      DO3100I=1,N
        ATEMP1=XTEMP(I)
        ATEMP2=1.0-XTEMP(N+1-I)
        IF(ATEMP1.LE.0.0)ATEMP1=0.1E-35
        IF(ATEMP2.LE.0.0)ATEMP2=0.1E-35
        DTERM1=(2.0D0*DBLE(I)-1.0D0)
        DTERM2=DLOG(DBLE(ATEMP1)) + DLOG(DBLE(ATEMP2))
        DSUM1=DSUM1 + DTERM1*DTERM2
 3100 CONTINUE
      A2=-REAL(DSUM1)/REAL(N) - REAL(N)
C
      IF(ICASDI.EQ.'NORM'.OR.ICASDI.EQ.'LOGN')THEN
CCCCC   STATVA=A2*(1.0 + 0.3/REAL(N))
        STATVA=A2*(1.0 + 4.0/REAL(N) - 25.0/(REAL(N)*REAL(N)))
        IF(N.GT.100)THEN
          CUT90=0.656
          CUT95=0.787
          CUT975=0.918
          CUT99=1.092
        ELSEIF(N.GT.50)THEN
          CUT90=0.631
          CUT95=0.754
          CUT975=0.884
          CUT99=1.047
        ELSEIF(N.GT.20)THEN
          CUT90=0.616
          CUT95=0.735
          CUT975=0.861
          CUT99=1.021
        ELSEIF(N.GT.10)THEN
          CUT90=0.591
          CUT95=0.704
          CUT975=0.815
          CUT99=0.969
        ELSE
          CUT90=0.578
          CUT95=0.683
          CUT975=0.779
          CUT99=0.926
        ENDIF
      ELSEIF(ICASDI.EQ.'EXPO')THEN
        STATVA=A2*(1.0 + 0.6/REAL(N))
        IF(N.GT.100)THEN
          CUT90=1.078
          CUT95=1.341
          CUT975=1.606
          CUT99=1.957
        ELSEIF(N.GT.50)THEN
          CUT90=1.070
          CUT95=1.330
          CUT975=1.595
          CUT99=1.951
        ELSEIF(N.GT.20)THEN
          CUT90=1.062
          CUT95=1.323
          CUT975=1.582
          CUT99=1.945
        ELSEIF(N.GT.10)THEN
          CUT90=1.045
          CUT95=1.300
          CUT975=1.556
          CUT99=1.927
        ELSE
          CUT90=1.022
          CUT95=1.265
          CUT975=1.515
          CUT99=1.888
        ENDIF
      ELSEIF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'FREC')THEN
        STATVA=(1.0+0.2/SQRT(REAL(N)))*A2
        CUT90=0.637
        CUT95=0.757
        CUT975=0.877
        CUT99=1.038
      ELSEIF(ICASDI.EQ.'EXTV')THEN
        STATVA=(1.0+1.0/(5.0*SQRT(REAL(N))))*A2
        CUT90=0.637
        CUT95=0.757
        CUT975=0.877
        CUT99=1.038
      ELSEIF(ICASDI.EQ.'LOGI')THEN
        STATVA=A2*(1.0+0.25/REAL(N))
        CUT90=0.563
        CUT95=0.660
        CUT975=0.769
        CUT99=0.906
      ELSEIF(ICASDI.EQ.'UNIF')THEN
        STATVA=A2
        CUT90=1.933
        CUT95=2.492
        CUT975=3.070
        CUT99=3.857
      ELSEIF(ICASDI.EQ.'GAMM')THEN
        STATVA=A2
        IF(SHAPE.LE.1.5)THEN
          CUT90 =GATABL(1,2)
          CUT95 =GATABL(1,3)
          CUT975=GATABL(1,4)
          CUT99 =GATABL(1,5)
        ELSEIF(SHAPE.LE.2.5)THEN
          CUT90 =GATABL(2,2)
          CUT95 =GATABL(2,3)
          CUT975=GATABL(2,4)
          CUT99 =GATABL(2,5)
        ELSEIF(SHAPE.LE.3.5)THEN
          CUT90 =GATABL(3,2)
          CUT95 =GATABL(3,3)
          CUT975=GATABL(3,4)
          CUT99 =GATABL(3,5)
        ELSEIF(SHAPE.LE.4.5)THEN
          CUT90 =GATABL(4,2)
          CUT95 =GATABL(4,3)
          CUT975=GATABL(4,4)
          CUT99 =GATABL(4,5)
        ELSEIF(SHAPE.LE.5.5)THEN
          CUT90 =GATABL(5,2)
          CUT95 =GATABL(5,3)
          CUT975=GATABL(5,4)
          CUT99 =GATABL(5,5)
        ELSEIF(SHAPE.LE.7.0)THEN
          CUT90 =GATABL(6,2)
          CUT95 =GATABL(6,3)
          CUT975=GATABL(6,4)
          CUT99 =GATABL(6,5)
        ELSEIF(SHAPE.LE.9.0)THEN
          CUT90 =GATABL(7,2)
          CUT95 =GATABL(7,3)
          CUT975=GATABL(7,4)
          CUT99 =GATABL(7,5)
        ELSEIF(SHAPE.LE.11.0)THEN
          CUT90 =GATABL(8,2)
          CUT95 =GATABL(8,3)
          CUT975=GATABL(8,4)
          CUT99 =GATABL(8,5)
        ELSEIF(SHAPE.LE.13.5)THEN
          CUT90 =GATABL(9,2)
          CUT95 =GATABL(9,3)
          CUT975=GATABL(9,4)
          CUT99 =GATABL(9,5)
        ELSEIF(SHAPE.LE.17.5)THEN
          CUT90 =GATABL(10,2)
          CUT95 =GATABL(10,3)
          CUT975=GATABL(10,4)
          CUT99 =GATABL(10,5)
        ELSEIF(SHAPE.LE.22.5)THEN
          CUT90 =GATABL(11,2)
          CUT95 =GATABL(11,3)
          CUT975=GATABL(11,4)
          CUT99 =GATABL(11,5)
        ELSE
          CUT90 =GATABL(12,2)
          CUT95 =GATABL(12,3)
          CUT975=GATABL(12,4)
          CUT99 =GATABL(12,5)
        ENDIF
      ELSEIF(ICASDI.EQ.'GPAR')THEN
        STATVA=A2
        G=GAMMML
        IF(G.LE.-0.90)THEN
          CUT90=GPTABL(1,3)
          CUT95=GPTABL(1,4)
          CUT975=GPTABL(1,5)
          CUT99=GPTABL(1,6)
        ELSEIF(G.GE.0.50)THEN
          CUT90=GPTABL(10,3)
          CUT95=GPTABL(10,4)
          CUT975=GPTABL(10,5)
          CUT99=GPTABL(10,6)
        ELSEIF(G.GT.-0.90 .AND. G.LE.-0.50)THEN
          A1=-0.5
          A2=-0.9
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(1,3) + AFACT*(GPTABL(2,3)-GPTABL(1,3))
          CUT95= GPTABL(1,4) + AFACT*(GPTABL(2,4)-GPTABL(1,4))
          CUT975=GPTABL(1,5) + AFACT*(GPTABL(2,5)-GPTABL(1,5))
          CUT99= GPTABL(1,6) + AFACT*(GPTABL(2,6)-GPTABL(1,6))
        ELSEIF(G.GT.-0.50 .AND. G.LE.-0.20)THEN
          A1=-0.2
          A2=-0.5
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(2,3) + AFACT*(GPTABL(3,3)-GPTABL(2,3))
          CUT95= GPTABL(2,4) + AFACT*(GPTABL(3,4)-GPTABL(2,4))
          CUT975=GPTABL(2,5) + AFACT*(GPTABL(3,5)-GPTABL(2,5))
          CUT99= GPTABL(2,6) + AFACT*(GPTABL(3,6)-GPTABL(2,6))
        ELSEIF(G.GT.-0.20 .AND. G.LE.-0.10)THEN
          A1=-0.1
          A2=-0.2
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(3,3) + AFACT*(GPTABL(4,3)-GPTABL(3,3))
          CUT95= GPTABL(3,4) + AFACT*(GPTABL(4,4)-GPTABL(3,4))
          CUT975=GPTABL(3,5) + AFACT*(GPTABL(4,5)-GPTABL(3,5))
          CUT99= GPTABL(3,6) + AFACT*(GPTABL(4,6)-GPTABL(3,6))
        ELSEIF(G.GT.-0.10 .AND. G.LE.0.0)THEN
          A1=0.0
          A2=-0.1
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(4,3) + AFACT*(GPTABL(5,3)-GPTABL(4,3))
          CUT95= GPTABL(4,4) + AFACT*(GPTABL(5,4)-GPTABL(4,4))
          CUT975=GPTABL(4,5) + AFACT*(GPTABL(5,5)-GPTABL(4,5))
          CUT99= GPTABL(4,6) + AFACT*(GPTABL(5,6)-GPTABL(4,6))
        ELSEIF(G.GT.0.0 .AND. G.LE.0.10)THEN
          A1=0.1
          A2=0.0
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(5,3) + AFACT*(GPTABL(6,3)-GPTABL(5,3))
          CUT95= GPTABL(5,4) + AFACT*(GPTABL(6,4)-GPTABL(5,4))
          CUT975=GPTABL(5,5) + AFACT*(GPTABL(6,5)-GPTABL(5,5))
          CUT99= GPTABL(5,6) + AFACT*(GPTABL(6,6)-GPTABL(5,6))
        ELSEIF(G.GT.0.10 .AND. G.LE.0.20)THEN
          A1=0.2
          A2=0.1
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(6,3) + AFACT*(GPTABL(7,3)-GPTABL(6,3))
          CUT95= GPTABL(6,4) + AFACT*(GPTABL(7,4)-GPTABL(6,4))
          CUT975=GPTABL(6,5) + AFACT*(GPTABL(7,5)-GPTABL(6,5))
          CUT99= GPTABL(6,6) + AFACT*(GPTABL(7,6)-GPTABL(6,6))
        ELSEIF(G.GT.0.20 .AND. G.LE.0.30)THEN
          A1=0.3
          A2=0.2
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(7,3) + AFACT*(GPTABL(8,3)-GPTABL(7,3))
          CUT95= GPTABL(7,4) + AFACT*(GPTABL(8,4)-GPTABL(7,4))
          CUT975=GPTABL(7,5) + AFACT*(GPTABL(8,5)-GPTABL(7,5))
          CUT99= GPTABL(7,6) + AFACT*(GPTABL(8,6)-GPTABL(7,6))
        ELSEIF(G.GT.0.30 .AND. G.LE.0.40)THEN
          A1=0.4
          A2=0.3
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(8,3) + AFACT*(GPTABL(9,3)-GPTABL(8,3))
          CUT95= GPTABL(8,4) + AFACT*(GPTABL(9,4)-GPTABL(8,4))
          CUT975=GPTABL(8,5) + AFACT*(GPTABL(9,5)-GPTABL(8,5))
          CUT99= GPTABL(8,6) + AFACT*(GPTABL(9,6)-GPTABL(8,6))
        ELSEIF(G.GT.0.40 .AND. G.LT.0.50)THEN
          A1=0.5
          A2=0.4
          AFACT=(G-A2)/(A1-A2)
          CUT90= GPTABL(9,3) + AFACT*(GPTABL(10,3)-GPTABL(9,3))
          CUT95= GPTABL(9,4) + AFACT*(GPTABL(10,4)-GPTABL(9,4))
          CUT975=GPTABL(9,5) + AFACT*(GPTABL(10,5)-GPTABL(9,5))
          CUT99= GPTABL(9,6) + AFACT*(GPTABL(10,6)-GPTABL(9,6))
        ENDIF
      ELSEIF(ICASDI.EQ.'DEXP')THEN
        STATVA=A2
        IF(N.LE.10)THEN
          CUT90=0.714
          CUT95=0.869
          CUT975=1.023
          CUT99=1.234
        ELSEIF(N.GE.10 .AND. N.LE.14)THEN
          AFACT=REAL(N-10)/REAL(15-10)
          CUT90=0.714 + (0.807 - 0.714)*AFACT
          CUT95=0.869 + (0.991 - 0.869)*AFACT
          CUT975=1.023 + (1.160 - 1.023)*AFACT
          CUT99=1.234 + (1.415 - 1.234)*AFACT
        ELSEIF(N.EQ.15)THEN
          CUT90=0.807
          CUT95=0.991
          CUT975=1.160
          CUT99=1.415
        ELSEIF(N.GE.16 .AND. N.LE.19)THEN
          AFACT=REAL(N-15)/REAL(20-15)
          CUT90=0.807 + (0.760 - 0.807)*AFACT
          CUT95=0.991 + (0.930 - 0.991)*AFACT
          CUT975=1.160 + (1.103 - 1.160)*AFACT
          CUT99=1.415 + (1.336 - 1.415)*AFACT
        ELSEIF(N.EQ.20)THEN
          CUT90=0.760
          CUT95=0.930
          CUT975=1.103
          CUT99=1.336
        ELSEIF(N.GE.21 .AND. N.LE.34)THEN
          AFACT=REAL(N-20)/REAL(35-20)
          CUT90=0.760 + (0.797 - 0.760)*AFACT
          CUT95=0.930 + (0.987 - 0.930)*AFACT
          CUT975=1.103 + (1.179 - 1.103)*AFACT
          CUT99=1.336 + (1.438 - 1.336)*AFACT
        ELSEIF(N.EQ.35)THEN
          CUT90=0.797
          CUT95=0.987
          CUT975=1.179
          CUT99=1.438
        ELSEIF(N.GE.36 .AND. N.LE.49)THEN
          AFACT=REAL(N-35)/REAL(50-35)
          CUT90=0.797 + (0.783 - 0.797)*AFACT
          CUT95=0.987 + (0.961 - 0.987)*AFACT
          CUT975=1.179 + (1.137 - 1.179)*AFACT
          CUT99=1.438 + (1.373 - 1.438)*AFACT
        ELSEIF(N.EQ.50)THEN
          CUT90=0.783
          CUT95=0.961
          CUT975=1.137
          CUT99=1.373
        ELSEIF(N.GE.51 .AND. N.LE.74)THEN
          AFACT=REAL(N-50)/REAL(75-50)
          CUT90=0.783 + (0.797 - 0.783)*AFACT
          CUT95=0.961 + (0.984 - 0.961)*AFACT
          CUT975=1.137 + (1.178 - 1.137)*AFACT
          CUT99=1.373 + (1.442 - 1.373)*AFACT
        ELSEIF(N.EQ.75)THEN
          CUT90=0.797
          CUT95=0.984
          CUT975=1.178
          CUT99=1.442
        ELSEIF(N.GE.76 .AND. N.LE.99)THEN
          AFACT=REAL(N-75)/REAL(100-75)
          CUT90=0.797 + (0.792 - 0.797)*AFACT
          CUT95=0.984 + (0.972 - 0.984)*AFACT
          CUT975=1.178 + (1.156 - 1.178)*AFACT
          CUT99=1.442 + (1.408 - 1.442)*AFACT
        ELSEIF(N.EQ.100)THEN
          CUT90=0.792
          CUT95=0.972
          CUT975=1.156
          CUT99=1.408
        ELSE
          CUT90=0.798
          CUT95=0.983
          CUT975=1.177
          CUT99=1.442
        ENDIF
      ELSEIF(ICASDI.EQ.'CAUC')THEN
        STATVA=A2
        IF(N.LE.5)THEN
          CUT90=CATABL(1,3)
          CUT95=CATABL(1,4)
          CUT975=CATABL(1,5)
          CUT99=CATABL(1,6)
        ELSEIF(N.GT.5 .AND. N.LE.8)THEN
          AFACT=REAL(N-5)/REAL(8-5)
          CUT90=CATABL(1,3) + (CATABL(2,3) - CATABL(1,3))*AFACT
          CUT95=CATABL(1,4) + (CATABL(2,4) - CATABL(1,4))*AFACT
          CUT975=CATABL(1,5) + (CATABL(2,5) - CATABL(1,5))*AFACT
          CUT99=CATABL(1,6) + (CATABL(2,6) - CATABL(1,6))*AFACT
        ELSEIF(N.GE.9 .AND. N.LE.10)THEN
          AFACT=REAL(N-8)/REAL(10-8)
          CUT90=CATABL(2,3) + (CATABL(3,3) - CATABL(2,3))*AFACT
          CUT95=CATABL(2,4) + (CATABL(3,4) - CATABL(2,4))*AFACT
          CUT975=CATABL(2,5) + (CATABL(3,5) - CATABL(2,5))*AFACT
          CUT99=CATABL(2,6) + (CATABL(3,6) - CATABL(2,6))*AFACT
        ELSEIF(N.GE.11 .AND. N.LE.12)THEN
          AFACT=REAL(N-10)/REAL(12-10)
          CUT90=CATABL(3,3) + (CATABL(4,3) - CATABL(3,3))*AFACT
          CUT95=CATABL(3,4) + (CATABL(4,4) - CATABL(3,4))*AFACT
          CUT975=CATABL(3,5) + (CATABL(4,5) - CATABL(3,5))*AFACT
          CUT99=CATABL(3,6) + (CATABL(4,6) - CATABL(3,6))*AFACT
        ELSEIF(N.GE.13 .AND. N.LE.15)THEN
          AFACT=REAL(N-12)/REAL(15-12)
          CUT90=CATABL(4,3) + (CATABL(5,3) - CATABL(4,3))*AFACT
          CUT95=CATABL(4,4) + (CATABL(5,4) - CATABL(4,4))*AFACT
          CUT975=CATABL(4,5) + (CATABL(5,5) - CATABL(4,5))*AFACT
          CUT99=CATABL(4,6) + (CATABL(5,6) - CATABL(4,6))*AFACT
        ELSEIF(N.GE.16 .AND. N.LE.20)THEN
          AFACT=REAL(N-15)/REAL(20-15)
          CUT90=CATABL(5,3) + (CATABL(6,3) - CATABL(5,3))*AFACT
          CUT95=CATABL(5,4) + (CATABL(6,4) - CATABL(5,4))*AFACT
          CUT975=CATABL(5,5) + (CATABL(6,5) - CATABL(5,5))*AFACT
          CUT99=CATABL(5,6) + (CATABL(6,6) - CATABL(5,6))*AFACT
        ELSEIF(N.GE.21 .AND. N.LE.25)THEN
          AFACT=REAL(N-20)/REAL(25-20)
          CUT90=CATABL(6,3) + (CATABL(7,3) - CATABL(6,3))*AFACT
          CUT95=CATABL(6,4) + (CATABL(7,4) - CATABL(6,4))*AFACT
          CUT975=CATABL(6,5) + (CATABL(7,5) - CATABL(6,5))*AFACT
          CUT99=CATABL(6,6) + (CATABL(7,6) - CATABL(6,6))*AFACT
        ELSEIF(N.GE.26 .AND. N.LE.30)THEN
          AFACT=REAL(N-25)/REAL(30-25)
          CUT90=CATABL(7,3) + (CATABL(8,3) - CATABL(7,3))*AFACT
          CUT95=CATABL(7,4) + (CATABL(8,4) - CATABL(7,4))*AFACT
          CUT975=CATABL(7,5) + (CATABL(8,5) - CATABL(7,5))*AFACT
          CUT99=CATABL(7,6) + (CATABL(8,6) - CATABL(7,6))*AFACT
        ELSEIF(N.GE.31 .AND. N.LE.40)THEN
          AFACT=REAL(N-30)/REAL(40-30)
          CUT90=CATABL(8,3) + (CATABL(9,3) - CATABL(8,3))*AFACT
          CUT95=CATABL(8,4) + (CATABL(9,4) - CATABL(8,4))*AFACT
          CUT975=CATABL(8,5) + (CATABL(9,5) - CATABL(8,5))*AFACT
          CUT99=CATABL(8,6) + (CATABL(9,6) - CATABL(8,6))*AFACT
        ELSEIF(N.GE.41 .AND. N.LE.50)THEN
          AFACT=REAL(N-40)/REAL(50-40)
          CUT90=CATABL(9,3) + (CATABL(10,3) - CATABL(9,3))*AFACT
          CUT95=CATABL(9,4) + (CATABL(10,4) - CATABL(9,4))*AFACT
          CUT975=CATABL(9,5) + (CATABL(10,5) - CATABL(9,5))*AFACT
          CUT99=CATABL(9,6) + (CATABL(10,6) - CATABL(9,6))*AFACT
        ELSEIF(N.GE.51 .AND. N.LE.60)THEN
          AFACT=REAL(N-50)/REAL(60-50)
          CUT90=CATABL(10,3) + (CATABL(11,3) - CATABL(10,3))*AFACT
          CUT95=CATABL(10,4) + (CATABL(11,4) - CATABL(10,4))*AFACT
          CUT975=CATABL(10,5) + (CATABL(11,5) - CATABL(10,5))*AFACT
          CUT99=CATABL(10,6) + (CATABL(11,6) - CATABL(10,6))*AFACT
        ELSEIF(N.GE.61 .AND. N.LE.100)THEN
          AFACT=REAL(N-50)/REAL(100-50)
          CUT90=CATABL(11,3) + (CATABL(12,3) - CATABL(11,3))*AFACT
          CUT95=CATABL(11,4) + (CATABL(12,4) - CATABL(11,4))*AFACT
          CUT975=CATABL(11,5) + (CATABL(12,5) - CATABL(11,5))*AFACT
          CUT99=CATABL(11,6) + (CATABL(12,6) - CATABL(11,6))*AFACT
        ELSE
          CUT90=CATABL(13,3)
          CUT95=CATABL(13,4)
          CUT975=CATABL(13,5)
          CUT99=CATABL(13,6)
        ENDIF
      ENDIF
C
      ICONC1='REJECT'
      ICONC2='REJECT'
      ICONC3='REJECT'
      ICONC4='REJECT'
C
C               *********************************
C               **   STEP 42--                 **
C               **   WRITE OUT EVERYTHING      **
C               **   FOR ANDERSON DARLING TEST **
C               **********************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDIST='NORMAL'
      IF(ICASDI.EQ.'EXPO')IDIST='EXPONENTIAL'
      IF(ICASDI.EQ.'LOGI')IDIST='LOGISTIC'
      IF(ICASDI.EQ.'WEIB')IDIST='WEIBULL'
      IF(ICASDI.EQ.'EXTV')IDIST='EXTREME VALUE'
      IF(ICASDI.EQ.'LOGN')IDIST='LOGNORMAL'
      IF(ICASDI.EQ.'UNIF')IDIST='UNIFORM (0,1)'
      IF(ICASDI.EQ.'DEXP')IDIST='DOUBLE EXPONENTIAL'
      IF(ICASDI.EQ.'GPAR')IDIST='GENERALIZED PARETO'
      IF(ICASDI.EQ.'GAMM')IDIST='GAMMA'
      IF(ICASDI.EQ.'FREC')IDIST='FRECHET (MAXIMUM)'
      IF(ICASDI.EQ.'CAUC')IDIST='CAUCHY'
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
        WRITE(ICOUT,5101)
 5101   FORMAT('</PRE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5108)
 5108   FORMAT('<CENTER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5102)
 5102   FORMAT('<B>ANDERSON-DARLING 1-SAMPLE TEST')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5103)IDIST
 5103   FORMAT('    <BR>THAT THE DATA CAME FROM A ',A20,
     1         'DISTRIBUTION</B>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5109)
 5109   FORMAT('</CENTER>')
        CALL DPWRST('XXX','WRIT')
CCCCC   WRITE(ICOUT,5104)
C5104   FORMAT('<BR><BR>')
CCCCC
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5105)
 5105   FORMAT('<OL>')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5106)
 5106   FORMAT('   <LI>Statistics:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
 5107   FORMAT('       <BR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
 5111   FORMAT('       <TABLE NOBORDER>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
 5121   FORMAT('         <TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
 5123   FORMAT('            <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=300>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5125)
 5125   FORMAT('               Number of Observations:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
 5127   FORMAT('            </TD>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
 5126   FORMAT('            <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=150>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5129)N
 5129   FORMAT('                ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
 5128   FORMAT('         </TR>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'LOGN')THEN
          WRITE(ICOUT,5841)
 5841     FORMAT('               Mean of Log of the Data:')
        ELSE
          WRITE(ICOUT,5141)
 5141     FORMAT('               Mean:')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)YMEAN
 5151   FORMAT('               ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'LOGN')THEN
          WRITE(ICOUT,5842)
 5842     FORMAT('               Standard Deviation of the Log of ',
     1           'the Data:')
        ELSE
          WRITE(ICOUT,5142)
 5142     FORMAT('               Standard Deviation:')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)YSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'GPAR' .OR.
     1     ICASDI.EQ.'GAMM' .OR. ICASDI.EQ.'FREC')THEN
          WRITE(ICOUT,5143)
 5143     FORMAT('               Shape Parameter:')
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'EXTV' .OR. ICASDI.EQ.'LOGI' .OR.
     1         ICASDI.EQ.'DEXP' .OR. ICASDI.EQ.'CAUC')THEN
          WRITE(ICOUT,5144)
 5144     FORMAT('               Location Parameter:')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'FREC')THEN
          WRITE(ICOUT,5151)BETA
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'EXTV' .OR. ICASDI.EQ.'CAUC')THEN
          WRITE(ICOUT,5151)ALOC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'LOGI')THEN
          WRITE(ICOUT,5151)ALPHA
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'DEXP')THEN
          WRITE(ICOUT,5151)ALOC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GPAR')THEN
          WRITE(ICOUT,5151)GAMMML
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GAMM')THEN
          WRITE(ICOUT,5151)SHAPE
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'WEIB'.OR.ICASDI.EQ.'EXTV'.OR.
     1     ICASDI.EQ.'LOGI'.OR.ICASDI.EQ.'DEXP'.OR.
     1     ICASDI.EQ.'GPAR'.OR.ICASDI.EQ.'GAMM'.OR.
     1     ICASDI.EQ.'FREC'.OR.ICASDI.EQ.'CAUC')THEN
          WRITE(ICOUT,5145)
 5145     FORMAT('               Scale Parameter:')
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'FREC')THEN
          WRITE(ICOUT,5151)ALPHA
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'EXTV' .OR. ICASDI.EQ.'CAUC')THEN
          WRITE(ICOUT,5151)ASCALE
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'LOGI')THEN
          WRITE(ICOUT,5151)BETA
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'DEXP')THEN
          WRITE(ICOUT,5151)SCALE
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GPAR')THEN
          WRITE(ICOUT,5151)AML
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GAMM')THEN
          WRITE(ICOUT,5151)SCALE
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5146)
 5146   FORMAT('               Anderson-Darling Test Statstic Value:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)A2
 5154   FORMAT('            ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5147)
 5147   FORMAT('               Adjusted Test Statstic Value:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5154)STATVA
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
 5991   FORMAT('       </TABLE>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5166)
 5166   FORMAT('   <LI>Critical Values:')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5167)
 5167   FORMAT('               90% Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)CUT90
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5168)
 5168   FORMAT('               95% Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)CUT95
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5169)
 5169   FORMAT('               97.5% Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)CUT975
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5170)
 5170   FORMAT('               99% Point:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5126)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5151)CUT99
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5128)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5991)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5176)
 5176   FORMAT('   <LI>Conclusion (at the 5% Level):')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,5107)
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LT.CUT95)THEN
          IF(IDIST.EQ.'NORMAL')THEN
            WRITE(ICOUT,5180)
          ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
            WRITE(ICOUT,5181)
          ELSEIF(IDIST.EQ.'LOGISTIC')THEN
            WRITE(ICOUT,5182)
          ELSEIF(IDIST.EQ.'WEIBULL')THEN
            WRITE(ICOUT,5183)
          ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
            WRITE(ICOUT,5184)
          ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
            WRITE(ICOUT,5185)
          ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
            WRITE(ICOUT,5186)
          ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
            WRITE(ICOUT,5187)
          ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
            WRITE(ICOUT,5188)
          ELSEIF(IDIST.EQ.'GAMMA')THEN
            WRITE(ICOUT,5189)
          ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
            WRITE(ICOUT,5190)
          ELSEIF(IDIST.EQ.'CAUCHY')THEN
            WRITE(ICOUT,5191)
          ENDIF
          CALL DPWRST('XXX','WRIT')
 5180     FORMAT('        The data do come from a normal distribution')
 5181     FORMAT('        The data do come from an exponential ',
     1           'distribution')
 5182     FORMAT('        The data do come from a logistic ',
     1           'distribution')
 5183     FORMAT('        The data do come from a Weibull distribution')
 5184     FORMAT('        The data do come from a extreme value ',
     1           ' (type 1) distribution')
 5185     FORMAT('        The data do come from a lognormal ',
     1           'distribution')
 5186     FORMAT('        The data do come from a uniform (0,1) ',
     1           'distribution')
 5187     FORMAT('        The data do come from a double exponential ',
     1           'distribution')
 5188     FORMAT('        The data do come from a generalized Pareto ',
     1           'distribution')
 5189     FORMAT('        The data do come from a gamma ',
     1           'distribution')
 5190     FORMAT('        The data do come from a Frechet ',
     1           '(maximum) distribution')
 5191     FORMAT('        The data do come from a Cauchy ',
     1           'distribution')
        ELSE
          IF(IDIST.EQ.'NORMAL')THEN
            WRITE(ICOUT,5280)
          ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
            WRITE(ICOUT,5281)
          ELSEIF(IDIST.EQ.'LOGISTIC')THEN
            WRITE(ICOUT,5282)
          ELSEIF(IDIST.EQ.'WEIBULL')THEN
            WRITE(ICOUT,5283)
          ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
            WRITE(ICOUT,5284)
          ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
            WRITE(ICOUT,5285)
          ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
            WRITE(ICOUT,5286)
          ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
            WRITE(ICOUT,5287)
          ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
            WRITE(ICOUT,5288)
          ELSEIF(IDIST.EQ.'GAMMA')THEN
            WRITE(ICOUT,5289)
          ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
            WRITE(ICOUT,5290)
          ELSEIF(IDIST.EQ.'CAUCHY')THEN
            WRITE(ICOUT,5291)
          ENDIF
          CALL DPWRST('XXX','WRIT')
 5280     FORMAT('        The data do not come from a normal ',
     1           'distribution')
 5281     FORMAT('        The data do not come from an exponential ',
     1           'distribution')
 5282     FORMAT('        The data do not come from a logistic ',
     1           'distribution')
 5283     FORMAT('        The data do not come from a Weibull ',
     1           'distribution')
 5284     FORMAT('        The data do not come from a extreme value ',
     1           ' (type 1) distribution')
 5285     FORMAT('        The data do not come from a lognormal ',
     1           'distribution')
 5286     FORMAT('        The data do not come from a uniform (0,1) ',
     1           'distribution')
 5287     FORMAT('        The data do not come from a double ',
     1           'exponential distribution')
 5288     FORMAT('        The data do not come from a generalized ',
     1           'Pareto distribution')
 5289     FORMAT('        The data do not come from a gamma ',
     1           'distribution')
 5290     FORMAT('        The data do not come from a Frechet ',
     1           '(maximum) distribution')
 5291     FORMAT('        The data do not come from a Cauchy ',
     1           'distribution')
        ENDIF
        WRITE(ICOUT,5997)
 5997   FORMAT('</OL>')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,5999)
 5999   FORMAT('<PRE>')
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
 8001   FORMAT('{',A1,'bf ANDERSON-DARLING 1-SAMPLE TEST}',2X,A1,A1)
 8002   FORMAT(A1,'begin{table}')
 8003   FORMAT(A1,'end{table}')
 8004   FORMAT('{',A1,'bf THAT THE DATA CAME FROM A ',A20,
     1         ' DISTRIBUTION}')
 8007   FORMAT(A1,'begin{center}')
 8008   FORMAT(A1,'end{center}')
 8012   FORMAT(A1,'end{verbatim}')
 8017   FORMAT(A1,'begin{enumerate}')
 8018   FORMAT(A1,'end{enumerate}')
 8019   FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1)
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,8012)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8007)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8002)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8001)IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8004)IBASLC,IDIST
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8019)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8017)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8021   FORMAT(5X,A1,'item Statistics:')
 8022   FORMAT(5X,A1,'item Critical Values:')
 8023   FORMAT(5X,A1,'item Conclusion (at the 5',A1,'% level):')
 8030   FORMAT(11X,A1,'begin{tabular} {lr}')
 8031   FORMAT(11X,'Number of Observations: & ',I8,2X,A1,A1)
 8032   FORMAT(11X,'Location Parameter: & ',G15.7,2X,A1,A1)
 8033   FORMAT(11X,'Scale Parameter: & ',G15.7,2X,A1,A1)
 8036   FORMAT(11X,'Sample Mean: & ',G15.7,2X,A1,A1)
 8037   FORMAT(11X,'Sample Standard Deviation: & ',G15.7,2X,A1,A1)
 8038   FORMAT(11X,'Shape Parameter: & ',G15.7,2X,A1,A1)
 8034   FORMAT(11X,'Anderson-Darling Test Statistic Value: & ',
     1         G15.7,2X,A1,A1)
 8035   FORMAT(11X,'Adjusted Test Statistic Value: & ',
     1         G15.7,2X,A1,A1)
 8040   FORMAT(11X,A1,'end{tabular}')
 8836   FORMAT(11X,'Sample Mean of Log of Data: & ',G15.7,2X,A1,A1)
 8837   FORMAT(11X,'Sample Standard Deviation of Log of Data: & ',
     1         G15.7,2X,A1,A1)
C
        WRITE(ICOUT,8021)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8031)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'LOGN')THEN
          WRITE(ICOUT,8836)YMEAN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8837)YSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,8036)YMEAN,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8037)YSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'FREC')THEN
          WRITE(ICOUT,8038)BETA,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)ALPHA,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'EXTV' .OR. ICASDI.EQ.'CAUC')THEN
          WRITE(ICOUT,8032)ALOC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)ASCALE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'LOGI')THEN
          WRITE(ICOUT,8032)ALPHA,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)BETA,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'DEXP')THEN
          WRITE(ICOUT,8032)ALOC,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)SCALE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GPAR')THEN
          WRITE(ICOUT,8038)GAMMML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)AML,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GAMM')THEN
          WRITE(ICOUT,8038)SHAPE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,8033)SCALE,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF 
        WRITE(ICOUT,8034)A2,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8034)STATVA,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8022)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8041   FORMAT(11X,'90',A1,'% Point: & ',G15.7,2X,A1,A1)
 8042   FORMAT(11X,'95',A1,'% Point: & ',G15.7,2X,A1,A1)
 8043   FORMAT(11X,'97.5',A1,'% Point: & ',G15.7,2X,A1,A1)
 8044   FORMAT(11X,'99',A1,'% Point: & ',G15.7,2X,A1,A1)
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8030)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8041)IBASLC,CUT90,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8042)IBASLC,CUT95,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8043)IBASLC,CUT975,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8044)IBASLC,CUT99,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8040)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,8023)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8050)IBASLC
        CALL DPWRST('XXX','WRIT')
C
 8050   FORMAT(11X,A1,'newline')
 8091   FORMAT(A1,'end{enumerate}')
 8092   FORMAT(A1,'begin{verbatim}')
        IF(STATVA.LT.CUT95)THEN
          IF(IDIST.EQ.'NORMAL')THEN
            WRITE(ICOUT,8051)
          ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
            WRITE(ICOUT,8052)
          ELSEIF(IDIST.EQ.'LOGISTIC')THEN
            WRITE(ICOUT,8053)
          ELSEIF(IDIST.EQ.'WEIBULL')THEN
            WRITE(ICOUT,8054)
          ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
            WRITE(ICOUT,8055)
          ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
            WRITE(ICOUT,8056)
          ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
            WRITE(ICOUT,8057)
          ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
            WRITE(ICOUT,8058)
          ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
            WRITE(ICOUT,8059)
          ELSEIF(IDIST.EQ.'GAMMA')THEN
            WRITE(ICOUT,8060)
          ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
            WRITE(ICOUT,8061)
          ELSEIF(IDIST.EQ.'CAUCHY')THEN
            WRITE(ICOUT,8062)
          ENDIF
          CALL DPWRST('XXX','WRIT')
 8051     FORMAT('        The data do come from a normal distribution')
 8052     FORMAT('        The data do come from an exponential ',
     1           'distribution')
 8053     FORMAT('        The data do come from a logistic ',
     1           'distribution')
 8054     FORMAT('        The data do come from a Weibull distribution')
 8055     FORMAT('        The data do come from a extreme value ',
     1           ' (type 1) distribution')
 8056     FORMAT('        The data do come from a lognormal ',
     1           'distribution')
 8057     FORMAT('        The data do come from a uniform (0,1) ',
     1           'distribution')
 8058     FORMAT('        The data do come from a double exponential ',
     1           'distribution')
 8059     FORMAT('        The data do come from a generalized Pareto ',
     1           'distribution')
 8060     FORMAT('        The data do come from a gamma ',
     1           'distribution')
 8061     FORMAT('        The data do come from a Frechet ',
     1           '(maximum) distribution')
 8062     FORMAT('        The data do come from a Cauchy ',
     1           'distribution')
        ELSE
          IF(IDIST.EQ.'NORMAL')THEN
            WRITE(ICOUT,8071)
          ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
            WRITE(ICOUT,8072)
          ELSEIF(IDIST.EQ.'LOGISTIC')THEN
            WRITE(ICOUT,8073)
          ELSEIF(IDIST.EQ.'WEIBULL')THEN
            WRITE(ICOUT,8074)
          ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
            WRITE(ICOUT,8075)
          ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
            WRITE(ICOUT,8076)
          ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
            WRITE(ICOUT,8077)
          ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
            WRITE(ICOUT,8078)
          ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
            WRITE(ICOUT,8079)
          ELSEIF(IDIST.EQ.'GAMMA')THEN
            WRITE(ICOUT,8080)
          ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
            WRITE(ICOUT,8081)
          ELSEIF(IDIST.EQ.'CAUCHY')THEN
            WRITE(ICOUT,8082)
          ENDIF
          CALL DPWRST('XXX','WRIT')
 8071     FORMAT('        The data do not come from a normal ',
     1           'distribution')
 8072     FORMAT('        The data do not come from an exponential ',
     1           'distribution')
 8073     FORMAT('        The data do not come from a logistic ',
     1           'distribution')
 8074     FORMAT('        The data do not come from a Weibull ',
     1           'distribution')
 8075     FORMAT('        The data do not come from a extreme value ',
     1           ' (type 1) distribution')
 8076     FORMAT('        The data do not come from a lognormal ',
     1           'distribution')
 8077     FORMAT('        The data do not come from a uniform ',
     1           '(0,1) distribution')
 8078     FORMAT('        The data do not come from a double ',
     1           'exponential distribution')
 8079     FORMAT('        The data do not come from a generalized ',
     1           'Pareto distribution')
 8080     FORMAT('        The data do not come from a gamma ',
     1           'distribution')
 8081     FORMAT('        The data do not come from a Frechet ',
     1           '(maximum) distribution')
 8082     FORMAT('        The data do not come from a Cauchy ',
     1           'distribution')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8008)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,8092)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'RTF')THEN
C  JUST A PLACEHOLDER FOR NOW.
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4211)
 4211   FORMAT( '              ANDERSON-DARLING 1-SAMPLE TEST')
        CALL DPWRST('XXX','WRIT')
        IF(IDIST.EQ.'NORMAL')THEN
          WRITE(ICOUT,4212)
 4212     FORMAT(
     1  '              THAT THE DATA CAME FROM A NORMAL DISTRIBUTION')
        ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
          WRITE(ICOUT,4214)
 4214     FORMAT(
     1  '              THAT THE DATA CAME FROM AN EXPONENTIAL ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'LOGISTIC')THEN
          WRITE(ICOUT,4216)
 4216     FORMAT(
     1  '              THAT THE DATA CAME FROM A LOGISTIC ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'WEIBULL')THEN
          WRITE(ICOUT,4218)
 4218     FORMAT(
     1  '              THAT THE DATA CAME FROM A WEIBULL ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
          WRITE(ICOUT,4220)
 4220     FORMAT(
     1  '              THAT THE DATA CAME FROM AN EXTREME VALUE ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
          WRITE(ICOUT,4222)
 4222     FORMAT(
     1  '              THAT THE DATA CAME FROM A LOGNORMAL ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
          WRITE(ICOUT,4224)
 4224     FORMAT(
     1  '              THAT THE DATA CAME FROM A UNIFORM (0,1) ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
          WRITE(ICOUT,4226)
 4226     FORMAT(
     1  '              THAT THE DATA CAME FROM A DOUBLE ',
     1  'EXPONENTIAL DISTRIBUTION')
        ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
          WRITE(ICOUT,4228)
 4228     FORMAT(
     1  '              THAT THE DATA CAME FROM A GENERALIZED ',
     1  'PARETO DISTRIBUTION')
        ELSEIF(IDIST.EQ.'GAMMA')THEN
          WRITE(ICOUT,4229)
 4229     FORMAT(
     1  '              THAT THE DATA CAME FROM A GAMMA ',
     1  'DISTRIBUTION')
        ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
          WRITE(ICOUT,4231)
 4231     FORMAT(
     1  '              THAT THE DATA CAME FROM A FRECHET ',
     1  '(MAXIMUM) DISTRIBUTION')
        ELSEIF(IDIST.EQ.'CAUCHY')THEN
          WRITE(ICOUT,4233)
 4233     FORMAT(
     1  '              THAT THE DATA CAME FROM A CAUCHY ',
     1  'DISTRIBUTION')
        ENDIF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4241)
 4241   FORMAT('1. STATISTICS:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4242)N
 4242   FORMAT(6X,'NUMBER OF OBSERVATIONS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        IF(ICASDI.EQ.'LOGN')THEN
          WRITE(ICOUT,24243)YMEAN
24243   FORMAT(6X,'MEAN OF LOG OF DATA                   = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,24244)YSD
24244   FORMAT(6X,'STANDARD DEVIATION OF LOG OF DATA     = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,4243)YMEAN
 4243   FORMAT(6X,'MEAN                                  = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4244)YSD
 4244   FORMAT(6X,'STANDARD DEVIATION                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        IF(ICASDI.EQ.'WEIB' .OR. ICASDI.EQ.'FREC')THEN
          WRITE(ICOUT,4251)BETA
 4251     FORMAT(6X,'SHAPE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,4253)ALPHA
 4253     FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'EXTV' .OR. ICASDI.EQ.'CAUC')THEN
          WRITE(ICOUT,14261)ALOC
14261     FORMAT(6X,'LOCATION PARAMETER                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,14263)ASCALE
14263     FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'LOGI')THEN
          WRITE(ICOUT,14265)ALPHA
14265     FORMAT(6X,'LOCATION PARAMETER                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,14267)BETA
14267     FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'DEXP')THEN
          WRITE(ICOUT,14268)ALOC
14268     FORMAT(6X,'LOCATION PARAMETER                    = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,14269)SCALE
14269     FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GPAR')THEN
          WRITE(ICOUT,14278)GAMMML
14278     FORMAT(6X,'SHAPE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,14279)AML
14279     FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ELSEIF(ICASDI.EQ.'GAMM')THEN
          WRITE(ICOUT,14288)SHAPE
14288     FORMAT(6X,'SHAPE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,14289)SCALE
14289     FORMAT(6X,'SCALE PARAMETER                       = ',G15.7)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4344)A2
 4344   FORMAT(6X,'ANDERSON-DARLING TEST STATISTIC VALUE = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4346)STATVA
 4346   FORMAT(6X,'ADJUSTED TEST STATISTIC VALUE         = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4341)
 4341   FORMAT('2. CRITICAL VALUES:')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4245)CUT90
 4245   FORMAT(6X,'90         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4246)CUT95
 4246   FORMAT(6X,'95         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4247)CUT975
 4247   FORMAT(6X,'97.5       % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,4248)CUT99
 4248   FORMAT(6X,'99         % POINT    = ',G15.7)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,4261)
 4261   FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
        CALL DPWRST('XXX','WRIT')
        IF(STATVA.LT.CUT95)THEN
          IF(IDIST.EQ.'NORMAL')THEN
            WRITE(ICOUT,4263)
 4263       FORMAT(6X,'THE DATA DO COME FROM A NORMAL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
            WRITE(ICOUT,4273)
 4273       FORMAT(6X,'THE DATA DO COME FROM AN EXPONENTIAL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'LOGISTIC')THEN
            WRITE(ICOUT,4283)
 4283       FORMAT(6X,'THE DATA DO COME FROM A LOGISTIC ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'WEIBULL')THEN
            WRITE(ICOUT,4293)
 4293       FORMAT(6X,'THE DATA DO COME FROM A WEIBULL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
            WRITE(ICOUT,4303)
 4303       FORMAT(6X,'THE DATA DO COME FROM AN EXTREME VALUE ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
            WRITE(ICOUT,4313)
 4313       FORMAT(6X,'THE DATA DO COME FROM A LOGNORMAL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
            WRITE(ICOUT,4315)
 4315       FORMAT(6X,'THE DATA DO COME FROM A UNIFORM (0,1) ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
            WRITE(ICOUT,4317)
 4317       FORMAT(6X,'THE DATA DO COME FROM A DOUBLE ',
     1             'EXPONENTIAL DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
            WRITE(ICOUT,4319)
 4319       FORMAT(6X,'THE DATA DO COME FROM A GENERALIZED ',
     1             'PARETO DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'GAMMA')THEN
            WRITE(ICOUT,4320)
 4320       FORMAT(6X,'THE DATA DO COME FROM A GAMMA ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
            WRITE(ICOUT,4322)
 4322       FORMAT(6X,'THE DATA DO COME FROM A FRECHET ',
     1             '(MAXIMUM) DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'CAUCHY')THEN
            WRITE(ICOUT,4324)
 4324       FORMAT(6X,'THE DATA DO COME FROM A CAUCHY ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ENDIF
        ELSE
          IF(IDIST.EQ.'NORMAL')THEN
            WRITE(ICOUT,4265)
 4265       FORMAT(6X,'THE DATA DO NOT COME FROM A NORMAL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'EXPONENTIAL')THEN
            WRITE(ICOUT,4275)
 4275       FORMAT(6X,'THE DATA DO NOT COME FROM AN EXPONENTIAL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'LOGISTIC')THEN
            WRITE(ICOUT,4285)
 4285       FORMAT(6X,'THE DATA DO NOT COME FROM A LOGISTIC ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'WEIBULL')THEN
            WRITE(ICOUT,4286)
 4286       FORMAT(6X,'THE DATA DO NOT COME FROM A WEIBULL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'EXTREME VALUE')THEN
            WRITE(ICOUT,4288)
 4288       FORMAT(6X,'THE DATA DO NOT COME FROM AN EXTREME ',
     1             'VALUE DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'LOGNORMAL')THEN
            WRITE(ICOUT,4290)
 4290       FORMAT(6X,'THE DATA DO NOT COME FROM A LOGNORMAL ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'UNIFORM (0,1)')THEN
            WRITE(ICOUT,4292)
 4292       FORMAT(6X,'THE DATA DO NOT COME FROM A UNIFORM (0,1) ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'DOUBLE EXPONENTIAL')THEN
            WRITE(ICOUT,4294)
 4294       FORMAT(6X,'THE DATA DO NOT COME FROM A DOUBLE ',
     1             'EXPONENTIAL DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'GENERALIZED PARETO')THEN
            WRITE(ICOUT,4296)
 4296       FORMAT(6X,'THE DATA DO NOT COME FROM A GENERALIZED ',
     1             'PARETO DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'GAMMA')THEN
            WRITE(ICOUT,4297)
 4297       FORMAT(6X,'THE DATA DO NOT COME FROM A GAMMA ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'FRECHET (MAXIMUM)')THEN
            WRITE(ICOUT,4298)
 4298       FORMAT(6X,'THE DATA DO NOT COME FROM A FRECHET ',
     1             '(MAXIMUM) DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ELSEIF(IDIST.EQ.'CAUCHY')THEN
            WRITE(ICOUT,4299)
 4299       FORMAT(6X,'THE DATA DO NOT COME FROM A CAUCHY ',
     1             'DISTRIBUTION.')
            CALL DPWRST('XXX','WRIT')
          ENDIF
      ENDIF
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      ENDIF
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF'.AND.ISUBRO.NE.'ADA2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPADA2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I),XTEMP(I)
 9017 FORMAT('I,Y(I),XTEMP(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGS2,IERROR)
C     PURPOSE--ADD A PARAMETER WITH NAME GIVEN IN    IH,IH2
C              AND WITH VALUE     VALUE0
C              INTO DATAPLOT'S INTERNAL ARRAY.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--93/12
C     ORIGINAL VERSION--DECEMBER  1993.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IH
      CHARACTER*4 IH2
      CHARACTER*4 IHOST1
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGS2
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
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='DPAD'
      ISUBN2='DP  '
C
      IERROR='NO'
C
      IF(IBUGS2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)ISUBN0
   51 FORMAT('***** AT THE BEGINNING OF DPADDP CALLED BY--',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,IERROR
   52 FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IH,IH2,VALUE0
   53 FORMAT('IH,IH2,VALUE0 = ',A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IHOST1,ISUBN0
   54 FORMAT('IHOST1,ISUBN0 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNAM,NUMNAM
   58 FORMAT('MAXNAM,NUMNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,59)MAXN,MAXCOL,NUMCOL
CCC59 FORMAT('MAXN,MAXCOL,NUMCOL = ',3I8)
CCCCC CALL DPWRST('XXX','BUG ')
      DO60I=1,NUMNAM
      WRITE(ICOUT,61)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
   61 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)I,IHNAME(I),IHNAM2(I)
   62 FORMAT('I,IHNAME(I),IHNAM2(I) = ',
     1I8,2X,A4,A4,6X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   60 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               **************************************************
C               **  DETERMINE IF THE NAME IS ALREADY IN         **
C               **  IN THE INTERNAL ARRAY.                      **
C               **  ADD OR UPDATE ACCORDINGLY.                  **
C               **************************************************
C
      ICUTMX=NUMBPW
      IF(IHOST1.EQ.'CDC '.OR.IHOST1.EQ.'CYBE')ICUTMX=48
      IF(IHOST1.EQ.'205 ')ICUTMX=48
      CUTOFF=2**(ICUTMX-3)
C
      DO1150I=1,NUMNAM
      I2=I
      IF(IH.EQ.IHNAME(I).AND.IH2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1180
 1150 CONTINUE
C
      IF(NUMNAM.LT.MAXNAM)GOTO1170
      WRITE(ICOUT,1151)ISUBN0
 1151 FORMAT('***** ERROR IN DPADDP AS CALLED FROM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      THE TOTAL NUMBER OF (VARIABLE + PARAMETER)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)MAXNAM
 1153 FORMAT('      NAMES MUST BE AT MOST ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)
 1154 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      THE MAXIMUM ALLOWABLE NUMBER OF NAMES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)
 1156 FORMAT('      HAS JUST EXCEEDED.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1157)
 1157 FORMAT('      SUGGESTED ACTION--ENTER     STAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1158)
 1158 FORMAT('      TO DETERMINE THE IMPORTANT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1159)
 1159 FORMAT('      (VERSUS UNIMPORTANT) VARIABLES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1160)
 1160 FORMAT('      AND PARAMETERS, AND THEN REUSE SOME')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('      OF THE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1162)
 1162 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1163)(IANS(I),I=1,IWIDTH)
 1163 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1170 CONTINUE
      NUMNAM=NUMNAM+1
      ILOC=NUMNAM
      IHNAME(ILOC)=IH
      IHNAM2(ILOC)=IH2
      IUSE(ILOC)='P'
      VALUE(ILOC)=VALUE0
      VAL=VALUE(ILOC)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(ILOC)=IVAL
      GOTO1190
C
 1180 CONTINUE
      VALUE(I2)=VALUE0
      VAL=VALUE(I2)
      IF((-CUTOFF).LE.VAL.AND.VAL.LE.CUTOFF)IVAL=VAL+0.5
      IF(VAL.GT.CUTOFF)IVAL=CUTOFF
      IF(VAL.LT.(-CUTOFF))IVAL=(-CUTOFF)
      IVALUE(I2)=IVAL
      GOTO1190
C
 1190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
C
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)ISUBN0
 9011 FORMAT('***** AT THE END       OF DPADDP CALLED BY--',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,IERROR
 9012 FORMAT('IBUGS2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IH,IH2,VALUE0
 9013 FORMAT('IH,IH2,VALUE0 = ',A4,2X,A4,2X,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IHOST1,ISUBN0
 9014 FORMAT('IHOST1,ISUBN0 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)MAXNAM,NUMNAM
 9018 FORMAT('MAXNAM,NUMNAM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NUMNAM
      WRITE(ICOUT,9021)I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I)
 9021 FORMAT('I,IHNAME(I),IHNAM2(I),IUSE(I),IVALUE(I),VALUE(I) = ',
     1I8,2X,A4,A4,2X,A4,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)I,IHNAME(I),IHNAM2(I)
 9022 FORMAT('I,IHNAME(I),IHNAM2(I)= ',
     1I8,2X,A4,A4,6X)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPADKS(YTEMP,XTEMP,MAXNXT,
     1IBUGA2,IBUGA3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT K-SAMPLE ANDERSON-DARLING TEST
C              (ARE BATCHES SIMILAR?)
C     EXAMPLE--ANDERSON-DARLING K-SAMPLE TEST Y X
C     REFERENCE--XX
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--98/4
C     ORIGINAL VERSION--APRIL     1998.
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 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
C
C---------------------------------------------------------------------
C
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DOUBLE PRECISION XPS(MAXOBV)
      DOUBLE PRECISION XPSU(MAXOBV)
      DOUBLE PRECISION WK3(MAXOBV)
C
      DIMENSION IPBCH(MAXOBV)
      DIMENSION IWK2(MAXOBV)
      DIMENSION ISIZE(MAXOBV)
      DIMENSION NTIE(MAXOBV)
C
      INCLUDE 'DPCOZD.INC'
      INCLUDE 'DPCOZI.INC'
C
      EQUIVALENCE(DGARBG(IDGAR1),XPS(1))
      EQUIVALENCE(DGARBG(IDGAR2),XPSU(1))
      EQUIVALENCE(DGARBG(IDGAR3),WK3(1))
C
      EQUIVALENCE(IGARBG(IIGAR1),IPBCH(1))
      EQUIVALENCE(IGARBG(IIGAR2),IWK2(1))
      EQUIVALENCE(IGARBG(IIGAR3),ISIZE(1))
      EQUIVALENCE(IGARBG(IIGAR4),NTIE(1))
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='DPLT'
      ISUBN2='ES  '
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
      N1=(-999)
      N2=(-999)
C
      NS1=(-999)
      NS2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               **************************************
C               **  TREAT THE ANDERSON-DARLING K-SAMPLE TEST 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 DPADKS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHULD BE A VARIABLE.)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1141)
 1141    FORMAT('***** ERROR IN DPADKS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1142)
 1142    FORMAT('      FOR ANDERSON-DARLING K-SAMPLE TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1145)
 1145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1146)
 1146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1147)
 1147    FORMAT('      ARGUMENT 1 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,1148)
 1148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,1150)(IANS(I),I=1,IWIDTH)
 1150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
 1190 CONTINUE
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  IF ARGUMENT 1 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1)  **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPADKS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH ANDERSON-DARLING K-SAMPLE TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 21--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD ALSO BE A VARIABLE)  **
C               ****************************************
C
      ISTEPN='21'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH21=IHARG(2)
      IH22=IHARG2(2)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH21,IH22,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
C
      IF(IERROR.EQ.'YES')THEN
         WRITE(ICOUT,999)
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2141)
 2141    FORMAT('***** ERROR IN DPADKS--')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2142)
 2142    FORMAT('      FOR ANDERSON-DARLING K-SAMPLE TEST,')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2145)
 2145    FORMAT('      BOTH ARGUMENTS MUST BE A VARIABLE')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2146)
 2146    FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2147)
 2147    FORMAT('      ARGUMENT 2 WAS NOT A VARIABLE HERE.')
         CALL DPWRST('XXX','BUG ')
         WRITE(ICOUT,2148)
 2148    FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
         CALL DPWRST('XXX','BUG ')
         IF(IWIDTH.GE.1)WRITE(ICOUT,2150)(IANS(I),I=1,IWIDTH)
 2150    FORMAT(80A1)
         IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
         IERROR='YES'
         GOTO9000
      ENDIF
C
      IUSE2=IUSE(ILOCV)
      ICOL2=IVALUE(ILOCV)
      N2=IN(ILOCV)
 2190 CONTINUE
C
C               ********************************************************
C               **  STEP 22--                                         **
C               **  IF ARGUMENT 2 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N2)  **
C               **  FOR ARGUMENT 2 IS THE SAME AS ARGUMENT 1.     **
C               ********************************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE2.NE.'V')GOTO2290
      IF(N2.EQ.N1)GOTO2290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2211)
 2211 FORMAT('***** ERROR IN DPADKS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)
 2212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2213)
 2213 FORMAT('      (FOR VARIABLE 2 OF ANDERSON-DARLING K-SAMPLE TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2214)
 2214 FORMAT('      MUST BE THE SAME AS VARIABLE 1')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2215)
 2215 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2216)N1,N2
 2216 FORMAT('      N1 = ',I8,' N2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2219)
 2219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2220)(IANS(I),I=1,IWIDTH)
 2220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 2290 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA  FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPADKS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH ANDERSON-DARLING K-SAMPLE TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y(J)=V(IJ)
      IF(ICOL1.EQ.MAXCP1)Y(J)=PRED(I)
      IF(ICOL1.EQ.MAXCP2)Y(J)=RES(I)
      IF(ICOL1.EQ.MAXCP3)Y(J)=YPLOT(I)
      IF(ICOL1.EQ.MAXCP4)Y(J)=XPLOT(I)
      IF(ICOL1.EQ.MAXCP5)Y(J)=X2PLOT(I)
      IF(ICOL1.EQ.MAXCP6)Y(J)=TAGPLO(I)
C
 4170 CONTINUE
      NS1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 42--                                **
C               **  TEMPORARILY FORM THE VARIABLE X(.)       **
C               **  WHICH WILL HOLD THE DATAN FROM SAMPLE 2.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE2.NE.'V')GOTO4290
C
      ISTEPN='42'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4210
      IF(ICASEQ.EQ.'SUBS')GOTO4220
      IF(ICASEQ.EQ.'FOR')GOTO4230
C
 4210 CONTINUE
      DO4215I=1,N2
      ISUB(I)=1
 4215 CONTINUE
      NQ=N2
      GOTO4250
C
 4220 CONTINUE
      NIOLD=N2
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4250
C
 4230 CONTINUE
      NIOLD=N2
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4250
C
 4250 CONTINUE
      IF(NQ.GE.MINN2)GOTO4260
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4251)
 4251 FORMAT('***** ERROR IN DPADKS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4252)
 4252 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4253)IH21,IH22
 4253 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4254)
 4254 FORMAT('      (FOR WHICH ANDERSON-DARLING K-SAMPLE TEST ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4255)
 4255 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4256)MINN2
 4256 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4257)NQ
 4257 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4258)
 4258 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4259)(IANS(I),I=1,IWIDTH)
 4259 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4260 CONTINUE
      J=0
      IMAX=N2
      IF(NQ.LT.N2)IMAX=NQ
      DO4270I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4270
      J=J+1
C
      IJ=MAXN*(ICOL2-1)+I
      IF(ICOL2.LE.MAXCOL)X(J)=V(IJ)
      IF(ICOL2.EQ.MAXCP1)X(J)=PRED(I)
      IF(ICOL2.EQ.MAXCP2)X(J)=RES(I)
      IF(ICOL2.EQ.MAXCP3)X(J)=YPLOT(I)
      IF(ICOL2.EQ.MAXCP4)X(J)=XPLOT(I)
      IF(ICOL2.EQ.MAXCP5)X(J)=X2PLOT(I)
      IF(ICOL2.EQ.MAXCP6)X(J)=TAGPLO(I)
C
 4270 CONTINUE
      NS2=J
C
 4290 CONTINUE
C
C               *****************************************
C               **  STEP 52--                          **
C               **  DO ANDERSON-DARLING K-SAMPLE TEST  **
C               *****************************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPADKS, AS WE ARE ABOUT TO CALL DPADK2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,NS1,NS2,MAXN
 5212 FORMAT('N1,N2,NS1,NS2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,NS1
      WRITE(ICOUT,5216)I,Y(I)
 5216 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      DO5217I=1,NS1
      WRITE(ICOUT,5218)I,Y(I)
 5218 FORMAT('I,Y(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5217 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPADK2(Y,X,NS1,
     1XTEMP,YTEMP,XPS,XPSU,WK3,IPBCH,ISIZE,IWK2,NTIE,
     1IBUGA3,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 DPADKS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPADK2(Y,TAG,N,
     1XTEMP,YTEMP,XPS,XPSU,WK3,IPBCH,ISIZE,IWK2,NTIE,
     1IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE COMPUTES THE ANDERSON-DARLING K-SAMPLE TEST
C              (ARE BATCHES SIMILAR?)
C     EXAMPLE--ANDERSON-DARLING K-SAMPLE TEST Y TAG
C     REFERENCE--XX
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--98/4
C     ORIGINAL VERSION--APRIL     1998.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IWRITE
C
      CHARACTER*6 ICONC1
CCCCC CHARACTER*6 ICONC2
CCCCC CHARACTER*6 ICONC3
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION TAG(*)
      DIMENSION YTEMP(*)
      DIMENSION XTEMP(*)
C
      DIMENSION IPBCH(*)
      DIMENSION ISIZE(*)
      DIMENSION IWK2(*)
      DIMENSION NTIE(*)
C
      DOUBLE PRECISION XPS(*)
      DOUBLE PRECISION XPSU(*)
      DOUBLE PRECISION WK3(*)
C
      DOUBLE PRECISION DADKST
      DOUBLE PRECISION DADC
      DOUBLE PRECISION DA, DB, DC, DD
      DOUBLE PRECISION DG, DS, DT
      DOUBLE PRECISION DK, DN
      DOUBLE PRECISION DVAR, DSD
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='DPAD'
      ISUBN2='K2  '
C
      IERROR='NO'
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPADK2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N
   55 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N
      WRITE(ICOUT,57)I,Y(I)
   57 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)N
   65 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO66I=1,N
      WRITE(ICOUT,67)I,TAG(I)
   67 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   66 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPADK2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPADK2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1135I=2,N
      IF(Y(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPADK2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
      IF(N.GE.1)GOTO1219
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPADK2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 2 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1212)N
 1212 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1219 CONTINUE
C
      IF(N.EQ.1)GOTO1220
      GOTO1229
 1220 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1221)
 1221 FORMAT('***** NOTE FROM DPADK2--VARIABLE 2 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1229 CONTINUE
C
      HOLD=TAG(1)
      DO1235I=2,N
      IF(TAG(I).NE.HOLD)GOTO1239
 1235 CONTINUE
 1230 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1231)HOLD
 1231 FORMAT('***** NOTE FROM DPADK2--VARIABLE 2 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1239 CONTINUE
C
 1290 CONTINUE
C
C               *****************************************
C               **  STEP 41--                          **
C               **  CARRY OUT CALCULATIONS             **
C               **  FOR ANDERSON-DARLING K-SAMPLE TEST **
C               *****************************************
C
 4100 CONTINUE
C
      ISTEPN='41'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C  SORT AND POOL Y AND TAG VARIABLE
C
      CALL SORTC(Y,TAG,N,Y,TAG)
C
C  COMPUTE DISTINCT VALUES OF Y AND TAG VARIABLE
C
      IWRITE='OFF'
      CALL DISTIN(TAG,N,IWRITE,XTEMP,NBCH,IBUGA3,IERROR)
      CALL DISTIN(Y,N,IWRITE,YTEMP,NDIST,IBUGA3,IERROR)
C
      DO4110I=1,N
        XPS(I)=DBLE(Y(I))
        IPBCH(I)=INT(TAG(I))
 4110 CONTINUE
      DO4120I=1,NDIST
        XPSU(I)=DBLE(YTEMP(I))
 4120 CONTINUE
C
      DO4130I=1,NBCH
        HOLD=XTEMP(I)
        ISIZE(I)=0
        DO4140J=1,N
          IF(TAG(J).EQ.HOLD)ISIZE(I)=ISIZE(I)+1
 4140   CONTINUE
 4130 CONTINUE
C
      CALL ANDYK(N,NBCH,XPS,XPSU,IPBCH,NTIE,ISIZE,WK3,IWK2,DADKST)
      ADKSTA=REAL(DADKST)
C
      ICONC1='REJECT'
C
C               ******************************************
C               **   STEP 42---                         **
C               **   CALCULATE 5% CRITICAL VALUE        **
C               **   FOR ANDERSON-DARLING K-SAMPLE TEST **
C               ******************************************
C
      DG=0.0D0
      DO4210I=1,N-2
        DO4220J=I+1,N-1
          DG=DG + 1.D0/DBLE((N-I)*J)
 4220   CONTINUE
 4210 CONTINUE
      DT=0.0D0
      DO4230I=1,N-1
        DT=DT + 1.0D0/DBLE(I)
 4230 CONTINUE
      DS=0.0D0
      DO4240I=1,NBCH
        DS=DS + 1.0D0/DBLE(ISIZE(I))
 4240 CONTINUE
C
      DK=DBLE(NBCH)
      DA=(4.0D0*DG-6.0D0)*(DK-1.0D0) + (10.D0-6.0D0*DG)*DS
      DB=(2.0D0*DG - 4.0D0)*DK*DK + 8.0D0*DT*DK +
     1   (2.0D0*DG - 14.0D0*DT -4.0D0)*DS -8.0D0*DT + 4.0D0*DG -6.0D0
      DC=(6.0D0*DT + 2.0D0*DG -2.0D0)*DK*DK +
     1   (4.0D0*DT - 4.0D0*DG + 6.0D0)*DK + (2.0*DT - 6.0D0)*DS +
     1   4.0D0*DT
      DD=(2.0D0*DT + 6.0D0)*DK*DK - 4.0*DT*DK
C
      DN=DBLE(N)
      DVAR=(DA*DN**3 +DB*DN**2 + DC*DN + DD)/
     1     DBLE((N-1)*(N-2)*(N-3)*(NBCH-1)**2)
      DSD=DSQRT(DVAR)
      DADC=1.0D0 + DSD*
     1  (1.645D0 + 0.678D0/DSQRT(DK-1.0D0) - 0.362D0/(DK-1.0D0))
      ADC=REAL(DADC)
C
      IF(ADKSTA.LT.ADC)ICONC1='ACCEPT'
C
C               ******************************************
C               **   STEP 43--                          **
C               **   WRITE OUT EVERYTHING               **
C               **   FOR ANDERSON-DARLING K-SAMPLE TEST **
C               ******************************************
C
      ISTEPN='42'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IPRINT.EQ.'OFF')GOTO7290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7211)
 7211 FORMAT('              ANDERSON-DARLING K-SAMPLE TEST FOR ',
     1'COMMON GROUPS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7222)
 7222 FORMAT('1. STATISTICS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7224)N
 7224 FORMAT(6X,'NUMBER OF OBSERVATIONS                     = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7226)NBCH
 7226 FORMAT(6X,'NUMBER OF GROUPS                           = ',I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7228)ADKSTA
 7228 FORMAT(6X,'ANDERSON-DARLING K-SAMPLE TEST STATISTIC   = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,7241)
 7241 FORMAT('2. FOR ANDERSON-DARLING K-SAMPLE TEST STATISTIC')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7349)ADC
 7349 FORMAT(6X,'95         % POINT                         = ',G15.7)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,7261)
 7261 FORMAT('3. CONCLUSION (AT THE 5% LEVEL):')
      CALL DPWRST('XXX','WRIT')
      IF(ICONC1.EQ.'ACCEPT')THEN
        WRITE(ICOUT,7262)
 7262   FORMAT(6X,'THE GROUPS ARE NOT SIGNIFICANTLY DIFFERENT.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7263)
 7263   FORMAT(6X,'THUS: CAN USE AS UNSTRUCTURED DATA.')
        CALL DPWRST('XXX','WRIT')
      ELSE
        WRITE(ICOUT,7272)
 7272   FORMAT(6X,'THE GROUPS ARE SIGNIFICANTLY DIFFERENT.')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,7273)
 7273   FORMAT(6X,'THUS: GROUPS SHOULD BE TREATED AS STRUCTURED.')
        CALL DPWRST('XXX','WRIT')
      ENDIF
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
 7290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPADK2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N
 9015 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N
      WRITE(ICOUT,9017)I,Y(I)
 9017 FORMAT('I,Y(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)N
 9025 FORMAT('N = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9026I=1,N
      WRITE(ICOUT,9027)I,TAG(I)
 9027 FORMAT('I,TAG(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPALLA(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IBUGG2,IBUGG3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--FORM
C              1) ALLAN VARIANCE PLOT;
C              2) ALLAN STANDARD DEVIATION PLOT;
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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/1
C     ORIGINAL VERSION--JANUARY   1987.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASQ
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
CCCCC CHARACTER*4 IHVA21
CCCCC CHARACTER*4 IHVA22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      ISUBN1='DPAL'
      ISUBN2='LA  '
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) ALLAN VARIANCE PLOT                               *
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 DPALLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ICASPL,IAND1,IAND2
   52 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGG2,IBUGG3,IBUGQ
   53 FORMAT('IBUGG2,IBUGG3,IBUGQ = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)MAXCOL
   54 FORMAT('MAXCOL = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***************************
C               **  STEP 1--             **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               *************************************************
C               **  STEP 1.1--                                 **
C               **  SEARCH FOR ALLAN VARIANCE PLOT             **
C               *************************************************
C
      ICASPL='ALVA'
C
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ALLA'.AND.IHARG(1).EQ.'VARI'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AV  '.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ALLA'.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
C
C               *************************************************
C               **  STEP 1.2--                                 **
C               **  SEARCH FOR ALLAN STANDARD DEVIATION PLOT   **
C               *************************************************
C
      ICASPL='ALSD'
C
      IF(NUMARG.GE.3.AND.
     1ICOM.EQ.'ALLA'.AND.IHARG(1).EQ.'STAN'.AND.IHARG(2).EQ.'DEVI'.AND.
     1IHARG(3).EQ.'PLOT')
     1GOTO113
      IF(NUMARG.GE.2.AND.
     1ICOM.EQ.'ALLA'.AND.IHARG(1).EQ.'SD'.AND.IHARG(2).EQ.'PLOT')
     1GOTO112
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'ASD '.AND.IHARG(1).EQ.'PLOT')
     1GOTO111
      IF(NUMARG.GE.1.AND.
     1ICOM.EQ.'AS  '.AND.IHARG(1).EQ.'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
  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 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.'ALVA')GOTO270
      IF(ICASPL.EQ.'ALSD')GOTO270
C
  260 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,261)
  261 FORMAT('***** INTERNAL ERROR IN DPALLA')
      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 ALVA OR ALSD')
      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
  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 DPALLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,312)IHLEFT,IHLEF2
  312 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS ',
     1'IN VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,313)
  313 FORMAT('      (FOR WHICH A PERIODOGRAM ANALYSIS  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,314)
  314 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,315)MINN2
  315 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,316)
  316 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,317)
  317 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,318)(IANS(I),I=1,IWIDTH)
  318 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  390 CONTINUE
C
C               *****************************************
C               **  STEP 5--                           **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='5'
      IF(IBUGG2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO490
      DO400J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO410
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO410
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO420
  400 CONTINUE
      GOTO490
  410 CONTINUE
      ICASQ='SUBS'
      ILOCQ=J1
      GOTO490
  420 CONTINUE
      ICASQ='FOR'
      ILOCQ=J1
      GOTO490
  490 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO495
      WRITE(ICOUT,491)NUMARG,ILOCQ
  491 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
  495 CONTINUE
C
C               ***********************************************
C               **  STEP 6--                                 **
C               **  CHECK FOR A VALID NUMBER                 **
C               **  OF VARIABLES                             **
C               **  (EXACTLY 1                               **
C               **  FOR AN ALLAN VARIANCE PLOT).             **
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
C
  550 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPALLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR AN ALLAN VARIANCE PLOT, ')
      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 1  ;')
      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
  590 CONTINUE
C
C               **********************************************
C               **  STEP 7--                                **
C               **  FORM THE VARIABLE Y1(.)                 **
C               **  WHICH WILL CONTAIN THE        VARIABLE; **
C               **  FORM THIS VARIABLE 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 DPALLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,652)
  652 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,653)IHLEFT,IHLEF2
  653 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,654)
  654 FORMAT('      (FOR WHICH AN AUTO OR CROSS-PERIODOGRAM ',
     1'ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,655)
  655 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,656)MINN2
  656 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,657)
  657 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,658)
  658 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,659)(IANS(I),I=1,IWIDTH)
  659 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  660 CONTINUE
      J=0
      IMAX=NLEFT
      IF(NQ.LT.NLEFT)IMAX=NQ
      DO670I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO670
      J=J+1
C
      IJ=MAXN*(ICOLL-1)+I
      IF(IBUGG2.EQ.'ON')WRITE(ICOUT,666)I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ)
  666 FORMAT('I,J,IJ,ICOLL,MAXCOL,MAXN,V(IJ) = ',6I8,E15.7)
      IF(IBUGG2.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(ICOLL.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLL.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLL.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLL.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLL.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLL.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLL.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
  670 CONTINUE
      NS=J
C
C
C               ****************************************************************
C               **  STEP 9--                                                   *
C               **  FORM THE VERTICAL AND HORIZONTAL AXIS                      *
C               **  VARIABLES (Y(.) AND X(.), RESPECTIVELY) FOR THE PLOT.      *
C               **  FORM THE CURVE DESIGNATION VARIABLE D(.)  .                *
C               **  THIS WILL BE ALL ONES.                                     *
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 DPALL2(Y1,Y2,NS,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPALLA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9013 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9090
      DO9015I=1,NPLOTP
      WRITE(ICOUT,9016)I,Y(I),X(I),D(I)
 9016 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPALL2(Y1,Y2,N,ICASPL,MAXN,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              1) ALLAN VARIANCE PLOT
C     NOTE-- IN ORDER THAT THE RESULTS OF THIS ALLAN ... PLOT ANALYSIS
C            BE VALID AND PROPERLY INTERPRETED, THE INPUT DATA
C            IN X SHOULD BE EQUI-SPACED IN TIME
C            (OR WHATEVER VARIABLE CORRESPONDS TO TIME).
C
C              THE HORIZONTAL AXIS OF THE PERIODOGRAM PRODUCED
C              BY THIS SUBROUTINE IS GROUP SIZE.
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 USUAL MAXIMUM NUMBER OF GROUP SIZES
C              FOR WHICH THE ALLAN VARIANCE PLOT IS
C              COMPUTED IS N/2 WHERE N IS
C              THE SAMPLE SIZE (LENGTH OF THE
C              DATA RECORD IN THE VECTOR X).
C     REFERENCES--ALLAN NBS PUBLICATION XXX
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--86/7
C     ORIGINAL VERSION--APRIL     6981.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IBUGG3
      CHARACTER*4 IERROR
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION Y1(*)
      DIMENSION Y2(*)
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION D(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPAL'
      ISUBN2='L2  '
C
      IERROR='NO'
C
      Y2BAR=0.0
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.2)GOTO39
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,31)
   31 FORMAT('***** ERROR IN DPALL2--')
      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 2;')
      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
      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 DPALL2--')
      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 DPALL2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)N,ICASPL,MAXN
   71 FORMAT('N,ICASPL,MAXN = ',I8,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      DO73I=1,N
      WRITE(ICOUT,74)I,Y1(I),Y2(I)
   74 FORMAT('I, Y1(I), Y2(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
   73 CONTINUE
   80 CONTINUE
C
C               *******************************
C               **  STEP 1--                 **
C               **  COMPUTE THE SAMPLE MEAN  **
C               *******************************
C
      AN=N
      SUM=0.0
      DO100I=1,N
      SUM=SUM+Y1(I)
  100 CONTINUE
      Y1BAR=SUM/AN
C
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)
      SDBY1=0.0
      IF(VARBY1.GT.0.0)SDBY1=SQRT(VARBY1)
      SDY1=0.0
      IF(VARY1.GT.0.0)SDY1=SQRT(VARY1)
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 ALLAN VARIANCE AND ALLAN STANDARD DEVIATION FOR Y1
C               **  REFERENCE--ALLAN, NBS PUBLICATION XXX
C               ****************************************************************
C
 1000 CONTINUE
      IF(ICASPL.EQ.'ALVA')GOTO1100
      IF(ICASPL.EQ.'ALSD')GOTO1100
CCCCC IF(ICASPL.EQ.'ALCO')GOTO1200
      GOTO1900
C
 1100 CONTINUE
C
CCCCC J=1
CCCCC Y(J)=0.0
CCCCC IF(ICASPL.EQ.'ALVA')Y(J)=VARBY1
CCCCC IF(ICASPL.EQ.'ALSD')Y(J)=SDBY1
CCCCC X(J)=J-1
CCCCC D(J)=1.0
      J=0
C
      NHALF=N/2
      NIMAX=NHALF
      IF(NHALF.GT.MAXN)NIMAX=MAXN
C
      DO1110NI=1,NIMAX
      ANI=NI
      J=J+1
C
      IMIN1=0
      IMAX1=0
      IMIN2=0
      IMAX2=0
C
      SSQD=0.0
      IRATIO=N/NI
      KMAX=IRATIO/2
      AKMAX=KMAX
      DO1120K=1,KMAX
C
      IMIN1=IMAX2+1
      IMAX1=IMIN1+(NI-1)
      IMIN2=IMAX1+1
      IMAX2=IMIN2+(NI-1)
C
      SUM=0.0
      DO1130I=IMIN1,IMAX1
      SUM=SUM+Y1(I)
 1130 CONTINUE
      Y3=SUM/ANI
C
      SUM=0.0
      DO1140I=IMIN2,IMAX2
      SUM=SUM+Y1(I)
 1140 CONTINUE
      Y4=SUM/ANI
C
      DEL=Y4-Y3
      DELSQ=DEL*DEL
      SSQD=SSQD+DELSQ
C
 1120 CONTINUE
C
      AV=SSQD/(2.0*AKMAX)
      ASD=0.0
      IF(AV.GT.0.0)ASD=SQRT(AV)
C
      Y(J)=0.0
      IF(ICASPL.EQ.'ALVA')Y(J)=AV
      IF(ICASPL.EQ.'ALSD')Y(J)=ASD
      X(J)=J
      D(J)=1.0
C
 1110 CONTINUE
      NPLOTP=J
      NPLOTV=2
      GOTO9000
C
 1900 CONTINUE
C
C               ******************
C               **   STEP 90--  **
C               **   EXIT       **
C               ******************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPALL2--')
      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 ')
      WRITE(ICOUT,9013)N,NHALF,MAXN,NIMAX
 9013 FORMAT('N,NHALF,MAXN,NIMAX = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IRATIO,KMAX
 9014 FORMAT('IRATIO,KMAX = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IMIN1,IMAX1,IMIN2,IMAX2
 9015 FORMAT('IMIN1,IMAX1,IMIN2,IMAX2 = ',4I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)Y3,Y4,DEL,DELSQ,SSQD,AV,ASD
 9016 FORMAT('Y3,Y4,DEL,DELSQ,SSQD,AV,ASD = ',7E11.4)
      CALL DPWRST('XXX','BUG ')
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3E15.7)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAMPL(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE AMPLIFIERS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE BACK CENTER AND THE FRONT TIP
C           OF THE AMPLIFIER.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE BACK CENTER OF THE
C           DRAWN AMPLIFIER WILL BE
C           AT THE LAST CURSOR POSITION,
C           AND THE FRONT POINT OF THE
C           DRAWN AMPLIFIER WILL BE
C           AT THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE BACK CENTER OF THE
C           DRAWN AMPLIFIER WILL BE
C           AT THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS,
C           AND THE FRONT POINT OF THE
C           DRAWN AMPLIFIER WILL BE
C           AT THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN 2 AMPLIFIERS WILL BE DRAWN.
C           THE BACK CENTER OF THE
C           FIRST DRAWN AMPLIFIER WILL BE
C           AT THE (X,Y) POSITION
C           AS RESULTING FROM THE FIRST AND SECOND NUMBERS,
C           AND THE FRONT POINT OF THE
C           FIRST DRAWN AMPLIFIER WILL BE
C           AT THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C           THE SECOND DRAWN AMPLIFIER WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS,
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--IF 8 NUMBERS ARE PROVIDED,
C           THEN 3 AMPLIFIERS WILL BE DRAWN.
C     NOTE--AND SO FORTH FOR 10, 12, 14 ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AMPL')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPAMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='AMPL'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPAMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW AN AMPLIFIER ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH BACK CENTER AT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND FRONT TIP AT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      AMPLIFIER 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      AMPLIFIER ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y5,Y5,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPAMP2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AMPL')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAMPL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAMP2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW AN AMPLIFIER
C              WITH THE BACK CENTER AT (X1,Y1)
C              AND THE FRONT TIP AT (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AMP2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPAMP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE AMPLIFIER          **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      LEN=SQRT((X2-X1)**2+(Y2-Y1)**2)
      ALEN=LEN
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      JXDEL=ALEN
      JYDEL=(SQRT(3.0)/3.0)*ALEN
C
      XDEL=JXDEL
      YDEL=JYDEL
C
      K=0
C
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=0.0
      Y=-YDEL
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=0.0
      Y=YDEL
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,
     1IPATT2)
 2190 CONTINUE
C
C               *********************************
C               **  STEP 3--                   **
C               **  DRAW OUT THE FIGURE  R     **
C               *********************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AMP2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAMP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAND(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE LOGICAL ANDS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE BACK CENTER AND THE FRONT CENTER
C           OF THE LOGICAL AND.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL AND WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL AND WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LOGICAL AND WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AND')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='AND'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A LOGICAL AND ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH THE MIDDLE OF THE FLAT SIDE  ',
     1'AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH THE MIDDLE OF ROUNDED SIDE AT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      LOGICAL AND 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      LOGICAL AND ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPAND2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AND')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAND--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAND2(X1,Y1,X2,Y2,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A LOGICAL AND (= AN AND BOX)
C              WITH THE MIDDLE OF THE FLAT SIDE
C              AT THE POINT (X1,Y1),
C              AND WITH THE MIDDLE OF THE CURVED SIDE
C              AT THE POINT (X2,Y2).
C     NOTE--THE HEIGHT OF THE BOX WILL BE EQUAL TO
C           THE ABOVE-DESCRIBED WIDTH OF THE BOX
C           (THAT IS, THE HEIGHT
C           OF THE BOX WILL BE EQUAL TO
C           THE WIDTH FROM (X1,Y1) TO (X2,Y2).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AND2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPAND2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE LOGICAL AND        **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      ALEN=0.0
      TERM=(X2-X1)**2+(Y2-Y1)**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      K=0
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      DO5110I=1,181,5
      PHI2=I-91
      PHI2=PHI2*(2.0*3.1415926)/360.0
      X=R*COS(PHI2)+R
      Y=R*SIN(PHI2)
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
 5110 CONTINUE
C
      X=0
      Y=R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=0
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=R
      Y=-R
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               *********************************
C               **  STEP 3--                   **
C               **  DRAW OUT THE FIGURE  AND   **
C               *********************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
C
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'AND2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAND2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANDR(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,PANINC,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--GENERATE AN ANDREWS PLOT--
C              A MULTIVARIATE TECHNICQUE WHICH PLOTS THE FOLLOWING
C              TRANSFORMATION--
C                Fi(T) = X1/SQRT(2) + X2*SIN(T) + X3*COS(T) +
C                        X4*SIN(2*T) + X5*COS(2T) + ...
C              ONE CURVE IS GENERATED FOR EACH ROW OF DATA (THE NUMBER
C              OF VARIABLES DOES NOT AFFECT THE NUMBER OF CURVES
C              GENERATED).
C     WRITTEN BY--ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--92/11
C     ORIGINAL VERSION--NOVEMBER  1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IHRIGH
      CHARACTER*4 IHRIG2
      CHARACTER*4 IVARN1
      CHARACTER*4 IVARN2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
C  MAXAND IS THE MAXIMUM NUMBER OF VARIABLES TO USE IN CREATING THE
C  ANDREWS CURVE
C
      PARAMETER(MAXAND=20)
C
      DIMENSION IVARN1(MAXAND)
      DIMENSION IVARN2(MAXAND)
      DIMENSION ILIS(MAXAND)
      DIMENSION Z(MAXOBV,MAXAND)
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),Z(1,1))
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='DPAN'
      ISUBN2='DR  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MAXV2=2
      MINN2=1
C
      ICOLH=0
C
C               ***********************************
C               **  TREAT THE ANDREWS PLOT CASE  **
C               ***********************************
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ANDR')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPANDR--')
      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.'ANDR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASPL='ANDR'
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.'ANDR')
     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               **  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.'ANDR')
     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.'ANDR')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,MAXAND,
     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.'ANDR')
     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(NRIGHT.NE.NTEMP)IFLAG=1
      ENDIF
      ILIS(I)=ILOCV
      IF(NRIGHT.GE.MINN2)GOTO1390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1311)
 1311 FORMAT('***** ERROR IN DPANDR--')
      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 ANDREWS 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               ******************************************************
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.'ANDR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFLAG.EQ.0)GOTO1490
C
 1410 CONTINUE
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPANDR--')
      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;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1415)
 1415 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      DO1417I=1,NUMVAR
      I2=ILIS(I)
      WRITE(ICOUT,1416)IVARN1(I2),IVARN2(I2),IN(I2)
 1416 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
 1417 CONTINUE
      WRITE(ICOUT,1420)
      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,IWIDTH)
 1421 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 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.'ANDR')
     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.'ANDR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2200K=1,NUMVAR
      IHRIGH=IVARN1(K)
      IHRIG2=IVARN2(K)
C
      DO2210I=1,NUMNAM
      I2=I
      IF(IHRIGH.EQ.IHNAME(I).AND.IHRIG2.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO2219
 2210 CONTINUE
      WRITE(ICOUT,2211)
 2211 FORMAT('***** INTERNAL ERROR IN DPANDR AT POINT 2210--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2212)IHRIGH,IHRIG2
 2212 FORMAT('      THE VARIABLE ',A4,A4)
      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.'ANDR')
     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.'ANDR')
     1CALL DPWRST('XXX','BUG ')
      IF(ICOLR.LE.MAXCOL)Z(J,K)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)Z(J,K)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)Z(J,K)=RES(I)
      IF(ICOLR.EQ.MAXCP3)Z(J,K)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)Z(J,K)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)Z(J,K)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)Z(J,K)=TAGPLO(I)
 2240 CONTINUE
      NLOCAL=J
      NSUB=NLOCAL
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(.) SO THAT EACH ANDREW'S     **
C               **  CURVE HAS ITS OWNS TAG NUMBER.                   **
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).    **
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).    **
C               *******************************************************
C
      ISTEPN='8'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANDR')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      CALL DPANR2(Z,NZ,ICASPL,PANINC,
     1NLOCAL,MAXOBV,MAXAND,MAXPOP,
     1Y,X,D,NPLOTP,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ANDR')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPANDR--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG2,IBUGG3,IBUGQ,ISUBRO
 9012 FORMAT('IBUGG2,IBUGG3,IBUGQ,ISUBRO = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IFOUND,IERROR
 9013 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2
 9014 FORMAT('NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2 = ',
     1I8,I8,I8,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NSUB
 9021 FORMAT('NSUB = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NSUB.LE.0)GOTO9024
      DO9022I=1,NSUB
      WRITE(ICOUT,9023)I,(Z(I,K),K=1,NUMVAR)
 9023 FORMAT('I,Z(I,K) = ',I8,20E15.7)
      CALL DPWRST('XXX','BUG ')
 9022 CONTINUE
 9024 CONTINUE
      WRITE(ICOUT,9041)NZ
 9041 FORMAT('NZ = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)NPLOTP
 9051 FORMAT('NPLOTP = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9054
      DO9052I=1,NPLOTP
      WRITE(ICOUT,9053)I,Y(I),X(I),D(I)
 9053 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9052 CONTINUE
 9054 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANR2(Z,NZ,ICASPL,PANINC,
     1NOBS,MAXOBV,MAXAND,MAXPOP,
     1Y2,X2,D2,N2,NPLOTV,IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              A ANDREWS PLOT
C              (USEFUL FOR MULTIVARIATE ANALYSIS).
C     WRITTEN BY--ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--92/11
C     ORIGINAL VERSION--NOVEMBER  1992.
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 Z(MAXOBV,MAXAND)
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='DPAN'
      ISUBN2='R2  '
C
      IERROR='NO'
C
      PI=3.1415926
      NINC=2*PI/PANINC+0.5
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 DPANR2--')
      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.'ANR2')GOTO90
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)
   71 FORMAT('***** AT THE BEGINNING OF DPANR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)ICASPL,NZ,NOBS,NPLOTV
   72 FORMAT('ICASPL,NZ,NOBS,NPLOTV = ',A4,2X,3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NZ.LE.0)GOTO83
      DO81I=1,NZ
      WRITE(ICOUT,82)I,(Z(I,K),K=1,NZ)
   82 FORMAT('I,Z(I,K) = ',I8,20E12.5)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
   83 CONTINUE
   90 CONTINUE
C
C               ****************************************
C               **  STEP 11--                         **
C               **  DETERMINE PLOT COORDINATES        **
C               ****************************************
C
      ICOUNT=0
      NTEMP=NZ-1
      IF(MOD(NTEMP,2).EQ.0)THEN
        NSIN=NTEMP/2
        NCOS=NSIN
      ELSE
        NSIN=NTEMP/2
        NCOS=NSIN
        NSIN=NSIN+1
      ENDIF
C
      DO100ICASE=1,NOBS
        TVALUE=-PI
        DO200J=1,NINC
          ICOUNT=ICOUNT+1
          IF(ICOUNT.GT.MAXPOP)THEN
            WRITE(ICOUT,201)
 201  FORMAT(1X,'ERROR IN DPANR2.  MAXIMUM NUMBER OF PLOT POINTS')
            CALL DPWRST('XXX','BUG ')
            WRITE(ICOUT,202)
 202  FORMAT(1X,'WAS EXCEEDED.')
            CALL DPWRST('XXX','BUG ')
            IERROR='YES'
            GOTO9000
          ENDIF
          X2(ICOUNT)=TVALUE
          D2(ICOUNT)=REAL(ICASE)
          Y2(ICOUNT)=Z(ICASE,1)/SQRT(2.0)
          IF(NSIN.GE.1)THEN
            DO300K=1,NSIN
              INDX=2+(K-1)*2
              Y2(ICOUNT)=Y2(ICOUNT)+Z(ICASE,INDX)*SIN(K*TVALUE)
 300        CONTINUE
          ENDIF
          IF(NCOS.GE.1)THEN
            DO400K=1,NCOS
              INDX=3+(K-1)*2
              Y2(ICOUNT)=Y2(ICOUNT)+Z(ICASE,INDX)*COS(K*TVALUE)
 400        CONTINUE
          ENDIF
          TVALUE=TVALUE+PANINC
 200    CONTINUE
 100  CONTINUE
C
      N2=ICOUNT
      NPLOTV=2
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ANR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPANR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,NZ,N2,IERROR
 9012 FORMAT('ICASPL,NZ,N2,IERROR = ',A4,2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)N2,NPLOTV
 9031 FORMAT('N2,NPLOTV = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO9035I=1,N2
      WRITE(ICOUT,9036)I,Y2(I),X2(I),D2(I)
 9036 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANIN(IHARG,IARGT,ARG,NUMARG,DEFAIN,
     1ANDINC,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ANDREWS INCREMENT
C              THIS DEFINES THE RESOLUTION ALONG THE X AXIS
C              FOR ANDREWS PLOTS.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --DEFAIN (A  FLOATING POINT VARIABLE)
C     OUTPUT ARGUMENTS--ANDINC  (A  FLOATING POINT VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY-ALAN HECKERT
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1992.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1199
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'INCR')GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPANIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ANDREWS INCREMENT ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      ANDREWS INCREMENT .01')
      CALL DPWRST('XXX','BUG ')
      GOTO1199
C
 1150 CONTINUE
      HOLD=DEFAIN
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      IF(HOLD.LE.0.0)HOLD=DEFAIN
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ANDINC=HOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ANDINC
 1181 FORMAT('THE ANDREWS INCREMENT HAS JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPANGL(IHARG,IARGT,ARG,NUMARG,
     1IATXSW,
     1ADEFAN,IDEFDI,
     1ATEXAN,ITEXDI,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ANGLE AT WHICH OR TEXT IS TO
C              BE PRINTED (AS, FOR EXAMPLE, IN DIAGRAMS).
C              THE SPECIFIED ANGLE VALUE WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE ATEXAN.
C     CAUTION--IATXSW IS BOTH AN INPUT AND OUTPUT ARGUMENT
C              TO THIS SUBROUTINE--IT MAY BE CHANGED HEREIN.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --IARGT  (A  CHARACTER VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IATXSW (A  CHARACTER VARIABLE)
C                     --ADEFAN (A  FLOATING POINT VARIABLE)
C                     --IDEFDI (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--ATEXAN  (A  FLOATING POINT VARIABLE)
C                     --ITEXDI (A CHARACTER VARIABLE)
C                     --IATXSW (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IBUGD2
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     UPDATED         --JUNE      1992. SET ITEXDI
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IATXSW
      CHARACTER*4 IDEFDI
      CHARACTER*4 ITEXDI
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(IBUGD2.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPANGL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IATXSW,ADEFAN,IDEFDI
   53 FORMAT('IATXSW,ADEFAN,IDEFDI = ',A4,2X,E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(1).EQ.'UNIT')GOTO9000
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      IF(IARGT(NUMARG).EQ.'NUMB')GOTO1160
C
      IF(IHARG(NUMARG).EQ.'RADI')GOTO1140
      IF(IHARG(NUMARG).EQ.'DEGR')GOTO1140
      IF(IHARG(NUMARG).EQ.'GRAD')GOTO1140
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPANGL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ANGLE ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE ANALYST DESIRES THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      ANGLE UNITS TO BE MEASURED IN DEGREES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      AND WISHES TO HAVE SUCCEEDING TEXT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1128)
 1128 FORMAT('      PRINTED OUT AT AN ANGLE OF 45 DEGREES, ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      ANGLE UNITS DEGREES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('      ANGLE 45 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1140 CONTINUE
      IFOUND='YES'
      IATXSW=IHARG(NUMARG)
C
      IF(IFEEDB.EQ.'OFF')GOTO1149
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)IATXSW
 1141 FORMAT('THE ANGLE UNITS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1149 CONTINUE
      GOTO9000
C
 1150 CONTINUE
      HOLD=ADEFAN
      GOTO1180
C
 1160 CONTINUE
      HOLD=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ATEXAN=HOLD
C
CCCCC THE FOLLOWING 15 LINES WERE ADDED JUNE 1992 (JJF)
      IF(IATXSW.EQ.'RADI')THEN
         IF(-0.1.LE.ATEXAN.AND.ATEXAN.LE.0.1)ITEXDI='HORI'
         IF(1.4.LE.ATEXAN.AND.ATEXAN.LE.1.7)ITEXDI='DIAG'
         IF(3.0.LE.ATEXAN.AND.ATEXAN.LE.3.3)ITEXDI='VERT'
      ENDIF
      IF(IATXSW.EQ.'DEGR')THEN
         IF(-1.0.LE.ATEXAN.AND.ATEXAN.LE.1.0)ITEXDI='HORI'
         IF(44.0.LE.ATEXAN.AND.ATEXAN.LE.46.0)ITEXDI='DIAG'
         IF(89.0.LE.ATEXAN.AND.ATEXAN.LE.91.0)ITEXDI='VERT'
      ENDIF
      IF(IATXSW.EQ.'GRAD')THEN
         IF(-1.0.LE.ATEXAN.AND.ATEXAN.LE.1.0)ITEXDI='HORI'
         IF(49.0.LE.ATEXAN.AND.ATEXAN.LE.51.0)ITEXDI='DIAG'
         IF(99.0.LE.ATEXAN.AND.ATEXAN.LE.101.0)ITEXDI='VERT'
      ENDIF
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IF(IATXSW.EQ.'RADI')WRITE(ICOUT,1181)ATEXAN
 1181 FORMAT('THE ANGLE HAS JUST BEEN SET TO ',
     1E15.7,' RADIANS')
      IF(IATXSW.EQ.'RADI')CALL DPWRST('XXX','BUG ')
      IF(IATXSW.EQ.'DEGR')WRITE(ICOUT,1182)ATEXAN
 1182 FORMAT('THE ANGLE HAS JUST BEEN SET TO ',
     1E15.7,' DEGREES')
      IF(IATXSW.EQ.'DEGR')CALL DPWRST('XXX','BUG ')
      IF(IATXSW.EQ.'GRAD')WRITE(ICOUT,1183)ATEXAN
 1183 FORMAT('THE ANGLE HAS JUST BEEN SET TO ',
     1E15.7,' GRADS')
      IF(IATXSW.EQ.'GRAD')CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)ATEXAN
 8111 FORMAT('THE CURRENT (TEXT) ANGLE  IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)ADEFAN
 8112 FORMAT('THE DEFAULT (TEXT) ANGLE  IS ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8121)IATXSW
 8121 FORMAT('THE CURRENT (TEXT) ANGLE UNITS  IS ',A4)
      CALL DPWRST('XXX','BUG ')
      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 DPANGL--')
      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)IATXSW,ADEFAN,IDEFDI
 9013 FORMAT('IATXSW,ADEFAN,IDEFDI = ',A4,2X,E15.7,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ATEXAN,ITEXDI
 9014 FORMAT('ATEXAN,ITEXDI = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANGU(IHARG,NUMARG,
     1IDEFAU,
     1IATXSW,
     1IBUGD2,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ANGLE UNITS IN WHICH
C              THE ANGLE FOR SCRIPT OR TEXT IS TO
C              BE PRINTED (AS, FOR EXAMPLE, IN DIAGRAMS).
C              OR IN WHICH
C              TRIGONOMETRIC CALCULATIONS ARE TO BE CARRIED OUT,
C              THE SPECIFIED ANGLE UNITS WILL BE PLACED
C              IN THE CHARACTER VARIABLE IATXSW.
C     INPUT  ARGUMENTS--IHARG  (A  CHARACTER VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C                     --IDEFAU (A  CHARACTER VARIABLE)
C     OUTPUT ARGUMENTS--IATXSW (A CHARACTER VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IBUGD2
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--NOVEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IDEFAU
      CHARACTER*4 IATXSW
      CHARACTER*4 IBUGD2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      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 DPANGU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IDEFAU
   53 FORMAT('IDEFAU = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMARG
   54 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I)
   56 FORMAT('I,IHARG(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
      IF(NUMARG.LE.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'UNIT')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'UNIT')GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
C
      IF(IHARG(NUMARG).EQ.'RADI')GOTO1160
      IF(IHARG(NUMARG).EQ.'DEGR')GOTO1160
      IF(IHARG(NUMARG).EQ.'GRAD')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPANGU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ANGLE UNITS ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE ANALYST DESIRES THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      ANGLE UNITS TO BE MEASURED IN DEGREES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      ANGLE UNITS DEGREES ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      IHOLD=IDEFAU
      GOTO1180
C
 1160 CONTINUE
      IHOLD=IHARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IATXSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IATXSW
 1181 FORMAT('THE ANGLE UNITS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               ********************************************
C               **  STEP 81--                             **
C               **  TREAT THE    ?    CASE--              **
C               **  DUMP OUT CURRENT AND DEFAULT VALUES.  **
C               ********************************************
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)IATXSW
 8111 FORMAT('THE CURRENT (TEXT) ANGLE UNITS IS ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8112)IDEFAU
 8112 FORMAT('THE DEFAULT (TEXT) ANGLE UNITS IS ',A4)
      CALL DPWRST('XXX','BUG ')
      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 DPANGU--')
      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)IDEFAU,IATXSW
 9013 FORMAT('IDEFAU,IATXSW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANIM(IHARG,NUMARG,IANISW,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ANIMATION SWITCH IANISW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG
C     OUTPUT ARGUMENTS--IANISW  ('ON'  OR 'OFF')
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--APRIL     1989.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IANISW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO1150
      IF(NUMARG.GE.1)GOTO1110
      GOTO1199
C
 1110 CONTINUE
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IANISW='ON'
      GOTO1180
C
 1160 CONTINUE
      IANISW='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IANISW
 1181 FORMAT('THE ANIMATION SWITCH HAS JUST BEEN TURNED ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPANO2(Y,F1,W,N,NUMFAC,
     1F1ID,F1N,F1MEAN,F1EFFE,F1EFSD,MAXOBV,MAXLEV,MAXFAC,
     1N1,ISET,AN1,E1,SS1,RESMS1,FVAL,F1CDF2,RSD,
CCCCC SUBROUTINE DPANO2(Y,F1,F2,F3,F4,F5,W,N,NUMFAC,
     1B,SDB,FCUM,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
     1Z,
     1ICAPSW,ICAPTY,
     1IBUGA3,IERROR)
C
C     PURPOSE--DO A MULTI-WAY ANOVA
C              FOR 1, 2, 3, 4, OR 5 FACTORS.
C              THE ASSUMED MODEL IS RESPONSE = CONSTANT + FACTOR-1 EFFECT + ...
C                                              FACTOR-NUMFAC EFFECT + ERROR
C     NOTE-- LINES NEAR 390 NEEDS TO BE GENERALIZED FOR
C     UNEQUAL NUMBER OF OBS PER CELL.
C     PRINTING--YES
C     SUBROUTINES NEEDED--FCDF
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --JULY      1979.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --OCTOBER   1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988.      ADD LOFCDF
C     UPDATED         --AUGUST    1988. CHANGED DIMENSIONS 100 TO 500
C     UPDATED         --JUNE      1989. 0-TRAP WHEN IRESDF = 0
C     UPDATED         --JUNE      1990. DIMENSION Z IN DPANOV
C     UPDATED         --MAY       1995. EQUIVALENCE FOR MACINTOSH
C     UPDATED         --JANUARY   1996. MAKE MAXIMUM NUMBER OF LEVELS
C                                       SETTABLE VIA PARAMETER
C                                       STATEMENT (AND PUT IN CHECKS
C                                       FOR EXCEEDING THIS MAXIMUM)
C     UPDATED         --FEBRUARY  1997. BUG FIX AT STEP 8
C     UPDATED         --JANUARY   1998. SIMPLIFY CODE, MAJOR REWRITE
C     UPDATED         --APRIL     1999. BUG FIX, MOVE 11690 CONTINUE
C     UPDATED         --JUNE      2002. RESSD FOR MODEL TO DPST3F.DAT
C     UPDATED         --NOVEMBER  2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 ICAPTY
      CHARACTER*1 IBASLC
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IREP
      CHARACTER*2 ISIG
CCCCC ADD FOLLOWING LINE 4/98
      CHARACTER*4 ICASBL
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
CCCCC THE FOLLOWING 2 SECTIONS WERE ADDED FEBRUARY 1998.
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*4 ISUBN0
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
C
C---------------------------------------------------------------------
C
      DIMENSION Y(*)
      DIMENSION W(*)
      DIMENSION F1(MAXOBV,MAXFAC)
      DIMENSION F1ID(MAXLEV,MAXFAC)
      DIMENSION F1N(MAXLEV,MAXFAC)
      DIMENSION F1MEAN(MAXLEV,MAXFAC)
      DIMENSION F1EFFE(MAXLEV,MAXFAC)
      DIMENSION F1EFSD(MAXLEV,MAXFAC)
C
      DIMENSION B(*)
      DIMENSION SDB(*)
      DIMENSION FCUM(*)
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
C
      DIMENSION N1(*)
      DIMENSION ISET(*)
      DIMENSION AN1(*)
      DIMENSION E1(*)
C
      DIMENSION SS1(*)
      DIMENSION RESMS1(*)
      DIMENSION FVAL(*)
      DIMENSION F1CDF2(*)
      DIMENSION RSD(*)
      DIMENSION Z(*)
CCCCC THE FOLLOWING INCLUDE STATEMENT WAS ADDED FEBRUARY 1998.
      INCLUDE 'DPCOF2.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERROR='NO'
C
      ISUBN1='DPAN'
      ISUBN2='O2  '
      AN=N
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 DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)N,NUMFAC
   52 FORMAT('N,NUMFAC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,N
      WRITE(ICOUT,56)I,Y(I),(F1(I,J),J=1,MIN(NUMFAC,5)),W(I)
   56 FORMAT('I,Y(I),(F1(I,J),J=1,MIN(NUMFAC,5)) = ',
     1I8,7E11.4)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO109
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,101)
  101 FORMAT('***** ERROR IN DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,102)
  102 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ANOVA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,103)
  103 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,104)N
  104 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  109 CONTINUE
C
      IF(N.GE.2)GOTO119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,116)
  116 FORMAT('***** ERROR IN DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,117)
  117 FORMAT('      THE NUMBER OF OBSERVATIONS FOR THE ANOVA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,118)
  118 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  119 CONTINUE
C
      IF(NUMFAC.GE.1.AND.NUMFAC.LE.MAXFAC)GOTO139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,131)
  131 FORMAT('***** ERROR IN DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,132)
  132 FORMAT('      THE NUMBER OF FACTORS FOR THE ANOVA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,133)MAXFAC
  133 FORMAT('      MUST BE AT LEAST 1 AND AT MOST ',I6,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,134)NUMFAC
  134 FORMAT('      THE ENTERED NUMBER OF FACTORS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  139 CONTINUE
C
      HOLD=Y(1)
      DO140I=1,N
      IF(Y(I).NE.HOLD)GOTO149
  140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,141)
  141 FORMAT('***** ERROR IN DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,142)
  142 FORMAT('      ALL RESPONSE VARIABLE ELEMENTS FOR THE ANOVA')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,143)HOLD
  143 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
  149 CONTINUE
C
      DO150J=1,NUMFAC
        HOLD=F1(1,J)
        DO155I=1,N
          HOLD2=F1(I,J)
          IF(HOLD2.NE.HOLD)GOTO150
  155   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,151)
        CALL DPWRST('XXX','BUG ')
  151   FORMAT('***** ERROR IN DPANO2--')
        WRITE(ICOUT,152)J
  152   FORMAT('      ALL ELEMENTS OF FACTOR ',I5,' IN THE ANOVA')
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,153)HOLD
  153   FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','BUG ')
        GOTO9000
  150 CONTINUE
C
C               ***********************************************
C               **  STEP 1.1--                               **
C               **  DETERMINE THE NUMBER OF DISTINCT VALUES  **
C               **  FOR EACH FACTOR                          **
C               ***********************************************
C
      ISTEPN='1.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC FOLLOWING INITIALIZATION NEEDED FOR LAHEY COMPILER.  OCTOBER 1998
      DO1159I=1,MAXFAC
        N1(I)=0
 1159 CONTINUE
C
      DO1160K=1,NUMFAC
        N1(K)=0
        DO160I=1,N
          IF(N1(K).LE.0)GOTO180
          DO170J=1,N1(K)
            IF(F1(I,K).EQ.F1ID(J,K))GOTO160
  170     CONTINUE
  180     CONTINUE
          N1(K)=N1(K)+1
          IF(N1(K).GT.MAXLEV)THEN
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','BUG')
            WRITE(ICOUT,190)MAXLEV,K
            CALL DPWRST('XXX','BUG')
            IERROR='YES'
            GOTO9000
          ENDIF
  190 FORMAT('***** ERROR IN DPANO2--MAXIMUM NUMBER OF LEVELS, ',I10,
     1' EXCEEDED FOR FACTOR ',I5)
          F1ID(N1(K),K)=F1(I,K)
  160   CONTINUE
        IF(N1(K).LE.0)THEN
          WRITE(ICOUT,999)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,165)K
          CALL DPWRST('XXX','BUG ')
          IERROR='YES'
          GOTO9000
        ENDIF
  165   FORMAT('***** ERROR IN DPANO2--N = 0 FOR FACTOR ',I5)
  169   CONTINUE
        AN1(K)=REAL(N1(K))
 1160 CONTINUE
C
C               **************************************
C               **  STEP 2--                        **
C               **  SORT THE LEVELS OF EACH FACTOR  **
C               **  SO AS TO PUT THEM IN ORDER FOR  **
C               **  PRESENTATION PURPOSES.          **
C               **************************************
C
      ISTEPN='2'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO1900K=1,NUMFAC
        CALL SORT(F1ID(1,K),N1(K),F1ID(1,K))
 1900 CONTINUE
C
C               ********************************************
C               **  STEP 3--                              **
C               **  DETERMINE IF HAVE                     **
C               **  REPLICATION WITHIN CELLS.             **
C               **  IF SO, COMPUTE (FOR EACH CELL)--      **
C               **         1) NUMBER OF OBSERVATIONS;     **
C               **         2) MEAN;                       **
C               **         3) SUM OF SQUARED DEVIATIONS.  **
C               **  NOTE: THIS SECTION NEEDS TO BE        **
C               **        IF MAXIMUM NUMBER OF FACTORS IS **
C               **        UPGRADED (I.E., MAXFAC)         **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IREP='NO'
      IREPDF=0
      REPDF=0.0
      REPSS=0.0
      REPSD=0.0
C
 3500 CONTINUE
      ISTEPN='3.5'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=0
      ICASBL='YES'
      DO3510ISET1=1,N1(1)
      ISET(1)=ISET1
      DO3520ISET2=1,MAX(1,N1(2))
      ISET(2)=ISET2
      DO3530ISET3=1,MAX(1,N1(3))
      ISET(3)=ISET3
      DO3540ISET4=1,MAX(1,N1(4))
      ISET(4)=ISET4
      DO3550ISET5=1,MAX(1,N1(5))
      ISET(5)=ISET5
      DO3563ISET6=1,MAX(1,N1(6))
      ISET(6)=ISET6
      DO3573ISET7=1,MAX(1,N1(7))
      ISET(7)=ISET7
      DO3583ISET8=1,MAX(1,N1(8))
      ISET(8)=ISET8
      DO3593ISET9=1,MAX(1,N1(9))
      ISET(9)=ISET9
      DO3598ISET10=1,MAX(1,N1(10))
      ISET(10)=ISET10
        K=K+1
        CELLN=0.0
        CELLME=0.0
C
        NI=0
        DO3560I=1,N
          DO3565L=1,NUMFAC
            IF(F1(I,L).NE.F1ID(ISET(L),L))GOTO3560 
 3565     CONTINUE
          NI=NI+1
          Z(NI)=Y(I)
 3560   CONTINUE
C
        CELLN=NI
        IF(NI.LE.0)GOTO3590
        IF(NI.EQ.1)CELLME=Z(NI)
        IF(NI.EQ.1)GOTO3590
        IREP='YES'
        SUM=0.0
        DO3570I=1,NI
          SUM=SUM+Z(I)
 3570   CONTINUE
        CELLME=SUM/CELLN
C
        IF(K.EQ.1)NIOLD=NI
        IF(NI.NE.NIOLD.AND.ICASBL.EQ.'YES')THEN
          WRITE(ICOUT,999)
          CALL DPWRST('BUG','XXXX')
          WRITE(ICOUT,3571)
          CALL DPWRST('BUG','XXXX')
          WRITE(ICOUT,999)
          CALL DPWRST('BUG','XXXX')
          ICASBL='NO'
        ENDIF
        NIOLD=NI
        SUM=0.0
        DO3580I=1,NI
          SUM=SUM+(Z(I)-CELLME)**2
 3580   CONTINUE
        CELLV=SUM/(CELLN-1.0)
C
        REPSS=REPSS+SUM
        IREPDF=IREPDF+NI-1
 3590   CONTINUE
 3571 FORMAT('WARNING: UNBALANCED CASE DETECTED.  SOME COMPUTATIONS',
     1       ' MAY NOT BE ACCURATE.')
 3598 CONTINUE
 3593 CONTINUE
 3583 CONTINUE
 3573 CONTINUE
 3563 CONTINUE
 3550 CONTINUE
 3540 CONTINUE
 3530 CONTINUE
 3520 CONTINUE
 3510 CONTINUE
      GOTO3900
C
C
 3900 CONTINUE
      NUMCEL=K
      IF(IREP.EQ.'NO')GOTO3950
      REPDF=IREPDF
      REPMS=REPSS/REPDF
      IF(REPMS.LE.0.0)REPSD=0.0
      IF(REPMS.GT.0.0)REPSD=SQRT(REPMS)
 3950 CONTINUE
C
C               ******************************
C               **  STEP 4--                **
C               **  COMPUTE THE GRAND MEAN  **
C               ******************************
C
      ISTEPN='4'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      SUM=0.0
      DO4100I=1,N
        SUM=SUM+Y(I)
 4100 CONTINUE
      GMEAN=SUM/AN
C
      SUM=0.0
      DO4200I=1,N
        SUM=SUM+(Y(I)-GMEAN)**2
 4200 CONTINUE
      GSS=SUM
      GVAR=GSS/(AN-1.0)
      IF(GVAR.LE.0.0)GSD=0.0
      IF(GVAR.GT.0.0)GSD=SQRT(GVAR)
C
C               ***********************************************
C               **  STEP 5.1--                               **
C               **  DETERMINE (FOR EACH LEVEL OF EACH FACTOR)**
C               **      1) NUMBER OF OBSERVATIONS;           **
C               **      2) MEAN;                             **
C               **      3) ESTIMATED EFFECT (COEFFICIENT)    **
C               ***********************************************
C
      ISTEPN='5.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO5190K=1,NUMFAC
        DO5100J=1,N1(K)
          SUM1=0.0
          SUM2=0.0
          DO5120I=1,N
            IF(F1(I,K).EQ.F1ID(J,K))THEN
              SUM1=SUM1+1.0
              SUM2=SUM2+Y(I)
            ENDIF
 5120     CONTINUE
          F1N(J,K)=SUM1
          F1MEAN(J,K)=SUM2/SUM1
          F1EFFE(J,K)=F1MEAN(J,K)-GMEAN
 5100   CONTINUE
 5190 CONTINUE
C
C               ******************************************
C               **  STEP 6--                            **
C               **  COMPUTE THE FOLLOWING--             **
C               **     1) PREDICTED VALUES;             **
C               **     2) RESIDUALS;                    **
C               **     3) RESIDUAL STANDARD DEVIATION;  **
C               **     4) RESIDUAL DEGREES OF FREEDOM;  **
C               **  IF HAVE REPLICATION,                **
C               **  THEN ALSO CARRY OUT                 **
C               **  THE LACK OF FIT F TEST.             **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      RESSS=0.0
      IRESDF=0
      RESDF=0.0
      RESMS=0.0
      RESSD=0.0
      ALFCDF=(-999.99)
C
      DO6000I=1,N
        DO6900K=1,NUMFAC
          DO6100ISET1=1,N1(K)
            J1=ISET1
            IF(F1(I,K).EQ.F1ID(ISET1,K))GOTO6115
 6100     CONTINUE
 6115     CONTINUE
          E1(K)=F1EFFE(J1,K)
 6900   CONTINUE
C
        PRED2(I)=GMEAN
        DO6910K=1,NUMFAC
         PRED2(I)=PRED2(I)+E1(K)
 6910   CONTINUE
        RES2(I)=Y(I)-PRED2(I)
 6000 CONTINUE
C
      IRESDF=N-1
      DO6920K=1,NUMFAC
        IRESDF=IRESDF-(N1(K)-1)
 6920 CONTINUE
      RESDF=IRESDF
      IF(IRESDF.GE.1)GOTO6009
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6001)
 6001 FORMAT('***** ERROR IN DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6002)
 6002 FORMAT('      RESIDUAL DEGREES OF FREEDOM = 0')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6003)
 6003 FORMAT('      THE PRESCRIBED MODEL PROVIDES')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6004)
 6004 FORMAT('      AN EXACT FIT FOR THE DATA.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6005)
 6005 FORMAT('      THE NUMBER OF PARAMETERS IN THE MODEL')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,6006)
 6006 FORMAT('      EQUALS THE NUMBER OF DATA POINTS.')
      CALL DPWRST('XXX','BUG ')
 6009 CONTINUE
C
      SUM=0.0
      DO6210I=1,N
        SUM=SUM+RES2(I)*RES2(I)
 6210 CONTINUE
      RESSS=SUM
      RESMS=0.0
      IF(IRESDF.GE.1)RESMS=RESSS/RESDF
      IF(RESMS.LE.0.0)RESSD=0.0
      IF(RESMS.GT.0.0)RESSD=SQRT(RESMS)
C
      IF(IREP.EQ.'NO')GOTO6990
      IFITDF=IRESDF-IREPDF
      FITDF=IFITDF
      IF(IFITDF.LE.0)GOTO6990
      IF(IREPDF.LE.0)GOTO6990
      FITSS=RESSS-REPSS
      FITMS=FITSS/FITDF
      FITFVA=FITMS/REPMS
      CALL FCDF(FITFVA,IFITDF,IREPDF,FITCDF)
      FITCD2=100.0*FITCDF
      ALFCDF=FITCDF
 6990 CONTINUE
C
C               ************************************************
C               **  STEP 7--                                  **
C               **  COMPUTE THE ESTIMATED STANDARD DEVIATION  **
C               **  OF THE GRAND MEAN                         **
C               **  AND THE ESTIMATED STANDARD DEVIATION      **
C               **  OF THE ESTIMATED EFFECTS.                 **
C               ************************************************
C
      ISTEPN='7'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N.LE.0)GMEASD=0.0
      IF(N.GT.0)GMEASD=RESSD/SQRT(AN)
C
      DO7190K=1,NUMFAC
        DO7100ISET1=1,N1(K)
          ANI=F1N(ISET1,K)
          CONST=((1.0/ANI)-(1.0/AN))
          F1EFSD(ISET1,K)=0.0
          IF(CONST.GT.0.0)F1EFSD(ISET1,K)=RESSD*SQRT(CONST)
 7100   CONTINUE
 7190 CONTINUE
C
C               ********************************
C               **  STEP 8--                  **
C               **  PERFORM THE F TEST        **
C               **  TO TEST THE SIGNIFICANCE  **
C               **  OF EACH FACTOR            **
C               ********************************
C
      ISTEPN='8'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IRESDF.LE.0.OR.RESMS.LE.0.0)GOTO8900
C
      DO8190K=1,NUMFAC
C
        SUM=0.0
        DO8100J=1,N1(K)
          SUM=SUM+F1N(J,K)*F1EFFE(J,K)*F1EFFE(J,K)
 8100   CONTINUE
        SS1(K)=SUM
        IDF1=N1(K)-1
        DF1=IDF1
        RESMS1(K)=SS1(K)/DF1
        IF(RESMS1(K).LE.0.0)RSD(K)=0.0
        IF(RESMS1(K).GT.0.0)RSD(K)=SQRT(RESMS1(K))
        FVAL(K)=RESMS1(K)/RESMS
        CALL FCDF(FVAL(K),IDF1,IRESDF,FCUM(K))
        F1CDF2(K)=100.0*FCUM(K)
 8190 CONTINUE
 8900 CONTINUE
C
C               *************************************************
C               **  STEP 9.1--                                 **
C               **  DETERMINE THE RESIDUAL STANDARD DEVIATION  **
C               **  FOR FACTOR K ONLY.                         **
C               *************************************************
C
      ISTEPN='9.1'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO9190K=1,NUMFAC
        SUM=0.0
        DO9100I=1,N
        DO9110J=1,N1(K)
          J1=J
          IF(F1(I,K).EQ.F1ID(J,K))GOTO9120
 9110   CONTINUE
 9120   CONTINUE
        WMEAN=F1MEAN(J1,K)
        SUM=SUM+(Y(I)-WMEAN)**2
 9100   CONTINUE
        WSS1=SUM
        WDF1=AN-AN1(K)
        WVAR1=WSS1/WDF1
        IF(WVAR1.LE.0.0)WSD1=0.0
        IF(WVAR1.GT.0.0)WSD1=SQRT(WVAR1)
        RSD(K)=WSD1
 9190 CONTINUE
C
C               ******************************************************
C               **  STEP 10--
C               **  COPY OVER INTO THE OUTPUT VECTORS B(.) AND SDB(.)--
C               **       1) THE GRAND MEAN;
C               **       2) THE ESTIMATED EFFECTS;
C               **       3) THE STANDARD DEVIATIONS OF GRAND MEAN
C               **          AND EFFECTS.
C               ******************************************************
C
      ISTEPN='10'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      K=1
      B(K)=GMEAN
      SDB(K)=GMEASD
C
      DO10190L=1,NUMFAC
C
        DO10100ISET1=1,N1(L)
          K=K+1
          B(K)=F1EFFE(ISET1,L)
          SDB(K)=F1EFSD(ISET1,L)
10100   CONTINUE
10190   CONTINUE
C
C               ****************************
C               **  STEP 11--             **
C               **  WRITE EVERYTHING OUT  **
C               ****************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IDEFAV=1
      SSAV=N*GMEAN
      SSTO=RESSS+SSAV
      DO13402L=1,NUMFAC
        SSTO=SSTO+SS1(L)
13402 CONTINUE
      IDEFTO=N
C
      IF(IPRINT.EQ.'ON')THEN
      IF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'HTML')THEN
CCCCC WRITE OUTPUT IN HTML FORMAT
C
C  STEP 1: END ASIS MODE AND WRITE A HEADER
C
15001   FORMAT('</PRE>')
15002   FORMAT('<CENTER>')
15003   FORMAT('<B>',I2,'-WAY ANALYSIS OF VARIANCE</B>')
15004   FORMAT('</CENTER>')
15005   FORMAT('<BR><BR>')
        WRITE(ICOUT,15001)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15002)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15003)NUMFAC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15004)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
15011   FORMAT('<UL>')
15013   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,15011)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15013)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
15041   FORMAT('   <TR>')
15043   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM WIDTH=250>')
15047   FORMAT('      </TD>')
15049   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=100>')
15051   FORMAT('         ',G15.7)
15053   FORMAT('         ',I8)
15055   FORMAT('         &nbsp;')
15059   FORMAT('   </TR>')
15061   FORMAT('         Number of Observations:')
15062   FORMAT('         Number of Factors:')
15063   FORMAT('         Number of Levels for Factor ',I2,':')
15064   FORMAT('         Balanced Case')
15065   FORMAT('         Unbalanced Case')
15066   FORMAT('         Residual Standard Deviation:')
15067   FORMAT('         Residual Degrees of Freedom:')
15068   FORMAT('         No Replication Case')
15069   FORMAT('         Replication Case')
15070   FORMAT('         Replication Standard Deviation:')
15071   FORMAT('         Replication Degrees of Freedom:')
15072   FORMAT('         Number of Distinct Cells:')
        WRITE(ICOUT,15041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15061)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15053)N
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15062)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15053)NUMFAC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15059)
        CALL DPWRST('XXX','WRIT')
C
        DO15080L=1,NUMFAC
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15063)L
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15053)N1(L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
15080   CONTINUE
C
        IF(ICASBL.EQ.'NO')THEN
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15065)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15064)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,15041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15066)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15051)RESSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15059)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15041)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15043)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15067)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15049)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15053)IRESDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15047)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15059)
        CALL DPWRST('XXX','WRIT')
C
        IF(IREP.EQ.'NO')THEN
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15068)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15069)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15055)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15070)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15051)REPSD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15041)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15043)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15071)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15049)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15053)IREPDF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15047)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15059)
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
15091   FORMAT('</TABLE>')
15093   FORMAT('</UL>')
        WRITE(ICOUT,15091)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15093)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
15111   FORMAT('<UL>')
15113   FORMAT('<TABLE NOBORDER>')
15115   FORMAT('   <CAPTION ALIGN=CENTER>')
15117   FORMAT('      <B>ANOVA Table</B>')
15119   FORMAT('   </CAPTION>')
        WRITE(ICOUT,15111)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15113)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15115)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15117)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15119)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
15121   FORMAT('   <TR>')
15123   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM>')
15127   FORMAT('      </TH>')
15139   FORMAT('   </TR>')
15160   FORMAT('      </TD>')
15161   FORMAT('      <TD COLSPAN=7>')
15162   FORMAT('          <HR>')
15163   FORMAT('         Source')
15164   FORMAT('         Degrees of<BR>Freedom')
15165   FORMAT('         Sum of<BR>Squares')
15166   FORMAT('         Mean<BR>Square')
15167   FORMAT('         F<BR>Statistic')
15168   FORMAT('         F<BR>CDF')
15169   FORMAT('         Significant')
15170   FORMAT('         Total<BR>(Corrected)')
15171   FORMAT('         Residual')
C
        WRITE(ICOUT,15121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15163)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15164)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15165)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15166)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15167)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15168)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15169)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15160)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15170)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15153)N-1
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15151)GSS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15151)GSS/REAL(N-1)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15160)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
15141   FORMAT('   <TR>')
15143   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=100>')
15144   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=50>')
15145   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=125>')
15147   FORMAT('      </TD>')
15151   FORMAT('         ',G15.7)
15152   FORMAT('         ',F8.3,'%')
15153   FORMAT('         ',I8)
15154   FORMAT('         Factor ',I2)
15155   FORMAT('         &nbsp;')
15156   FORMAT('         ',F14.4)
15157   FORMAT('         ',A2)
15159   FORMAT('   </TR>')
        DO15179L=1,NUMFAC
          WRITE(ICOUT,15141)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15154)L
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15144)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15153)N1(L)-1
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15145)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15151)SS1(L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15145)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15151)SS1(L)/REAL(N1(L)-1)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15156)FVAL(L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15143)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15152)F1CDF2(L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          ISIG='  '
          IF(F1CDF2(L).GE.95.0)ISIG=' *'
          IF(F1CDF2(L).GE.99.0)ISIG='**'
          WRITE(ICOUT,15144)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15157)ISIG
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15147)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15159)
          CALL DPWRST('XXX','WRIT')
15179   CONTINUE
C
        WRITE(ICOUT,15121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15161)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15162)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15160)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15139)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15121)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15171)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15153)IRESDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15151)RESSS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15151)RESMS
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15123)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15155)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15127)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15139)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
15191   FORMAT('</TABLE>')
15193   FORMAT('</UL>')
        WRITE(ICOUT,15191)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15193)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
15211   FORMAT('<UL>')
15213   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,15211)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15213)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
15241   FORMAT('   <TR>')
15243   FORMAT('      <TD ALIGN=LEFT VALIGN=TOP WIDTH=300>')
15247   FORMAT('      </TD>')
15249   FORMAT('      <TD ALIGN=RIGHT VALIGN=TOP WIDTH=100>')
15251   FORMAT('         ',G15.7)
15253   FORMAT('         ',I8)
15255   FORMAT('         &nbsp;')
15259   FORMAT('   </TR>')
15261   FORMAT('         Residual Standard Deviation:')
15262   FORMAT('         Residual Degrees of Freedom:')
15263   FORMAT('         Replication Standard Deviation:')
15264   FORMAT('         Replication Degrees of Freedom:')
15265   FORMAT('         Lack of Fit Test cannot Be performed')
15266   FORMAT('         because there is only 0 degrees of freedom')
15267   FORMAT('         in the numerator of the F ratio.  This')
15268   FORMAT('         happens when the number of parameters fitted')
15269   FORMAT('         is identical to number of distinct subsets.')
15270   FORMAT('         Lack of Fit Ratio:')
15271   FORMAT('         <br>(= the ',F9.4,'% point of the F')
15272   FORMAT('         distribution with ',I6,' and ',I6,'degrees')
15273   FORMAT('         of freedom.')
        WRITE(ICOUT,15241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15261)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15251)RESSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15259)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15241)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15243)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15262)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15249)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15253)IRESDF
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15247)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15259)
        CALL DPWRST('XXX','WRIT')
C
        IF(IREP.EQ.'YES')THEN
          WRITE(ICOUT,15241)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15263)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15247)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15249)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15251)REPSD
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15247)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15259)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15241)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15243)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15264)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15247)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15249)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15253)IREPDF
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15247)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15259)
          CALL DPWRST('XXX','WRIT')
          IF(IFITDF.LT.1)THEN
            IF(NUMFAC.NE.1)THEN
              WRITE(ICOUT,15241)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15243)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15265)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15266)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15267)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15268)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15269)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15247)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15249)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15255)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15247)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15259)
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ELSE
            WRITE(ICOUT,15241)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15243)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15270)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15271)FITCD2
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15272)IFITDF,IREPDF
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15273)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15247)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15249)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15251)FITFVA
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15247)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15259)
            CALL DPWRST('XXX','WRIT')
          ENDIF
        ENDIF
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
15291   FORMAT('</TABLE>')
15293   FORMAT('</UL>')
        WRITE(ICOUT,15291)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15293)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
15311   FORMAT('<UL>')
15312   FORMAT('<TABLE NOBORDER>')
15313   FORMAT('   <CAPTION ALIGN=CENTER>')
15314   FORMAT('      <B>Estimation</B>')
15315   FORMAT('   </CAPTION>')
        WRITE(ICOUT,15311)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15312)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15313)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15314)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15315)
        CALL DPWRST('XXX','WRIT')
C
15316   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM COLSPAN=4>')
15317   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM COLSPAN=2>')
15318   FORMAT('         Grand Mean:')
15319   FORMAT('         Grand Standard Deviation:')
        WRITE(ICOUT,15341)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15316)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15318)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15349)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15351)GMEAN
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15359)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,15341)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15316)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15319)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15349)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15351)GSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15359)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
15321   FORMAT('   <TR>')
15322   FORMAT('      <TH ALIGN=RIGHT VALIGN=TOP WIDTH=100>')
15323   FORMAT('      </TH>')
15324   FORMAT('   </TR>')
15325   FORMAT('      <TD COLSPAN=6>')
15326   FORMAT('          <HR>')
15331   FORMAT('         &nbsp;')
15332   FORMAT('         Level-ID')
15333   FORMAT('         NI')
15334   FORMAT('         Mean')
15335   FORMAT('         Effect')
15336   FORMAT('         SD<SUB>Effect</SUB>')
        WRITE(ICOUT,15321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15322)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15331)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15322)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15332)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15322)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15333)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15322)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15334)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15322)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15335)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15322)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15336)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15323)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15324)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,15321)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15325)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15326)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15347)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15324)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
15341   FORMAT('   <TR>')
15347   FORMAT('      </TD>')
15349   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM WIDTH=100>')
15351   FORMAT('         ',G15.7)
15352   FORMAT('         ',F11.5)
15353   FORMAT('         ',I8)
15354   FORMAT('         Factor ',I2,'--')
15355   FORMAT('         ',A8)
15356   FORMAT('         &nbsp;')
15359   FORMAT('   </TR>')
        DO15340L=1,NUMFAC
C
          WRITE(ICOUT,15341)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,15349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15354)L
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15352)F1ID(1,L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15353)INT(F1N(1,L))
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15351)F1MEAN(1,L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15351)F1EFFE(1,L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15347)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15349)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15351)F1EFSD(1,L)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,15347)
          CALL DPWRST('XXX','WRIT')
C
          WRITE(ICOUT,15359)
          CALL DPWRST('XXX','WRIT')
C
          IF(N1(L).GT.1)THEN
            DO15360I=2,N1(L)
C
              WRITE(ICOUT,15341)
              CALL DPWRST('XXX','WRIT')
C
              WRITE(ICOUT,15349)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15356)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15347)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15349)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15352)F1ID(I,L)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15347)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15349)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15353)INT(F1N(I,L))
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15347)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15349)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15351)F1MEAN(I,L)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15347)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15349)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15351)F1EFFE(I,L)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15347)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15349)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15351)F1EFSD(I,L)
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,15347)
              CALL DPWRST('XXX','WRIT')
C
              WRITE(ICOUT,15359)
              CALL DPWRST('XXX','WRIT')
C
15360       CONTINUE
          ENDIF
C
15340   CONTINUE
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
15391   FORMAT('</TABLE>')
15393   FORMAT('</UL>')
        WRITE(ICOUT,15391)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15393)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 2: START TABLE AND DEFINE A CAPTION
C
15511   FORMAT('<UL>')
15513   FORMAT('<TABLE NOBORDER>')
        WRITE(ICOUT,15511)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15513)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 3: DEFINE HEADER ROW
C
15521   FORMAT('   <TR>')
15523   FORMAT('      <TH ALIGN=CENTER VALIGN=BOTTOM>')
15525   FORMAT('         Model')
15526   FORMAT('         Residual<BR>Standard Deviation')
15527   FORMAT('      </TH>')
15529   FORMAT('      <TH ALIGN=RIGHT VALIGN=BOTTOM>')
15539   FORMAT('   </TR>')
15561   FORMAT('      <TD COLSPAN=2>')
15562   FORMAT('          <HR>')
        WRITE(ICOUT,15521)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15523)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15525)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15527)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15529)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15526)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15527)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15539)
        CALL DPWRST('XXX','WRIT')
C
C  FOLLOWING ADDS A RULE LINE BETWEEN HEADER AND DATA LINES
C
        WRITE(ICOUT,15521)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15561)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15562)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15539)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: DEFINE DATA ROW
C
15541   FORMAT('   <TR>')
15543   FORMAT('      <TD ALIGN=LEFT VALIGN=BOTTOM>')
15547   FORMAT('      </TD>')
15549   FORMAT('      <TD ALIGN=RIGHT VALIGN=BOTTOM>')
15551   FORMAT('         ',G15.7)
15553   FORMAT('         ',I8)
15555   FORMAT('         ',A8)
15559   FORMAT('   </TR>')
15571   FORMAT('         Constant Only:')
15572   FORMAT('         Constant and Factor ',I2,':')
15573   FORMAT('         Constant and All ',I2,' Factors:')
        WRITE(ICOUT,15541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15571)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15551)GSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15559)
        CALL DPWRST('XXX','WRIT')
C
        IF(NUMFAC.GE.1)THEN
          DO15569I=1,NUMFAC
            WRITE(ICOUT,15541)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15543)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15572)I
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15547)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15549)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15551)RSD(I)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15547)
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,15559)
            CALL DPWRST('XXX','WRIT')
15569     CONTINUE
        ENDIF
C
        WRITE(ICOUT,15541)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15543)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15573)I
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15549)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15551)RESSD
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15547)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15559)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 4: END THE TABLE AND RESET ASIS MODE
C
15591   FORMAT('</TABLE>')
15593   FORMAT('</UL>')
15599   FORMAT('<PRE>')
        WRITE(ICOUT,15591)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15593)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,15599)
        CALL DPWRST('XXX','WRIT')
C
CCCCC WRITE OUTPUT IN LATEX FORMAT
      ELSEIF(ICAPSW.EQ.'ON' .AND. ICAPTY.EQ.'LATE')THEN
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
18001 FORMAT(A1,'end{verbatim}')
18003 FORMAT(A1,'begin{table}')
18005 FORMAT('{',A1,'bf ',I2,'-WAY ANALYSIS OF VARIANCE}')
18007 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
18009 FORMAT(A1,'begin{center}')
18013 FORMAT(A1,'end{center}')
C
        CALL DPCONA(92,IBASLC)
C
        WRITE(ICOUT,18001)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18003)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18005)IBASLC,NUMFAC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18007)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
18020 FORMAT(5X,A1,'begin{tabular} {lr}')
18021 FORMAT(5X,'Number of Observations: & ',I8,2X,A1,A1)
18022 FORMAT(5X,'Number of Factors: & ',I8,2X,A1,A1)
18023 FORMAT(5X,'Number of Levels for Factor ',I2,': & ',I8,2X,A1,A1)
18024 FORMAT(5X,'Unbalanced Case: & ',2X,A1,A1)
18025 FORMAT(5X,'Balanced Case: & ',2X,A1,A1)
18026 FORMAT(5X,'Residual Standard Deviation: & ',G15.7,2X,A1,A1)
18027 FORMAT(5X,'Residual Degrees of Freedom: & ',I8,2X,A1,A1)
18028 FORMAT(5X,'No Replication Case: & ',2X,A1,A1)
18029 FORMAT(5X,'Replication Case: & ',2X,A1,A1)
18030 FORMAT(5X,'Replication Standard Deviation: & ',G15.7,2X,A1,A1)
18031 FORMAT(5X,'Replication Degrees of Freedom: & ',I8,2X,A1,A1)
18032 FORMAT(5X,'Number of Distinct Cells: & ',I8,2X,A1,A1)
18040 FORMAT(5X,A1,'hline')
18049 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,18009)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18020)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18021)N,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18022)NUMFAC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        DO18080L=1,NUMFAC
          WRITE(ICOUT,18023)L,N1(L),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
18080   CONTINUE
        IF(ICASBL.EQ.'NO')THEN
          WRITE(ICOUT,18024)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,18025)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,18026)RESSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18027)IRESDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IREP.EQ.'NO')THEN
          WRITE(ICOUT,18028)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,18029)IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,18030)REPSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,18031)IREPDF,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,18032)NUMCEL,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18049)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
18091 FORMAT(A1,'end{center}')
18093 FORMAT(A1,'end{table}')
        WRITE(ICOUT,18091)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18093)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
18103 FORMAT(A1,'begin{table}')
18107 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
18109 FORMAT(A1,'begin{center}')
18111 FORMAT(5X,'{',A1,'bf ANOVA Table}')
18113 FORMAT(A1,'end{center}')
C
        WRITE(ICOUT,18103)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18111)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18107)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18113)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
18120 FORMAT(5X,A1,'begin{tabular} {rrrrrrr}')
18121 FORMAT(5X,' & Degrees of & Sum of & Mean & F & F & Significant ',
     1       2X,A1,A1)
18122 FORMAT(5X,'Source & Freedom & Squares & Square & Statistic & ',
     1       'CDF & Significant ',2X,A1,A1)
18123 FORMAT(5X,'Total & & & & & & ',2X,A1,A1)
18124 FORMAT(5X,'(Corrected) & ',I5,' & ',G15.7,' & ',G15.7,
     1       ' &  &  &  ',2X,A1,A1)
18125 FORMAT(5X,'Factor ',I2,' & ',I5,' & ',G15.7,' & ',G15.7,
     1       ' & ',F14.4,' & ',F8.3,A1,'% &  ',A2,2X,A1,A1)
18126 FORMAT(5X,'Residual & ',I5,' & ',G15.7,' & ',G15.7,
     1       ' &  &  &  ',2X,A1,A1)
18140 FORMAT(5X,A1,'hline')
18149 FORMAT(A1,'end{tabular}')
C
        WRITE(ICOUT,18109)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18120)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18121)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18122)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18140)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18123)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18124)N-1,GSS,GSS/(N-1),IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18140)IBASLC
        CALL DPWRST('XXX','WRIT')
        DO18129L=1,NUMFAC
          ISIG='  '
          IF(F1CDF2(L).GE.95.0)ISIG=' *'
          IF(F1CDF2(L).GE.99.0)ISIG='**'
          WRITE(ICOUT,18125)L,N1(L)-1,SS1(L),SS1(L)/REAL(N1(L)-1),
     1                      FVAL(L),F1CDF2(L),IBASLC,ISIG,
     1                      IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
18129   CONTINUE
        WRITE(ICOUT,18140)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18126)IRESDF,RESSS,RESMS,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18149)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
18191 FORMAT(A1,'end{center}')
18193 FORMAT(A1,'end{table}')
        WRITE(ICOUT,18191)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18193)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
18203 FORMAT(A1,'begin{table}')
18209 FORMAT(A1,'begin{center}')
18213 FORMAT(A1,'end{center}')
C
        WRITE(ICOUT,18203)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
18220 FORMAT(5X,A1,'begin{tabular} {lr}')
18221 FORMAT(5X,'Residual Standard Deviation: & ',G15.7,2X,A1,A1)
18222 FORMAT(5X,'Residual Degrees of Freedom: & ',I8,2X,A1,A1)
18223 FORMAT(5X,'Replication Standard Deviation: & ',G15.7,2X,A1,A1)
18224 FORMAT(5X,'Replication Degrees of Freedom: & ',I8,2X,A1,A1)
18225 FORMAT(5X,'Lack of Fit Test cannot be performed because & ',
     1       2X,A1,A1)
18226 FORMAT(5X,'there is only 0 degrees of freedom in the numerator ',
     1       '&',2X,A1,A1)
18227 FORMAT(5X,'of the F ratio. This happens when the number of ',
     1       '&',2X,A1,A1)
18228 FORMAT(5X,'parameters fitted is identical to the number of ',
     1       'distinct subsets. &',2X,A1,A1)
18229 FORMAT(5X,'Lack of Fit Ratio: & ',G15.7,2X,A1,A1)
18230 FORMAT(5X,'(= the ',F9.4,A1,'% point of the F distribution & ',
     1       2X,A1,A1)
18231 FORMAT(5X,'with ',I6,' and ',I6,' degrees of freedom. & ',
     1       2X,A1,A1)
18249 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,18209)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18220)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18221)RESSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18222)IRESDF,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        IF(IREP.EQ.'YES')THEN
          WRITE(ICOUT,18223)REPSD,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,18224)IREPDF,IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(IFITDF.LT.1)THEN
            IF(NUMFAC.NE.1)THEN
              WRITE(ICOUT,18225)IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,18226)IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,18227)IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,18228)IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
            ENDIF
          ELSE
            WRITE(ICOUT,18229)FITFVA,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,18230)FITCD2,IBASLC,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,18231)IFITDF,IREPDF,IBASLC,IBASLC
            CALL DPWRST('XXX','WRIT')
          ENDIF
        ENDIF
        WRITE(ICOUT,18249)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
18291 FORMAT(A1,'end{center}')
18293 FORMAT(A1,'end{table}')
        WRITE(ICOUT,18291)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18293)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
18303 FORMAT(A1,'begin{table}')
18307 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
18309 FORMAT(A1,'begin{center}')
18311 FORMAT(5X,'{',A1,'bf Estimation}')
18313 FORMAT(A1,'end{center}')
C
        WRITE(ICOUT,18303)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18311)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18307)IBASLC,IBASLC,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18313)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
18320 FORMAT(5X,A1,'begin{tabular} {rrrrrr}')
18321 FORMAT(5X,'Grand Mean: & & & ',G15.7,' & & ',2X,A1,A1)
18322 FORMAT(5X,'Grand Standard: & & & & & ',
     1       2X,A1,A1)
18328 FORMAT(5X,'Deviation: & & & ',G15.7,' & & ',
     1       2X,A1,A1)
18323 FORMAT(5X,'& Level-ID & NI & Mean & Effect & $SD_{Effect}$',
     1       2X,A1,A1)
18325 FORMAT(5X,'Factor ',I2,': & ',F11.5,' & ',I8,' & ',
     1       F11.5,' & ',F11.5,' & ',F11.5,2X,A1,A1)
18326 FORMAT(5X,' & ',F11.5,' & ',I8,' & ',
     1       F11.5,' & ',F11.5,' & ',F11.5,2X,A1,A1)
18329 FORMAT(5X,' & & & & & ',2X,A1,A1)
18340 FORMAT(5X,A1,'hline')
18349 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,18309)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18320)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18321)GMEAN,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18322)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18328)GSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18329)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18323)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18340)IBASLC
        CALL DPWRST('XXX','WRIT')
C
        DO18350L=1,NUMFAC
          WRITE(ICOUT,18325)L,F1ID(1,L),INT(F1N(1,L)+0.5),F1MEAN(1,L),
     1                      F1EFFE(1,L),F1EFSD(1,L),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
          IF(N1(L).GT.1)THEN
            DO18360I=2,N1(L)
              WRITE(ICOUT,18326)F1ID(I,L),INT(F1N(I,L)+0.5),
     1                          F1MEAN(I,L),F1EFFE(I,L),F1EFSD(I,L),
     1                          IBASLC,IBASLC
              CALL DPWRST('XXX','WRIT')
18360       CONTINUE
          ENDIF
18350   CONTINUE
C
        WRITE(ICOUT,18349)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
18391 FORMAT(A1,'end{center}')
18393 FORMAT(A1,'end{table}')
        WRITE(ICOUT,18391)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18393)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C  STEP 1: END ASIS FORMAT, START TABLE ENVIRONMENT, WRITE A HEADER, AND
C          WRITE A TABLE CAPTION
C
18403 FORMAT(A1,'begin{table}')
18407 FORMAT(5X,'$ ',A1,1X,A1,' $ ',A1,A1,' ')
18409 FORMAT(A1,'begin{center}')
18413 FORMAT(A1,'end{center}')
C
        WRITE(ICOUT,18403)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
C STEP 2: START TABULAR ENVIRONMENT, WRITE SUBSESQUENT ROWS, END
C         TABULAR ENVIRONMENT
C
18420 FORMAT(5X,A1,'begin{tabular} {lr}')
18421 FORMAT(5X,' & Residual',2X,A1,A1)
18422 FORMAT(5X,'Model & Standard Deviation',2X,A1,A1)
18423 FORMAT(5X,'Constant Only: & ',G15.7,2X,A1,A1)
18424 FORMAT(5X,'Constant and Factor ',I2,' Only: & ',G15.7,2X,A1,A1)
18425 FORMAT(5X,'Constant and All ',I2,' Factors: & ',G15.7,2X,A1,A1)
18440 FORMAT(5X,A1,'hline')
18449 FORMAT(A1,'end{tabular}')
        WRITE(ICOUT,18409)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18420)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18421)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18422)IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18440)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18423)GSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        DO18450I=1,NUMFAC
          WRITE(ICOUT,18424)I,RSD(I),IBASLC,IBASLC
          CALL DPWRST('XXX','WRIT')
18450   CONTINUE
        WRITE(ICOUT,18425)I,RESSD,IBASLC,IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18449)IBASLC
        CALL DPWRST('XXX','WRIT')
C
C STEP 3: END TABLE ENVIRONMENT, RESET ASIS MODE
C
18491 FORMAT(A1,'end{center}')
18493 FORMAT(A1,'end{table}')
18499 FORMAT(A1,'begin{verbatim}')
        WRITE(ICOUT,18491)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18493)IBASLC
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,18499)IBASLC
        CALL DPWRST('XXX','WRIT')
C
      ELSE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11101)
11101   FORMAT('                **********************************')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11102)NUMFAC
11102   FORMAT('                ** ',I2,'-WAY ANALYSIS OF VARIANCE',
     1         '  **')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11103)N
11103   FORMAT('      NUMBER OF OBSERVATIONS           = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11104)NUMFAC
11104   FORMAT('      NUMBER OF FACTORS                = ',I8)
        CALL DPWRST('XXX','WRIT')
        DO11112L=1,NUMFAC
          WRITE(ICOUT,11111)L,N1(L)
          CALL DPWRST('XXX','WRIT')
11111     FORMAT('      NUMBER OF LEVELS FOR FACTOR ',I2,'  = ',I8)
11112   CONTINUE
        IF(ICASBL.EQ.'NO')THEN
          WRITE(ICOUT,11106)
11106     FORMAT('      UNBALANCED CASE')
          CALL DPWRST('XXX','WRIT')
        ELSE
          WRITE(ICOUT,11107)
11107     FORMAT('      BALANCED CASE')
          CALL DPWRST('XXX','WRIT')
        ENDIF
C
        WRITE(ICOUT,11123)RESSD
11123   FORMAT('      RESIDUAL    STANDARD DEVIATION   = ',E20.11)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11124)IRESDF
11124   FORMAT('      RESIDUAL    DEGREES OF FREEDOM   = ',I8)
        CALL DPWRST('XXX','WRIT')
        IF(IREP.EQ.'NO')THEN
          WRITE(ICOUT,11201)
11201     FORMAT('      NO REPLICATION CASE')
          CALL DPWRST('XXX','WRIT')
        ELSEIF(IREP.EQ.'YES')THEN
          WRITE(ICOUT,11202)
11202     FORMAT('      REPLICATION CASE')
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,11203)REPSD
11203     FORMAT('      REPLICATION STANDARD DEVIATION   = ',E20.11)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,11204)IREPDF
11204     FORMAT('      REPLICATION DEGREES OF FREEDOM   = ',I8)
          CALL DPWRST('XXX','WRIT')
        ENDIF
        WRITE(ICOUT,11205)NUMCEL
11205   FORMAT('      NUMBER OF DISTINCT CELLS         = ',I8)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
CCCCC ADD ANOVA TABLE.  FEBRUARY 1998.
        WRITE(ICOUT,13101)
13101   FORMAT('                         *****************')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13102)
13102   FORMAT('                         *  ANOVA TABLE  *')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13101)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13104)
13104   FORMAT('SOURCE              DF SUM OF SQUARES  ',
     1         '  MEAN SQUARE   F STATISTIC    F CDF SIG')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13105)
13105   FORMAT('-----------------------------------------------',
     1         '--------------------------------')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,13204)N-1,GSS,GSS/REAL(N-1)
13204   FORMAT('TOTAL (CORRECTED)',I5,2F15.6,F14.4)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,13105)
        CALL DPWRST('XXX','WRIT')
        DO13210L=1,NUMFAC
        ISIG='  '
        IF(F1CDF2(L).GE.95.0)ISIG=' *'
        IF(F1CDF2(L).GE.99.0)ISIG='**'
        WRITE(ICOUT,13214)L,N1(L)-1,SS1(L),SS1(L)/(N1(L)-1),FVAL(L),
     1                    F1CDF2(L),ISIG
13214   FORMAT('FACTOR ',I2,8X,I5,2F15.6,F14.4,F8.3,'%  ',A2)
        CALL DPWRST('XXX','WRIT')
13210   CONTINUE
        WRITE(ICOUT,13105)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,13304)IRESDF,RESSS,RESMS
13304   FORMAT('RESIDUAL         ',I5,2F15.6)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,11611)RESSD
11611   FORMAT('      RESIDUAL    STANDARD DEVIATION = ',F20.11)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11612)IRESDF
11612   FORMAT('      RESIDUAL    DEGREES OF FREEDOM = ',2X,I11)
        CALL DPWRST('XXX','WRIT')
C
        IF(IREP.EQ.'YES')THEN
          WRITE(ICOUT,11621)REPSD
11621     FORMAT('      REPLICATION STANDARD DEVIATION = ',F20.11)
          CALL DPWRST('XXX','WRIT')
          WRITE(ICOUT,11622)IREPDF
11622     FORMAT('      REPLICATION DEGREES OF FREEDOM = ',2X,I11)
          CALL DPWRST('XXX','WRIT')
C
          IF(IFITDF.LT.1)THEN
            IF(NUMFAC.NE.1)THEN
              WRITE(ICOUT,11636)
11636         FORMAT('      LACK OF FIT F TEST CANNOT BE DONE BECAUSE')
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,11637)
11637         FORMAT('      HAVE ONLY 0 DEGREES OF FREEDOM IN ',
     1               'NUMERATOR OF F RATIO.')
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,11638)
11638         FORMAT('      THIS HAPPENS WHEN NUMBER OF PARAMETERS ',
     1               'FITTED')
              CALL DPWRST('XXX','WRIT')
              WRITE(ICOUT,11639)
11639         FORMAT('      IS IDENTICAL TO NUMBER OF DISTINCT ',
     1               'SUBSETS.')
              CALL DPWRST('XXX','WRIT')
            ENDIF
C
          ELSEIF(IFITDF.GE.1)THEN
C
            WRITE(ICOUT,11640)FITFVA,FITCD2
11640       FORMAT('      LACK OF FIT F RATIO = ',F11.4,' = THE ',
     1             F9.4,'% POINT OF THE')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,11645)IFITDF,IREPDF
11645       FORMAT('      F DISTRIBUTION WITH ',I6,' AND ',I6,
     1             ' DEGREES OF FREEDOM')
            CALL DPWRST('XXX','WRIT')
            WRITE(ICOUT,999)
            CALL DPWRST('XXX','WRIT')
C
          ENDIF
        ENDIF
C
        WRITE(ICOUT,11301)
11301   FORMAT('                         ****************')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11302)
11302   FORMAT('                         *  ESTIMATION  *')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11301)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11211)GMEAN
11211   FORMAT('      GRAND MEAN                       = ',E20.11)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11212)GSD
11212   FORMAT('      GRAND STANDARD DEVIATION         = ',E20.11)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
11214   FORMAT('      (BASED ON FULL MODEL)            = ',E20.11)
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11304)
11304   FORMAT('             LEVEL-ID      NI      MEAN      ',
     1         'EFFECT     SD(EFFECT)')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,11305)
11305   FORMAT('-----------------------------------------------',
     1         '---------------------')
        CALL DPWRST('XXX','WRIT')
        DO11590L=1,NUMFAC
          WRITE(ICOUT,11511)L,F1ID(1,L),F1N(1,L),F1MEAN(1,L),
     1                      F1EFFE(1,L),F1EFSD(1,L)
11511     FORMAT('FACTOR ',I1,'--',F11.5,F8.0,3F11.5)
          CALL DPWRST('XXX','WRIT')
          IF(N1(L).LE.1)GOTO11590
          DO11510I=2,N1(L)
            WRITE(ICOUT,11512)F1ID(I,L),F1N(I,L),F1MEAN(I,L),
     1                        F1EFFE(I,L),F1EFSD(I,L)
11512       FORMAT('        --',F11.5,F8.0,3F11.5)
            CALL DPWRST('XXX','WRIT')
11510     CONTINUE
11590   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,12815)
12815   FORMAT('        MODEL               RESIDUAL STANDARD ',
     1         'DEVIATION')
        CALL DPWRST('XXX','WRIT')
        WRITE(ICOUT,12816)
12816   FORMAT('----------------------------------------------',
     1         '---------')
        CALL DPWRST('XXX','WRIT')
C
        WRITE(ICOUT,12820)GSD
12820   FORMAT('CONSTANT                ONLY--',F20.10)
        CALL DPWRST('XXX','WRIT')
        IF(NUMFAC.GE.1)THEN
          DO12827I=1,NUMFAC
            WRITE(ICOUT,12821)I,RSD(I)
12821       FORMAT('CONSTANT AND FACTOR  ',I2,' ONLY--',F20.10)
            CALL DPWRST('XXX','WRIT')
12827     CONTINUE
        ENDIF
        WRITE(ICOUT,12833)I,RESSD
12833   FORMAT('CONSTANT AND ALL ',I2,' FACTORS --',F20.10)
        CALL DPWRST('XXX','WRIT')
C
12890   CONTINUE
        WRITE(ICOUT,999)
        CALL DPWRST('XXX','WRIT')
C
      ENDIF
      ENDIF
C
C
C               *************************************************
C               **  STEP 12--                                  **
C               **  WRITE INFO TO FILES DPST1F.DAT, DPST2F.DAT **
C               *************************************************
C
      ISTEPN='12'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ANO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='ANO2'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='ANO2'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='ANO2'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
CCCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY  1998
C               ********************************************
C               **  STEP 12.5                             **
C               **  WRITE INFO OUT TO FILES--             **
C               **     1) DPST1F.DAT--FACTOR ELEMENTS     **
C               **        (DF, SUMSQ, MSQ, F STAT, F CDF) **
C               **     2) DPST2F.DAT--EFFECT ESTIMATES    **
C               **        (FACTOR ID, LEVEL ID, NI, MEAN, **
C               **        EFFECT, SD (EFFECT)             **
C               **     3) RESSD FOR EACH MODEL            **
C               ********************************************
C
      ISTEPN='12.5'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ANO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO14100L=1,NUMFAC
        WRITE(IOUNI1,14110)L,N1(L)-1,SS1(L),SS1(L)/(N1(L)-1),FVAL(L),
     1                     F1CDF2(L)
14100 CONTINUE
14110 FORMAT(I5,2X,I5,4(1X,E15.7))
C
      DO14120L=1,NUMFAC
        DO14130J=1,N1(L)
        WRITE(IOUNI2,14122)L,F1ID(J,L),F1N(J,L),F1MEAN(J,L),
     1                     F1EFFE(J,L),F1EFSD(J,L)
14122   FORMAT(I5,2X,F6.0,2X,F6.0,3(1X,E15.7))
14130   CONTINUE
14120 CONTINUE
C
      WRITE(IOUNI3,14620)GSD
14620 FORMAT(F20.10)
      IF(NUMFAC.GE.1)THEN
        DO14627I=1,NUMFAC
          WRITE(IOUNI3,14621)RSD(I)
14621     FORMAT(F20.10)
14627   CONTINUE
      ENDIF
      WRITE(IOUNI3,14633)RESSD
14633 FORMAT(F20.10)
C
      IF(IPRINT.EQ.'OFF')GOTO14219
      WRITE(ICOUT,14211)
14211 FORMAT('FACTOR DF, SUM OF SQUARES, MEAN SQUARE, F STAT, ',
     1'F CDF   WRITTEN TO FILE DPST1F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14212)
14212 FORMAT('FACTOR-ID, LEVEL-ID, NI, MEAN, EFFECT, SD(EFFECT) ', 
     1'  WRITTEN TO FILE DPST2F.DAT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,14214)
14214 FORMAT('RESIDUAL STANDARD DEVIATION OF MODELS ', 
     1'  WRITTEN TO FILE DPST3F.DAT')
      CALL DPWRST('XXX','BUG ')
14219 CONTINUE
C
CCCCCC THE FOLLOWING SECTION WAS ADDED FEBRUARY 1998.
C               **************************************
C               **  STEP 13--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
      ISTEPN='13'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ANO2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
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 DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IERROR
 9012 FORMAT('IERROR = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)N,NUMFAC
 9013 FORMAT('N,NUMFAC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IBUGA3
 9014 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IREP
 9022 FORMAT('IREP = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)REPSS,REPMS,REPSD,REPDF
 9023 FORMAT('REPSS,REPMS,REPSD,REPDF = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      DO9025I=1,N
      WRITE(ICOUT,9026)I,Y(I),F1(I,1),F1(I,1),W(I),PRED2(I),RES2(I)
 9026 FORMAT('I,Y(I),F1(I),F2(I),W(I),PRED2(I),RES2(I) = ',
     1I8,6E11.4)
      CALL DPWRST('XXX','BUG ')
 9025 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANOL(IHARG,IARGT,ARG,NUMARG,DEFAL1,DEFAL2,
     1ANOPL1,ANOPL2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE ANOP LIMITS
C              (THE PROPORTION LIMITS ARE THE SAME AS THE ANOP LIMITS).
C              WHICH DEFINE THE TARGET INTERVAL OF INTEREST
C              IN THE ANOP PROCEDURE AND THE ANOP PLOT
C              (AND IN THE PROPORTION PLOT).
C              THE SPECIFIED LIMITS WILL BE PLACED
C              IN THE FLOATING POINT VARIABLE ANOPL1 AND ANOPL2.
 
C                     --IARGT  (A  HOLLERITH VECTOR)
C                     --ARG    (A  FLOATING POINT VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--DEFAL1 = A FLOATING POINT VARIABLE
C                                CONTAINING THE LOWER LIMIT
C                                OF THE INTERVAL OF INTEREST.
C                     --DEFAL2 = A FLOATING POINT VARIABLE
C                                CONTAINING THE UPPER LIMIT
C                                OF THE INTERVAL OF INTEREST.
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--APRIL     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --SEPTEMBER 1988.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1150
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1150
      IF(IHARG(NUMARG).EQ.'?')GOTO8100
      NUMAM1=NUMARG-1
      IF(NUMAM1.GE.2.AND.IARGT(NUMAM1).EQ.'NUMB'.AND.
     1IARGT(NUMARG).EQ.'NUMB')GOTO1160
      GOTO1120
C
 1120 CONTINUE
      IERROR='YES'
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPANOL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      ILLEGAL FORM FOR ANOP LIMITS ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1124)
 1124 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1125)
 1125 FORMAT('      SUPPOSE THE ANALYST DESIRES THE  ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1126)
 1126 FORMAT('      INTERVAL OF INTEREST IN AN ANOP OR ANOP PLOT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1127)
 1127 FORMAT('      TO BE 120 TO 1000')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1129)
 1129 FORMAT('      THEN THE ALLOWABLE FORM IS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1130)
 1130 FORMAT('      ANOP LIMITS 120 1000 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      HOLD1=DEFAL1
      HOLD2=DEFAL2
      GOTO1180
C
 1160 CONTINUE
      HOLD1=ARG(NUMAM1)
      HOLD2=ARG(NUMARG)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      ANOPL1=HOLD1
      ANOPL2=HOLD2
      IF(HOLD1.GT.HOLD2)ANOPL1=HOLD2
      IF(HOLD1.GT.HOLD2)ANOPL2=HOLD1
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)ANOPL1,ANOPL2
 1181 FORMAT('THE PROPORTION/ANOP LIMITS HAS JUST BEEN SET TO ',
     1E15.7,' AND ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 8100 CONTINUE
      IFOUND='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,8111)ANOPL1,ANOPL2
 8111 FORMAT('THE CURRENT PROPORTION/ANOP LIMITS ARE ',
     1E15.7,' AND ',E15.7)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPANOV(ICAPSW,IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN ANALYSIS OF VARIANCE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1978.
C     UPDATED         --JULY      1978.
C     UPDATED         --NOVEMBER  1978.
C     UPDATED         --FEBRUARY  1981.
C     UPDATED         --JULY      1981.
C     UPDATED         --SEPTEMBER 1981.
C     UPDATED         --DECEMBER  1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --MARCH     1988. ADD LOFCDF
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE
C                                       COMMON
C     UPDATED         --FEBRUARY  1998. SLIGHT RECODING FOR BETTER
C                                       EFFICIENCY IN DPANO2
C                                       TO INCREASE MAXIMUM ALLOWED
C                                       NUMBER OF FACTORS, ONLY HAVE
C                                       TO CHANGE VALUE OF MAXFAC AND
C                                       ONE BLOCK OF CODE (STEP 3.5)
C                                       IN DPANO2.
C     UPDATED         --OCTOBER   2003. SUPPORT FOR HTML, LATEX OUTPUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICAPSW
      CHARACTER*4 IBUGA2
      CHARACTER*4 IBUGA3
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHLEFT
      CHARACTER*4 IHLEF2
      CHARACTER*4 IHFACT
      CHARACTER*4 IHFAC2
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 ICASEQ
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
CCCCC FOLLOWING SECTION MODIFIED FEBRUARY 1998.
      PARAMETER (MAXLEV=500)
      PARAMETER (MAXFAC=10)
C
      DIMENSION F1(MAXOBV,MAXFAC)
CCCCC DIMENSION F1(MAXOBV)
CCCCC DIMENSION F2(MAXOBV)
CCCCC DIMENSION F3(MAXOBV)
CCCCC DIMENSION F4(MAXOBV)
CCCCC DIMENSION F5(MAXOBV)
      DIMENSION F1ID(MAXLEV,MAXFAC)
      DIMENSION F1N(MAXLEV,MAXFAC)
      DIMENSION F1MEAN(MAXLEV,MAXFAC)
      DIMENSION F1EFFE(MAXLEV,MAXFAC)
      DIMENSION F1EFSD(MAXLEV,MAXFAC)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      DIMENSION W(MAXOBV)
CCCCC FOLLOWING LINE ADDED JUNE, 1990.
      DIMENSION Z(MAXOBV)
C
      DIMENSION B(100)
      DIMENSION SDB(100)
      DIMENSION FCUM(100)
      DIMENSION N1(MAXFAC)
      DIMENSION ISET(MAXFAC)
      DIMENSION AN1(MAXFAC)
      DIMENSION E1(MAXFAC)
C
      DIMENSION SS1(MAXFAC)
      DIMENSION RESMS1(MAXFAC)
      DIMENSION FVAL(MAXFAC)
      DIMENSION F1CDF2(MAXFAC)
      DIMENSION RSD(MAXFAC)
C
      DIMENSION ICOLIV(10)
      DIMENSION NIV(10)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
CCCCC INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),F1(1,1))
CCCCC EQUIVALENCE (GARBAG(IGARB2),F2(1))
CCCCC EQUIVALENCE (GARBAG(IGARB3),F3(1))
      EQUIVALENCE (G2RBAG(IGAR20),PRED2(1))
      EQUIVALENCE (G2RBAG(IGAR21),RES2(1))
      EQUIVALENCE (G2RBAG(IGAR22),Z(1))
      EQUIVALENCE (G2RBAG(IGAR23),B(1))
      EQUIVALENCE (G2RBAG(IGAR24),SDB(1))
      EQUIVALENCE (G2RBAG(IGAR25),FCUM(1))
      EQUIVALENCE (G2RBAG(IGAR26),F1ID(1,1))
      EQUIVALENCE (G2RBAG(IGAR28),F1N(1,1))
      EQUIVALENCE (G2RBAG(IGAR30),F1MEAN(1,1))
      EQUIVALENCE (G2RBAG(IGAR32),F1EFFE(1,1))
      EQUIVALENCE (G2RBAG(IGAR34),F1EFSD(1,1))
CCCCC END CHANGE
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
      INCLUDE 'DPCOSU.INC'
C
C-----EQUIVALENCES----------------------------------------------------
C
CCCCC EQUIVALENCE (W(1),X3D(1))
CCCCC EQUIVALENCE (F5(1),X(1))
CCCCC EQUIVALENCE (F4(1),D(1))
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='DPAN'
      ISUBN2='OV  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IERROR='NO'
C
      MAXV2=6
      MINN2=2
C
CCCCC FOLLOWING LINE NOW SET IN PARAMETER STATEMENT.  FEBRUARY 1998.
CCCCC MAXFAC=MAXV2-1
C
      ICASEQ='UNKN'
C
C               *******************************************
C               **  TREAT THE ANALYSIS OF VARIANCE 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 DPANOV--')
      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               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='1'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICOM.EQ.'ANOV'.AND.ICOM2.EQ.'A   ')GOTO110
      IF(NUMARG.GE.2.AND.ICOM.EQ.'ANAL'.AND.
     1IHARG(1).EQ.'OF  '.AND.IHARG(2).EQ.'VARI')
     1GOTO112
C
      IFOUND='NO'
      GOTO9000
C
  110 CONTINUE
      ILASTC=0
      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(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ********************************************
C               **  STEP 3--                              **
C               **  CHECK THE VALIDITY OF ARGUMENT 1      **
C               **  (THIS WILL BE THE RESPONSE VARIABLE)  **
C               ********************************************
C
      ISTEPN='3'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHLEFT=IHARG(1)
      IHLEF2=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IHLEFT,IHLEF2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      ICOLL=IVALUE(ILOCV)
      NLEFT=IN(ILOCV)
C
C               ***********************************************************
C               **  STEP 4--                                             **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (NLEFT)  **
C               **  FOR THE RESPONSE VARIABLE IS 2 OR MORE.              **
C               ***********************************************************
C
      ISTEPN='4'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NLEFT.GE.MINN2)GOTO390
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,311)
  311 FORMAT('***** ERROR IN DPANOV--')
      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 AN ANALYSIS OF VARIANCE ')
      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)NLEFT
  317 FORMAT('      NLEFT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,318)
  318 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,319)(IANS(I),I=1,IWIDTH)
  319 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 6--                            **
C               **  CHECK FOR A VALID NUMBER            **
C               **  OF INDEPENDENT VARIABLES (1 TO 5).  **
C               **  CHECK THE VALIDITY OF EACH          **
C               **  OF THE INDEPENDENT VARIABLES        **
C               **  (THAT IS, OF EACH OF THE FACTORS).  **
C               **  DOES THE NAME EXIST IN THE TABLE?   **
C               **  DOES THE NUMBER OF ELEMENTS         **
C               **  AGREE WITH THE NUMBER OF ELEMENTS   **
C               **  IN THE RESPONSE VARIABLE?           **
C               ******************************************
C
      ISTEPN='6'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMFAC=ILOCQ-2
      IF(1.LE.NUMFAC.AND.NUMFAC.LE.MAXFAC)GOTO520
C
      WRITE(ICOUT,511)
  511 FORMAT('***** ERROR IN DPANOV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,512)
  512 FORMAT('      FOR AN ANALYSIS OF VARIANCE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,513)
  513 FORMAT('      THE NUMBER OF INDEPENDENT VARIABLES (FACTORS)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,514)MAXFAC
  514 FORMAT('      MUST BE AT LEAST 1 AND AT MOST ',I8,'  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,515)
  515 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,516)
  516 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,517)NUMFAC
  517 FORMAT('      OF INDEPENDENT VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,518)
  518 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,519)(IANS(I),I=1,IWIDTH)
  519 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  520 CONTINUE
      DO530IFAC=1,NUMFAC
      J=IFAC+1
      IHFACT=IHARG(J)
      IHFAC2=IHARG2(J)
      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,532)IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),
     1NIV(IFAC)
  532 FORMAT('IFAC,IHFACT,IHFAC2,ICOLIV(IFAC),NIV(IFAC) = ',
     1I8,2X,A4,2X,A4,I8,I8)
      IF(IBUGA2.EQ.'ON')CALL DPWRST('XXX','BUG ')
  530 CONTINUE
C
      DO540IFAC=1,NUMFAC
      IF(NIV(IFAC).NE.NLEFT)GOTO550
  540 CONTINUE
      GOTO590
C
  550 CONTINUE
      WRITE(ICOUT,551)
  551 FORMAT('***** ERROR IN DPANOV--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,552)
  552 FORMAT('      FOR AN ANALYSIS OF VARIANCE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,553)
  553 FORMAT('      THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,554)
  554 FORMAT('      IN EACH INDEPENDENT VARIABLE (FACTOR)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,555)
  555 FORMAT('      SHOULD BE THE SAME AS THE NUMBER OF ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,556)
  556 FORMAT('      IN THE DEPENDENT VARIABLE (RESPONSE);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,557)
  557 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,561)
  561 FORMAT('      DEPENDENT   VARIABLE  (RESPONSE)--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,562)IHLEFT,IHLEF2,NLEFT
  562 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,563)
  563 FORMAT('      INDEPENDENT VARIABLES (FACTORS)--')
      CALL DPWRST('XXX','BUG ')
      DO565IFAC=1,NUMFAC
      J=IFAC+1
      WRITE(ICOUT,566)IHARG(J),IHARG2(J),NIV(IFAC)
  566 FORMAT('                  ',A4,A4,'  HAS ',I8,' ELEMENTS')
      CALL DPWRST('XXX','BUG ')
  565 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,567)
  567 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,568)(IANS(I),I=1,IWIDTH)
  568 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  590 CONTINUE
C
C               *****************************************
C               **  STEP 7--                           **
C               **  BRANCH TO THE APPROPRIATE SUBCASE; **
C               **  THEN FORM THE RESPONSE VARIABLE    **
C               **  AND THE FACTORS                    **
C               *****************************************
C
      ISTEPN='7'
      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
      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
CCCCC REWRITE FOLLOWING BLOCK OF CODE   FEBRUARY 1998.
CCCCC ORIGINAL CODE DELETED.
      DO659LL=1,NUMFAC
      ICOLR=ICOLIV(LL)
      IJ=MAXN*(ICOLR-1)+I
      IF(ICOLR.LE.MAXCOL)F1(J,LL)=V(IJ)
      IF(ICOLR.EQ.MAXCP1)F1(J,LL)=PRED(I)
      IF(ICOLR.EQ.MAXCP2)F1(J,LL)=RES(I)
      IF(ICOLR.EQ.MAXCP3)F1(J,LL)=YPLOT(I)
      IF(ICOLR.EQ.MAXCP4)F1(J,LL)=XPLOT(I)
      IF(ICOLR.EQ.MAXCP5)F1(J,LL)=X2PLOT(I)
      IF(ICOLR.EQ.MAXCP6)F1(J,LL)=TAGPLO(I)
 659  CONTINUE
C
  660 CONTINUE
      NS=J
C
C               ******************************************************
C               **  STEP 8--
C               **  PREPARE FOR ENTRANCE INTO DPANO2--
C               **  SET THE WEIGHT VECTOR TO UNITY THROUGHOUT.
C               ******************************************************
C
      ISTEPN='8'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO680I=1,NS
      W(I)=1.0
  680 CONTINUE
C
C               ***************************
C               **  STEP 9--             **
C               **  CARRY OUT THE ANOVA  **
C               ***************************
C
      ISTEPN='9'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO790
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,711)
  711 FORMAT('***** FROM DPANOV, AS WE ARE ABOUT TO CALL DPANO2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,712)NLEFT,MAXN,NS,NUMFAC
  712 FORMAT('NLEFT,MAXN,NS,NUMFAC = ',4I8)
      CALL DPWRST('XXX','BUG ')
      DO715I=1,NS
      WRITE(ICOUT,716)I,Y(I),(F1(I,LL),LL=1,MAXFAC),W(I)
  716 FORMAT('I,Y(I),F1(I),F2(I),F3(I),F4(I),F5(I),W(I) = ',
     1I6,2X,7F10.5)
      CALL DPWRST('XXX','BUG ')
  715 CONTINUE
CCCCC IBUGA3='ABCD'
      WRITE(ICOUT,731)IBUGA3
  731 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
  790 CONTINUE
C
CCCCC JUNE, 1990.  DIMENSION Z IN DPANOV RATHER THAT DPANO2 (SO CAN
CCCCC EQUIVALENCE TO GARBAGE COMMON).
CCCCC ARGUMENT LIST MODIFIED, ADDITIONAL DIMENSIONING IN
CCCCC DPANOV INSTEAD OF DPANO2.  FEBRUARY 1998.
CCCCC CALL DPANO2(Y,F1,F2,F3,F4,F5,W,NS,NUMFAC,
      CALL DPANO2(Y,F1,W,NS,NUMFAC,
     1F1ID,F1N,F1MEAN,F1EFFE,F1EFSD,MAXOBV,MAXLEV,MAXFAC,
     1N1,ISET,AN1,E1,SS1,RESMS1,FVAL,F1CDF2,RSD,
     1B,SDB,FCUM,REPSD,REPDF,RESSD,RESDF,PRED2,RES2,ALFCDF,
     1Z,
     1ICAPSW,ICAPTY,
     1IBUGA3,IERROR)
C
C               ***************************************
C               **  STEP 10--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
      ISTEPN='10'
      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
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 DPANOV--')
      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,NUMFAC
 9014 FORMAT('NS,NUMFAC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANPP(NPLOTV,NPLOTP,NS,ICASPL,IAND1,IAND2,
     1IANGLU,MAXNPP,
     1ANOPL1,ANOPL2,
     1IBUGG2,IBUGG3,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--FORM A ANOP (ANALYSIS OF PROPORTIONS) PLOT
C              (USEFUL FOR DETERMINING WHICH INDEPENDENT VARIABLE
C              CONTRIBUTES MOST TO EXTREMAL OBSERVATIONS
C              IN THE RESPONSE VARIABLE).
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/6
C     ORIGINAL VERSION--JUNE      1987.
C     UPDATED         --JUNE      1990. TEMPORARY ARRAYS TO GARBAGE COMMON
C                                       MOVE SOME DIMENSIONS FROM DPANP2
C     UPDATED         --OCTOBER   1992. FIX GARBAGE EQUIVALENCE
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 ICASPL
      CHARACTER*4 IAND1
      CHARACTER*4 IAND2
      CHARACTER*4 IANGLU
      CHARACTER*4 IBUGG2
      CHARACTER*4 IBUGG3
      CHARACTER*4 IBUGQ
      CHARACTER*4 ISUBRO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 ICASEQ
C
      CHARACTER*4 IHRI11
      CHARACTER*4 IHRI12
      CHARACTER*4 IHRI21
      CHARACTER*4 IHRI22
CCCCC CHARACTER*4 IHRI31
CCCCC CHARACTER*4 IHRI32
CCCCC CHARACTER*4 IHRI41
CCCCC CHARACTER*4 IHRI42
      CHARACTER*4 IHRIX1
      CHARACTER*4 IHRIX2
C
      CHARACTER*4 ICTAR1
      CHARACTER*4 ICTAR2
C
      CHARACTER*4 IERRO4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      DIMENSION Y1(MAXOBV)
      DIMENSION Y2(MAXOBV)
CCCCC FOLLOWING LINES ADDED JUNE, 1990
      INCLUDE 'DPCOZZ.INC'
      DIMENSION XD(MAXOBV)
      DIMENSION PIR(MAXOBV)
      EQUIVALENCE (GARBAG(IGARB1),Y1(1))
 
      EQUIVALENCE (GARBAG(IGARB2),Y2(1))
CCCCC THE FOLLOWING 2 LINES WERE FIXED   OCTOBER 1992
CCCCC EQUIVALENCE (GARBAG(IGARB2),XD(1))
CCCCC EQUIVALENCE (GARBAG(IGARB2),PIR(1))
      EQUIVALENCE (GARBAG(IGARB3),XD(1))
      EQUIVALENCE (GARBAG(IGARB4),PIR(1))
CCCCC END CHANGE
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
      ISUBN1='DPAN'
      ISUBN2='PP  '
C
      IFOUND='NO'
      IERROR='NO'
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      MINN2=2
C
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ANPP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPANPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)NPLOTV,NPLOTP,NS
   52 FORMAT('NPLOTV,NPLOTP,NS = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,IAND1,IAND2
   53 FORMAT('ICASPL,IAND1,IAND2 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)IANGLU,IBUGG2,IBUGG3,IBUGQ
   54 FORMAT('IANGLU,IBUGG2,IBUGG3,IBUGQ = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)ICASPL,MAXN
   56 FORMAT('ICASPL,MAXN = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)IFOUND,IERROR
   57 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)MAXNPP
   58 FORMAT('MAXNPP = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ANOPL1,ANOPL2
   61 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  TREAT THE ANOP     PLOT CASE **
C               ***********************************
C
C               ***************************
C               **  STEP 11--            **
C               **  EXTRACT THE COMMAND  **
C               ***************************
C
      ISTEPN='11'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PLOT')GOTO1110
      GOTO9000
C
 1110 CONTINUE
      ILASTC=1
      CALL ADJUST(ILASTC,IHARG,IHARG2,IARG,ARG,IARGT,NUMARG)
      GOTO1190
C
 1190 CONTINUE
      IFOUND='YES'
      ICASPL='ANPP'
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  CARRY OUT A GENERAL CHECK FOR THE                 **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               *****************************************
C               **  STEP 13--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='13'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO1390
      DO1300J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO1310
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO1310
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO1320
 1300 CONTINUE
      GOTO1390
 1310 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO1390
 1320 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO1390
 1390 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ANPP')GOTO1395
      WRITE(ICOUT,1391)ICASEQ,NUMARG,ILOCQ
 1391 FORMAT('ICASEQ,NUMARG,ILOCQ = ',A4,2X,2I8)
      CALL DPWRST('XXX','BUG ')
 1395 CONTINUE
C
C               ********************************************************
C               **  STEP 14--                                         **
C               **  CARRY OUT A SPECIFIC CHECK FOR THE                **
C               **  PROPER NUMBER OF INPUT ARGUMENTS                  **
C               **  (IT SHOULD BE EXACTLY 2).                         **
C               ********************************************************
C
      ISTEPN='14'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NUMVAR=ILOCQ-1
      IF(NUMVAR.EQ.2)GOTO1490
      GOTO1410
C
 1410 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1411)
 1411 FORMAT('***** ERROR IN DPANPP--')
      CALL DPWRST('XXX','BUG ')
      IF(ICASPL.EQ.'MECC')WRITE(ICOUT,1412)
 1412 FORMAT('      FOR AN ANOP PLOT, ')
      IF(ICASPL.EQ.'MECC')CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1418)
 1418 FORMAT('      THE NUMBER OF VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1419)
 1419 FORMAT('      MUST BE EXACTLY 2  ;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1420)
 1420 FORMAT('      SUCH WAS NOT THE CASE HERE;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1421)
 1421 FORMAT('      THE SPECIFIED NUMBER')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1422)NUMVAR
 1422 FORMAT('      OF VARIABLES WAS ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1423)
 1423 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1424)(IANS(I),I=1,IWIDTH)
 1424 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1490 CONTINUE
C
C               ****************************************************************
C               **  STEP 15--                                                  *
C               **  EXAMINE THE VARIABLES--                                    *
C               **  HAS EACH VARIABLE                                          *
C               **  ALREADY BEEN DEFINED?                                      *
C               **  NOTE THAT     ILISR1, ILISR2,                              *
C               **  IS THE LINE IN THE TABLE                                   *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               **  NOTE THAT     ICOLR1, ICOLR2,                              *
C               **  IS THE DATA COLUMN (1 TO 10+6)                             *
C               **  OF THE FIRST, SECOND                VARIABLE               *
C               **  RESPECTIVELY.                                              *
C               ****************************************************************
C
      ISTEPN='15'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICTAR1='FIRS'
      ICTAR2='T   '
      ILOCR1=1
      IHRI11=IHARG(ILOCR1)
      IHRI12=IHARG2(ILOCR1)
      IHRIX1=IHRI11
      IHRIX2=IHRI12
      DO1510I=1,NUMNAM
      I2=I
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1519
      IF(IHRI11.EQ.IHNAME(I).AND.IHRI12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1510 CONTINUE
      GOTO1570
 1519 CONTINUE
      ILISR1=I2
      ICOLR1=IVALUE(ILISR1)
      NIRIG1=IN(ILISR1)
C
      ICTAR1='SECO'
      ICTAR2='ND  '
      ILOCR2=2
      IHRI21=IHARG(ILOCR2)
      IHRI22=IHARG2(ILOCR2)
      IHRIX1=IHRI21
      IHRIX2=IHRI22
      DO1520I=1,NUMNAM
      I2=I
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO1529
      IF(IHRI21.EQ.IHNAME(I).AND.IHRI22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'P')GOTO1560
 1520 CONTINUE
      GOTO1570
 1529 CONTINUE
      ILISR2=I2
      ICOLR2=IVALUE(ILISR2)
      NIRIG2=IN(ILISR2)
      GOTO1590
C
 1560 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1561)
 1561 FORMAT('***** ERROR IN DPANPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1562)ICTAR1,ICTAR2
 1562 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1563)IHRIX1,IHRIX2
 1563 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1565)
 1565 FORMAT('      WAS FOUND IN THE INTERNAL NAME LIST,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1566)
 1566 FORMAT('      BUT AS A PARAMETER,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1567)
 1567 FORMAT('      AND NOT AS A VARIABLE AS IT SHOULD BE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1568)
 1568 FORMAT('      THE COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1569)(IANS(I),I=1,IWIDTH)
 1569 FORMAT(80A1)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1570 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1571)
 1571 FORMAT('***** ERROR IN DPANPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1572)ICTAR1,ICTAR2
 1572 FORMAT('      THE SPECIFIED ',A4,A4,' ARGUMENT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1573)IHRIX1,IHRIX2
 1573 FORMAT('      (',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1575)
 1575 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME LIST')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1576)
 1576 FORMAT('      OF AVAILABLE VARIABLE NAMES.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1577)IHRI11,IHRI12
 1577 FORMAT('      THE VARIABLE IN QUESTION WAS ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1578)
 1578 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1579)(IANS(I),I=1,IWIDTH)
 1579 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 1590 CONTINUE
C
C               ******************************************************
C               **  STEP 22--                                       **
C               **  CHECK THAT VARIABLES 1 AND 2       HAVE         **
C               **  THE SAME NUMBER OF ELEMENTS.                    **
C               ******************************************************
C
 2100 CONTINUE
      ISTEPN='21'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NIRIG1.EQ.NIRIG2)GOTO2190
C
 2110 CONTINUE
      WRITE(ICOUT,2111)
 2111 FORMAT('***** ERROR IN DPANPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2113)
 2113 FORMAT('      THE NUMBER OF OBSERVATIONS IN VARIABLES ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2114)
 2114 FORMAT('      1 AND 2 MUST BE THE SAME;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2115)
 2115 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2116)IHRI11,IHRI12,NIRIG1
 2116 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2117)IHRI21,IHRI22,NIRIG2
 2117 FORMAT('           VARIABLE ',A4,A4,' HAS ',I8,
     1' OBSERVATIONS;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2120)
 2120 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,2121)(IANS(I),I=1,IWIDTH)
 2121 FORMAT('      ',100A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 2190 CONTINUE
C
C               *********************************************
C               **  STEP 32--                              **
C               **  FORM THE VECTOR ISUB(.)                **
C               **  DEPENDING ON THE TYPE OF CASE          **
C               **  FOR THE QUALIFIER.                     **
C               **  BRANCH TO THE PROPER CASE.             **
C               *********************************************
C
      ISTEPN='32'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      NLOCAL=NIRIG1
C
      IF(ICASEQ.EQ.'FULL')GOTO3210
      IF(ICASEQ.EQ.'SUBS')GOTO3220
      IF(ICASEQ.EQ.'FOR')GOTO3230
C
 3210 CONTINUE
      DO3215I=1,NLOCAL
      ISUB(I)=1
 3215 CONTINUE
      NQ=NLOCAL
      GOTO3250
C
 3220 CONTINUE
      NIOLD=NLOCAL
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NIOLD
      GOTO3250
C
 3230 CONTINUE
      NIOLD=NLOCAL
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERRO4)
      NQ=NFOR
      GOTO3250
C
 3250 CONTINUE
      IF(NQ.GE.MINN2)GOTO3290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3251)
 3251 FORMAT('***** ERROR IN DPANPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3252)
 3252 FORMAT('      AFTER THE APPROPRIATE SUBSET ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3253)
 3253 FORMAT('      HAS BEEN EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3254)IHRI11,IHRI12
 3254 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3255)
 3255 FORMAT('      (FOR WHICH AN ANOP PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3256)
 3256 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3257)MINN2
 3257 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3258)NQ
 3258 FORMAT('      SUCH WAS NOT THE CASE HERE (NQ = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3259)
 3259 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3260)(IANS(I),I=1,IWIDTH)
 3260 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3290 CONTINUE
C
C               **********************************************
C               **  STEP 33--                               **
C               **  FORM THE SUBSETTED VARIABLES            **
C               **       Y1(.)                              **
C               **       Y2(.)                              **
C               **  CONTAINING                              **
C               **       THE VERTICAL AXIS VARIABLE         **
C               **       THE HORIZONTAL AXIS VARIABLE       **
C               **  RESPECTIVELY.                           **
C               **********************************************
C
      ISTEPN='33'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      J=0
      IMAX=NIRIG1
      IF(NQ.LT.NIRIG1)IMAX=NQ
      DO3300I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO3300
      J=J+1
C
      IJ=MAXN*(ICOLR1-1)+I
      IF(ICOLR1.LE.MAXCOL)Y1(J)=V(IJ)
      IF(ICOLR1.EQ.MAXCP1)Y1(J)=PRED(I)
      IF(ICOLR1.EQ.MAXCP2)Y1(J)=RES(I)
      IF(ICOLR1.EQ.MAXCP3)Y1(J)=YPLOT(I)
      IF(ICOLR1.EQ.MAXCP4)Y1(J)=XPLOT(I)
      IF(ICOLR1.EQ.MAXCP5)Y1(J)=X2PLOT(I)
      IF(ICOLR1.EQ.MAXCP6)Y1(J)=TAGPLO(I)
C
      IJ=MAXN*(ICOLR2-1)+I
      IF(ICOLR2.LE.MAXCOL)Y2(J)=V(IJ)
      IF(ICOLR2.EQ.MAXCP1)Y2(J)=PRED(I)
      IF(ICOLR2.EQ.MAXCP2)Y2(J)=RES(I)
      IF(ICOLR2.EQ.MAXCP3)Y2(J)=YPLOT(I)
      IF(ICOLR2.EQ.MAXCP4)Y2(J)=XPLOT(I)
      IF(ICOLR2.EQ.MAXCP5)Y2(J)=X2PLOT(I)
      IF(ICOLR2.EQ.MAXCP6)Y2(J)=TAGPLO(I)
C
 3300 CONTINUE
      NS=J
C
C               *********************************************
C               **  STEP 34--                              **
C               **  CHECK TO MAKE SURE THAT                **
C               **  AFTER SUBSETTING, EACH OF              **
C               **  THE 2 VARIABLES HAS AT LEAST           **
C               **  2 POINTS (THE MINIMUM NEEDED           **
C               **  TO YIELD A PLOT).                      **
C               *********************************************
C
      ISTEPN='34'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOUN1=0
      ICOUN2=0
      IF(NS.LE.2)ICOUN1=NS
      IF(NS.LE.2)ICOUN2=NS
      IF(NS.LE.2)GOTO3410
      DO3400I=1,NS
      IF(Y1(I).LE.-0.0001.OR.Y1(I).GE.0.0001)ICOUN1=ICOUN1+1
      IF(Y2(I).LE.-0.0001.OR.Y2(I).GE.0.0001)ICOUN2=ICOUN2+1
 3400 CONTINUE
 3410 CONTINUE
      IF(ICOUN1.LE.MINN2)GOTO3450
      IF(ICOUN2.LE.MINN2)GOTO3450
      GOTO3490
C
 3450 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3451)
 3451 FORMAT('***** ERROR IN DPANPP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3452)
 3452 FORMAT('      AFTER THE SPECIFIED SUBSETTING ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3453)
 3453 FORMAT('      HAS BEEN DONE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3454)
 3454 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3455)
 3455 FORMAT('      (FOR WHICH AN ANOP PLOT ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3456)
 3456 FORMAT('      IS TO BE FORMED)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3457)MINN2
 3457 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3458)
 3458 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3459)ICOUN1,ICOUN2
 3459 FORMAT('(ICOUN1, ICOUN2 = ',2I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3460)
 3460 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3461)(IANS(I),I=1,IWIDTH)
 3461 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3490 CONTINUE
C
C               ****************************************************************
C               **  STEP 41--                                                  *
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 BOTH ONES FOR BOTH CASES                      *
C               **  DEFINE THE NUMBER OF PLOT POINTS    (NPLOTP).              *
C               **  DEFINE THE NUMBER OF PLOT VARIABLES (NPLOTV).              *
C               ****************************************************************
C
      ISTEPN='41'
      IF(IBUGG2.EQ.'ON'.OR.ISUBRO.EQ.'ANPP')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
CCCCC JUNE, 1990.  MOVE SOME DIMENSIONS FROM DPANP2 TO DPANPP
      CALL DPANP2(Y1,Y2,NS,ICASPL,MAXN,
     1ANOPL1,ANOPL2,
     1Y,X,D,NPLOTP,NPLOTV,
     1XD,PIR,
     1IBUGG3,ISUBRO,IERROR)
C
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG2.EQ.'OFF'.AND.ISUBRO.NE.'ANPP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPANPP--')
      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)ICASPL,MAXN,NUMVAR
 9014 FORMAT('ICASPL,MAXN,NUMVAR = ',A4,I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NIRIG1,NIRIG2
 9015 FORMAT('NIRIG1,NIRIG2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)NLOCAL,NQ,MINN2
 9016 FORMAT('NLOCAL,NQ,MINN2 = ',3I8)
      CALL DPWRST('XXX','BUG ')
      IF(NPLOTP.LE.0)GOTO9029
      DO9020I=1,NPLOTP
      WRITE(ICOUT,9021)I,Y(I),X(I),D(I)
 9021 FORMAT('I,Y(I),X(I),D(I) = ',I8,3F12.5)
      CALL DPWRST('XXX','BUG ')
 9020 CONTINUE
 9029 CONTINUE
      WRITE(ICOUT,9031)ICOUN1,ICOUN2
 9031 FORMAT('ICOUN1,ICOUN2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)ANOPL1,ANOPL2
 9041 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)IHRI11,IHRI12
 9051 FORMAT('IHRI11,IHRI12 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IHRI21,IHRI22
 9052 FORMAT('IHRI21,IHRI22 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPANP2(Y,X,N,ICASPL,MAXN,
     1ANOPL1,ANOPL2,
     1Y2,X2,D2,N2,NPLOTV,
     1XD,PIR,
     1IBUGG3,ISUBRO,IERROR)
CCCCC JUNE, 1990.  XD AND PIR NOW DIMENSIONED IN DPANPP
C
C     PURPOSE--GENERATE A PAIR OF COORDINATE VECTORS
C              THAT WILL DEFINE
C              AN ANOP (ANALYSIS OF PROPORITONS) PLOT.
C              THE PLOT WILL CONSIST OF 2 COMPONENTS--
C                  1) A PROPORTIONS LINE TRACE
C                     WITH LEVELS OF THE INDEPENDENT VARIABLE (HORIZONTALLY)
C                     AND THE PROPORTION OF OBSERVATIONS IN THAT LEVEL
C                     WHICH FALL INTO THE REPONSE VARIABLE TARGET REGION
C                     (THAT IS, BETWEEN ANOPL1 AND ANOPL2, INCLUSIVELY)
C                     (VERTICALLY)
C                  2) A GRAND PROPORTIONS HORIZONTAL LINE WHICH RUNS ACROSS
C                     THE ENTIRE PLOT AND WHICH GIVES THE
C                     PROPORTION OF OBSERVATIONS (OVER THE ENTIRE DATA SET)
C                     WHICH FALL INTO THE RESPONSE VARIABLE TARGET REGION.
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/6
C     ORIGINAL VERSION--JUNE      1987.
C     UPDATED--         JUNE      1990.  SOME DIMENSIONS NOW DONE IN DPANPP
C     UPDATED--         APRIL     1992.  COMMENT OUT
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
CCCCC ADD FOLLOWING LINE NOVEMBER 1994.
      CHARACTER*4 ICASPL
C
      CHARACTER*4 IWRITE
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION Y(*)
      DIMENSION X(*)
      DIMENSION Y2(*)
      DIMENSION X2(*)
      DIMENSION D2(*)
C
CCCCC JUNE, 1990.  FOLLOWING 2 LINES NOW DIMENSIONED IN DPANPP
CCCCC DIMENSION XD(MAXOBV)
CCCCC DIMENSION PIR(MAXOBV)
      DIMENSION XD(*)
      DIMENSION PIR(*)
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='DPAN'
      ISUBN2='P2  '
C
      IERROR='NO'
C
      AN=N
C
      IF(IBUGG3.EQ.'OFF'.AND.ISUBRO.NE.'ANP2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPANP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG3,ISUBRO
   52 FORMAT('IBUGG3,ISUBRO = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)ICASPL,MAXN,N,NPLOTV
   53 FORMAT('ICASPL,MAXN,N,NPLOTV = ',A4,2X,I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT   APRIL 1992 (ALAN)
CCCCC WRITE(ICOUT,54)ALAMB1,ALAMB2
CCC54 FORMAT('ALAMB1,ALAMB2 = ',2E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)N
   60 FORMAT('N = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(N.LE.0)GOTO63
      DO61I=1,N
      WRITE(ICOUT,62)I,Y(I),X(I)
   62 FORMAT('I,Y(I),X(I) = ',I8,2E12.5)
      CALL DPWRST('XXX','BUG ')
   61 CONTINUE
   63 CONTINUE
      WRITE(ICOUT,71)ANOPL1,ANOPL2
   71 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      IF(N.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPANP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      MUST BE AT LEAST 1;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)N
 1114 FORMAT('      THE ENTERED NUMBER OF OBSERVATIONS HERE = ',I6)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N.GE.2)GOTO1129
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** ERROR IN DPANP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1122)
 1122 FORMAT('      THE NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1123)
 1123 FORMAT('      WAS EXACTLY EQUAL TO 1.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y(1)
      DO1130I=1,N
      IF(Y(I).NE.HOLD)GOTO1139
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPANP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ALL INPUT RESPONSE VARIABLE ELEMENTS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1133)HOLD
 1133 FORMAT('      ARE IDENTICALLY EQUAL TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1139 CONTINUE
C
C               **************************************************
C               **  STEP 21--                                   **
C               **  DETERMINE THE NUMBER OF OBSERVATIONS        **
C               **  (AND THE PROPORTION) OF ALL OBSERVATIONS    **
C               **  WHICH FALL IN THE RESPONSE VARIABLE         **
C               **  TARGET REGION                               **
C               **  (BASED ON THE TOTAL DATA SET).              **
C               **  N AND AN   = TOTAL NUMBER OF OBSERVATIONS   **
C               **  NR AND ANR = TOTAL NUMBER OF OBSERVATIONS   **
C               **               IN THE TARGET REGION.          **
C               **  PR         = PROPROTION OF OBSERVATIONS     **
C               **               IN THE TARGET REGION.          **
C               **************************************************
C
      YMIN=ANOPL1
      IF(ANOPL1.GT.ANOPL2)YMIN=ANOPL2
      YMAX=ANOPL2
      IF(ANOPL1.GT.ANOPL2)YMAX=ANOPL1
C
      NR=0
      DO2120J=1,N
      IF(YMIN.LE.Y(J).AND.Y(J).LE.YMAX)NR=NR+1
 2120 CONTINUE
      ANR=NR
C
      PR=100.0*(ANR/AN)
C
C               **************************************************
C               **  STEP 22--                                   **
C               **  DETERMINE THE DISTINCT VALUES               **
C               **  OF THE VARIABLE X                           **
C               **************************************************
C
      IWRITE='OFF'
      CALL DISTIN(X,N,IWRITE,XD,NXD,IBUGG3,IERROR)
C
C               ****************************************************
C               **  STEP 23--                                     **
C               **  LOOP THROUGH THE DISTINCT LEVELS OF X.        **
C               **  FOR EACH DISTINCT LEVEL OF X,                 **
C               **  DETERMINE THE NUMBER OF OBSERVATIONS          **
C               **  (AND THE PROPORTION) OF ALL OBSERVATIONS      **
C               **  WHICH FALL IN THE RESPONSE VARIABLE           **
C               **  TARGET REGION                                 **
C               **  (BASED ON THE DATA FROM THIS LEVEL ONLY).     **
C               **  NI AND ANI   = NUMBER OF OBSERVATIONS         **
C               **                 IN LEVEL I OF THE IND. VAR.    **
C               **  NIR AND ANIR = NUMBER OF OBSERVATIONS         **
C               **                 IN LEVEL I OF THE IND. VAR.    **
C               **                 AND IN THE TARGET REGION.      **
C               **  PIR          = PROPROTION OF OBSERVATIONS     **
C               **                 IN LEVEL I OF THE IND. VAR.    **
C               **                 AND IN THE TARGET REGION.      **
C               ****************************************************
C
      DO2300I=1,NXD
      XDI=XD(I)
C
      NI=0
      DO2310J=1,N
      IF(X(J).EQ.XDI)NI=NI+1
 2310 CONTINUE
      ANI=NI
C
      NIR=0
      DO2330J=1,N
      IF(X(J).EQ.XDI.AND.
     1   YMIN.LE.Y(J).AND.Y(J).LE.YMAX)NIR=NIR+1
 2330 CONTINUE
      ANIR=NIR
C
      PIR(I)=100.0*(ANIR/ANI)
C
 2300 CONTINUE
C
C               ****************************************************
C               **  STEP 24--                                     **
C               **  DETERMINIMUME THE MIN DISTINCT X VALUE        **
C               **  DETERMAXIMUME THE MIN DISTINCT X VALUE        **
C               ****************************************************
C
      XDMIN=XD(1)
      XDMAX=XD(1)
      DO2400I=1,NXD
      IF(XD(I).LT.XDMIN)XDMIN=XD(I)
      IF(XD(I).GT.XDMAX)XDMAX=XD(I)
 2400 CONTINUE
C
C               *******************************************
C               **  STEP 51--                            **
C               **  FORM PLOT COORDINATES                **
C               **  WITH 2 COMPONENTS--                  **
C               **     1) PROPORTIONS TRACE              **
C               **     2) TOTAL PROPORTIONS HORIZ. LINE  **
C               *******************************************
C
      J=0
      DO5110I=1,NXD
      J=J+1
      Y2(J)=PIR(I)
      X2(J)=XD(I)
      D2(J)=1.0
 5110 CONTINUE
C
      J=J+1
      Y2(J)=PR
      X2(J)=XDMIN
      D2(J)=2.0
      J=J+1
      Y2(J)=PR
      X2(J)=XDMAX
      D2(J)=2.0
C
      N2=J
      NPLOTV=3
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 DPANP2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ICASPL,MAXN,N2,IERROR
 9012 FORMAT('ICASPL,MAXN,N2,IERROR = ',A4,I8,I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,N2
      WRITE(ICOUT,9016)I,Y2(I),X2(I),D2(I)
 9016 FORMAT('I,Y2(I),X2(I),D2(I) = ',I8,2E15.7,F9.2)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
CCCCC THE FOLLOWING 4 LINES WERE COMMENTED OUT   APRIL 1992 (ALAN)
CCCCC WRITE(ICOUT,9021)IX1TSC,IX2TSC,IY1TSC,IY2TSC
C9021 FORMAT('IX1TSC,IX2TSC,IY1TSC,IY2TSC = ',A4,2X,A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9022)IX1TSV,IX2TSV,IY1TSV,IY2TSV
C9022 FORMAT('IX1TSV,IX2TSV,IY1TSV,IY2TSV = ',A4,2X,A4,2X,A4,2X,A4)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NXD
 9031 FORMAT('NXD = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9032I=1,NXD
      WRITE(ICOUT,9033)I,XD(I),PIR(I)
 9033 FORMAT('I,XD(I),PIR(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
      WRITE(ICOUT,9041)ANOPL1,ANOPL2
 9041 FORMAT('ANOPL1,ANOPL2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)AN,ANR,PR
 9042 FORMAT('AN,ANR,PR = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9043)ANI,ANIR,PIR(NXD)
 9043 FORMAT('ANI,ANIR,PIR(NXD) = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)XDMIN,XDMAX
 9051 FORMAT('XDMIN,XDMAX = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAPNU(IHREF1,IHREF2,KNUMB,IVAL,
     1IH1,IH2,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN CHARACTER*4 REFERENCE PAIR IHREF1/IHREF2,
C              A GIVEN TARGET POSITION OF THE 8 IN IHREF1 AND IHREF2,
C              AND A GIVEN INTEGER IVAL,
C              FORM THE CHARACTER*4 IH1/IH2 PAIR
C              WITH THE SAME BODY AS IHREF1/IHREF2
C              BUT WITH IVAL APPENDED.
C     NOTE--THE TARGET POSTION IS THE FIRST LOCATION
C           INTO WHICH THE NUMBER IS TO BE APPENDED.
C
C     ORIGINAL VERSION--DECEMBER   1986.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IHREF1
      CHARACTER*4 IHREF2
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*8 IH8
      CHARACTER*4 IHOUT
      CHARACTER*4 IVALID
      CHARACTER*1 IHOUT1
      CHARACTER*4 IHOUT4
      CHARACTER*8 IHOUT8
C
      DIMENSION IHOUT(40)
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
      KNUMB2=KNUMB
C
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'APNU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPAPNU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IHREF1,IHREF2,KNUMB,IVAL
   53 FORMAT('IHREF1,IHREF2,KNUMB,IVAL = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FORM IH8 WHICH WILL BE A CHARACTER*8          **
C               **  COMBINATION OF IH1 AND IH2.                   **
C               **  COPY IHREF1 INTO THE FIRST  HALF OF IH8.      **
C               **  COPY IHREF2 INTO THE SECOND HALF OF IH8.      **
C               **  THEN BLANK OUT THE END OF IH8.                **
C               ****************************************************
C
      IH8(1:4)=IHREF1(1:4)
      IH8(5:8)=IHREF2(1:4)
C
      IF(KNUMB2.LE.0)KNUMB2=1
      IF(KNUMB2.GE.9)GOTO2100
      DO1100K=KNUMB2,8
      IH8(K:K)=' '
 1100 CONTINUE
C
C               *************************************
C               **  STEP 12--                      **
C               **  CONVERT IVAL INTO ALPHABETIC.  **
C               *************************************
C
      CALL DPCOIH(IVAL,IHOUT,NOUT,IVALID,IBUGS2,ISUBRO,IERROR)
      IF(IVALID.EQ.'NO')IERROR='YES'
      IF(IVALID.EQ.'NO')GOTO9000
C
      IF(NOUT.LE.0)GOTO1290
      IHOUT8='        '
      KMAX=NOUT
      IF(KMAX.GT.8)KMAX=8
      DO1200K=1,KMAX
      IHOUT4=IHOUT(K)
      IHOUT1=IHOUT4(1:1)
      IHOUT8(K:K)=IHOUT1
 1200 CONTINUE
 1290 CONTINUE
C
C               ********************************************
C               **  STEP 13--                             **
C               **  APPEND THE ALPHABETIC REPRESENTATION  **
C               **  OF IVAL AT THE PROPER POSITION        **
C               **  IN IH1IH2.                            **
C               ********************************************
C
      IF(NOUT.LE.0)GOTO9000
C
      L=0
      DO1300K=KNUMB2,8
      L=L+1
      IF(L.LE.NOUT)IH8(K:K)=IHOUT8(L:L)
 1300 CONTINUE
C
C               ***********************************************
C               **  STEP 21--                                **
C               **  COPY IH8 INTO 2 COMPONENTS--IH1 AND IH2  **
C               ***********************************************
C
 2100 CONTINUE
      IH1(1:4)=IH8(1:4)
      IH2(1:4)=IH8(5:8)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'APNU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAPNU--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHREF1,IHREF2,KNUMB,IVAL
 9013 FORMAT('IHREF1,IHREF2,KNUMB,IVAL = ',A4,2X,A4,2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IH8,IH1,IH2
 9014 FORMAT('IH8,IH1,IH2 = ',A8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)KNUMB2,NOUT,IVALID
 9015 FORMAT('KNUMB2,NOUT,IVALID = ',2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IHOUT1,IHOUT4,IHOUT8
 9016 FORMAT('IHOUT1,IHOUT4,IHOUT8 = ',A1,2X,A4,2X,A8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAPN2(IHREF1,IHREF2,IVAL,
     1IH1,IH2,IBUGS2,ISUBRO,IERROR)
C
C     PURPOSE--FOR A GIVEN CHARACTER*4 REFERENCE PAIR IHREF1/IHREF2,
C              AND A GIVEN INTEGER IVAL,
C              FORM THE CHARACTER*4 IH1/IH2 PAIR
C              WITH THE SAME BODY AS IHREF1/IHREF2
C              BUT WITH IVAL APPENDED.
C     NOTE--THE APPENDING IS DONE TO THE FIRST BLANK POSITION
C           OR (IF ALL 8 POSITIONS ARE FILLED), THE APPENDING
C           IS DONE STARTING IN POSITION 7 (THEREBY OVERWRITING)
C           THE CHARACTERS IN 7 AND 8
C           EXAMPLE--IF IHREF1/IHREF2 IS ABC AND IVAL IS 6
C                    THEN IH1/IH2 IS ABC6
C                  --IF IHREF1/IHREF2 IS ABCDEFGH AND IVAL IS 6
C                    THEN IH1/IH2 IS ABCDEF6
C                  --IF IHREF1/IHREF2 IS ABCDEFGH AND IVAL IS 24
C                    THEN IH1/IH2 IS ABCDEF24
C     NOTE--IVAL SHOULD ASSUMED TO BE BETWEEN 0 AND 99 (NOT TESTED FOR)
C           IF IVAL IS BIGGER THAN THIS AND IF THERE ARE ENOUGH
C           TRAILING BLANKS IN IHREF1/IHREF2 TO ACCOMODATE, THEN
C           THE FULL VALUE WILL BE APPENDED.
C           ON THE OTHER HAND, IF IHREF1/IHREF2 HAS 7 OR 8 CHARACTERS,
C           AND IF IVAL IS 3 OR MORE DIGITS, THEN IVAL WILL BE TRUNCATED.
C
C     ORIGINAL VERSION--SEPTEMBER 1987.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IHREF1
      CHARACTER*4 IHREF2
      CHARACTER*4 IH1
      CHARACTER*4 IH2
      CHARACTER*4 IBUGS2
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      CHARACTER*8 IH8
      CHARACTER*4 IHOUT
      CHARACTER*4 IVALID
      CHARACTER*1 IHOUT1
      CHARACTER*4 IHOUT4
      CHARACTER*8 IHOUT8
C
      DIMENSION IHOUT(40)
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
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'APNU')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPAPN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,ISUBRO,IERROR
   52 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IHREF1,IHREF2,IVAL
   53 FORMAT('IHREF1,IHREF2,IVAL = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ****************************************************
C               **  STEP 11--                                     **
C               **  FORM IH8 WHICH WILL BE A CHARACTER*8          **
C               **  COMBINATION OF IH1 AND IH2.                   **
C               **  COPY IHREF1 INTO THE FIRST  HALF OF IH8.      **
C               **  COPY IHREF2 INTO THE SECOND HALF OF IH8.      **
C               **  THEN BLANK OUT THE END OF IH8.                **
C               ****************************************************
C
      IH8(1:8)='        '
      IH8(1:4)=IHREF1(1:4)
      IH8(5:8)=IHREF2(1:4)
C
C               ****************************************************
C               **  STEP 12--                                     **
C               **  DETERMINE THE TARGET POSITION =               **
C               **  THE FIRST NON-BLANK POSITION IN               **
C               **  IHREF1/IHREF2                                 **
C               **  (BUT IF 7 AND BEYOND, SET IT TO 7)            **
C               ****************************************************
C
      IFIRBL=9
      DO1100I=1,8
      IREV=8-I+1
      IF(IH8(IREV:IREV).NE.' ')GOTO1190
      IFIRBL=IREV
 1100 CONTINUE
 1190 CONTINUE
      IF(IFIRBL.GE.7)IFIRBL=7
C
C               ***********************************************
C               **  STEP 13--                                **
C               **  CONVERT IVAL INTO ALPHABETIC.            **
C               **  NOTE--NOUT = NUMBER OF RESULTING DIGITS  **
C               ***********************************************
C
      CALL DPCOIH(IVAL,IHOUT,NOUT,IVALID,IBUGS2,ISUBRO,IERROR)
      IF(IVALID.EQ.'NO')IERROR='YES'
      IF(IVALID.EQ.'NO')GOTO9000
C
      IF(NOUT.LE.0)GOTO1390
      IHOUT8='        '
      KMAX=NOUT
      IF(KMAX.GT.8)KMAX=8
      DO1300K=1,KMAX
      IHOUT4=IHOUT(K)
      IHOUT1=IHOUT4(1:1)
      IHOUT8(K:K)=IHOUT1
 1300 CONTINUE
 1390 CONTINUE
C
C               ********************************************
C               **  STEP 14--                             **
C               **  APPEND THE ALPHABETIC REPRESENTATION  **
C               **  OF IVAL AT THE PROPER POSITION        **
C               **  IN IH8.                               **
C               **  IF THERE ARE MORE DIGITS IN IVAL      **
C               **  THAN SPACE IN IH8 ALLOWS, THEN        **
C               **  TRUNCATE REMAINING DIGITS             **
C               ********************************************
C
      IF(NOUT.LE.0)GOTO9000
C
      L=0
      DO1400K=IFIRBL,8
      L=L+1
      IF(L.LE.NOUT)IH8(K:K)=IHOUT8(L:L)
 1400 CONTINUE
C
C               ***********************************************
C               **  STEP 21--                                **
C               **  COPY IH8 INTO 2 COMPONENTS--IH1 AND IH2  **
C               ***********************************************
C
 2100 CONTINUE
      IH1(1:4)=IH8(1:4)
      IH2(1:4)=IH8(5:8)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF'.AND.ISUBRO.NE.'APNU')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAPN2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGS2,ISUBRO,IERROR
 9012 FORMAT('IBUGS2,ISUBRO,IERROR = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHREF1,IHREF2,IVAL
 9013 FORMAT('IHREF1,IHREF2,IVAL = ',A4,2X,A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)IH8,IH1,IH2
 9014 FORMAT('IH8,IH1,IH2 = ',A8,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)IFIRBL,NOUT,IVALID
 9015 FORMAT('IFIRBL,NOUT,IVALID = ',2I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IHOUT1,IHOUT4,IHOUT8
 9016 FORMAT('IHOUT1,IHOUT4,IHOUT8 = ',A1,2X,A4,2X,A8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPAPPE(IBUGS2,IBUGQ,ISUBRO,IFOUND,IERROR)
C
C     PURPOSE--APPEND A VARIABLE X TO A VARIABLE Y.
C     EXAMPLE--APPEND X Y    WHICH APPENDS X TO Y
C     NOTE--SIMILAR TO THE    EXTEND   COMMAND
C           BUT WITH THE ARGUMENTS REVERSED.
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 (IN DPLET)--APRIL     1984.
C     UPDATED                    --JUNE      1990.  ADD ISUBRO TO CALL LIST
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGS2
      CHARACTER*4 IBUGQ
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
CCCCC FOLLOWING LINE ADDED JUNE 1990.
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IVAR11
      CHARACTER*4 IVAR12
      CHARACTER*4 IVAR21
      CHARACTER*4 IVAR22
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOHK.INC'
      INCLUDE 'DPCODA.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPAP'
      ISUBN2='PE  '
C
      MAXCP1=MAXCOL+1
      MAXCP2=MAXCOL+2
      MAXCP3=MAXCOL+3
      MAXCP4=MAXCOL+4
      MAXCP5=MAXCOL+5
      MAXCP6=MAXCOL+6
C
      IFOUND='YES'
      IERROR='NO'
C
      I2=0
      N1=0
      N2=0
      ICOL1=0
      ICOL2=0
C
      IVAR11='UNKN'
      IVAR12='UNKN'
      IVAR21='UNKN'
      IVAR22='UNKN'
      ILIST1=(-999)
      ILIST2=(-999)
      N1PN2=(-999)
      N1PI=(-999)
      IJ1=(-999)
      IJ2=(-999)
      N1NEW=(-999)
      IROW1=(-999)
      IROWN=(-99)
C
C               **********************************************
C               **  TREAT THE CASE OF APPENDING A VARIABLE  **
C               **  BY THE CONTENTS OF ANOTHER VARIABLE.    **
C               **********************************************
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 DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGS2,IBUGQ
   52 FORMAT('IBUGS2,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=2
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************************************
C               **  STEP 3--
C               **  EXAMINE THE FIRST  VARIABLE.
C               **  IS IT IN THE TABLE?
C               **  IS IT A VARIABLE?
C               **  IVAR11 AND IVAR12 = THE NAME OF THE FIRST  VARIABLE.
C               **  ILIST1 = THE LINE IN THE INTERNAL TABLE
C               **           WHERE THE FIRST  VARIABLE IS FOUND.
C               **  ICOL1  = THE DATA COLUMN FOR THE FIRST  VARIABLE.
C               **  N1     = THE NUMBER OF OBSERVATIONS FOR THE FIRST  VARIABLE.
C               ****************************************************************
C
      ISTEPN='3'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVAR11=IHARG(1)
      IVAR12=IHARG2(1)
C
      DO310I=1,NUMNAM
      I2=I
      IF(IVAR11.EQ.IHNAME(I).AND.IVAR12.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO380
      IF(IVAR11.EQ.IHNAME(I).AND.IVAR12.EQ.IHNAM2(I).AND.
     1IUSE(I).NE.'V')GOTO330
  310 CONTINUE
C
  320 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,321)
  321 FORMAT('***** ERROR IN DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,322)
  322 FORMAT('      THE FIRST  VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,323)IVAR11,IVAR12
  323 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,324)
  324 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,325)
  325 FORMAT('      SUGGESTED ACTION--USE THE STATUS COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,326)
  326 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  330 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,331)
  331 FORMAT('***** ERROR IN DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,332)
  332 FORMAT('      THE FIRST  VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,333)IVAR11,IVAR12
  333 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,334)
  334 FORMAT('      SHOULD HAVE BEEN A VARIABLE, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  380 CONTINUE
      ILIST1=I2
      ICOL1=IVALUE(ILIST1)
      N1=IN(ILIST1)
C
C               ****************************************************************
C               **  STEP 4--
C               **  EXAMINE THE SECOND VARIABLE.
C               **  IS IT IN THE TABLE?
C               **  IS IT A VARIABLE?
C               **  IVAR21 AND IVAR22 = THE NAME OF THE SECOND VARIABLE.
C               **  ILIST2 = THE LINE IN THE INTERNAL TABLE
C               **           WHERE THE SECOND VARIABLE IS FOUND.
C               **  ICOL2  = THE DATA COLUMN FOR THE SECOND VARIABLE.
C               **  N2     = THE NUMBER OF OBSERVATIONS FOR THE SECOND VARIABLE.
C               ****************************************************************
C
      ISTEPN='4'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IVAR21=IHARG(2)
      IVAR22=IHARG2(2)
C
      DO410I=1,NUMNAM
      I2=I
      IF(IVAR21.EQ.IHNAME(I).AND.IVAR22.EQ.IHNAM2(I).AND.
     1IUSE(I).EQ.'V')GOTO480
      IF(IVAR21.EQ.IHNAME(I).AND.IVAR22.EQ.IHNAM2(I).AND.
     1IUSE(I).NE.'V')GOTO430
  410 CONTINUE
C
  420 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,421)
  421 FORMAT('***** ERROR IN DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,422)
  422 FORMAT('      THE SECOND VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,423)IVAR21,IVAR22
  423 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,424)
  424 FORMAT('      WAS NOT FOUND IN THE INTERNAL NAME TABLE,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,425)
  425 FORMAT('      SUGGESTED ACTION--USE THE STATUS COMMAND')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,426)
  426 FORMAT('      TO FIND OUT THE FULL LIST OF USED NAMES.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  430 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,431)
  431 FORMAT('***** ERROR IN DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,432)
  432 FORMAT('      THE SECOND VARIABLE NAME REFERENCED ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,433)IVAR21,IVAR22
  433 FORMAT('      (= ',A4,A4,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,434)
  434 FORMAT('      SHOULD HAVE BEEN A VARIABLE, BUT WAS NOT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  480 CONTINUE
      ILIST2=I2
      ICOL2=IVALUE(ILIST2)
      N2=IN(ILIST2)
C
      ISTEPN='6'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
C               ***********************************************
C               **  STEP 6--                                 **
C               **  DO A PRELIMINARY CHECK--                 **
C               **  WILL APPENDING VARIABLE 1 TO VARIABLE 2  **
C               **  MAKE VARIABLE 2 TOO LONG?                **
C               **  (THAT IS, WILL IT EXCEED MAXN)?          **
C               ***********************************************
C
      N1PN2=N1+N2
      IF(N1PN2.LE.MAXN)GOTO690
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,621)
  621 FORMAT('***** ERROR IN DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,622)IVAR11,IVAR12
  622 FORMAT('      THE APPENDING OF VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,623)IVAR21,IVAR22
  623 FORMAT('      TO VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,624)IVAR21,IVAR22
  624 FORMAT('      WILL MAKE VARIABLE ',A4,A4,' TOO LONG.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,625)IVAR11,IVAR12,N1
  625 FORMAT('      NUMBER OF OBSERVATIONS IN ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,626)IVAR21,IVAR22,N2
  626 FORMAT('      NUMBER OF OBSERVATIONS IN ',A4,A4,' = ' ,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,627)IVAR11,IVAR12,N1PN2
  627 FORMAT('      NEW NUMBER OF OBSERVATIONS IN ',A4,A4,
     1' WOULD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,628)MAXN
  628 FORMAT('      ALLOWABLE NUMBER OF OBSERVATIONS    = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,629)
  629 FORMAT('      THEREFORE, NO APPENDING CARRIED OUT.')
      CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
  690 CONTINUE
C
C               ****************************************************
C               **  STEP 10--                                     **
C               **  APPEND VARIABLE 1 BY VARIABLE 2               **
C               ****************************************************
C
      ISTEPN='10'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      DO2100I=1,N1
      N2PI=N2+I
      IJ1=MAXN*(ICOL2-1)+N2PI
      IJ2=MAXN*(ICOL1-1)+I
      IF(ICOL2.LE.MAXCOL)V(IJ1)=V(IJ2)
      IF(ICOL2.EQ.MAXCP1)PRED(N2PI)=Y(IJ2)
      IF(ICOL2.EQ.MAXCP2)RES(N2PI)=Y(IJ2)
 2100 CONTINUE
      N2NEW=N2PI
C
C               *******************************************
C               **  STEP 11--                            **
C               **  CARRY OUT THE LIST UPDATING AND      **
C               **  GENERATE THE INFORMATIVE PRINTING.   **
C               *******************************************
C
      ISTEPN='11'
      IF(IBUGS2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IHNAME(ILIST2)=IVAR21
      IHNAM2(ILIST2)=IVAR22
      IUSE(ILIST2)='V'
      IVALUE(ILIST2)=ICOL2
      VALUE(ILIST2)=ICOL2
      IN(ILIST2)=N2NEW
C
      DO2400J4=1,NUMNAM
      IF(IUSE(J4).EQ.'V'.AND.IVALUE(J4).EQ.ICOL2)GOTO2405
      GOTO2400
 2405 CONTINUE
      IUSE(J4)='V'
      IVALUE(J4)=ICOL2
      VALUE(J4)=ICOL2
      IN(J4)=N2NEW
 2400 CONTINUE
C
      IF(IPRINT.EQ.'OFF')GOTO2459
      IF(IFEEDB.EQ.'OFF')GOTO2459
      NNUM=N1
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2411)IVAR21,IVAR22,NNUM
 2411 FORMAT('THE NUMBER OF VALUES ADDED TO ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
C
      IROW1=N2+1
      IROWN=N2+N1
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOL2-1)+IROW1
      IF(ICOL2.LE.MAXCOL)WRITE(ICOUT,2421)IVAR21,IVAR22,V(IJ),IROW1
      IF(ICOL2.LE.MAXCOL)CALL DPWRST('XXX','BUG ')
      IF(ICOL2.EQ.MAXCP1)WRITE(ICOUT,2421)IVAR21,IVAR22,PRED(IROW1),
     1IROW1
      IF(ICOL2.EQ.MAXCP1)CALL DPWRST('XXX','BUG ')
      IF(ICOL2.EQ.MAXCP2)WRITE(ICOUT,2421)IVAR21,IVAR22,RES(IROW1),
     1IROW1
 2421 FORMAT('THE FIRST           VALUE ADDED TO ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOL2.EQ.MAXCP2)CALL DPWRST('XXX','BUG ')
      IJ=MAXN*(ICOL2-1)+IROWN
      IF(ICOL2.LE.MAXCOL.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,IVAR21,IVAR22,V(IJ),IROWN
 2431 FORMAT('THE LAST (',I5,'-TH) VALUE ADDED TO ',A4,A4,
     1' = ',E15.7,'   (ROW ',I6,')')
      IF(ICOL2.LE.MAXCOL.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOL2.EQ.MAXCP1.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,IVAR21,IVAR22,PRED(IROWN),IROWN
      IF(ICOL2.LE.MAXCOL.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
      IF(ICOL2.EQ.MAXCP2.AND.
     1NNUM.NE.1)WRITE(ICOUT,2431)NNUM,IVAR21,IVAR22,RES(IROWN),IROWN
      IF(ICOL2.EQ.MAXCP2.AND.
     1NNUM.NE.1)CALL DPWRST('XXX','BUG ')
C
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,2453)IVAR21,IVAR22,N2NEW
 2453 FORMAT('THE NEW     LENGTH OF  ',
     1'THE VARIABLE ',A4,A4,' = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
 2459 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGS2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPAPPE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGS2,IBUGQ
 9013 FORMAT('IBUGS2,IBUGQ = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IVAR11,IVAR12,ILIST1,ICOL1,N1
 9021 FORMAT('IVAR11,IVAR12,ILIST1,ICOL1,N1 = ',A4,2X,A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IVAR22,IVAR22,ILIST2,ICOL2,N2
 9022 FORMAT('IVAR22,IVAR22,ILIST2,ICOL2,N2 = ',A4,2X,A4,3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)N1PI,N1PN2,N1NEW,IROW1,IROWN,IJ1,IJ2
 9023 FORMAT('N1PI,N1PN2,N1NEW,IROW1,IROWN,IJ1,IJ2 = ',6I8)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARC(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C
C     PURPOSE--DRAW ONE OR MORE ARCS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE 3 SUCCESSIVE POINTS
C           ON THE ARC.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 3
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*3 = 6.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN ARC WILL GO
C           FROM THE LAST CURSOR POSITION
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIRST AND SECOND NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN ARC WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS RESULTING FORM THE FIRST AND SECOND NUMBERS
C           THROUGH THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS
C     NOTE--AND SO FORTH FOR 10, 14, 18, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARC')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPARC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='ARC'
      NUMPT=3
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPARC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW AN ARC ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END OF MAJOR AXIS AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      ONE END OF THE MINOR AXIS AT THE POINT 30 10')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)
 1138 FORMAT('      AND WITH THE OTHER END OF THE MAJOR AXIS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1139)
 1139 FORMAT('      AT THE POINT 40 20')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      ARC 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      ARC ABSOLUTE 20 20 30 10 40 20 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE LINE(S)  **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X3,X3,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X3=X2+X3
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y3=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y5,Y5,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y3=Y2+Y3
C
      CALL DPARC2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X3
      Y1=Y3
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X3
      PYEND=Y3
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARC')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARC--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2,X3,Y3
 9013 FORMAT('X1,Y1,X2,Y2,X3,Y3 = ',6E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARC2(X1,Y1,X2,Y2,X3,Y3,
     1IFIG,
     1ILINPA,ILINCO,PLINTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C     PURPOSE--DRAW A ARC
C              WITH ONE END OF THE ARC AT (X1,Y1)
C              SOME MIDDLE POINT AT (X2,Y2),
C              AND THE OTHER END OF THE ARC AT (X3,Y3).
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 ILINPA
      CHARACTER*4 ILINCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
      DIMENSION PX3(1000)
      DIMENSION PY3(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
      EQUIVALENCE (G2RBAG(IGAR13),PX3(1))
      EQUIVALENCE (G2RBAG(IGAR14),PY3(1))
CCCCC END CHANGE
C
      DIMENSION ILINPA(*)
      DIMENSION ILINCO(*)
      DIMENSION PLINTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARC2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPARC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ILINPA(1),ILINCO(1),PLINTH(1)
   61 FORMAT('ILINPA(1),ILINCO(1),PLINTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE ARC                **
C               *********************************
C
      PI=3.1415926
C
      THETA=0.0
      THETA1=0.0
      THETA2=0.0
      THETA3=0.0
C
C               ****************************************************************
C               **  STEP 1.1--                                                **
C               **  COMPUTE THE INTERCEPT AND SLOPE OF THE LINE               **
C               **  THROUGH THE MIDPOINT OF POINTS 1 AND 2                    **
C               **  AND PERPENDICULAR TO THE SEGMENT BETWEEN POINTS 1 AND 2.  **
C               ****************************************************************
C
      DELX12=X2-X1
      DELY12=Y2-Y1
C
      IF(DELX12.EQ.0.0)GOTO711
      IF(DELY12.EQ.0.0)GOTO712
      GOTO713
C
  711 CONTINUE
      AM12=CPUMAX
      B12=CPUMAX
      AM12P=0.0
      B12P=Y1
      GOTO715
C
  712 CONTINUE
      AM12=0.0
      B12=Y1
      AM12P=CPUMAX
      B12P=CPUMAX
      GOTO715
C
  713 CONTINUE
      AM12=DELY12/DELX12
      B12=-AM12*X1+Y1
      X12=(X1+X2)/2.0
      Y12=(Y1+Y2)/2.0
      AM12P=-1.0/AM12
      B12P=-AM12P*X12+Y12
      GOTO715
C
  715 CONTINUE
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,716)DELX12,DELY12,B12,AM12,B12P,AM12P
  716 FORMAT('DELX12,DELY12,B12,AM12,B12P,AM12P = ',6E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ****************************************************************
C               **  STEP 1.2--                                                **
C               **  COMPUTE THE INTERCEPT AND SLOPE OF THE LINE               **
C               **  THROUGH THE MIDPOINT OF POINTS 2 AND 3                    **
C               **  AND PERPENDICULAR TO THE SEGMENT BETWEEN POINTS 2 AND 3.  **
C               ****************************************************************
C
      DELX23=X3-X2
      DELY23=Y3-Y2
C
      IF(DELX23.EQ.0.0)GOTO721
      IF(DELY23.EQ.0.0)GOTO722
      GOTO723
C
  721 CONTINUE
      AM23=CPUMAX
      B23=CPUMAX
      AM23P=0.0
      B23P=Y2
      GOTO725
C
  722 CONTINUE
      AM23=0.0
      B23=Y2
      AM23P=CPUMAX
      B23P=CPUMAX
      GOTO725
C
  723 CONTINUE
      AM23=DELY23/DELX23
      B23=-AM23*X2+Y2
      X23=(X2+X3)/2.0
      Y23=(Y2+Y3)/2.0
      AM23P=-1.0/AM23
      B23P=-AM23P*X23+Y23
      GOTO725
C
  725 CONTINUE
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,726)DELX23,DELY23,B23,AM23,B23P,AM23P
  726 FORMAT('DELX23,DELY23,B23,AM23,B23P,AM23P = ',6E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***************************************************
C               **  STEP 1.3--                                   **
C               **  COMPUTE THE COORDINATES OF THE CENTER POINT  **
C               **  OF THE CIRCLE DEFINED BY THE 3 ARC POINTS.   **
C               ***************************************************
C
      ANUM=-(B12P-B23P)
      ADEN=AM12P-AM23P
      XCENT=CPUMAX
      IF(ADEN.NE.0.0)XCENT=ANUM/ADEN
      YCENT=AM12P*XCENT+B12P
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,731)ANUM,ADEN,XCENT,YCENT
  731 FORMAT('ANUM,ADEN,XCENT,YCENT = ',4E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ****************************************************
C               **  STEP 1.4--                                    **
C               **  COMPUTE THE ANGLE OF ROTATION OF THE FIGURE.  **
C               ****************************************************
C
      DELX=X3-X1
      DELY=Y3-Y1
C
      IF(ABS(DELX).GE.0.00001.AND.DELX.LT.0.0)
     1THETA=PI+ATAN(DELY/DELX)
      IF(ABS(DELX).GE.0.00001.AND.DELX.GT.0.0)
     1THETA=ATAN(DELY/DELX)
C
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)
     1THETA=1.5*(PI/2.0)
      IF(ABS(DELX).LT.0.00001.AND.DELX.EQ.0.0)
     1THETA=PI/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.GT.0.0)
     1THETA=PI/2.0
C
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,741)DELX,DELY,THETA
  741 FORMAT('DELX,DELY,THETA = ',3E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 1.5--                                           **
C               **  COMPUTE THE RADIUS OF THE CIRCLE.                    **
C               **  COMPUTE THE ANGLE FROM THE CENTER POINT TO POINT 1.  **
C               ***********************************************************
C
      DELXC1=2.0*(X1-XCENT)
      DELYC1=2.0*(Y1-YCENT)
      ALEN=0.0
      TERM=DELXC1**2+DELYC1**2
      IF(TERM.GT.0.0)ALEN=SQRT(TERM)
      R=ALEN/2.0
      IF(ABS(DELXC1).GE.0.00001.AND.DELXC1.GE.0.0)
     1THETA1=ATAN(DELYC1/DELXC1)
      IF(ABS(DELXC1).GE.0.00001.AND.DELXC1.LT.0.0)
     1THETA1=PI+ATAN(DELYC1/DELXC1)
      IF(ABS(DELXC1).LT.0.00001.AND.DELYC1.GE.0.0)
     1THETA1=PI/2.0
      IF(ABS(DELXC1).LT.0.00001.AND.DELYC1.LT.0.0)
     1THETA1=1.5*(PI/2.0)
      IF(THETA1.LT.0.0)THETA1=THETA1+2.0*PI
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,751)ALEN,R
  751 FORMAT('ALEN,R = ',2E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,752)DELXC1,DELYC1,THETA1
  752 FORMAT('DELXC1,DELYC1,THETA1 = ',3E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 1.6--                                           **
C               **  COMPUTE THE ANGLE FROM THE CENTER POINT TO POINT 2.  **
C               ***********************************************************
C
      DELXC2=2.0*(X2-XCENT)
      DELYC2=2.0*(Y2-YCENT)
      IF(ABS(DELXC2).GE.0.00001.AND.DELXC2.GE.0.0)
     1THETA2=ATAN(DELYC2/DELXC2)
      IF(ABS(DELXC2).GE.0.00001.AND.DELXC2.LT.0.0)
     1THETA2=PI+ATAN(DELYC2/DELXC2)
      IF(ABS(DELXC2).LT.0.00001.AND.DELYC2.GE.0.0)
     1THETA2=PI/2.0
      IF(ABS(DELXC2).LT.0.00001.AND.DELYC2.LT.0.0)
     1THETA2=1.5*(PI/2.0)
      IF(THETA2.LT.0.0)THETA2=THETA2+2.0*PI
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,761)DELXC2,DELYC2,THETA2
  761 FORMAT('DELXC2,DELYC2,THETA2 = ',3E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ***********************************************************
C               **  STEP 1.7--                                           **
C               **  COMPUTE THE ANGLE FROM THE CENTER POINT TO POINT 3.  **
C               ***********************************************************
C
      DELXC3=2.0*(X3-XCENT)
      DELYC3=2.0*(Y3-YCENT)
      IF(ABS(DELXC3).GE.0.00001.AND.DELXC3.GE.0.0)
     1THETA3=ATAN(DELYC3/DELXC3)
      IF(ABS(DELXC3).GE.0.00001.AND.DELXC3.LT.0.0)
     1THETA3=PI+ATAN(DELYC3/DELXC3)
      IF(ABS(DELXC3).LT.0.00001.AND.DELYC3.GE.0.0)
     1THETA3=PI/2.0
      IF(ABS(DELXC3).LT.0.00001.AND.DELYC3.LT.0.0)
     1THETA3=1.5*(PI/2.0)
      IF(THETA3.LT.0.0)THETA3=THETA3+2.0*PI
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,771)DELXC3,DELYC3,THETA3
  771 FORMAT('DELXC3,DELYC3,THETA3 = ',3E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
C               ******************************
C               **  STEP 1.8--              **
C               **  COMPUTE THE ARC POINTS  **
C               ******************************
C
      K=0
C
      K=K+1
      PX(K)=X1
      PY(K)=Y1
C
      IF(THETA1.LE.THETA3.AND.THETA3.LE.THETA2)GOTO3001
      IF(THETA2.LE.THETA1.AND.THETA1.LE.THETA3)GOTO3002
      IF(THETA3.LE.THETA1.AND.THETA1.LE.THETA2)GOTO3003
      IF(THETA2.LE.THETA3.AND.THETA3.LE.THETA1)GOTO3004
      GOTO3005
 3001 CONTINUE
      THETA1=THETA1+2.0*PI
      GOTO3005
 3002 CONTINUE
      THETA1=THETA1+2.0*PI
      THETA2=THETA2+2.0*PI
      GOTO3005
 3003 CONTINUE
      THETA1=THETA1+2.0*PI
      GOTO3005
 3004 CONTINUE
      THETA2=THETA2+2.0*PI
      THETA3=THETA3+2.0*PI
      GOTO3005
 3005 CONTINUE
      IF(IBUGG4.EQ.'ON')WRITE(ICOUT,3009)THETA1,THETA2,THETA3
 3009 FORMAT('THETA1,THETA2,THETA3 = ',3E15.7)
      IF(IBUGG4.EQ.'ON')CALL DPWRST('XXX','BUG ')
C
      DELTHE=THETA3-THETA1
      IMAX=101
      AIMAX=IMAX
      DO3010I=1,IMAX
      AI=I
      P=(AI-1.0)/(AIMAX-1.0)
      PHI2=THETA1+P*DELTHE
      X=XCENT+R*COS(PHI2)
      Y=YCENT+R*SIN(PHI2)
      K=K+1
      PX(K)=X
      PY(K)=Y
 3010 CONTINUE
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=ILINPA(1)
      PTHICK=PLINTH(1)
      ICOL=ILINCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCC 1IFIG,IPATT,PTHICK,ICOL)
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARC2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARC2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)XCENT,YCENT,R
 9012 FORMAT('XCENT,YCENT,R = ',3E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NP
 9014 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARCL(IHARG,IARGT,IARG,NUMARG,IDEFCO,
     1MAXARR,IARRCO,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE COLOR FOR AN ARROW.
C              THE COLOR FOR ARROW I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IARRCO(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFCO
C                     --MAXARR
C     OUTPUT ARGUMENTS--IARRCO (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              COLOR FOR ARROW I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      CHARACTER*4 IDEFCO
      CHARACTER*4 IARRCO
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IARRCO(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COLO')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COLO')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFCO
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXARR
      IARRCO(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IARRCO(I)
 1136 FORMAT('ALL ARROW COLORS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPARCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE ARROW ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE ARROW IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      ARROW 3 COLOR GREEN')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXARR)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPARCL--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE ARROW ... COLOR COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF ARROWS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXARR
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'ARROW.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFCO
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IARRCO(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IARRCO(I)
 1186 FORMAT('THE COLOR FOR ARROW ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPARCO(IHARG,IHARG2,IARGT,IARG,ARG,NUMARG,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,IANS,IWIDTH,
     1MAXARR,PARRXC,PARRYC,NUMARR,IBUGP2,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE 2 PAIRS OF (X,Y) COORDINATES
C              FOR AN ARROW.
C              THE FIRST PAIR WILL BE FOR THE TAIL OF THE ARROW;
C              THE SECOND PAIR WILL BE FOR THE HEAD OF THE ARROW.
C              THE (X1,Y1), (X2,Y2) COORDINATES WILL BE PLACED IN THE
C              FIRST AND SECOND ELEMENTS (RESPECTIVELY) OF
C              THE 2 ARRAYS PARRXC(.,.) AND PARRYC(.,.)
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --MAXARR
C     OUTPUT ARGUMENTS--PARRXC (A FLOATING POINT VECTOR
C                              WHOSE (I,1)-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR THE TAIL OF ARROW I;
C                              WHOSE (I,2)-TH ELEMENT CONTAINS THE
C                              X COORDINATE FOR THE HEAD OF ARROW I;
C                     --PARRYC (A FLOATING POINT VECTOR
C                              WHOSE (I,1)-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR THE TAIL OF ARROW I;
C                              WHOSE (I,2)-TH ELEMENT CONTAINS THE
C                              Y COORDINATE FOR THE HEAD OF ARROW I;
C                     --NUMARR = THE NUMBER OF ARROWS DEFINED SO FAR
C                              (ACTUALLY, THE HIGHEST REFERENCED ARROW SO FAR)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-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         --MARCH     1981.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IHARG2
      CHARACTER*4 IARGT
      CHARACTER*4 IHNAME
      CHARACTER*4 IHNAM2
      CHARACTER*4 IUSE
      CHARACTER*4 IANS
      CHARACTER*4 IBUGP2
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHWUSE
      CHARACTER*4 MESSAG
      CHARACTER*4 IHWORD
      CHARACTER*4 IHWOR2
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION IHNAME(*)
      DIMENSION IHNAM2(*)
      DIMENSION IUSE(*)
      DIMENSION IN(*)
      DIMENSION IVALUE(*)
      DIMENSION VALUE(*)
      DIMENSION IANS(*)
C
      DIMENSION PARRXC(100,2)
      DIMENSION PARRYC(100,2)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPAR'
      ISUBN2='CO  '
C
      IFOUND='NO'
      IERROR='NO'
C
      HOLD1=0.0
      HOLD2=0.0
      HOLD3=0.0
      HOLD4=0.0
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'COOR')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'COOR')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      IF(NUMARG.GE.5)GOTO1125
C
      IERROR='YES'
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPARCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
 1112 FORMAT('      IN THE ARROW ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
 1113 FORMAT('      THE COORDINATES ARE SPECIFIED BY 4 NUMBERS, ',
     1'AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
 1114 FORMAT('      ARROW 3 COORDINATES 30 80 31 79')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1120 CONTINUE
      HOLD1=CPUMIN
      HOLD2=CPUMIN
      HOLD3=CPUMIN
      HOLD4=CPUMIN
      NUMARR=0
      GOTO1130
C
 1125 CONTINUE
      DO1126J=2,5
      IF(IARGT(J).EQ.'NUMB')GOTO1127
      GOTO1128
 1127 CONTINUE
      IF(J.EQ.2)HOLD1=ARG(J)
      IF(J.EQ.3)HOLD2=ARG(J)
      IF(J.EQ.4)HOLD3=ARG(J)
      IF(J.EQ.5)HOLD4=ARG(J)
      GOTO1126
 1128 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.2)HOLD1=VALUE(ILOC)
      IF(J.EQ.3)HOLD2=VALUE(ILOC)
      IF(J.EQ.4)HOLD3=VALUE(ILOC)
      IF(J.EQ.5)HOLD4=VALUE(ILOC)
 1126 CONTINUE
      NUMARR=MAXARR
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXARR
      PARRXC(I,1)=HOLD1
      PARRYC(I,1)=HOLD2
      PARRXC(I,2)=HOLD3
      PARRYC(I,2)=HOLD4
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)
 1136 FORMAT('ALL ARROW COORDINATES HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)PARRXC(I,1),PARRYC(I,1)
 1137 FORMAT('    (X,Y) FOR TAIL OF ARROW = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)PARRXC(I,2),PARRYC(I,2)
 1138 FORMAT('    (X,Y) FOR HEAD OF ARROW = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPARCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE ARROW ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE ARROW IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      ARROW 3 COORDINATES 30 80 31 79')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXARR)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPARCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE ARROW ... COORDINATES COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF ARROWS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXARR
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'ARROW.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      IF(NUMARG.GE.6)GOTO1175
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1111)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1112)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1113)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1114)
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1170 CONTINUE
      HOLD1=CPUMIN
      HOLD2=CPUMIN
      HOLD3=CPUMIN
      HOLD4=CPUMIN
      IF(I.EQ.NUMARR)NUMARR=I-1
      GOTO1180
C
 1175 CONTINUE
      DO1176J=3,6
      IF(IARGT(J).EQ.'NUMB')GOTO1177
      GOTO1178
 1177 CONTINUE
      IF(J.EQ.3)HOLD1=ARG(J)
      IF(J.EQ.4)HOLD2=ARG(J)
      IF(J.EQ.5)HOLD3=ARG(J)
      IF(J.EQ.6)HOLD4=ARG(J)
      GOTO1176
 1178 CONTINUE
      IHWORD=IHARG(J)
      IHWOR2=IHARG2(J)
      IHWUSE='P'
      MESSAG='YES'
      CALL CHECKN(IHWORD,IHWOR2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOC,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IF(J.EQ.3)HOLD1=VALUE(ILOC)
      IF(J.EQ.4)HOLD2=VALUE(ILOC)
      IF(J.EQ.5)HOLD3=VALUE(ILOC)
      IF(J.EQ.6)HOLD4=VALUE(ILOC)
 1176 CONTINUE
      IF(I.GT.NUMARR)NUMARR=I
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PARRXC(I,1)=HOLD1
      PARRYC(I,1)=HOLD2
      PARRXC(I,2)=HOLD3
      PARRYC(I,2)=HOLD4
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I
 1186 FORMAT('THE COORDINATES FOR ARROW ',I8,
     1' HAVE JUST BEEN SET TO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)PARRXC(I,1),PARRYC(I,1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1138)PARRXC(I,2),PARRYC(I,2)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGP2.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARCO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IFOUND,IERROR
 9012 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARMA(XTEMP1,XTEMP2,MAXNXT,
     1ISUBRO,IBUGA2,IBUGA3,IBUGQ,IFOUND,IERROR)
C
C     PURPOSE--CARRY OUT AN ARIMA ANALYSIS
C              (1-SAMPLE)
C     EXAMPLE--ARMA Y 1 0 1 
C              THIS FITS AN AR(1) AND A MA(1) WITH NO DIFFERENCING.
C              THE DATAPLOT ARIMA MODEL ALLOWS UP TO 7 TERMS:
C                 ARMA P1 D1 Q1 P2 D2 Q2 S2
C              WHERE
C                 P1 = ORDER OF AUTOREGRESSIVE TERM
C                 D1 = NUMBER OF DIFFERENCES (TYPICALLY EITHER
C                      0 FOR NO DIFFERENCE, 1 FOR A SINGLE DIFFERENCE)
C                 Q1 = ORDER OF MOVING AVERAGE TERM
C                 S1 = SEASONAL PERIOD (THIS IS TYPICALLY 1, I.E.
C                      THIS IS THE NON-SEASONAL TERM)
C                      DATAPLOT ALWAYS SETS THIS TO 1 SO NOT
C                      ENTERED BY THE USER
C                 P1 = ORDER OF SEASONAL AUTOREGRESSIVE TERM
C                 D2 = NUMBER OF DIFFERENCING FOR SEASONAL TERM
C                 Q2 = ORDER OF SEASONAL MOVING AVERAGE
C                 S2 = PERIOD FOR SEASONAL DIFFERENCING
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-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/2
C     ORIGINAL VERSION--MAY       1999.
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
C
      CHARACTER*4 IH11
      CHARACTER*4 IH12
      CHARACTER*4 IH21
      CHARACTER*4 IH22
      CHARACTER*4 IH31
      CHARACTER*4 IH32
      CHARACTER*4 IH41
      CHARACTER*4 IH42
      CHARACTER*4 IH51
      CHARACTER*4 IH52
      CHARACTER*4 IH61
      CHARACTER*4 IH62
      CHARACTER*4 IH71
      CHARACTER*4 IH72
      CHARACTER*4 IH81
      CHARACTER*4 IH82
      CHARACTER*4 IHP
      CHARACTER*4 IHP2
      CHARACTER*4 IH
      CHARACTER*4 IH2
C
      CHARACTER*4 ISUBN0
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IUSE1
      CHARACTER*4 IUSE2
      CHARACTER*4 IUSE3
      CHARACTER*4 IUSE4
      CHARACTER*4 IUSE5
      CHARACTER*4 IUSE6
      CHARACTER*4 IUSE7
      CHARACTER*4 IUSE8
      CHARACTER*4 IREPU
      CHARACTER*4 IRESU
C
      CHARACTER*4 IPVFLG
      CHARACTER*4 IFXFLG
C
C---------------------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
C
      DIMENSION XTEMP1(*)
      DIMENSION XTEMP2(*)
C
      DOUBLE PRECISION Y1(MAXOBV)
      DOUBLE PRECISION STP(100)
      DOUBLE PRECISION SCALE(100)
      DOUBLE PRECISION PV(MAXOBV)
      DOUBLE PRECISION SDPV(MAXOBV)
      DOUBLE PRECISION SDRES(MAXOBV)
      DOUBLE PRECISION FCST(MAXOBV,1)
      DOUBLE PRECISION FCSTSD(MAXOBV,1)
      DOUBLE PRECISION DRES(MAXOBV)
      PARAMETER(MAXPAR=100)
      DOUBLE PRECISION VCV(MAXPAR,MAXPAR)
      DOUBLE PRECISION PAR(MAXPAR)
C
      INTEGER IFIXED(MAXOBV)
C
      DIMENSION PRED2(MAXOBV)
      DIMENSION RES2(MAXOBV)
C
      INCLUDE 'DPCOZD.INC'
      INCLUDE 'DPCOZZ.INC'
      INCLUDE 'DPCOZI.INC'
C
      EQUIVALENCE (DGARBG(IDGAR1),Y1(1))
      EQUIVALENCE (DGARBG(IDGAR2),PV(1))
      EQUIVALENCE (DGARBG(IDGAR3),SDPV(1))
C
      EQUIVALENCE (GARBAG(IGARB1),PRED2(1))
      EQUIVALENCE (GARBAG(IGARB3),RES2(1))
      EQUIVALENCE (GARBAG(IGARB5),SDRES(1))
      EQUIVALENCE (GARBAG(IGARB7),DRES(1))
      EQUIVALENCE (GARBAG(IGARB9),VCV(1,1))
      EQUIVALENCE (GARBAG(JGAR11),STP(1))
      EQUIVALENCE (GARBAG(JGAR13),PAR(1))
      EQUIVALENCE (GARBAG(JGAR14),SCALE(1))
      EQUIVALENCE (GARBAG(JGAR16),FCST(1,1))
      EQUIVALENCE (GARBAG(JGAR18),FCSTSD(1,1))
C
      EQUIVALENCE (IGARBG(IIGAR1),IFIXED(1))
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOHO.INC'
      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='DPAR'
      ISUBN2='MA  '
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
      N1=(-999)
      N2=(-999)
C
      IUSE1='-999'
      IUSE2='-999'
C
      NUMVAR=(-999)
      ILOCV=(-999)
C
      VALUE1=(-999.0)
      VALUE2=(-999.0)
C
      ICOL1=(-999)
      ICOL2=(-999)
C
      MINN2=2
C
      IFOUND='YES'
C
      NLEFT=0
C
      ICASEQ='UNKN'
C
C               ********************************
C               **  TREAT THE ARMA    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 DPARMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGA2,IBUGA3
   52 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IBUGQ
   53 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)MAXNXT
   55 FORMAT('MAXNXT = ',I8)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *******************************************************
C               **  STEP 2--                                         **
C               **  CHECK FOR THE PROPER NUMBER OF INPUT ARGUMENTS.  **
C               *******************************************************
C
      ISTEPN='2'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      MINNA=1
      MAXNA=100
      CALL CHECKA(NUMARG,MINNA,MAXNA,IANS,IWIDTH,ISUBN1,ISUBN2,
     1IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ****************************************
C               **  STEP 11--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 1  **
C               **  (THIS SHOULD BE A VARIABLE)       **
C               ****************************************
C
      ISTEPN='11'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IH11=IHARG(1)
      IH12=IHARG2(1)
      IHWUSE='V'
      MESSAG='YES'
      CALL CHECKN(IH11,IH12,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCV,IERROR)
      IF(IERROR.EQ.'YES')GOTO9000
      IUSE1=IUSE(ILOCV)
      ICOL1=IVALUE(ILOCV)
      N1=IN(ILOCV)
      NUMVAR=1
C
C               ********************************************************
C               **  STEP 12--                                         **
C               **  IF ARGUMENT 1 IS A VARIABLE,                      **
C               **  CHECK THAT THE INPUT NUMBER OF OBSERVATIONS (N1)  **
C               **  FOR ARGUMENT 1 IS 2 OR MORE.                      **
C               ********************************************************
C
      ISTEPN='12'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO1290
      IF(N1.GE.MINN2)GOTO1290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1211)
 1211 FORMAT('***** ERROR IN DPARMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1212)
 1212 FORMAT('      THE INPUT NUMBER OF OBSERVATIONS')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1213)
 1213 FORMAT('      (FOR WHICH A DDS ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1214)
 1214 FORMAT('      WAS TO HAVE BEEN CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1215)MINN2
 1215 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1216)
 1216 FORMAT('      SUCH WAS NOT THE CASE HERE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1217)IH11,IH12
 1217 FORMAT('      FOR VARIABLE ',A4,A4,' WHICH HAD')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1218)N1
 1218 FORMAT('      NUMBER OF OBSERVATIONS = ',I8,';')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1219)
 1219 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,1220)(IANS(I),I=1,IWIDTH)
 1220 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
 1290 CONTINUE
C
C               ****************************************
C               **  STEP 22--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 2  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='22'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.1)IORDAR=1
      IF(NUMARG.GE.2)THEN
         IH21=IHARG(2)
         IH22=IHARG2(2)
         IF(IARGT(2).EQ.'NUMB')THEN
            VALUE2=ARG(2)
            IORDAR=IARG(2)
            IUSE2='P'
         ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 23--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 3  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='23'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.2)IDIFF=0
      IF(NUMARG.GE.3)THEN
         IH31=IHARG(3)
         IH32=IHARG2(3)
         IF(IARGT(3).EQ.'NUMB')THEN
            VALUE3=ARG(3)
            IDIFF=IARG(3)
            IUSE3='P'
         ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 24--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 4  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='24'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.3)IORDMA=0
      IF(NUMARG.GE.4)THEN
         IH41=IHARG(4)
         IH42=IHARG2(4)
         IF(IARGT(4).EQ.'NUMB')THEN
            VALUE4=ARG(4)
            IORDMA=IARG(4)
            IUSE4='P'
         ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 25--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 5  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='25'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.4)IORSAR=0
      IF(NUMARG.GE.5)THEN
         IH51=IHARG(5)
         IH52=IHARG2(5)
         IF(IARGT(5).EQ.'NUMB')THEN
            VALUE4=ARG(5)
            IORSAR=IARG(5)
            IUSE5='P'
         ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 26--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 6  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='26'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.5)ISDIFF=0
      IF(NUMARG.GE.6)THEN
         IH61=IHARG(6)
         IH62=IHARG2(6)
         IF(IARGT(6).EQ.'NUMB')THEN
            VALUE6=ARG(6)
            ISDIFF=IARG(6)
            IUSE6='P'
         ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 27--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 7  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='27'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.6)IORSMA=0
      IF(NUMARG.GE.7)THEN
         IH71=IHARG(7)
         IH72=IHARG2(7)
         IF(IARGT(7).EQ.'NUMB')THEN
            VALUE7=ARG(7)
            IORSMA=IARG(7)
            IUSE7='P'
         ENDIF
      ENDIF
C
C               ****************************************
C               **  STEP 28--                         **
C               **  CHECK THE VALIDITY OF ARGUMENT 8  **
C               **  (THIS SHOULD BE A                 **
C               **  A PARAMETER, OR A NUMBER).        **
C               ****************************************
C
      ISTEPN='28'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(NUMARG.LE.7)ISPER=12
      IF(NUMARG.GE.8)THEN
         IH81=IHARG(8)
         IH82=IHARG2(8)
         IF(IARGT(8).EQ.'NUMB')THEN
            VALUE8=ARG(8)
            ISPER=IARG(8)
            IUSE8='P'
         ENDIF
      ENDIF
C
C               *******************************************************
C               **  STEP 31--                                        **
C               **  FOR AN ARIMA ANALYSIS,                           **
C               **  THE FIRST ARGUMENT                               **
C               **  MUST BE A VARIABLE.                              **
C               **  CHECK FOR THIS.                                  **
C               *******************************************************
C
      ISTEPN='31'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IUSE1.NE.'V')GOTO3140
      GOTO3190
C
 3140 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3141)
 3141 FORMAT('***** ERROR IN DPARMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3142)
 3142 FORMAT('      FOR A DDS ANALYSIS,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3143)
 3143 FORMAT('      THE FIRST ARGUMENT')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3146)
 3146 FORMAT('      MUST BE A VARIABLE')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3147)
 3147 FORMAT('      (AS OPPOSED TO A PARAMETER OR FUNCTION).')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3148)
 3148 FORMAT('      SUCH WAS NOT THE CASE HERE.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,3149)
 3149 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,3150)(IANS(I),I=1,IWIDTH)
 3150 FORMAT(80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 3190 CONTINUE
C
C               *****************************************
C               **  STEP 40--                          **
C               **  CHECK TO SEE THE TYPE CASE--       **
C               **    1) UNQUALIFIED (THAT IS, FULL);  **
C               **    2) SUBSET/EXCEPT; OR             **
C               **    3) FOR.                          **
C               *****************************************
C
      ISTEPN='40'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICASEQ='FULL'
      ILOCQ=NUMARG+1
      IF(NUMARG.LT.1)GOTO4090
      DO4000J=1,NUMARG
      J1=J
      IF(IHARG(J).EQ.'SUBS'.AND.IHARG2(J).EQ.'ET  ') GOTO4010
      IF(IHARG(J).EQ.'EXCE'.AND.IHARG2(J).EQ.'PT  ') GOTO4010
      IF(IHARG(J).EQ.'FOR '.AND.IHARG2(J).EQ.'    ') GOTO4020
 4000 CONTINUE
      GOTO4090
 4010 CONTINUE
      ICASEQ='SUBS'
      ILOCQ=J1
      GOTO4090
 4020 CONTINUE
      ICASEQ='FOR'
      ILOCQ=J1
      GOTO4090
 4090 CONTINUE
      IF(IBUGA2.EQ.'OFF')GOTO4095
      WRITE(ICOUT,4091)NUMARG,ILOCQ
 4091 FORMAT('NUMARG,ILOCQ = ',2I8)
      CALL DPWRST('XXX','BUG ')
 4095 CONTINUE
C
C               ***********************************************
C               **  STEP 41--                                **
C               **  TEMPORARILY FORM THE VARIABLE Y(.)       **
C               **  WHICH WILL HOLD THE DATA FROM SAMPLE 1.  **
C               **  FORM THIS VARIABLE BY                    **
C               **  BRANCHING TO THE APPROPRIATE SUBCASE     **
C               **  (FULL, SUBSET, OR FOR).                  **
C               ***********************************************
C
      IF(IUSE1.NE.'V')GOTO4190
C
      ISTEPN='41'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(ICASEQ.EQ.'FULL')GOTO4110
      IF(ICASEQ.EQ.'SUBS')GOTO4120
      IF(ICASEQ.EQ.'FOR')GOTO4130
C
 4110 CONTINUE
      DO4115I=1,N1
      ISUB(I)=1
 4115 CONTINUE
      NQ=N1
      GOTO4150
C
 4120 CONTINUE
      NIOLD=N1
      CALL DPSUBS(NIOLD,ILOCS,NS,IBUGQ,IERROR)
      NQ=NIOLD
      GOTO4150
C
 4130 CONTINUE
      NIOLD=N1
      CALL DPFOR(NIOLD,NFOR,IROW1,IROWN,
     1NLOCAL,ILOCS,NS,IBUGQ,IERROR)
      NQ=NFOR
      GOTO4150
C
 4150 CONTINUE
      IF(NQ.GE.MINN2)GOTO4160
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4151)
 4151 FORMAT('***** ERROR IN DPARMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4152)
 4152 FORMAT('      AFTER THE APPROPRIATE SUBSET HAS BEEN ',
     1'EXTRACTED,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4153)IH11,IH12
 4153 FORMAT('      THE NUMBER OF OBSERVATIONS REMAINING',
     1'FROM VARIABLE ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4154)
 4154 FORMAT('      (FOR WHICH A DDS ANALYSIS ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4155)
 4155 FORMAT('      IS TO BE CARRIED OUT)')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4156)MINN2
 4156 FORMAT('      MUST BE ',I8,' OR LARGER;')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4157)NQ
 4157 FORMAT('      SUCH WAS NOT THE CASE HERE.  (N = ',I8,')')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,4158)
 4158 FORMAT('      THE ENTERED COMMAND LINE WAS AS FOLLOWS--')
      CALL DPWRST('XXX','BUG ')
      IF(IWIDTH.GE.1)WRITE(ICOUT,4159)(IANS(I),I=1,IWIDTH)
 4159 FORMAT('      ',80A1)
      IF(IWIDTH.GE.1)CALL DPWRST('XXX','BUG ')
      IERROR='YES'
      GOTO9000
C
 4160 CONTINUE
      J=0
      IMAX=N1
      IF(NQ.LT.N1)IMAX=NQ
      DO4170I=1,IMAX
      IF(ISUB(I).EQ.0)GOTO4170
      J=J+1
C
      IJ=MAXN*(ICOL1-1)+I
      IF(ICOL1.LE.MAXCOL)Y1(J)=DBLE(V(IJ))
      IF(ICOL1.EQ.MAXCP1)Y1(J)=DBLE(PRED(I))
      IF(ICOL1.EQ.MAXCP2)Y1(J)=DBLE(RES(I))
      IF(ICOL1.EQ.MAXCP3)Y1(J)=DBLE(YPLOT(I))
      IF(ICOL1.EQ.MAXCP4)Y1(J)=DBLE(XPLOT(I))
      IF(ICOL1.EQ.MAXCP5)Y1(J)=DBLE(X2PLOT(I))
      IF(ICOL1.EQ.MAXCP6)Y1(J)=DBLE(TAGPLO(I))
C
 4170 CONTINUE
      N1=J
C
 4190 CONTINUE
C
C               ***********************************************
C               **  STEP 4.50--                              **
C               **  CHECK FOR ARPAR VARIABLE THAT CONTAINS   **
C               **  STARTING VALUES FOR PARAMETERS           **
C               ***********************************************
C
 4500 CONTINUE
      DO4505I=1,MAXPAR
        PAR(I)=0.1D0
 4505 CONTINUE
      IPVFLG='OFF'
      IHP='ARPA'
      IHP2='R   '
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO4590
      IPVFLG='ON'
      NTEMP=IN(ILOCP)
      ICOLT=IVALUE(ILOCP)
      DO4510I=1,MIN(NTEMP,MAXPAR)
        IJ=MAXN*(ICOLT-1)+I
        PAR(I)=DBLE(V(IJ))
 4510 CONTINUE
 4590 CONTINUE
C
C               *************************************************
C               **  STEP 4.60--                                **
C               **  CHECK FOR ARFIXED VARIABLE THAT CONTAINS   **
C               **  1 IF PARAMETER IS FIXED, 0 OTHERWISE       **
C               *************************************************
C
 4600 CONTINUE
      IFXFLG='OFF'
      IHP='ARFI'
      IHP2='IXED'
      IHWUSE='V'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO4690
      IFXFLG='ON'
      NTEMP=IN(ILOCP)
      ICOLT=IVALUE(ILOCP)
      DO4605I=1,MAXOBV
        IFIXED(I)=0
 4605 CONTINUE
      DO4610I=1,NTEMP
        IJ=MAXN*(ICOLT-1)+I
        IFIXED(I)=0
        IF(I.LE.MAXPAR)PAR(I)=INT(V(IJ))
        IF(IFIXED(I).LE.0 .OR. IFIXED(I).GE.2)IFIXED(I)=0
 4610 CONTINUE
 4690 CONTINUE
C
C               *************************************************
C               **  STEP 4.70--                                **
C               **  CHECK FOR NFORECAS PARAMETER THAT          **
C               **  SPECIFIES NUMBER OF FORECASTS AHEAD TO MAKE**
C               *************************************************
C
 4700 CONTINUE
      NFORE=0
      IHP='NFOR'
      IHP2='ECAS'
      IHWUSE='P'
      MESSAG='NO'
      CALL CHECKN(IHP,IHP2,IHWUSE,
     1IHNAME,IHNAM2,IUSE,IN,IVALUE,VALUE,NUMNAM,MAXNAM,
     1ISUBN1,ISUBN2,MESSAG,IANS,IWIDTH,ILOCP,IERROR)
      IF(IERROR.EQ.'YES')GOTO4790
      NFORE=VALUE(ILOCP)
      IF(NFORE.LT.1)NFORE=0
 4790 CONTINUE
C
      AIC=9999.0
      AICC=9999.0
C
C               *********************************
C               **  STEP 52--                  **
C               **  PERFORM THE ARIMA ANALYSIS **
C               *********************************
C
      ISTEPN='52'
      IF(IBUGA2.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IBUGA2.EQ.'OFF')GOTO5290
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5211)
 5211 FORMAT('***** FROM DPARMA, AS WE ARE ABOUT TO CALL DPARM2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,5212)N1,N2,N1,N2,MAXN
 5212 FORMAT('N1,N2,N1,N2,MAXN = ',5I8)
      CALL DPWRST('XXX','BUG ')
      DO5215I=1,N1
      WRITE(ICOUT,5216)I,Y1(I)
 5216 FORMAT('I,Y1(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 5215 CONTINUE
      WRITE(ICOUT,5231)IBUGA3
 5231 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','BUG ')
 5290 CONTINUE
C
      CALL DPARM2(Y1,N1,
     1IORDAR,IDIFF,IORDMA,IORSAR,ISDIFF,IORSMA,ISPER,
     1PAR,STP,SCALE,PV,SDPV,SDRES,DRES,VCV,MAXPAR,IFIXED,
     1PRED2,RES2,RESSD,RESDF,
     1FCST,FCSTSD,MAXOBV,
     1IPVFLG,IFXFLG,NFORE,
     1AIC,AICC,
     1ISUBRO,IBUGA3,IERROR)
C
      IF(IERROR.EQ.'YES')GOTO9000
C
C               ***************************************
C               **  STEP 15--                        **
C               **  UPDATE INTERNAL DATAPLOT TABLES  **
C               ***************************************
C
 7000 CONTINUE
C
      ISTEPN='15'
      IF(IBUGA2.EQ.'ON'.OR.ISUBRO.EQ.'PDDS')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      ICOLPR=MAXCP1
      ICOLRE=MAXCP2
      IREPU='OFF'
      IRESU='ON'
      NLEFT=N1
      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
      IH='AIC '
      IH2='    '
      VALUE0=AIC
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,IERROR)
C
      IH='AICC'
      IH2='    '
      VALUE0=AICC
      CALL DPADDP(IH,IH2,VALUE0,IHOST1,ISUBN0,
     1IHNAME,IHNAM2,IUSE,VALUE,IVALUE,NUMNAM,MAXNAM,
     1IANS,IWIDTH,IBUGA2,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 DPARMA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGA2,IBUGA3
 9012 FORMAT('IBUGA2,IBUGA3 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IBUGQ
 9013 FORMAT('IBUGQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NLEFT,NS
 9014 FORMAT('NLEFT,NS = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)ICASEQ
 9015 FORMAT('ICASEQ = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)IFOUND,IERROR
 9016 FORMAT('IFOUND,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARM2(Y1,N1,
     1IORDAR,IDIFF,IORDMA,IORSAR,ISDIFF,IORSMA,ISPER,
     1PAR,STP,SCALE,PV,SDPV,SDRES,DRES2,VCV,MAXPAR,IFIXED,
     1PRED2,RES2,RESSD,RESDF,
     1FCST,FCSTSD,MAXOBV,
     1IPVFLG,IFXFLG,NFORE,
     1AIC,AICC,
     1ISUBRO,IBUGA3,IERROR)
C
C     PURPOSE--THIS ROUTINE CARRIES OUT A 1-SAMPLE ARIMA ANALYSIS
C     EXAMPLE--ARMA Y 1 0 1 
C              THIS FITS AN AR(1) AND A MA(1) WITH NO DIFFERENCING.
C              THE DATAPLOT ARIMA MODEL ALLOWS UP TO 7 TERMS:
C                 ARMA P1 D1 Q1 P2 D2 Q2 S2
C              WHERE
C                 P1 = ORDER OF AUTOREGRESSIVE TERM
C                 D1 = NUMBER OF DIFFERENCES (TYPICALLY EITHER
C                      0 FOR NO DIFFERENCE, 1 FOR A SINGLE DIFFERENCE)
C                 Q1 = ORDER OF MOVING AVERAGE TERM
C                 S1 = SEASONAL PERIOD (THIS IS TYPICALLY 1, I.E.
C                      THIS IS THE NON-SEASONAL TERM)
C                      DATAPLOT ALWAYS SETS THIS TO 1 SO NOT
C                      ENTERED BY THE USER
C                 P1 = ORDER OF SEASONAL AUTOREGRESSIVE TERM
C                 D2 = NUMBER OF DIFFERENCING FOR SEASONAL TERM
C                 Q2 = ORDER OF SEASONAL MOVING AVERAGE
C                 S2 = PERIOD FOR SEASONAL DIFFERENCING
C
C     SAMPLE DATA IS IN INPUT VECTOR Y1 (WITH N1 OBSERVATIONS).
C     DATAPLOT USES THE NIST STARPAC LIBRARY (WRITTEN BY
C     JANET DONALDSON AND PETER TYRON.  STARPAC IS BASED ON THE
C     NON-LINEAR LEAST SQUARES ROUTINES OF DENNIS AND SCHNABEL.
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-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/5
C     ORIGINAL VERSION--MAY       1999.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IBUGA3
      CHARACTER*4 IERROR
C
      CHARACTER*4 IPVFLG
      CHARACTER*4 IFXFLG
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
      CHARACTER*4 ISTEPN
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION STOPSS
      DOUBLE PRECISION STOPP
      DOUBLE PRECISION DELTA
      DOUBLE PRECISION RSD
C
      INTEGER MSPEC(4,2)
      INTEGER IFIXED(*)
      INTEGER IFCST0(1)
C
      DOUBLE PRECISION Y1(*)
      DOUBLE PRECISION PAR(*)
      DOUBLE PRECISION STP(*)
      DOUBLE PRECISION SCALE(*)
      DOUBLE PRECISION PV(*)
      DOUBLE PRECISION SDPV(*)
      DOUBLE PRECISION SDRES(*)
      DOUBLE PRECISION VCV(MAXPAR,MAXPAR)
      DOUBLE PRECISION DRES2(*)
      DOUBLE PRECISION FCST(MAXOBV,1)
      DOUBLE PRECISION FCSTSD(MAXOBV,1)
C
      DIMENSION PRED2(*)
      DIMENSION RES2(*)
C
      CHARACTER*4 ISUBRO
      CHARACTER*4 ISUBN0
      CHARACTER*80 IFILE1
      CHARACTER*12 ISTAT1
      CHARACTER*12 IFORM1
      CHARACTER*12 IACCE1
      CHARACTER*12 IPROT1
      CHARACTER*12 ICURS1
      CHARACTER*4 IERRF1
      CHARACTER*4 IENDF1
      CHARACTER*4 IREWI1
C
      CHARACTER*80 IFILE2
      CHARACTER*12 ISTAT2
      CHARACTER*12 IFORM2
      CHARACTER*12 IACCE2
      CHARACTER*12 IPROT2
      CHARACTER*12 ICURS2
      CHARACTER*4 IERRF2
      CHARACTER*4 IENDF2
      CHARACTER*4 IREWI2
C
      CHARACTER*80 IFILE3
      CHARACTER*12 ISTAT3
      CHARACTER*12 IFORM3
      CHARACTER*12 IACCE3
      CHARACTER*12 IPROT3
      CHARACTER*12 ICURS3
      CHARACTER*4 IERRF3
      CHARACTER*4 IENDF3
      CHARACTER*4 IREWI3
C
      CHARACTER*80 IFILE4
      CHARACTER*12 ISTAT4
      CHARACTER*12 IFORM4
      CHARACTER*12 IACCE4
      CHARACTER*12 IPROT4
      CHARACTER*12 ICURS4
      CHARACTER*4 IERRF4
      CHARACTER*4 IENDF4
      CHARACTER*4 IREWI4
C
      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
C
C-----COMMON FOR STARPAC LIBRARY
C
      PARAMETER(LDSTAK=100000)
      DOUBLE PRECISION DSTAK(LDSTAK)
      COMMON/CSTAK/DSTAK
      COMMON/ERRCHK/IERR,IOUNI1,IOUNI2,IOUNI3,IOUNI4,IOUNI5
      COMMON/STARPC/IRESDF
C
      INCLUDE 'DPCOF2.INC'
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='DPAR'
      ISUBN2='M2  '
C
      IERROR='NO'
C
      N=(-99)
C
      IF(IBUGA3.EQ.'OFF')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,51)
   51 FORMAT('**** AT THE BEGINNING OF DPARM2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,52)IBUGA3
   52 FORMAT('IBUGA3 = ',A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,55)N1
   55 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO56I=1,N1
      WRITE(ICOUT,57)I,Y1(I)
   57 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
   56 CONTINUE
      WRITE(ICOUT,65)IORDAR,IDIFF,IORDMA
   65 FORMAT('IORDAR,IDIFF,IORDMA = ',3I8)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,66)IORSAR,ISDIFF,IORSMA,ISPER
   66 FORMAT('IORSAR,ISDIFF,IORSMA,ISPER = ',4I8)
      CALL DPWRST('XXX','WRIT')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 11--                             **
C               **  CHECK THE INPUT ARGUMENTS FOR ERRORS  **
C               ********************************************
C
      ISTEPN='11'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(N1.GE.1)GOTO1119
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1111)
 1111 FORMAT('***** ERROR IN DPARM2--THE NUMBER OF OBSERVATIONS ',
     1'FOR VARIABLE 1 IS NON-POSITIVE')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1112)N1
 1112 FORMAT('SAMPLE SIZE = ',I8)
      CALL DPWRST('XXX','WRIT')
      IERROR='YES'
      GOTO9000
 1119 CONTINUE
C
      IF(N1.EQ.1)GOTO1120
      GOTO1129
 1120 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1121)
 1121 FORMAT('***** NOTE FROM DPARM2--VARIABLE 1 ',
     1'HAS ONLY 1 ELEMENT')
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1129 CONTINUE
C
      HOLD=Y1(1)
      DO1135I=2,N1
      IF(Y1(I).NE.HOLD)GOTO1139
 1135 CONTINUE
 1130 CONTINUE
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,1131)HOLD
 1131 FORMAT('***** NOTE FROM DPARM2--VARIABLE 1 ',
     1'HAS ALL ELEMENTS = ',E15.7)
      CALL DPWRST('XXX','WRIT')
      GOTO9000
 1139 CONTINUE
C
 1290 CONTINUE
C
C               **************************************************
C               **  STEP 2.1--                                  **
C               **   OPEN THE STORAGE FILES                     **
C               **************************************************
C
      ISTEPN='2.1'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ARM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IOUNI1=IST1NU
      IFILE1=IST1NA
      ISTAT1=IST1ST
      IFORM1=IST1FO
      IACCE1=IST1AC
      IPROT1=IST1PR
      ICURS1=IST1CS
      ISUBN0='FIT3'
      IERRF1='NO'
C
      IREWI1='ON'
      CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IOUNI2=IST2NU
      IFILE2=IST2NA
      ISTAT2=IST2ST
      IFORM2=IST2FO
      IACCE2=IST2AC
      IPROT2=IST2PR
      ICURS2=IST2CS
      ISUBN0='FIT3'
      IERRF2='NO'
C
      IREWI2='ON'
      CALL DPOPFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IOUNI3=IST3NU
      IFILE3=IST3NA
      ISTAT3=IST3ST
      IFORM3=IST3FO
      IACCE3=IST3AC
      IPROT3=IST3PR
      ICURS3=IST3CS
      ISUBN0='FIT3'
      IERRF3='NO'
C
      IREWI3='ON'
      CALL DPOPFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IOUNI4=IST4NU
      IFILE4=IST4NA
      ISTAT4=IST4ST
      IFORM4=IST4FO
      IACCE4=IST4AC
      IPROT4=IST4PR
      ICURS4=IST4CS
      ISUBN0='FIT3'
      IERRF4='NO'
C
      IREWI4='ON'
      CALL DPOPFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
      IOUNI5=IST5NU
      IFILE5=IST5NA
      ISTAT5=IST5ST
      IFORM5=IST5FO
      IACCE5=IST5AC
      IPROT5=IST5PR
      ICURS5=IST5CS
      ISUBN0='FIT3'
      IERRF5='NO'
C
      IREWI5='ON'
      CALL DPOPFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IREWI5,ISUBN0,IERRF5,IBUGA3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
C               *************************************
C               **  STEP 31--                      **
C               **  CARRY OUT CALCULATIONS         **
C               **  FOR A 1-SAMPLE ARIMA ANALYSIS  **
C               *************************************
C
 3100 CONTINUE
C
      ISTEPN='31'
      IF(IBUGA3.EQ.'ON')CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IF(IFXFLG.EQ.'OFF')THEN
        IFIXED(1)=-1
      ENDIF
      IVARPX=1
      MIT=500
      NPRT=22202
      STOPP=-1.0
      STOPSS=-1.0
      DELTA=-1.0
      SCALE(1)=-1.0
      STP(1)=-1.0
      IVCV=MAXPAR
      NPARE=0
C
      NFAC=1
      IF(IORSAR.GT.0 .OR. IORSMA.GT.0 .OR. ISDIFF.GT.0)NFAC=2
      MSPEC(1,1)=IORDAR
      MSPEC(2,1)=IDIFF
      MSPEC(3,1)=IORDMA
      MSPEC(4,1)=1
      MSPEC(1,2)=IORSAR
      MSPEC(2,2)=ISDIFF
      MSPEC(3,2)=IORSMA
      MSPEC(4,2)=ISPER
      IF(MSPEC(1,2).EQ.0 .AND. MSPEC(2,2).EQ.0 .AND. 
     1  MSPEC(3,2).EQ.0)MSPEC(4,2)=0
      NPAR=1 + MSPEC(1,1) + MSPEC(3,1) + MSPEC(1,2) + MSPEC(3,2)
      IF(IPVFLG.EQ.'OFF')THEN
        DO3200I=1,NPAR
          PAR(I)=0.1D0
 3200   CONTINUE 
        PAR(MSPEC(1,1)+MSPEC(1,2)+1)=0.0D0
      ENDIF
C
      CALL AIMES(Y1,N1,MSPEC,NFAC,PAR,NPAR,DRES2,LDSTAK,
     1           IFIXED,STP,MIT,STOPSS,STOPP,
     1           SCALE,DELTA,IVARPX,NPRT,
     1           NPARE,RSD,PV,SDPV,SDRES,VCV,IVCV)
C
      IF(IERR.NE.0)IERROR='YES'
      RESSD=REAL(RSD)
      RESDF=REAL(IRESDF)
      DO3810I=1,N1
        PRED2(I)=REAL(PV(I))
        RES2(I)=REAL(DRES2(I))
 3810 CONTINUE
C
CCCCC FEBRUARY 2003: COMPUTE AIC: AIC(NPAR) = N*LOG(RESSD**2)+2*NPAR
C
      AN=REAL(N1)
      AIC=AN*LOG(RESSD**2)+2.0*REAL(NPAR)
      AP=REAL(IORDAR)
      AQ=REAL(IORDMA)
      AFACT=2.0*(AP + AQ + 1.0)*AN/(AN - AP - AQ - 2.0)
      AICC=REAL(N1)*LOG(RESSD**2)+AFACT
C
      NPRT=0
      NFCST=0
      NFCST0=0
CCCCC IF(NFORE.GT.0)NFCST=NFORE
      IFCST0(1)=0
      IFCST=MAXOBV
      IERR=0
C
      CALL AIMFS(Y1,N1,MSPEC,NFAC,PAR,NPAR,LDSTAK,
     1           NFCST,NFCST0,IFCST0,NPRT,FCST,IFCST,FCSTSD)
      IF(IERR.NE.0)IERROR='YES'
C
C  THIS DONE IN STARPAC CODE
C
CCCCC DO3820I=1,NPAR
CCCCC   WRITE(IOUNI1,3821)PAR(I)
C3821   FORMAT(E15.7,1X,E15.7)
C3820 CONTINUE
C
C  THIS DONE IN STARPAC CODE
C
CCCCC DO3830I=1,N1
CCCCC   WRITE(IOUNI2,3831)PV(I),SDPV(I),REAL(DRES2(I)),SDRES(I)
C3831   FORMAT(4(E15.7,1X))
C3830 CONTINUE
C
CCCCC NTEMP=(N1/10)+1
CCCCC DO3840I=1,NTEMP
CCCCC   WRITE(IOUNI5,3841)FCST(I,1),FCSTSD(I,1)
C3841   FORMAT(2(E15.7,1X))
C3840 CONTINUE
C
C
      IF(IPRINT.EQ.'OFF')GOTO8189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8112)
 8112 FORMAT(6X,'PARAMETERS,  SD(PARAMETERS), 1/SD(PAR), LOWER AND ',
     1'UPPER')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8113)
 8113 FORMAT(6X,'95% CONFIDENCE INTERVAL WRITTEN OUT TO FILE ',
     1'DPST1F.DAT')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8114)
 8114 FORMAT(6X,'ORDER IS:')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8115)
 8115 FORMAT(6X,'   1. AUTO_REGRESSIVE TERMS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8116)
 8116 FORMAT(6X,'   2. SEASONAL AUTO_REGRESSIVE TERMS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8117)
 8117 FORMAT(6X,'   3. MU (MEAN TERM)')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8118)
 8118 FORMAT(6X,'   4. MOVING AVERAGE TERMS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8119)
 8119 FORMAT(6X,'   5. SEASONAL MOVING AVERAGE TERMS')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,8122)
 8122 FORMAT(6X,'FOLLOWING WRITTEN OUT TO FILE DPST2F.DAT')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8123)
 8123 FORMAT(6X,'   1. ROW NUMBER')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8124)
 8124 FORMAT(6X,'   2. PREDICTED VALUES')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8125)
 8125 FORMAT(6X,'   3. STANDARD DEVIATION OF PREDICTED VALUES')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8126)
 8126 FORMAT(6X,'   4. RESIDUALS')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8127)
 8127 FORMAT(6X,'   5. STANDARDIZED RESIDUALS')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,8132)
 8132 FORMAT(6X,'RESULTS OF ITERATIONS WRITTEN OUT TO FILE DPST3F.DAT')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,8142)
 8142 FORMAT(6X,'PARAMETER VARIANCE-COVARIANCE MATRIX  WRITTEN OUT ',
     1'TO FILE DPST4F.DAT')
      CALL DPWRST('XXX','WRIT')
C
      WRITE(ICOUT,8152)
 8152 FORMAT(6X,'FORECAST, STANDARD DEVIATION OF FORECASTS, AND')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,8153)
 8153 FORMAT(6X,'95% CONFIDENCE INTERVAL FOR FORECAST ',
     1'WRITTEN TO FILE DPST5F.DAT')
      CALL DPWRST('XXX','WRIT')
C
 8189 CONTINUE
C
      GOTO8200
C
C               **************************************
C               **  STEP 92--                       **
C               **  CLOSE       THE STORAGE FILES.  **
C               **************************************
C
 8200 CONTINUE
C
      ISTEPN='82'
      IF(IBUGA3.EQ.'ON'.OR.ISUBRO.EQ.'ARM2')
     1CALL TRACE2(ISTEPN,ISUBN1,ISUBN2)
C
      IENDF1='OFF'
      IREWI1='ON'
      CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1,
     1IENDF1,IREWI1,ISUBN0,IERRF1,IBUGA3,ISUBRO,IERROR)
      IF(IERRF1.EQ.'YES')GOTO9000
C
      IENDF2='OFF'
      IREWI2='ON'
      CALL DPCLFI(IOUNI2,IFILE2,ISTAT2,IFORM2,IACCE2,IPROT2,ICURS2,
     1IENDF2,IREWI2,ISUBN0,IERRF2,IBUGA3,ISUBRO,IERROR)
      IF(IERRF2.EQ.'YES')GOTO9000
C
      IENDF3='OFF'
      IREWI3='ON'
      CALL DPCLFI(IOUNI3,IFILE3,ISTAT3,IFORM3,IACCE3,IPROT3,ICURS3,
     1IENDF3,IREWI3,ISUBN0,IERRF3,IBUGA3,ISUBRO,IERROR)
      IF(IERRF3.EQ.'YES')GOTO9000
C
      IENDF4='OFF'
      IREWI4='ON'
      CALL DPCLFI(IOUNI4,IFILE4,ISTAT4,IFORM4,IACCE4,IPROT4,ICURS4,
     1IENDF4,IREWI4,ISUBN0,IERRF4,IBUGA3,ISUBRO,IERROR)
      IF(IERRF4.EQ.'YES')GOTO9000
C
      IENDF5='OFF'
      IREWI5='ON'
      CALL DPCLFI(IOUNI5,IFILE5,ISTAT5,IFORM5,IACCE5,IPROT5,ICURS5,
     1IENDF5,IREWI5,ISUBN0,IERRF5,IBUGA3,ISUBRO,IERROR)
      IF(IERRF5.EQ.'YES')GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGA3.EQ.'OFF')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARM2--')
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9012)N,IBUGA3,IERROR
 9012 FORMAT('N,IBUGA3,IERROR = ',I8,2X,A4,2X,A4)
      CALL DPWRST('XXX','WRIT')
      WRITE(ICOUT,9015)N1
 9015 FORMAT('N1 = ',I8)
      CALL DPWRST('XXX','WRIT')
      DO9016I=1,N1
      WRITE(ICOUT,9017)I,Y1(I)
 9017 FORMAT('I,Y1(I) = ',I8,E15.7)
      CALL DPWRST('XXX','WRIT')
 9016 CONTINUE
      WRITE(ICOUT,9025)IORDAR,IDIFF,IORDMA
 9025 FORMAT('IORDAR,IDIFF,IORDMA = ',3I8)
      CALL DPWRST('XXX','WRIT')
 9026 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARPA(IHARG,IHARG2,IARGT,IARG,NUMARG,IDEFPA,
CCCCC AUGUST 1995.  ADD IHARG2 FOR DASH2, ETC
CCCCC SUBROUTINE DPARPA(IHARG,IARGT,IARG,NUMARG,IDEFPA,
     1MAXARR,IARRPA,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE PATTERN FOR AN ARROW.
C              THE PATTERN FOR ARROW I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE HOLLERITH
C              VECTOR IARRPA(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --NUMARG
C                     --IDEFPA
C                     --MAXARR
C     OUTPUT ARGUMENTS--IARRPA (A HOLLERITH VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              PATTERN FOR ARROW I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
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 IARGT
      CHARACTER*4 IDEFPA
      CHARACTER*4 IARRPA
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
CCCCC AUGUST 1995.  ADD FOLLOWING LINE
      DIMENSION IHARG2(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
C
      DIMENSION IARRPA(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'PATT')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'PATT')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      IHOLD=IDEFPA
      GOTO1130
C
 1125 CONTINUE
      IHOLD=IHARG(2)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(2).EQ.'5')IHOLD='DA5'
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXARR
      IARRPA(I)=IHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)IARRPA(I)
 1136 FORMAT('ALL ARROW PATTERNS HAVE JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPARPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE ARROW ... PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE ARROW IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      ARROW 3 PATTERN SOLID')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXARR)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPARPA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE ARROW ... PATTERN COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF ARROWS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXARR
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'ARROW.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      IHOLD=IDEFPA
      GOTO1180
C
 1175 CONTINUE
      IHOLD=IHARG(3)
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'2')IHOLD='DA2'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'3')IHOLD='DA3'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'4')IHOLD='DA4'
      IF(IHOLD.EQ.'DASH'.AND.IHARG2(3).EQ.'5')IHOLD='DA5'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IARRPA(I)=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,IARRPA(I)
 1186 FORMAT('THE PATTERN FOR ARROW ',I8,
     1' HAS JUST BEEN SET TO ',A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPARRO(IHARG,IARGT,ARG,NUMARG,
     1PXSTAR,PYSTAR,
     1PXEND,PYEND,
     1IARRPA,IARRCO,PARRTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG,
     1IGRASW,IDIASW,
     1PGRAXF,PGRAYF,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG,
     1NUMDEV,
     1IDMANU,IDMODE,IDMOD2,IDMOD3,
     1IDPOWE,IDCONT,IDCOLO,IDNVPP,IDNHPP,IDUNIT,
     1IDNVOF,IDNHOF,
CCCCC ADD FOLLOWING LINE MARCH 1997.
     1IDFONT,
CCCCC ADD FOLLOWING LINE JULY 1997.
     1UNITSW,
     1IBUGD2,IFOUND,IERROR)
C  AUGUST, 1987: USE PATTERN, THICKNESS, AND COLOR SETTINGS FROM
C  ARROW COMMON BLOCK RATHER THAN LINE COMMON BLOCK.  DID A
C  GLOBAL CHANGE FROM ILINPA, ILINCO, PLINTH  TO IARRPA, IARRCO, PARRTH
C
C     PURPOSE--DRAW ONE OR MORE ARROWS
C              (DEPENDING ON HOW MANY NUMBERS ARE PROVIDED).
C              THE COORDINATES ARE IN STANDARDIZED UNITS
C              OF 0 TO 100.
C     NOTE--THE INPUT COORDINATES DEFINE THE ENDS
C           OF THE LINE SEGMENTS.
C     NOTE-THE USUAL INPUT NUMBER OF COORDINATES IS 2
C          AND THEREFORE THE USUAL INPUT NUMBER OF NUMBERS IS 2*2 = 4.
C     NOTE--IF 2 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN LINE WILL GO
C           FROM THE LAST CURSOR POSITION
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE 2 NUMBERS.
C     NOTE--IF 4 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN ARROW WILL GO
C           FROM THE ABSOLUTE (X,Y) POSITION
C           AS DEFINED BY THE FIRST 2 NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE THIRD AND FOURTH NUMBERS.
C     NOTE--IF 6 NUMBERS ARE PROVIDED,
C           THEN THE DRAWN ARROW WILL GO
C           FROM THE (X,Y) POSITION
C           AS RESULTING FROM THE THIRD AND FOURTH NUMBERS
C           TO THE (X,Y) POINT
C           (EITHER ABSOLUTE OR RELATIVE)
C           AS DEFINED BY THE FIFTH AND SIXTH NUMBERS.
C     NOTE--AND SO FORTH FOR 8, 10, 12, ... NUMBERS.
C     INPUT  ARGUMENTS--IHARG
C                     --IARGT
C                     --ARG
C                     --NUMARG
C                     --PXSTAR
C                     --PYSTAR
C     OUTPUT ARGUMENTS--PXEND
C                     --PYEND
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MARCH     1982.
C     UPDATED         --MAY       1982.
C     UPDATED         --NOVEMBER  1982.
C     UPDATED         --JANUARY   1989.  CALL LIST FOR OFFSET VAR (ALAN)
C     UPDATED         --JANUARY   1989.  USE COMMON PARAMETERS (ALAN)
C     UPDATED         --MARCH     1997.  SUPPORT FOR DEVICE FONT (ALAN)
C     UPDATED         --JULY      1997.  SUPPORT FOR "DATA" UNITS (ALAN)
C
C-----NON-COMMON VARIABLES-----------------------------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
C
      CHARACTER*4 IARRPA
      CHARACTER*4 IARRCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IGRASW
      CHARACTER*4 IDIASW
C
      CHARACTER*4 IDMANU
      CHARACTER*4 IDMODE
      CHARACTER*4 IDMOD2
      CHARACTER*4 IDMOD3
      CHARACTER*4 IDPOWE
      CHARACTER*4 IDCONT
      CHARACTER*4 IDCOLO
CCCCC ADD FOLLOWING LINE MARCH 1997.
      CHARACTER*4 IDFONT
CCCCC ADD FOLLOWING LINE JULY 1997.
      CHARACTER*4 UNITSW
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
      CHARACTER*4 ISUBRO
C
      CHARACTER*4 IFIG
      CHARACTER*4 IBELSW
      CHARACTER*4 IERASW
      CHARACTER*4 IBACCO
      CHARACTER*4 ICOPSW
      CHARACTER*4 ITYPEO
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION ARG(*)
C
      DIMENSION IARRPA(*)
      DIMENSION IARRCO(*)
      DIMENSION PARRTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
      DIMENSION IDMANU(*)
      DIMENSION IDMODE(*)
      DIMENSION IDMOD2(*)
      DIMENSION IDMOD3(*)
      DIMENSION IDPOWE(*)
      DIMENSION IDCONT(*)
      DIMENSION IDCOLO(*)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      DIMENSION IDFONT(*)
      DIMENSION IDNVPP(*)
      DIMENSION IDNHPP(*)
      DIMENSION IDUNIT(*)
C
      DIMENSION IDNVOF(*)
      DIMENSION IDNHOF(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
      IERRG4=IERROR
CCCCC IBUGG4=IBUGD2
CCCCC ISUBG4=ISUBRO
C
      ILOCFN=0
      NUMNUM=0
C
      X1=0.0
      Y1=0.0
      X2=0.0
      Y2=0.0
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARRO')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPARRO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NUMARG
   53 FORMAT('NUMARG = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO55I=1,NUMARG
      WRITE(ICOUT,56)I,IHARG(I),IARGT(I),ARG(I)
   56 FORMAT('I,IHARG(I),IARGT(I),ARG(I) = ',I8,2X,A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
      WRITE(ICOUT,57)PXSTAR,PYSTAR
   57 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,58)PXEND,PYEND
   58 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IARRPA(1),IARRCO(1),PARRTH(1)
   61 FORMAT('IARRPA(1),IARRCO(1),PARRTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,76)IGRASW,IDIASW
   76 FORMAT('IGRASW,IDIASW = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,77)PGRAXF,PGRAYF,PDIAXC,PDIAYC
   77 FORMAT('PGRAXF,PGRAYF,PDIAXC,PDIAYC = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,78)PDIAHE,PDIAWI,PDIAVG,PDIAHG
   78 FORMAT('PDIAHE,PDIAWI,PDIAVG,PDIAHG = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,80)NUMDEV
   80 FORMAT('NUMDEV= ',I8)
      CALL DPWRST('XXX','BUG ')
      DO81I=1,NUMDEV
      WRITE(ICOUT,82)IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I)
   82 FORMAT('IDMANU(I),IDMODE(I),IDMOD2(I),IDMOD3(I) = ',
     1A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,83)IDPOWE(I),IDCONT(I),IDCOLO(I)
   83 FORMAT('IDPOWE(I),IDCONT(I),IDCOLO(I) = ',
     1A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,84)IDNVPP(I),IDNHPP(I),IDUNIT(I)
   84 FORMAT('IDNVPP(I),IDNHPP(I),IDUNIT(I) = ',
     1I8,I8,I8)
      CALL DPWRST('XXX','BUG ')
   81 CONTINUE
      WRITE(ICOUT,87)IFOUND
   87 FORMAT('IFOUND= ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,88)IBUGG4,ISUBG4,IERRG4
   88 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,89)IBUGD2,IERROR
   89 FORMAT('IBUGD2,IERROR= ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IFIG='ARRO'
      NUMPT=2
      NUMPT2=2*NUMPT
C
C               ********************************
C               **  STEP 0--                  **
C               **  STEP THROUGH EACH DEVICE  **
C               ********************************
C
      IF(NUMDEV.LE.0)GOTO9000
      DO8000IDEVIC=1,NUMDEV
C
      IF(IDPOWE(IDEVIC).EQ.'OFF')GOTO8000
C
      IMANUF=IDMANU(IDEVIC)
      IMODEL=IDMODE(IDEVIC)
      IMODE2=IDMOD2(IDEVIC)
      IMODE3=IDMOD3(IDEVIC)
      IGCONT=IDCONT(IDEVIC)
      IGCOLO=IDCOLO(IDEVIC)
CCCCC ADD FOLLOWING LINE MARCH 1997.
      IGFONT=IDFONT(IDEVIC)
      NUMVPP=IDNVPP(IDEVIC)
      NUMHPP=IDNHPP(IDEVIC)
      ANUMVP=NUMVPP
      ANUMHP=NUMHPP
C  AUGUST 1988.  ADD OFFSET VARIABLE
      IOFFSV=IDNVOF(IDEVIC)
      IOFFSH=IDNHOF(IDEVIC)
C
      IGUNIT=IDUNIT(IDEVIC)
C
C               ************************************
C               **  STEP 1--                      **
C               **  CARRY OUT OPENING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      CALL DPOPDE
C
      IBELSW='OFF'
      NUMRIN=0
      IERASW='OFF'
      IBACCO='JUNK'
C
      CALL DPOPPL(IGRASW,
     1IBELSW,NUMRIN,IERASW,
     1IBACCO)
C
C               *****************************************
C               **  STEP 2--                           **
C               **  SEARCH FOR COMMAND SPECIFICATIONS  **
C               *****************************************
C
      IF(NUMARG.GE.2.AND.
     1IARGT(1).EQ.'NUMB'.AND.IARGT(2).EQ.'NUMB')
     1GOTO1111
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'ABSO'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1112
      IF(NUMARG.GE.3.AND.IHARG(1).EQ.'RELA'.AND.
     1IARGT(2).EQ.'NUMB'.AND.IARGT(3).EQ.'NUMB')
     1GOTO1113
      GOTO1130
C
 1111 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=1
      GOTO1119
C
 1112 CONTINUE
      ITYPEO='ABSO'
      ILOCFN=2
      GOTO1119
C
 1113 CONTINUE
      ITYPEO='RELA'
      ILOCFN=2
      GOTO1119
 1119 CONTINUE
C
      IF(ILOCFN.GT.NUMARG)GOTO1129
      DO1120I=ILOCFN,NUMARG
      IF(IARGT(I).EQ.'NUMB')GOTO1120
      GOTO1129
 1120 CONTINUE
      IFOUND='YES'
      GOTO1149
 1129 CONTINUE
      GOTO1130
C
 1130 CONTINUE
      IERRG4='YES'
      WRITE(ICOUT,1131)
 1131 FORMAT('***** ERROR IN DPARRO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1132)
 1132 FORMAT('      ILLEGAL FORM FOR DRAW ',
     1'COMMAND.')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1134)
 1134 FORMAT('      TEST EXAMPLE TO DEMONSTRATE THE ',
     1'PROPER FORM--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1135)
 1135 FORMAT('      SUPPOSE IT IS DESIRED TO DRAW A LINE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1136)
 1136 FORMAT('      WITH ONE END AT THE POINT 20 20 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1137)
 1137 FORMAT('      AND WITH OPPOSITE END AT THE POINT 40 60')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('      THEN THE ALLOWABLE FORMS ARE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      DRAW 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      DRAW ABSOLUTE 20 20 40 60 ')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
 1149 CONTINUE
C
C               ****************************
C               **  STEP 3--              **
C               **  DRAW OUT THE FIGURE   **
C               ****************************
C
      NUMNUM=NUMARG-ILOCFN+1
      IF(NUMNUM.LT.NUMPT2)GOTO1151
      GOTO1152
C
 1151 CONTINUE
      J=ILOCFN-1
      X1=PXSTAR
      Y1=PYSTAR
      GOTO1159
C
 1152 CONTINUE
      J=ILOCFN
      IF(J.GT.NUMARG)GOTO1190
      X1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X1,X1,IBUGD2,ISUBRO,IERROR)
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y1=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y1,Y1,IBUGD2,ISUBRO,IERROR)
      GOTO1159
 1159 CONTINUE
C
 1160 CONTINUE
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      X2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('X',X2,X2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')X2=X1+X2
      J=J+1
      IF(J.GT.NUMARG)GOTO1190
      Y2=ARG(J)
CCCCC THE FOLLOWING LINE WAS ADDED JULY 1997
      IF(UNITSW.EQ.'DATA')CALL DPCODS('Y',Y2,Y2,IBUGD2,ISUBRO,IERROR)
      IF(ITYPEO.EQ.'RELA')Y2=Y1+Y2
C
 1170 CONTINUE
      CALL DPARR2(X1,Y1,X2,Y2,
     1IFIG,
     1IARRPA,IARRCO,PARRTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
      X1=X2
      Y1=Y2
C
      GOTO1160
 1190 CONTINUE
C
      PXEND=X2
      PYEND=Y2
C
C               ************************************
C               **  STEP 4--                      **
C               **  CARRY OUT CLOSING OPERATIONS  **
C               **  ON THE GRAPHICS DEVICES       **
C               ************************************
C
      ICOPSW='OFF'
      NUMCOP=0
      CALL DPCLPL(ICOPSW,NUMCOP,
     1PGRAXF,PGRAYF,
     1IGRASW,PDIAXC,PDIAYC,PDIAX2,PDIAY2,
     1PDIAHE,PDIAWI,PDIAVG,PDIAHG)
C
      CALL DPCLDE
C
 8000 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARRO')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARRO--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)ILOCFN,NUMNUM
 9012 FORMAT('ILOCFN,NUMNUM = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)X1,Y1,X2,Y2
 9013 FORMAT('X1,Y1,X2,Y2 = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PXSTAR,PYSTAR
 9015 FORMAT('PXSTAR,PYSTAR = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PXEND,PYEND
 9016 FORMAT('PXEND,PYEND = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)IFIG
 9017 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)IFOUND
 9027 FORMAT('IFOUND = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)IBUGG4,ISUBG4,IERRG4
 9028 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGD2,IERROR
 9029 FORMAT('IBUGD2,IERROR = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARR2(X1,Y1,X2,Y2,
     1IFIG,
     1IARRPA,IARRCO,PARRTH,
     1AREGBA,
     1IREBLI,IREBCO,PREBTH,
     1IREFSW,IREFCO,
     1IREPTY,IREPLI,IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C  AUGUST, 1987: GLOBAL CHANGE OF ILINPA, ILINCO, PLINTH TO
C  IARRPA, IARRCO, PARRTH
C
C     PURPOSE--DRAW AN ARROW
C              WITH THE BACK OF THE ARROW AT (X1,Y1)
C              AND THE TIP AT (X2,Y2).
C     NOTE--THE ARROW HEAD WILL HAVE A STEM LENGTH OF PTEXWI
C           AND WILL HAVE A BASE WIDTH OF PTEXHE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C     UPDATED         --JANUARY   1989.  MODIFY CALLS TO DPDRPL (ALAN)
C     UPDATED         --JANUARY   1989.  MODIFY CALL  TO DPFIRE (ALAN)
C     UPDATED         --JANUARY   1989.  USE COMMON PARAMETERS (ALAN)
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
C
      CHARACTER*4 IARRPA
      CHARACTER*4 IARRCO
C
      CHARACTER*4 IREBLI
      CHARACTER*4 IREBCO
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPTY
      CHARACTER*4 IREPLI
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(1000)
      DIMENSION PY(1000)
CCCCC FEBRUARY 1994.  ADD FOLLOWING SECTION
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOZ2.INC'
      EQUIVALENCE (G2RBAG(IGAR11),PX(1))
      EQUIVALENCE (G2RBAG(IGAR12),PY(1))
CCCCC END CHANGE
CCCCC DIMENSION PX3(1000)
CCCCC DIMENSION PY3(1000)
C
      DIMENSION IARRPA(*)
      DIMENSION IARRCO(*)
      DIMENSION PARRTH(*)
C
      DIMENSION AREGBA(*)
      DIMENSION IREBLI(*)
      DIMENSION IREBCO(*)
      DIMENSION PREBTH(*)
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPTY(*)
      DIMENSION IREPLI(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARR2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPARR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IARRPA(1),IARRCO(1),PARRTH(1)
   61 FORMAT('IARRPA(1),IARRCO(1),PARRTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)AREGBA(1)
   62 FORMAT('AREGBA(1) = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IREBLI(1),IREBCO(1),PREBTH(1)
   63 FORMAT('IREBLI(1),IREBCO(1),PREBTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPTY(1),IREPLI(1),IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2X,A4,2X,A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE ARROW              **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      LEN=SQRT((X2-X1)**2+(Y2-Y1)**2)
      ALEN=LEN
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      XDEL=PTEXWI
      YDEL=PTEXHE
C
      K=0
C
      X=0
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN-XDEL
      Y=-YDEL
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN-XDEL
      Y=YDEL
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN
      Y=0
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT=IREPTY(1)
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      CALL DPFIRE(PX,PY,NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
      IPATT=IARRPA(1)
      PTHICK=PARRTH(1)
      ICOL=IARRCO(1)
      IFLAG='ON'
CCCCC CALL DPDRPL(PX,PY,NP,PX3,PY3,NP3,
CCCCC1IFIG,IPATT,PTHICK,ICOL)
C
      CALL DPDRPL(PX,PY,NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARR2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARR2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NP
 9013 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARR3(X1,Y1,X2,Y2,
     1IFIG,
     1ITRCSW,
     1IARRPA,IARRCO,PARRTH,
     1IREFSW,IREFCO,
     1IREPCO,PREPTH,PREPSP,
     1PTEXHE,PTEXWI,PTEXVG,PTEXHG)
C
C  THIS IS A SLIGHTLY MODIFIED VERSION OF DPARR2.  THIS VERSION IS
C  CALLED FOR THE ARROW ... COORDINATES CASE AND THE CHARACTER ARROW
C  CASE.  MAKE A SEPARATE ROUTINE FOR EASIER SEGMENTATION.  ALSO
C  DELETE UNUSED PARAMETERS.
C
C  AUGUST, 1987: GLOBAL CHANGE OF ILINPA, ILINCO, PLINTH TO
C  IARRPA, IARRCO, PARRTH
C
C     PURPOSE--DRAW AN ARROW
C              WITH THE BACK OF THE ARROW AT (X1,Y1)
C              AND THE TIP AT (X2,Y2).
C     NOTE--THE ARROW HEAD WILL HAVE A STEM LENGTH OF PTEXWI
C           AND WILL HAVE A BASE WIDTH OF PTEXHE.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--82/7
C     ORIGINAL VERSION--APRIL     1981.
C     UPDATED         --MAY       1982.
C
C-----NON-COMMON VARIABLES-------------------------------------
C
      CHARACTER*4 IFIG
      CHARACTER*4 IPATT2
      CHARACTER*4 ITRCSW
C
      CHARACTER*4 IARRPA
      CHARACTER*4 IARRCO
C
      CHARACTER*4 IREFSW
      CHARACTER*4 IREFCO
      CHARACTER*4 IREPCO
C
      CHARACTER*4 IPATT
      CHARACTER*4 ICOLF
      CHARACTER*4 ICOLP
      CHARACTER*4 ICOL
      CHARACTER*4 IFLAG
C
      DIMENSION PX(10)
      DIMENSION PY(10)
C
      DIMENSION IARRPA(*)
      DIMENSION IARRCO(*)
      DIMENSION PARRTH(*)
C
      DIMENSION IREFSW(*)
      DIMENSION IREFCO(*)
      DIMENSION IREPCO(*)
      DIMENSION PREPTH(*)
      DIMENSION PREPSP(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOSU.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.'ARR3')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF DPARR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)X1,Y1
   53 FORMAT('X1,Y1 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)X2,Y2
   54 FORMAT('X2,Y2 = ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IFIG
   59 FORMAT('IFIG = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)IARRPA(1),IARRCO(1),PARRTH(1)
   61 FORMAT('IARRPA(1),IARRCO(1),PARRTH(1) = ',A4,2X,A4,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)IREFSW(1),IREFCO(1)
   64 FORMAT('IREFSW(1),IREFCO(1) = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IREPCO(1),PREPTH(1),PREPSP(1)
   65 FORMAT('IREPCO(1),PREPTH(1),PREPSP(1) = ',
     1A4,2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PTEXHE,PTEXWI
   69 FORMAT('PTEXHE,PTEXWI= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PTEXVG,PTEXHG
   70 FORMAT('PTEXVG,PTEXHG= ',2E15.6)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *********************************
C               **  STEP 1--                   **
C               **  DETERMINE THE COORDINATES  **
C               **  FOR THE ARROW              **
C               *********************************
C
      DELX=X2-X1
      DELY=Y2-Y1
      LEN=SQRT((X2-X1)**2+(Y2-Y1)**2)
      ALEN=LEN
      IF(ABS(DELX).GE.0.00001)THETA=ATAN(DELY/DELX)
      IF(ABS(DELX).LT.0.00001.AND.DELY.GE.0.0)THETA=3.1415926/2.0
      IF(ABS(DELX).LT.0.00001.AND.DELY.LT.0.0)THETA=-3.1415926/2.0
C
      XDEL=PTEXWI
      YDEL=PTEXHE
C
      K=0
C
      X=0.
      Y=0.
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
C  NOTE: IN THIS CASE, WANT ARROW HEAD TO BE EXACTLY AT (PX2,PY2).
C  DRAWING AT ANGLE THROWS THIS OFF SOMEWHAT.  ADJUST ALL THE ARROW
C  HEAD POINTS SO THAT THE ARROW HEAD IS PLOTTED EXACTLY AT THE
C  POINT (LEAVE START POINT ALONE).
      X=ALEN
      Y=0.
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      PXINC=PX(K)-X2
      PYINC=PY(K)-Y2
C
      X=ALEN-XDEL
      Y=-YDEL
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN-XDEL
      Y=YDEL
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      X=ALEN
      Y=0.
      CALL TRANS(X,Y,X1,Y1,THETA,DELX,DELY,XP,YP,KXP,KYP)
      K=K+1
      PX(K)=XP
      PY(K)=YP
C
      NP=K
C
      DO200I=2,NP
      PX(I)=PX(I)-PXINC
      PY(I)=PY(I)-PYINC
 200  CONTINUE
C
C               ***********************
C               **  STEP 2--         **
C               **  FILL THE FIGURE  **
C               **  (IF CALLED FOR)  **
C               ***********************
C
      IF(IREFSW(1).EQ.'OFF')GOTO2190
      IPATT='SOLI'
      IPATT2='SOLI'
      PTHICK=PREPTH(1)
      PXGAP=PREPSP(1)
      PYGAP=PREPSP(1)
      ICOLF=IREFCO(1)
      ICOLP=IREPCO(1)
      NP=4
      CALL DPFIRE(PX(2),PY(2),NP,
     1IFIG,IPATT,PTHICK,PXGAP,PYGAP,ICOLF,ICOLP,IPATT2)
 2190 CONTINUE
C
C               ***************************
C               **  STEP 3--             **
C               **  DRAW OUT THE FIGURE  **
C               ***************************
C
C  2 FACTORS CONTROL APPEARANCE OF VECTOR:
C
C  ITRCSW CONTROLS WHETHER JUST THE ARROW HEAD OR THE ARROW HEAD
C         AND THE VECTOR ARE DRAWN
C  IVCOPN CONTROLS WHETHER THE BASE OF THE ARROW HEAD IS DRAWN OR NOT
C
      IPATT=IARRPA(1)
      PTHICK=PARRTH(1)
      ICOL=IARRCO(1)
      IFLAG='ON'
C
C  DRAW AS CLOSED ARROW (I.E., DRAW THE BASE OF THE TRIANGLE)
      IF(IVCOPN.EQ.'OPEN')GOTO2000
      NP=5
      INDX=1
      IF(ITRCSW.EQ.'OFF')THEN
        NP=4
        INDX=2
      ENDIF
      CALL DPDRPL(PX(INDX),PY(INDX),NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      GOTO9000
C
C  DRAW AS OPEN ARROW (I.E., LEAVE OFF THE BASE OF THE TRIANGLE)
C
 2000 CONTINUE
      NP=3
      INDX=1
      IF(ITRCSW.EQ.'OFF')THEN
        NP=2
        INDX=2
      ENDIF
      CALL DPDRPL(PX(INDX),PY(INDX),NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      NP=2
      INDX=4
      CALL DPDRPL(PX(INDX),PY(INDX),NP,
     1IFIG,IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,IFLAG)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'ARR3')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF DPARR3--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NP
 9013 FORMAT('NP = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NP
      WRITE(ICOUT,9016)I,PX(I),PY(I)
 9016 FORMAT('I,PX(I),PY(I) = ',I8,2E15.7)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE DPARTH(IHARG,IARGT,IARG,ARG,NUMARG,PDEFTH,
     1MAXARR,PARRTH,IFOUND,IERROR)
C
C     PURPOSE--DEFINE THE THICKNESS FOR AN ARROW.
C              THE THICKNESS FOR ARROW I WILL BE PLACED
C              IN THE I-TH ELEMENT OF THE REAL
C              VECTOR PARRTH(.).
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --IARGT  (A HOLLERITH VECTOR)
C                     --IARG   (A HOLLERITH VECTOR)
C                     --ARG    (A REAL VECTOR)
C                     --NUMARG
C                     --PDEFTH
C                     --MAXARR
C     OUTPUT ARGUMENTS--PARRTH (A REAL VECTOR
C                              WHOSE I-TH ELEMENT CONTAINS THE
C                              THICKNESS FOR ARROW I.
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--ALAN HECKERT
C                 COMPUTER SERVICES 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--82/7
C     ORIGINAL VERSION--SEPTEMBER 1980.
C     UPDATED         --MAY       1982.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IARGT
      REAL        PDEFTH
      REAL        PARRTH
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      REAL        PHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
      DIMENSION IARGT(*)
      DIMENSION IARG(*)
      DIMENSION ARG(*)
C
      DIMENSION PARRTH(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
      IF(NUMARG.EQ.0)GOTO9000
      IF(NUMARG.GE.1.AND.IHARG(1).EQ.'THIC')GOTO1110
      IF(NUMARG.GE.2.AND.IHARG(2).EQ.'THIC')GOTO1140
      GOTO9000
C
 1110 CONTINUE
      IF(NUMARG.LE.1)GOTO1120
      IF(IHARG(2).EQ.'ON')GOTO1120
      IF(IHARG(2).EQ.'OFF')GOTO1120
      IF(IHARG(2).EQ.'AUTO')GOTO1120
      IF(IHARG(2).EQ.'DEFA')GOTO1120
      GOTO1125
C
 1120 CONTINUE
      PHOLD=PDEFTH
      GOTO1130
C
 1125 CONTINUE
      PHOLD=ARG(2)
      GOTO1130
C
 1130 CONTINUE
      IFOUND='YES'
      DO1135I=1,MAXARR
      PARRTH(I)=PHOLD
 1135 CONTINUE
C
      IF(IFEEDB.EQ.'OFF')GOTO1139
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      I=1
      WRITE(ICOUT,1136)PARRTH(I)
 1136 FORMAT('ALL ARROW THICKNESSS HAVE JUST BEEN SET TO ',
     1E15.7)
      CALL DPWRST('XXX','BUG ')
 1139 CONTINUE
      GOTO9000
C
 1140 CONTINUE
      IF(IARGT(1).EQ.'NUMB')GOTO1150
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1141)
 1141 FORMAT('***** ERROR IN DPARTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1142)
 1142 FORMAT('      IN THE ARROW ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1143)
 1143 FORMAT('      THE ARROW IS IDENTIFIED BY A NUMBER, AS IN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1144)
 1144 FORMAT('      ARROW 3 THICKNESS 0.3')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1150 CONTINUE
      I=IARG(1)
      IF(1.LE.I.AND.I.LE.MAXARR)GOTO1160
      IERROR='YES'
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1151)
 1151 FORMAT('***** ERROR IN DPARTH--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1152)
 1152 FORMAT('      IN THE ARROW ... THICKNESS COMMAND,')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1153)
 1153 FORMAT('      THE NUMBER OF ARROWS MUST BE ')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1154)MAXARR
 1154 FORMAT('      BETWEEN 1 AND ',I8,' (INCLUSIVELY);')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1155)
 1155 FORMAT('      SUCH WAS NOT THE CASE HERE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1156)I
 1156 FORMAT('      A REFERENCE WAS MADE TO THE ',I8,'-TH ',
     1'ARROW.')
      CALL DPWRST('XXX','BUG ')
      GOTO9000
C
 1160 CONTINUE
      IF(NUMARG.LE.2)GOTO1170
      IF(IHARG(3).EQ.'ON')GOTO1170
      IF(IHARG(3).EQ.'OFF')GOTO1170
      IF(IHARG(3).EQ.'AUTO')GOTO1170
      IF(IHARG(3).EQ.'DEFA')GOTO1170
      GOTO1175
C
 1170 CONTINUE
      PHOLD=PDEFTH
      GOTO1180
C
 1175 CONTINUE
      PHOLD=ARG(3)
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      PARRTH(I)=PHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1186)I,PARRTH(I)
 1186 FORMAT('THE THICKNESS FOR ARROW ',I8,
     1' HAS JUST BEEN SET TO ',E15.7)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO9000
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE DPAUPL(IHARG,NUMARG,
     1IAUTSW,IAUTEX,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE AUTOPLOT SWITCH WHICH IN TURN
C              DETERMINES WHETHER SAVED PLOT COMMANDS
C              SHOULD BE AUTOMATICALLY RE-EXECUTED AFTER
C              EVERY SUCCEEDING NON-PLOT COMMAND.
C              THIS CAPABILITY IS USEFUL IF ONE WISHES TO BUILD-UP
C              AN ANNOTATED PLOT BY ITERATIVELY ENTERING SUCCESSIVE
C              PLOT CONTROL COMMANDS.
C              AFTER EACH SUCH PLOT CONTROL COMMAND
C              IS ENTERED, THE SAVED PLOT STATEMENTS
C              WILL BE REECECUTED WITHOUT NEEDING
C              TO ENTER AN EXPLICIT PLOT OR REPLOT COMMAND.
C              THE SPECIFIED AUTOPLOT SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IAUTSW.
C     NOTE--IAUTEX (AN EXECUTION SWITCH) WILL ALWAYS
C           BE SET TO 'OFF' IN THIS SUBROUTINE.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IAUTSW (A HOLLERITH VARIABLE)
C                     --IAUTEX (A HOLLARITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86/7
C     ORIGINAL VERSION--MAY       1986.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IAUTSW
      CHARACTER*4 IAUTEX
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1150
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1199
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IAUTSW=IHOLD
      IAUTEX='OFF'
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IAUTSW
 1181 FORMAT('THE AUTOPLOT SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
      SUBROUTINE DPAUTX(IHARG,NUMARG,
     1IATXSW,IFOUND,IERROR)
C
C     PURPOSE--SPECIFY THE AUTO TEXT SWITCH WHICH IN TURN
C              DETERMINES WHETHER ENTERED COMMANDS WILL BE
C              PREPENDED WITH A "TEXT" STATEMENT.
C              THIS CAPABILITY IS USEFUL FOR MAKING WORD SLIDES
C              OF LONG BLOCKS OF TEXT.
C              THE SPECIFIED AUTO TEXT SWITCH SPECIFICATION
C              WILL BE PLACED IN THE HOLLERITH VARIABLE IATXSW.
C     INPUT  ARGUMENTS--IHARG  (A  HOLLERITH VECTOR)
C                     --NUMARG (AN INTEGER VARIABLE)
C     OUTPUT ARGUMENTS--IATXSW  (A HOLLERITH VARIABLE)
C                     --IFOUND ('YES' OR 'NO' )
C                     --IERROR ('YES' OR 'NO' )
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-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--2002/8
C     ORIGINAL VERSION--AUGUST    2002.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
      CHARACTER*4 IHARG
      CHARACTER*4 IATXSW
      CHARACTER*4 IFOUND
      CHARACTER*4 IERROR
C
      CHARACTER*4 IHOLD
C
C---------------------------------------------------------------------
C
      DIMENSION IHARG(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IFOUND='NO'
      IERROR='NO'
C
 1110 CONTINUE
      IF(NUMARG.LE.0)GOTO1150
      IF(IHARG(NUMARG).EQ.'ON')GOTO1150
      IF(IHARG(NUMARG).EQ.'OFF')GOTO1160
      IF(IHARG(NUMARG).EQ.'AUTO')GOTO1160
      IF(IHARG(NUMARG).EQ.'DEFA')GOTO1160
      GOTO1150
C
 1150 CONTINUE
      IHOLD='ON'
      GOTO1180
C
 1160 CONTINUE
      IHOLD='OFF'
      GOTO1180
C
 1180 CONTINUE
      IFOUND='YES'
      IATXSW=IHOLD
C
      IF(IFEEDB.EQ.'OFF')GOTO1189
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1181)IATXSW
 1181 FORMAT('THE AUTO TEXT SWITCH HAS JUST BEEN SET TO ',
     1A4)
      CALL DPWRST('XXX','BUG ')
 1189 CONTINUE
      GOTO1199
C
 1199 CONTINUE
      RETURN
      END
